freer 0.2.2.4 → 0.2.2.5

raw patch · 7 files changed

+69/−26 lines, 7 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• freer.cabal +4/−4
• src/Control/Monad/Freer/Coroutine.hs +10/−10
• src/Control/Monad/Freer/Internal.hs +11/−0
• src/Control/Monad/Freer/State.hs +8/−5
• src/Control/Monad/Freer/Writer.hs +3/−3
• tests/Tests.hs +31/−2
• tests/Tests/NonDetEff.hs +2/−2

@@ -1,13 +1,13 @@ name:                freer-version:             0.2.2.4+version:             0.2.2.5 synopsis:            Implementation of the Freer Monad license:             BSD3 license-file:        LICENSE author:              Allele Dev maintainer:          allele.dev@gmail.com copyright:           Allele Dev 2016-homepage:            https://gitlab.com/cpp.cabrera/freer-bug-reports:         https://gitlab.com/cpp.cabrera/freer/issues+homepage:            https://gitlab.com/queertypes/freer+bug-reports:         https://gitlab.com/queertypes/freer/issues category:            Control build-type:          Simple cabal-version:       >=1.18@@ -32,7 +32,7 @@  source-repository head     type: git-    location: git clone https://gitlab.com/cpp.cabrera/freer.git+    location: git clone https://gitlab.com/queertypes/freer.git  library   exposed-modules:     Control.Monad.Freer

