contstuff 0.1.0 → 0.2.0

raw patch · 3 files changed

+152/−9 lines, 3 filesnew-component:exe:testPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/ContStuff.hs +120/−1
• Test.hs +24/−0
• contstuff.cabal +8/−8

@@ -24,6 +24,9 @@     Cont, runCont, evalCont, modifyCont,     ContT(..), runContT, evalContT, modifyContT,     -- ** Advanced CPS monads+    -- *** Choice/nondeterminism+    ChoiceT(..), runChoiceT, findFirst, findAll, listChoiceT, listA,+    -- *** State     State, runState, evalState, execState,     StateT(..), runStateT, evalStateT, execStateT,     -- ** Writer monads@@ -33,6 +36,7 @@      -- * Effect classes     Abortable(..),+    CallCC(..), Label, labelCC, goto,     LiftBase(..), io,     Runnable(..),     Stateful(..), getField, modify, modifyField, modifyFieldLazy, modifyLazy,@@ -83,6 +87,85 @@ -- ================== --  +-------------+-- ChoiceT --+-------------++-- | The choice monad transformer, which models, as the most common+-- interpretation, nondeterminism.  Internally a list of choices is+-- represented as a CPS-based left-fold function.++newtype ChoiceT r i m a =+  ChoiceT { getChoiceT ::+              (i -> a -> (i -> m r) -> m r)+                -> i+                -> (i -> m r)+                -> m r }+++instance Alternative (ChoiceT r i m) where+  empty = ChoiceT $ \_ z k -> k z+  ChoiceT c <|> ChoiceT d =+    ChoiceT $ \fold z k ->+      c fold z (\zc -> d fold zc k)++instance Applicative (ChoiceT r i m) where+  pure x = ChoiceT $ \fold z k -> fold z x k+  ChoiceT cf <*> ChoiceT cx =+    ChoiceT $ \fold z k ->+      cx (\xx yx kx -> cf (\xf yf kf -> fold xf (yf yx) kf) xx kx) z k++instance Functor (ChoiceT r i m) where+  fmap f (ChoiceT c) =+    ChoiceT $ \fold z k ->+      c (\x y k -> fold x (f y) k) z k++instance Monad (ChoiceT r i m) where+  return x = ChoiceT $ \fold z k -> fold z x k+  ChoiceT c >>= f =+    ChoiceT $ \fold z k ->+      c (\x y kc -> getChoiceT (f y) fold x kc) z k++instance Transformer (ChoiceT r i) where+  lift c = ChoiceT $ \fold z k -> c >>= \x -> fold z x k+++-- | Run a choice computation.++runChoiceT ::+  (i -> a -> (i -> m r) -> m r)+    -> i+    -> (i -> m r)+    -> ChoiceT r i m a+    -> m r+runChoiceT fold z k (ChoiceT c) = c fold z k+++-- | Find the first solution.++findFirst :: (Alternative f, Applicative m) => ChoiceT (f a) (f a) m a -> m (f a)+findFirst = runChoiceT (\_ y _ -> pure (pure y)) empty pure+++-- | Find all solutions.++findAll :: (Alternative f, Applicative m) => ChoiceT (f a) (f a) m a -> m (f a)+findAll = runChoiceT (\x y k -> k (x <|> pure y)) empty pure+++-- | Get list of solutions (faster than 'findAll', but returns solutions+-- in reversed order).++listChoiceT :: Applicative m => ChoiceT [a] [a] m a -> m [a]+listChoiceT = runChoiceT (\x y k -> k (y:x)) [] pure+++-- | Turn a list into a computation with alternatives.++listA :: Alternative f => [a] -> f a+listA = foldr (<|>) empty . map pure++ ----------- -- ContT -- -----------@@ -107,6 +190,9 @@   ContT cf <*> ContT cx =     ContT $ \k -> cf (\f -> cx (\x -> k (f x))) +instance CallCC (ContT r m) where+  callCC f = ContT $ \k -> getContT (f (ContT . const . k)) k+ instance Functor (ContT r m) where   fmap f (ContT c) = ContT $ \k -> c (\x -> k (f x)) @@ -278,6 +364,9 @@   StateT cf <*> StateT cx =     StateT $ \s0 k -> cf s0 (\s1 f -> cx s1 (\s2 x -> k s2 (f x))) +instance CallCC (StateT r s m) where+  callCC f = StateT $ \s0 k -> getStateT (f (\x -> StateT $ \s1 _ -> k s1 x)) s0 k+ instance Functor (StateT r s m) where   fmap f (StateT c) =     StateT $ \s0 k -> c s0 (\s1 -> k s1 . f)@@ -375,6 +464,28 @@   abort :: Result m -> m a  +-- | Monads supporting *call-with-current-continuation* (aka callCC).++class CallCC m where+  -- | Call with current continuation.+  callCC :: ((a -> m b) -> m a) -> m a+++newtype Label m a = Label (a -> Label m a -> m ())+++-- | Capture the current continuation for later use.++labelCC :: (Applicative m, CallCC m) => a -> m (a, Label m a)+labelCC x = callCC $ \k -> pure (x, Label $ curry k)+++-- | Jump to a label.++goto :: Applicative m => Label m a -> a -> m b+goto lk@(Label k) x = k x lk *> pure undefined++ -- | Monads, which support lifting base monad computations.  class LiftBase m a where@@ -390,6 +501,8 @@  instance (LiftBase m a, Monad m) => LiftBase (IdT m) a where   type Base (IdT m) a = Base m a; base = lift . base+instance (LiftBase m a, Monad m) => LiftBase (ChoiceT r i m) a where+  type Base (ChoiceT r i m) a = Base m a; base = lift . base instance (LiftBase m a, Monad m) => LiftBase (ContT r m) a where   type Base (ContT r m) a = Base m a; base = lift . base instance (LiftBase m a, Monad m) => LiftBase (StateT r s m) a where@@ -403,7 +516,7 @@   -- | Every monad transformer @t@ that supports transforming @t m a@ to--- @m a@ should be an instance of this class.+-- @m a@ can be an instance of this class.  class Runnable t r m a where   type Argument t r m a@@ -421,6 +534,12 @@   put x = x `seq` putLazy x   -- | Set the current state, but don't force it.   putLazy :: StateOf m -> m ()++instance (Monad m, Stateful m) => Stateful (ContT r m) where+  type StateOf (ContT r m) = StateOf m+  get = lift get+  put = lift . put+  putLazy = lift . putLazy   -- | Get a certain field.

@@ -0,0 +1,24 @@+-- |+-- Module:     Main+-- Copyright:  (c) 2010 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <es@ertes.de>+-- Stability:  experimental+--+-- This is a test program to test the various monads found in the+-- contstuff library.++module Main where++import Control.ContStuff+import Text.Printf+++main :: IO ()+main =+  evalContT $ do+    (x, begin) <- labelCC 0+    when (mod x 100000 == 0) . io $ do+      putStr (show x)+      putChar '\r'+    goto begin (x+1)

@@ -1,5 +1,5 @@ Name:          contstuff-Version:       0.1.0+Version:       0.2.0 Category:      Control, Monads Synopsis:      Easy to use CPS-based monads Maintainer:    Ertugrul Söylemez <es@ertes.de>@@ -24,10 +24,10 @@   Exposed-modules:     Control.ContStuff ---Executable test---  Build-depends:---    base >= 4 && <= 5---  Main-is:        Test.hs---  GHC-Options:    -W---  Other-modules:---    Control.ContStuff+Executable test+  Build-depends:+    base >= 4 && <= 5+  Main-is:        Test.hs+  GHC-Options:    -W+  Other-modules:+    Control.ContStuff