summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore1
-rw-r--r--Data/Conduit/Lift.hs526
-rw-r--r--Presence/ConsoleWriter.hs2
-rw-r--r--Presence/Nesting.hs12
-rw-r--r--Presence/XMPPServer.hs11
-rw-r--r--Setup.lhs2
-rw-r--r--presence.cabal10
-rw-r--r--stack.yaml35
8 files changed, 58 insertions, 541 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 00000000..6fabf46f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
/.stack-work/
diff --git a/Data/Conduit/Lift.hs b/Data/Conduit/Lift.hs
deleted file mode 100644
index 341fce53..00000000
--- a/Data/Conduit/Lift.hs
+++ /dev/null
@@ -1,526 +0,0 @@
1
2
3{-# LANGUAGE RankNTypes #-}
4-- | Allow monad transformers to be run/eval/exec in a section of conduit
5-- rather then needing to run across the whole conduit. The circumvents many
6-- of the problems with breaking the monad transformer laws. For more
7-- information, see the announcement blog post:
8-- <http://www.yesodweb.com/blog/2014/01/conduit-transformer-exception>
9--
10-- This module was added in conduit 1.0.11.
11module Data.Conduit.Lift (
12 -- * ErrorT
13 errorC,
14 runErrorC,
15 catchErrorC,
16-- liftCatchError,
17
18 -- * MaybeT
19 maybeC,
20 runMaybeC,
21
22 -- * ReaderT
23 readerC,
24 runReaderC,
25
26 -- * StateT
27 stateC,
28 runStateC,
29 evalStateC,
30 execStateC,
31
32 -- ** Strict
33 stateSC,
34 runStateSC,
35 evalStateSC,
36 execStateSC,
37
38 -- * WriterT
39 writerC,
40 runWriterC,
41 execWriterC,
42
43 -- ** Strict
44 writerSC,
45 runWriterSC,
46 execWriterSC,
47
48 -- * RWST
49 rwsC,
50 runRWSC,
51 evalRWSC,
52 execRWSC,
53
54 -- ** Strict
55 rwsSC,
56 runRWSSC,
57 evalRWSSC,
58 execRWSSC,
59
60 -- * Utilities
61
62 distribute
63 ) where
64
65import Data.Conduit
66import Data.Conduit.Internal (ConduitM (..), Pipe (..))
67
68import Control.Monad.Morph (hoist, lift, MFunctor(..), )
69import Control.Monad.Trans.Class (MonadTrans(..))
70
71import Data.Monoid (Monoid(..))
72
73
74import qualified Control.Monad.Trans.Error as E
75import qualified Control.Monad.Trans.Maybe as M
76import qualified Control.Monad.Trans.Reader as R
77
78import qualified Control.Monad.Trans.State.Strict as SS
79import qualified Control.Monad.Trans.Writer.Strict as WS
80import qualified Control.Monad.Trans.RWS.Strict as RWSS
81
82import qualified Control.Monad.Trans.State.Lazy as SL
83import qualified Control.Monad.Trans.Writer.Lazy as WL
84import qualified Control.Monad.Trans.RWS.Lazy as RWSL
85
86
87catAwaitLifted
88 :: (Monad (t (ConduitM o1 o m)), Monad m, MonadTrans t) =>
89 ConduitM i o1 (t (ConduitM o1 o m)) ()
90catAwaitLifted = go
91 where
92 go = do
93 x <- lift . lift $ await
94 case x of
95 Nothing -> return ()
96 Just x2 -> do
97 yield x2
98 go
99
100catYieldLifted
101 :: (Monad (t (ConduitM i o1 m)), Monad m, MonadTrans t) =>
102 ConduitM o1 o (t (ConduitM i o1 m)) ()
103catYieldLifted = go
104 where
105 go = do
106 x <- await
107 case x of
108 Nothing -> return ()
109 Just x2 -> do
110 lift . lift $ yield x2
111 go
112
113
114distribute
115 :: (Monad (t (ConduitM b o m)), Monad m, Monad (t m), MonadTrans t,
116 MFunctor t) =>
117 ConduitM b o (t m) () -> t (ConduitM b o m) ()
118distribute p = catAwaitLifted =$= hoist (hoist lift) p $$ catYieldLifted
119
120-- | Run 'E.ErrorT' in the base monad
121--
122-- Since 1.0.11
123errorC
124 :: (Monad m, Monad (t (E.ErrorT e m)), MonadTrans t, E.Error e,
125 MFunctor t) =>
126 t m (Either e b) -> t (E.ErrorT e m) b
127errorC p = do
128 x <- hoist lift p
129 lift $ E.ErrorT (return x)
130
131-- | Run 'E.ErrorT' in the base monad
132--
133-- Since 1.0.11
134runErrorC
135 :: (Monad m, E.Error e) =>
136 ConduitM i o (E.ErrorT e m) r -> ConduitM i o m (Either e r)
137runErrorC =
138 ConduitM . go . unConduitM
139 where
140 go (Done r) = Done (Right r)
141 go (PipeM mp) = PipeM $ do
142 eres <- E.runErrorT mp
143 return $ case eres of
144 Left e -> Done $ Left e
145 Right p -> go p
146 go (Leftover p i) = Leftover (go p) i
147 go (HaveOutput p f o) = HaveOutput (go p) (E.runErrorT f >> return ()) o
148 go (NeedInput x y) = NeedInput (go . x) (go . y)
149{-# INLINABLE runErrorC #-}
150
151-- | Catch an error in the base monad
152--
153-- Since 1.0.11
154catchErrorC
155 :: (Monad m, E.Error e) =>
156 ConduitM i o (E.ErrorT e m) r
157 -> (e -> ConduitM i o (E.ErrorT e m) r)
158 -> ConduitM i o (E.ErrorT e m) r
159catchErrorC c0 h =
160 ConduitM $ go $ unConduitM c0
161 where
162 go (Done r) = Done r
163 go (PipeM mp) = PipeM $ do
164 eres <- lift $ E.runErrorT mp
165 return $ case eres of
166 Left e -> unConduitM $ h e
167 Right p -> go p
168 go (Leftover p i) = Leftover (go p) i
169 go (HaveOutput p f o) = HaveOutput (go p) f o
170 go (NeedInput x y) = NeedInput (go . x) (go . y)
171{-# INLINABLE catchErrorC #-}
172
173-- | Wrap the base monad in 'M.MaybeT'
174--
175-- Since 1.0.11
176maybeC
177 :: (Monad m, Monad (t (M.MaybeT m)),
178 MonadTrans t,
179 MFunctor t) =>
180 t m (Maybe b) -> t (M.MaybeT m) b
181maybeC p = do
182 x <- hoist lift p
183 lift $ M.MaybeT (return x)
184{-# INLINABLE maybeC #-}
185
186-- | Run 'M.MaybeT' in the base monad
187--
188-- Since 1.0.11
189runMaybeC
190 :: Monad m =>
191 ConduitM i o (M.MaybeT m) r -> ConduitM i o m (Maybe r)
192runMaybeC =
193 ConduitM . go . unConduitM
194 where
195 go (Done r) = Done (Just r)
196 go (PipeM mp) = PipeM $ do
197 mres <- M.runMaybeT mp
198 return $ case mres of
199 Nothing -> Done Nothing
200 Just p -> go p
201 go (Leftover p i) = Leftover (go p) i
202 go (HaveOutput p c o) = HaveOutput (go p) (M.runMaybeT c >> return ()) o
203 go (NeedInput x y) = NeedInput (go . x) (go . y)
204{-# INLINABLE runMaybeC #-}
205
206-- | Wrap the base monad in 'R.ReaderT'
207--
208-- Since 1.0.11
209readerC
210 :: (Monad m, Monad (t1 (R.ReaderT t m)),
211 MonadTrans t1,
212 MFunctor t1) =>
213 (t -> t1 m b) -> t1 (R.ReaderT t m) b
214readerC k = do
215 i <- lift R.ask
216 hoist lift (k i)
217{-# INLINABLE readerC #-}
218
219-- | Run 'R.ReaderT' in the base monad
220--
221-- Since 1.0.11
222runReaderC
223 :: Monad m =>
224 r -> ConduitM i o (R.ReaderT r m) res -> ConduitM i o m res
225runReaderC r = hoist (`R.runReaderT` r)
226{-# INLINABLE runReaderC #-}
227
228
229-- | Wrap the base monad in 'SL.StateT'
230--
231-- Since 1.0.11
232stateC
233 :: (Monad m, Monad (t1 (SL.StateT t m)),
234 MonadTrans t1,
235 MFunctor t1) =>
236 (t -> t1 m (b, t)) -> t1 (SL.StateT t m) b
237stateC k = do
238 s <- lift SL.get
239 (r, s') <- hoist lift (k s)
240 lift (SL.put s')
241 return r
242{-# INLINABLE stateC #-}
243
244thread :: Monad m
245 => (r -> s -> res)
246 -> (forall a. t m a -> s -> m (a, s))
247 -> s
248 -> ConduitM i o (t m) r
249 -> ConduitM i o m res
250thread toRes runM s0 =
251 ConduitM . go s0 . unConduitM
252 where
253 go s (Done r) = Done (toRes r s)
254 go s (PipeM mp) = PipeM $ do
255 (p, s') <- runM mp s
256 return $ go s' p
257 go s (Leftover p i) = Leftover (go s p) i
258 go s (NeedInput x y) = NeedInput (go s . x) (go s . y)
259 go s (HaveOutput p f o) = HaveOutput (go s p) (runM f s >> return ()) o
260{-# INLINABLE thread #-}
261
262-- | Run 'SL.StateT' in the base monad
263--
264-- Since 1.0.11
265runStateC
266 :: Monad m =>
267 s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m (r, s)
268runStateC = thread (,) SL.runStateT
269{-# INLINABLE runStateC #-}
270
271-- | Evaluate 'SL.StateT' in the base monad
272--
273-- Since 1.0.11
274evalStateC
275 :: Monad m =>
276 s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m r
277evalStateC s p = fmap fst $ runStateC s p
278{-# INLINABLE evalStateC #-}
279
280-- | Execute 'SL.StateT' in the base monad
281--
282-- Since 1.0.11
283execStateC
284 :: Monad m =>
285 s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m s
286execStateC s p = fmap snd $ runStateC s p
287{-# INLINABLE execStateC #-}
288
289
290-- | Wrap the base monad in 'SS.StateT'
291--
292-- Since 1.0.11
293stateSC
294 :: (Monad m, Monad (t1 (SS.StateT t m)),
295 MonadTrans t1,
296 MFunctor t1) =>
297 (t -> t1 m (b, t)) -> t1 (SS.StateT t m) b
298stateSC k = do
299 s <- lift SS.get
300 (r, s') <- hoist lift (k s)
301 lift (SS.put s')
302 return r
303{-# INLINABLE stateSC #-}
304
305-- | Run 'SS.StateT' in the base monad
306--
307-- Since 1.0.11
308runStateSC
309 :: Monad m =>
310 s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m (r, s)
311runStateSC = thread (,) SS.runStateT
312{-# INLINABLE runStateSC #-}
313
314-- | Evaluate 'SS.StateT' in the base monad
315--
316-- Since 1.0.11
317evalStateSC
318 :: Monad m =>
319 s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m r
320evalStateSC s p = fmap fst $ runStateSC s p
321{-# INLINABLE evalStateSC #-}
322
323-- | Execute 'SS.StateT' in the base monad
324--
325-- Since 1.0.11
326execStateSC
327 :: Monad m =>
328 s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m s
329execStateSC s p = fmap snd $ runStateSC s p
330{-# INLINABLE execStateSC #-}
331
332
333-- | Wrap the base monad in 'WL.WriterT'
334--
335-- Since 1.0.11
336writerC
337 :: (Monad m, Monad (t (WL.WriterT w m)), MonadTrans t, Monoid w,
338 MFunctor t) =>
339 t m (b, w) -> t (WL.WriterT w m) b
340writerC p = do
341 (r, w) <- hoist lift p
342 lift $ WL.tell w
343 return r
344{-# INLINABLE writerC #-}
345
346-- | Run 'WL.WriterT' in the base monad
347--
348-- Since 1.0.11
349runWriterC
350 :: (Monad m, Monoid w) =>
351 ConduitM i o (WL.WriterT w m) r -> ConduitM i o m (r, w)
352runWriterC = thread (,) run mempty
353 where
354 run m w = do
355 (a, w') <- WL.runWriterT m
356 return (a, w `mappend` w')
357{-# INLINABLE runWriterC #-}
358
359-- | Execute 'WL.WriterT' in the base monad
360--
361-- Since 1.0.11
362execWriterC
363 :: (Monad m, Monoid w) =>
364 ConduitM i o (WL.WriterT w m) r -> ConduitM i o m w
365execWriterC p = fmap snd $ runWriterC p
366{-# INLINABLE execWriterC #-}
367
368
369-- | Wrap the base monad in 'WS.WriterT'
370--
371-- Since 1.0.11
372writerSC
373 :: (Monad m, Monad (t (WS.WriterT w m)), MonadTrans t, Monoid w,
374 MFunctor t) =>
375 t m (b, w) -> t (WS.WriterT w m) b
376writerSC p = do
377 (r, w) <- hoist lift p
378 lift $ WS.tell w
379 return r
380{-# INLINABLE writerSC #-}
381
382-- | Run 'WS.WriterT' in the base monad
383--
384-- Since 1.0.11
385runWriterSC
386 :: (Monad m, Monoid w) =>
387 ConduitM i o (WS.WriterT w m) r -> ConduitM i o m (r, w)
388runWriterSC = thread (,) run mempty
389 where
390 run m w = do
391 (a, w') <- WS.runWriterT m
392 return (a, w `mappend` w')
393{-# INLINABLE runWriterSC #-}
394
395-- | Execute 'WS.WriterT' in the base monad
396--
397-- Since 1.0.11
398execWriterSC
399 :: (Monad m, Monoid w) =>
400 ConduitM i o (WS.WriterT w m) r -> ConduitM i o m w
401execWriterSC p = fmap snd $ runWriterSC p
402{-# INLINABLE execWriterSC #-}
403
404
405-- | Wrap the base monad in 'RWSL.RWST'
406--
407-- Since 1.0.11
408rwsC
409 :: (Monad m, Monad (t1 (RWSL.RWST t w t2 m)), MonadTrans t1,
410 Monoid w, MFunctor t1) =>
411 (t -> t2 -> t1 m (b, t2, w)) -> t1 (RWSL.RWST t w t2 m) b
412rwsC k = do
413 i <- lift RWSL.ask
414 s <- lift RWSL.get
415 (r, s', w) <- hoist lift (k i s)
416 lift $ do
417 RWSL.put s'
418 RWSL.tell w
419 return r
420{-# INLINABLE rwsC #-}
421
422-- | Run 'RWSL.RWST' in the base monad
423--
424-- Since 1.0.11
425runRWSC
426 :: (Monad m, Monoid w) =>
427 r
428 -> s
429 -> ConduitM i o (RWSL.RWST r w s m) res
430 -> ConduitM i o m (res, s, w)
431runRWSC r s0 = thread toRes run (s0, mempty)
432 where
433 toRes a (s, w) = (a, s, w)
434 run m (s, w) = do
435 (res, s', w') <- RWSL.runRWST m r s
436 return (res, (s', w `mappend` w'))
437{-# INLINABLE runRWSC #-}
438
439-- | Evaluate 'RWSL.RWST' in the base monad
440--
441-- Since 1.0.11
442evalRWSC
443 :: (Monad m, Monoid w) =>
444 r
445 -> s
446 -> ConduitM i o (RWSL.RWST r w s m) res
447 -> ConduitM i o m (res, w)
448evalRWSC i s p = fmap f $ runRWSC i s p
449 where f x = let (r, _, w) = x in (r, w)
450{-# INLINABLE evalRWSC #-}
451
452-- | Execute 'RWSL.RWST' in the base monad
453--
454-- Since 1.0.11
455execRWSC
456 :: (Monad m, Monoid w) =>
457 r
458 -> s
459 -> ConduitM i o (RWSL.RWST r w s m) res
460 -> ConduitM i o m (s, w)
461execRWSC i s p = fmap f $ runRWSC i s p
462 where f x = let (_, s2, w2) = x in (s2, w2)
463{-# INLINABLE execRWSC #-}
464
465
466-- | Wrap the base monad in 'RWSS.RWST'
467--
468-- Since 1.0.11
469rwsSC
470 :: (Monad m, Monad (t1 (RWSS.RWST t w t2 m)), MonadTrans t1,
471 Monoid w, MFunctor t1) =>
472 (t -> t2 -> t1 m (b, t2, w)) -> t1 (RWSS.RWST t w t2 m) b
473rwsSC k = do
474 i <- lift RWSS.ask
475 s <- lift RWSS.get
476 (r, s', w) <- hoist lift (k i s)
477 lift $ do
478 RWSS.put s'
479 RWSS.tell w
480 return r
481{-# INLINABLE rwsSC #-}
482
483-- | Run 'RWSS.RWST' in the base monad
484--
485-- Since 1.0.11
486runRWSSC
487 :: (Monad m, Monoid w) =>
488 r
489 -> s
490 -> ConduitM i o (RWSS.RWST r w s m) res
491 -> ConduitM i o m (res, s, w)
492runRWSSC r s0 = thread toRes run (s0, mempty)
493 where
494 toRes a (s, w) = (a, s, w)
495 run m (s, w) = do
496 (res, s', w') <- RWSS.runRWST m r s
497 return (res, (s', w `mappend` w'))
498{-# INLINABLE runRWSSC #-}
499
500-- | Evaluate 'RWSS.RWST' in the base monad
501--
502-- Since 1.0.11
503evalRWSSC
504 :: (Monad m, Monoid w) =>
505 r
506 -> s
507 -> ConduitM i o (RWSS.RWST r w s m) res
508 -> ConduitM i o m (res, w)
509evalRWSSC i s p = fmap f $ runRWSSC i s p
510 where f x = let (r, _, w) = x in (r, w)
511{-# INLINABLE evalRWSSC #-}
512
513-- | Execute 'RWSS.RWST' in the base monad
514--
515-- Since 1.0.11
516execRWSSC
517 :: (Monad m, Monoid w) =>
518 r
519 -> s
520 -> ConduitM i o (RWSS.RWST r w s m) res
521 -> ConduitM i o m (s, w)
522execRWSSC i s p = fmap f $ runRWSSC i s p
523 where f x = let (_, s2, w2) = x in (s2, w2)
524{-# INLINABLE execRWSSC #-}
525
526
diff --git a/Presence/ConsoleWriter.hs b/Presence/ConsoleWriter.hs
index b5040ba7..e755b27f 100644
--- a/Presence/ConsoleWriter.hs
+++ b/Presence/ConsoleWriter.hs
@@ -16,7 +16,7 @@ import Control.Concurrent.STM
16import Data.Monoid 16import Data.Monoid
17import Data.Char 17import Data.Char
18import Data.Maybe 18import Data.Maybe
19import System.Environment 19import System.Environment hiding (setEnv)
20import System.Process ( rawSystem ) 20import System.Process ( rawSystem )
21import System.Exit ( ExitCode(ExitSuccess) ) 21import System.Exit ( ExitCode(ExitSuccess) )
22import System.Posix.Env ( setEnv ) 22import System.Posix.Env ( setEnv )
diff --git a/Presence/Nesting.hs b/Presence/Nesting.hs
index dd0e4113..720237fd 100644
--- a/Presence/Nesting.hs
+++ b/Presence/Nesting.hs
@@ -6,7 +6,7 @@ import Data.Conduit
6import Data.Conduit.Lift 6import Data.Conduit.Lift
7import Data.XML.Types 7import Data.XML.Types
8import qualified Data.Text as S 8import qualified Data.Text as S
9import Control.Monad.State 9import Control.Monad.State.Strict
10import qualified Data.List as List 10import qualified Data.List as List
11 11
12type Lang = S.Text 12type Lang = S.Text
@@ -30,11 +30,10 @@ nesting = lift $ (return . nestingLevel) =<< get
30xmlLang :: Monad m => NestingXML o m (Maybe Lang) 30xmlLang :: Monad m => NestingXML o m (Maybe Lang)
31xmlLang = fmap (fmap snd . top . langStack) (lift get) 31xmlLang = fmap (fmap snd . top . langStack) (lift get)
32 where 32 where
33 top ( a :! as ) = Just a 33 top ( a :! _as ) = Just a
34 top _ = Nothing 34 top _ = Nothing
35 35
36 36trackNesting :: Monad m => Conduit Event (StateT XMLState m) Event
37trackNesting :: Monad m => ConduitM Event Event (StateT XMLState m) ()
38trackNesting = awaitForever doit 37trackNesting = awaitForever doit
39 where 38 where
40 doit xml = do 39 doit xml = do
@@ -61,7 +60,7 @@ lookupLang attrs =
61 60
62 61
63awaitCloser :: Monad m => Int -> NestingXML o m () 62awaitCloser :: Monad m => Int -> NestingXML o m ()
64awaitCloser lvl = do 63awaitCloser lvl =
65 fix $ \loop -> do 64 fix $ \loop -> do
66 lvl' <- nesting 65 lvl' <- nesting
67 when (lvl' >= lvl) $ do 66 when (lvl' >= lvl) $ do
@@ -80,8 +79,7 @@ nextElement = do
80 xml <- await 79 xml <- await
81 case xml of 80 case xml of
82 Nothing -> return Nothing 81 Nothing -> return Nothing
83 Just (EventBeginElement _ _) -> do 82 Just (EventBeginElement _ _) -> return xml
84 return xml
85 Just _ -> do 83 Just _ -> do
86 lvl' <- nesting 84 lvl' <- nesting
87 if (lvl'>=lvl) then loop 85 if (lvl'>=lvl) then loop
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 1f88fb9c..6176bbe6 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -51,7 +51,7 @@ import qualified Data.Conduit.List as CL
51import qualified Data.Conduit.Binary as CB 51import qualified Data.Conduit.Binary as CB
52import Data.Conduit.Blaze (builderToByteStringFlush) 52import Data.Conduit.Blaze (builderToByteStringFlush)
53 53
54import qualified Text.XML.Stream.Render as XML 54import qualified Text.XML.Stream.Render as XML hiding (content)
55import qualified Text.XML.Stream.Parse as XML 55import qualified Text.XML.Stream.Parse as XML
56import Data.XML.Types as XML 56import Data.XML.Types as XML
57import Data.Maybe 57import Data.Maybe
@@ -77,6 +77,7 @@ import EventUtil
77import ControlMaybe 77import ControlMaybe
78import LockedChan 78import LockedChan
79import PeerResolve 79import PeerResolve
80import Blaze.ByteString.Builder (Builder)
80 81
81peerport :: PortNumber 82peerport :: PortNumber
82peerport = 5269 83peerport = 5269
@@ -247,13 +248,17 @@ wlog s = putStrLn s >> hFlush stdout
247wlogb :: ByteString -> IO () 248wlogb :: ByteString -> IO ()
248wlogb s = Strict8.putStrLn s >> hFlush stdout 249wlogb s = Strict8.putStrLn s >> hFlush stdout
249 250
251renderBuilderFlush :: Monad m => XML.RenderSettings -> Conduit (Flush Event) m (Flush Builder)
252renderBuilderFlush = undefined
253
250xmlStream :: ReadCommand -> WriteCommand -> ( Source IO XML.Event 254xmlStream :: ReadCommand -> WriteCommand -> ( Source IO XML.Event
251 , Sink (Flush XML.Event) IO () ) 255 , Sink (Flush XML.Event) IO () )
252xmlStream conread conwrite = (xsrc,xsnk) 256xmlStream conread conwrite = (xsrc,xsnk)
253 where 257 where
254 xsrc = src $= XML.parseBytes XML.def 258 xsrc = src $= XML.parseBytes XML.def
259 xsnk :: Sink (Flush Event) IO ()
255 xsnk = -- XML.renderBytes XML.def =$ snk 260 xsnk = -- XML.renderBytes XML.def =$ snk
256 XML.renderBuilderFlush XML.def 261 renderBuilderFlush XML.def
257 =$= builderToByteStringFlush 262 =$= builderToByteStringFlush
258 =$= discardFlush 263 =$= discardFlush
259 =$ snk 264 =$ snk
@@ -271,7 +276,7 @@ xmlStream conread conwrite = (xsrc,xsnk)
271 (\v -> yield v >> src) 276 (\v -> yield v >> src)
272 v 277 v
273 snk = awaitForever $ liftIO . conwrite 278 snk = awaitForever $ liftIO . conwrite
274 279
275 280
276type FlagCommand = STM Bool 281type FlagCommand = STM Bool
277type ReadCommand = IO (Maybe ByteString) 282type ReadCommand = IO (Maybe ByteString)
diff --git a/Setup.lhs b/Setup.lhs
deleted file mode 100644
index fcbfea54..00000000
--- a/Setup.lhs
+++ /dev/null
@@ -1,2 +0,0 @@
1> import Distribution.Simple
2> main = Distribution.Simple.defaultMain
diff --git a/presence.cabal b/presence.cabal
index 5672a17f..ee6704a3 100644
--- a/presence.cabal
+++ b/presence.cabal
@@ -3,7 +3,6 @@ version: 0.0.1
3cabal-version: >=1.2 3cabal-version: >=1.2
4build-type: Simple 4build-type: Simple
5license: AllRightsReserved 5license: AllRightsReserved
6license-file: ""
7synopsis: XMPP Server which detects unix logins 6synopsis: XMPP Server which detects unix logins
8description: When users login to your localhost, their presence is detected and announced 7description: When users login to your localhost, their presence is detected and announced
9 to connected xmpp clients. presence is a modern XMPP variant of the old Unix Talk 8 to connected xmpp clients. presence is a modern XMPP variant of the old Unix Talk
@@ -19,8 +18,15 @@ executable presence
19 mtl -any, mmorph -any, conduit (>=1.0.4), void -any, random -any, 18 mtl -any, mmorph -any, conduit (>=1.0.4), void -any, random -any,
20 data-default -any, blaze-builder -any, unix -any, conduit-extra -any, 19 data-default -any, blaze-builder -any, unix -any, conduit-extra -any,
21 binary -any, directory -any, cpu -any, template-haskell -any, deepseq -any, 20 binary -any, directory -any, cpu -any, template-haskell -any, deepseq -any,
22 filepath -any, hinotify -any, process -any, xml-conduit2 -any 21 filepath -any, hinotify -any, process -any, xml-conduit -any
23 main-is: xmppServer.hs 22 main-is: xmppServer.hs
23 other-modules: ByteStringOperators, ClientState, ConfigFiles, ConnectionKey,
24 ConsoleWriter, Control.Concurrent.STM.StatusCache,
25 Control.Concurrent.STM.UpdateStream, ControlMaybe, DNSCache,
26 Data.BitSyntax, EventUtil, FGConsole, GetHostByAddr,
27 LocalPeerCred, LockedChan, Logging, Nesting, Paths,
28 PeerResolve, Server, SockAddr, SocketLike, TraversableT,
29 UTmp, XMPPServer
24 buildable: True 30 buildable: True
25 cpp-options: -DRENDERFLUSH 31 cpp-options: -DRENDERFLUSH
26 c-sources: Presence/monitortty.c 32 c-sources: Presence/monitortty.c
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 00000000..e2280624
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,35 @@
1# This file was automatically generated by stack init
2# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html
3
4# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
5resolver: lts-5.4
6
7# Local packages, usually specified by relative directory name
8packages:
9- '.'
10# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
11extra-deps: []
12
13# Override default flag values for local packages and extra-deps
14flags: {}
15
16# Extra package databases containing global packages
17extra-package-dbs: []
18
19# Control whether we use the GHC we find on the path
20# system-ghc: true
21
22# Require a specific version of stack, using version ranges
23# require-stack-version: -any # Default
24# require-stack-version: >= 1.0.0
25
26# Override the architecture used by stack, especially useful on Windows
27# arch: i386
28# arch: x86_64
29
30# Extra directories used by stack for building
31# extra-include-dirs: [/path/to/dir]
32# extra-lib-dirs: [/path/to/dir]
33
34# Allow a newer minor version of GHC than the snapshot specifies
35# compiler-check: newer-minor
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-13 17:02:50 +0000