polysemy-zoo 0.1.2.0 → 0.1.2.1

raw patch · 7 files changed

+237/−68 lines, 7 filesdep ~polysemyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: polysemy

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• polysemy-zoo.cabal +5/−3
• src/Polysemy/Operators.hs +73/−63
• src/Polysemy/Several.hs +73/−0
• test/IdempotentLoweringSpec.hs +1/−1
• test/MTLSpec.hs +2/−1
• test/SeveralSpec.hs +78/−0

@@ -1,5 +1,10 @@ # Changelog for polysemy-zoo +## 0.1.2.1 (2019-06-12)++- Update the tests to run against `polysemy-0.4.0.0`++ ## 0.1.2.0 (2019-06-01)  - Added `Polysemy.MTL` for inter-op with MTL (thanks to @adamConnerSax)

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 07f2fe507c2afe8ef70bcc42b26d3eaa3541eee97656ce45a5afa9ea207334cc+-- hash: b8422eaa237bad8199d235d37dd432322f191094275f7e61d94fb38fb030d101  name:           polysemy-zoo-version:        0.1.2.0+version:        0.1.2.1 synopsis:       Experimental, user-contributed effects and interpreters for polysemy description:    Please see the README on GitHub at <https://github.com/isovector/polysemy-zoo#readme> category:       Polysemy@@ -35,6 +35,7 @@       Polysemy.Operators       Polysemy.Random       Polysemy.RandomFu+      Polysemy.Several   other-modules:       Paths_polysemy_zoo   hs-source-dirs:@@ -62,6 +63,7 @@       KVStoreSpec       MTLSpec       RandomFuSpec+      SeveralSpec       Paths_polysemy_zoo   hs-source-dirs:       test@@ -73,7 +75,7 @@     , containers     , hspec     , mtl >=2.0.1.0 && <3.0.0.0-    , polysemy >=0.3+    , polysemy >=0.4     , polysemy-plugin     , polysemy-zoo     , random >=1.1 && <1.2