@@ -1,5 +1,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}  {-| Module      : Control.Monad.Freer.Coroutine@@ -19,7 +21,8 @@ module Control.Monad.Freer.Coroutine (   Yield,   yield,-  Status(..)+  Status(..),+  runC ) where  import Control.Monad.Freer.Internal@@ -40,12 +43,9 @@ -- resuming with the value of type b data Status r a b = Done | Continue a (b -> Eff r (Status r a b)) -{- FIXME: this does not compile--- Launch a thread and report its status-runC :: Eff (Yield a b ': r) w -> Eff r (Y r a b)-runC m = loop m-  where loop :: Monad m => Eff a b -> m (Y r c d)-        loop (Val _)  = return Done-        loop (E u u') = handleRelay u loop $-                          \(Yield x k) -> return (Y x (loop . k))--}+-- | Launch a thread and report its status+runC :: Eff (Yield a b ': r) w -> Eff r (Status r a b)+runC = handleRelay (\_ -> return Done) handler+  where+    handler :: Yield a b v -> Arr r v (Status r a b) -> Eff r (Status r a b)+    handler (Yield a k) arr = return $ Continue a (arr . k)

@@ -49,6 +49,7 @@   qComp,   send,   run,+  runM,   handleRelay,   handleRelayS,   interpose,@@ -129,6 +130,16 @@ run :: Eff '[] w -> w run (Val x) = x run _       = error "Internal:run - This (E) should never happen"++-- | Runs a set of Effects. Requires that all effects are consumed,+-- except for a single effect known to be a monad.+-- The value returned is a computation in that monad.+-- This is useful for plugging in traditional transformer stacks.+runM :: Monad m => Eff '[m] w -> m w+runM (Val x) = return x+runM (E u q) = case decomp u of+  Right mb -> mb >>= runM . qApp q+  Left _   -> error "Internal:runM - This (Left) should never happen"  -- the other case is unreachable since Union [] a cannot be -- constructed. Therefore, run is a total function if its argument

@@ -23,13 +23,14 @@   State,   get,   put,+  modify,   runState, -  ProxyState(..),   transactionState ) where  import Control.Monad.Freer.Internal+import Data.Proxy  --------------------------------------------------------------------------------                          -- State, strict --@@ -44,10 +45,14 @@ get :: Member (State s) r => Eff r s get = send Get --- | Modify state+-- | Store state put :: Member (State s) r => s -> Eff r () put s = send (Put s) +-- | Modify state+modify :: Member (State s) r => (s -> s) -> Eff r ()+modify f = fmap f get >>= put+ -- | Handler for State effects runState :: Eff (State s ': r) w -> s -> Eff r (w,s) runState (Val x) s = return (x,s)@@ -57,14 +62,12 @@   Left  u'       -> E u' (tsingleton (\x -> runState (qApp q x) s))  -data ProxyState s = ProxyState- -- | -- An encapsulated State handler, for transactional semantics -- The global state is updated only if the transactionState finished -- successfully transactionState :: forall s r w. Member (State s) r =>-                    ProxyState s -> Eff r w -> Eff r w+                    Proxy s -> Eff r w -> Eff r w transactionState _ m = do s <- get; loop s m  where    loop :: s -> Eff r w -> Eff r w

@@ -35,6 +35,6 @@ tell o = send $ Writer o  -- | Simple handler for Writer effects-runWriter :: Eff (Writer o ': r) a -> Eff r (a,[o])-runWriter = handleRelay (\x -> return (x,[]))-                  (\ (Writer o) k -> k () >>= \ (x,l) -> return (x,o:l))+runWriter :: Monoid o => Eff (Writer o ': r) a -> Eff r (a,o)+runWriter = handleRelay (\x -> return (x,mempty))+                  (\ (Writer o) k -> k () >>= \ (x,l) -> return (x,o `mappend` l))

@@ -6,6 +6,7 @@ import Test.Tasty.HUnit import Test.Tasty.QuickCheck +import Tests.Coroutine import Tests.Exception import Tests.Fresh import Tests.NonDetEff@@ -13,6 +14,8 @@ import Tests.State import Tests.StateRW +import qualified Data.List+ --------------------------------------------------------------------------------                            -- Pure Tests -- --------------------------------------------------------------------------------@@ -26,6 +29,23 @@   ]  --------------------------------------------------------------------------------+                        -- Coroutine Tests --+--------------------------------------------------------------------------------++-- | Counts number of consecutive pairs of odd elements at beginning of a list.+countOddDuoPrefix :: [Int] -> Int+countOddDuoPrefix list = count list 0+  where+    count (i1:i2:is) n = if even i1 && even i2 then n else count is (n+1)+    count _ n = n++coroutineTests :: TestTree+coroutineTests = testGroup "Coroutine Eff tests"+  [ testProperty "Counting consecutive pairs of odds"+      (\list -> runTestCoroutine list == countOddDuoPrefix list)+  ]++--------------------------------------------------------------------------------                         -- Exception Tests -- -------------------------------------------------------------------------------- exceptionTests :: TestTree@@ -58,9 +78,17 @@ --------------------------------------------------------------------------------                  -- Nondeterministic Effect Tests -- --------------------------------------------------------------------------------+-- https://wiki.haskell.org/Prime_numbers+primesTo :: Int -> [Int]+primesTo m = sieve [2..m]       {- (\\) is set-difference for unordered lists -}+  where+    sieve (x:xs) = x : sieve (xs Data.List.\\ [x,x+x..m])+    sieve [] = []+ nonDetEffTests :: TestTree nonDetEffTests = testGroup "NonDetEff tests"-  [ testCase "[2,3,5] are primes generated by ifte" (testIfte [2..6] @?= [2,3,5])+  [ testProperty "Primes in 2..n generated by ifte"+      (\n' -> let n = abs n' in testIfte [2..n] == primesTo n)   ]  --------------------------------------------------------------------------------@@ -100,9 +128,10 @@ main :: IO () main = defaultMain $ testGroup "Tests"   [ pureTests+  , coroutineTests   , exceptionTests   , freshTests-  -- , nonDetEffTests -- FIXME: failing+  , nonDetEffTests   , readerTests   , stateTests   ]

@@ -7,7 +7,7 @@  ifte :: Member NonDetEff r      => Eff r a -> (a -> Eff r b) -> Eff r b -> Eff r b-ifte t th el = (t >>= th) <|> el+ifte t th el = msplit t >>= maybe el (\(a,m) -> th a <|> (m >>= th))  generatePrimes :: Member NonDetEff r => [Int] -> Eff r Int generatePrimes xs = do@@ -16,7 +16,7 @@            guard $ d < n && n `mod` d == 0)        (const mzero)        (return n)-  where gen = msum . fmap return $ xs+  where gen = msum (fmap return xs)  testIfte :: [Int] -> [Int] testIfte = run . makeChoiceA . generatePrimes