@@ -1,62 +1,75 @@-{-|--Operators meant as replacements for traditional 'Sem' type and 'Member' /-'Members' constraints, that allow you to specify types of your actions and-interpreters in more concise way, e.g. without mentioning unnecessary-details:--@-foo :: 'Member' ('Lift' 'IO') r => 'String' -> 'Int' -> 'Sem' r ()-@--can be written simply as:--@-foo :: 'String' -> 'Int' -> 'IO' '~@>' ()-@--Working example with operators:--@-import Data.Function-import Polysemy-import Polysemy.Operators-import Polysemy.Random--data ConsoleIO m a where-  WriteStrLn ::           'String' -> ConsoleIO m ()-  ReadStrLn  ::                     ConsoleIO m 'String'-  ShowStrLn  :: 'Show' a => a      -> ConsoleIO m ()--'makeSem' ''ConsoleIO---- runConsoleIO :: Member (Lift IO) r => Sem (ConsoleIO:r) a -> Sem r a-runConsoleIO :: ConsoleIO:r '@>' a -> 'IO' '~@' r '@>' a-runConsoleIO = 'interpret' \\case-  WriteStrLn s -> 'sendM' '$' 'putStrLn' s-  ReadStrLn    -> 'sendM'   'getLine'-  ShowStrLn  v -> 'sendM' '$' 'print' v--main :: 'IO' ()-main = program-     'Data.Function.&' runConsoleIO-     'Data.Function.&' 'Polysemy.Random.runRandomIO'-     'Data.Function.&' 'runM'---- program :: Members \'[Random, ConsoleIO] r => Sem r ()-program :: \'['Polysemy.Random', ConsoleIO] '>@>' ()-program = do-  writeStrLn "It works! Write something:"-  val <- readStrLn-  writeStrLn '$' "Here it is!: " '++' val-  num <- 'Polysemy.Random.random' \@'Int'-  writeStrLn '$' "Some random number:"-  showStrLn num-@--See documentation of specific operators for more details.---}+-- | Operators meant as replacements for traditional 'Sem' type and 'Member' /+-- 'Members' constraints, that allow you to specify types of your actions and+-- interpreters in more concise way, without mentioning unnecessary details:+--+-- @+-- foo :: 'Member' ('Lift' 'IO') r => 'String' -> 'Int' -> 'Sem' r ()+-- @+--+-- can be written simply as:+--+-- @+-- foo :: 'String' -> 'Int' -> 'IO' '~@>' ()+-- @+--+-- Working example with operators:+--+-- @+-- import Data.Function+-- import Polysemy+-- import Polysemy.Operators+-- import Polysemy.Random+--+-- data ConsoleIO m a where+--   WriteStrLn ::           'String' -> ConsoleIO m ()+--   ReadStrLn  ::                     ConsoleIO m 'String'+--   ShowStrLn  :: 'Show' a => a      -> ConsoleIO m ()+--+-- 'makeSem' ''ConsoleIO+--+-- -- runConsoleIO :: Member (Lift IO) r => Sem (ConsoleIO : r) a -> Sem r a+-- runConsoleIO :: ConsoleIO : r '@>' a -> 'IO' '~@' r '@>' a+-- runConsoleIO = 'interpret' \\case+--   WriteStrLn s -> 'sendM' '$' 'putStrLn' s+--   ReadStrLn    -> 'sendM'   'getLine'+--   ShowStrLn  v -> 'sendM' '$' 'print' v+--+-- main :: 'IO' ()+-- main = program+--      'Data.Function.&' runConsoleIO+--      'Data.Function.&' 'Polysemy.Random.runRandomIO'+--      'Data.Function.&' 'runM'+--+-- -- program :: Members \'[Random, ConsoleIO] r => Sem r ()+-- program :: \'['Polysemy.Random', ConsoleIO] '>@>' ()+-- program = do+--   writeStrLn "It works! Write something:"+--   val <- readStrLn+--   writeStrLn '$' "Here it is!: " '++' val+--   num <- 'Polysemy.Random.random' \@'Int'+--   writeStrLn '$' "Some random number:"+--   showStrLn num+-- @+--+-- Please keep in mind that constraints created through these operators are+-- limited to the action they are being used on, for example:+--+-- @+-- foo :: (forall x. r '@>' x -> 'IO' x)+--     -> 'IO' (forall a. Foo : r '@>' a -> 'IO' '~@' r '@>' a)+-- @+--+-- The first argument in the signature above won't have access to the+-- @('IO' ~\@)@ constraint in the result - in such cases, use a normal+-- constraint instead:+--+-- @+-- foo :: 'Member' ('Lift' 'IO') r+--     => (forall x. r '@>' x -> 'IO' x)+--     -> 'IO' (forall a. Foo : r '@>' a -> r '@>' a)+-- @+--+-- See the documentation of specific operators for more details.  module Polysemy.Operators   ( -- * 'Sem' operators@@ -80,16 +93,13 @@  import Polysemy ------------------------------------------------------------------------------- -- Miscellaneous -------------------------------------------------------------------------------------------------------------------------------------------- -- | Gets list of effects from 'Sem'. type family SemList s where   SemList (Sem r _) = r ------------------------------------------------------------------------------- -- Operators ------------------------------------------------------------------------------------------------------------------------------------------------+ -- $SemOperators -- Infix equivalents of 'Sem' with versions for specifiying list of effects -- ('@>'), single effect ('@-') and single monad ('@~') as effects of union.

@@ -0,0 +1,73 @@+{-# LANGUAGE BlockArguments  #-}+{-# LANGUAGE TemplateHaskell #-}++module Polysemy.Several+        ( -- * Data+          HList(..)+        , TypeMap+        , TypeConcat+        , runSeveral+        )+where++import Polysemy+import Data.Kind++------------------------------------------------------------------------------+-- | A list capable of storing values of different types. Like the Sem type,+-- it uses a type level list to keep track of what's stored inside. Creating an+-- HList looks like:+--+-- > 1 ::: "test" ::: True ::: HNil+infixr 5 :::+data HList a where+    HNil  :: HList '[]+    (:::) :: a -> HList (b :: [Type]) -> HList (a ': b)++type Eff = (Type -> Type) -> Type -> Type+------------------------------------------------------------------------------+-- | A map function over type level lists. For example, the following two+-- lines are equivalent:+--+-- > TypeMap Reader [Int, String, False]+-- > [Reader Int, Reader String, Reader Bool]+type family TypeMap (f :: a -> b) (xs :: [a]) where+    TypeMap _ '[]       = '[]+    TypeMap f (x ': xs) = f x ': TypeMap f xs++------------------------------------------------------------------------------+-- | Like ++ but at the type level. The following two lines are equivalent:+--+-- > TypeConcat [Int, String] [Bool]+-- > [Int, String, Bool]+type family TypeConcat (a :: [t]) (b :: [t]) where+    TypeConcat '[] b = b+    TypeConcat (a ': as) b = a ': TypeConcat as b++------------------------------------------------------------------------------+-- | A helper function for building new runners which accept HLists intsead of+-- individual elements. If you would normally write+--+-- > f 5 . f "Text" . f True+--+-- then this function can turn that into+--+-- > runSeveral f (True ::: "Text" ::: 5 ::: HNil)+--+-- For example, a runReaders function could be implemented as:+--+-- > runReaders :: HList t -> Sem (TypeConcat (TypeMap Reader t) r) a -> Sem r a+-- > runReaders = runSeveral runReader+--+-- Likewise, runStates could be the following if you didn't want the returned+-- state:+--+-- > runStates :: HList t -> Sem (TypeConcat (TypeMap State t) r) a -> Sem r a+-- > runStates = runSeveral (fmap (fmap snd) . runState)+runSeveral+    :: (forall r k x. k -> Sem (e k ': r) x -> Sem r x)+    -> HList t+    -> Sem (TypeConcat (TypeMap e t) r) a+    -> Sem r a+runSeveral f (a ::: as) = runSeveral f as . f a+runSeveral _ HNil       = id

@@ -32,7 +32,7 @@ spec :: Spec spec = describe "Idempotent Lowering" $ do   it "should persist an IORef through a bracket" $ do-    runIt <- nat runM .@! const (runStateInIO 0) .@! liftNat runResource+    runIt <- nat runM .@! const (runStateInIO 0) .@! liftNat runResourceInIO     result <- runIt test     result `shouldBe` (3 :: Int) 

@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications    #-}+ module MTLSpec where  import           Polysemy@@ -70,7 +71,7 @@       ++ " In this case, 16, the sum of \"init [1,5,5,5,5]\""       )     $ do-        flip shouldBe 16 . sum . fst . run . runWriter $ do+        flip shouldBe 16 . sum @[] . fst . run . runWriter $ do           tell [1]           absorbWriter $ replicateTell 2 5           censor init $ absorbWriter $ replicateTell 2 5

@@ -0,0 +1,78 @@+module SeveralSpec where++import           Polysemy+import           Polysemy.State+import           Polysemy.Reader+import           Polysemy.Input+import           Polysemy.Several+import           Test.Hspec+++readerProgram :: ( Member (Reader String) r+                 , Member (Reader Int) r+                 , Member (Reader Bool) r+                 , Members [Reader String, Reader Int, Reader Bool] r+                     ~ Members (TypeMap Reader [String, Int, Bool]) r+                 ) => Sem r (Int, String, Bool)+readerProgram = do+  a <- ask @Int+  b <- ask @String+  c <- ask @Bool+  pure $ (a, b, c)++stateProgram :: ( Member (State String) r+                , Member (State Int) r+                , Member (State Bool) r+                , Members [State String, State Int, State Bool] r+                    ~ Members (TypeMap State [String, Int, Bool]) r+                ) => Sem r (Int, String, Bool)+stateProgram = do+  put @Int 5+  put "Changed"+  a <- get @Int+  b <- get @String+  c <- get @Bool+  pure $ (a, b, c)++inputProgram :: ( Member (Input String) r+                , Member (Input Int) r+                , Member (Input Bool) r+                , Members [Input String, Input Int, Input Bool] r+                    ~ Members (TypeMap Input [String, Int, Bool]) r+                ) => Sem r (Int, String, Bool)+inputProgram = do+  a <- input @Int+  b <- input @String+  c <- input @Bool+  pure $ (a, b, c)+++runReaders = runSeveral runReader++runStates = runSeveral (fmap (fmap snd) . runState)++runConstInputs = runSeveral runConstInput++spec = do+  describe "runReaders" $ do+    let original = runReader 5 . runReader "test" . runReader True $ readerProgram+        new = runReaders (True ::: "test" ::: 5 ::: HNil) readerProgram++    it "should be equivalent to composed runReader" $ do+      run original `shouldBe` run new++  describe "runStates" $ do+    let getResult = fmap $ snd . snd . snd+        original = getResult $ runState 5 . runState "test" . runState True $ stateProgram+        new = runStates (True ::: "test" ::: 5 ::: HNil) stateProgram++    it "should be equivalent to composed runState" $ do+      run original `shouldBe` run new++  describe "runConstInput" $ do+    let original = runConstInput 5 . runConstInput "test"+                                   . runConstInput True $ inputProgram+        new = runConstInputs (True ::: "test" ::: 5 ::: HNil) inputProgram++    it "should be equivalent to composed runConstInput" $ do+      run original `shouldBe` run new