effet 0.3.0.1 → 0.3.0.2
raw patch · 18 files changed
+1041/−4 lines, 18 filesdep +effetdep +hspecPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: effet, hspec
API changes (from Hackage documentation)
+ Control.Effect.Identity: runIdentity :: Identity a -> a
- Control.Effect.Cont: callCC :: Cont m_aoKr => ((a_aoKs -> m_aoKr b_aoKt) -> m_aoKr a_aoKs) -> m_aoKr a_aoKs
+ Control.Effect.Cont: callCC :: Cont m_aoKO => ((a_aoKP -> m_aoKO b_aoKQ) -> m_aoKO a_aoKP) -> m_aoKO a_aoKP
- Control.Effect.Cont: retagCont' :: forall tag_aoQj new_aoQk m_aoQn a_aoQo. Via (Cont' tag_aoQj) (Tagger tag_aoQj new_aoQk) m_aoQn a_aoQo -> m_aoQn a_aoQo
+ Control.Effect.Cont: retagCont' :: forall tag_aoQG new_aoQH m_aoQK a_aoQL. Via (Cont' tag_aoQG) (Tagger tag_aoQG new_aoQH) m_aoQK a_aoQL -> m_aoQK a_aoQL
- Control.Effect.Cont: tagCont' :: forall new_aoQk m_aoQl a_aoQm. Via (Cont' G) (Tagger G new_aoQk) m_aoQl a_aoQm -> m_aoQl a_aoQm
+ Control.Effect.Cont: tagCont' :: forall new_aoQH m_aoQI a_aoQJ. Via (Cont' G) (Tagger G new_aoQH) m_aoQI a_aoQJ -> m_aoQI a_aoQJ
- Control.Effect.Cont: untagCont' :: forall tag_aoQj m_aoQp a_aoQq. Via (Cont' tag_aoQj) (Tagger tag_aoQj G) m_aoQp a_aoQq -> m_aoQp a_aoQq
+ Control.Effect.Cont: untagCont' :: forall tag_aoQG m_aoQM a_aoQN. Via (Cont' tag_aoQG) (Tagger tag_aoQG G) m_aoQM a_aoQN -> m_aoQM a_aoQN
- Control.Effect.Embed: embed :: Embed n_alYc m_alYd => n_alYc a_alYe -> m_alYd a_alYe
+ Control.Effect.Embed: embed :: Embed n_alYz m_alYA => n_alYz a_alYB -> m_alYA a_alYB
- Control.Effect.Embed: retagEmbed' :: forall tag_alZj new_alZk n_alYc m_alZn a_alZo. Via (Embed' tag_alZj n_alYc) (Tagger tag_alZj new_alZk) m_alZn a_alZo -> m_alZn a_alZo
+ Control.Effect.Embed: retagEmbed' :: forall tag_alZG new_alZH n_alYz m_alZK a_alZL. Via (Embed' tag_alZG n_alYz) (Tagger tag_alZG new_alZH) m_alZK a_alZL -> m_alZK a_alZL
- Control.Effect.Embed: tagEmbed' :: forall new_alZk n_alYc m_alZl a_alZm. Via (Embed' G n_alYc) (Tagger G new_alZk) m_alZl a_alZm -> m_alZl a_alZm
+ Control.Effect.Embed: tagEmbed' :: forall new_alZH n_alYz m_alZI a_alZJ. Via (Embed' G n_alYz) (Tagger G new_alZH) m_alZI a_alZJ -> m_alZI a_alZJ
- Control.Effect.Embed: type Embed n_alYc = Embed' G n_alYc
+ Control.Effect.Embed: type Embed n_alYz = Embed' G n_alYz
- Control.Effect.Embed: untagEmbed' :: forall tag_alZj n_alYc m_alZp a_alZq. Via (Embed' tag_alZj n_alYc) (Tagger tag_alZj G) m_alZp a_alZq -> m_alZp a_alZq
+ Control.Effect.Embed: untagEmbed' :: forall tag_alZG n_alYz m_alZM a_alZN. Via (Embed' tag_alZG n_alYz) (Tagger tag_alZG G) m_alZM a_alZN -> m_alZM a_alZN
- Control.Effect.Error: catchError :: Error e_akRg m_akRh => m_akRh a_akRj -> (e_akRg -> m_akRh a_akRj) -> m_akRh a_akRj
+ Control.Effect.Error: catchError :: Error e_akRD m_akRE => m_akRE a_akRG -> (e_akRD -> m_akRE a_akRG) -> m_akRE a_akRG
- Control.Effect.Error: retagError' :: forall tag_akTi new_akTj e_akRg m_akTm a_akTn. Via (Error' tag_akTi e_akRg) (Tagger tag_akTi new_akTj) m_akTm a_akTn -> m_akTm a_akTn
+ Control.Effect.Error: retagError' :: forall tag_akTF new_akTG e_akRD m_akTJ a_akTK. Via (Error' tag_akTF e_akRD) (Tagger tag_akTF new_akTG) m_akTJ a_akTK -> m_akTJ a_akTK
- Control.Effect.Error: tagError' :: forall new_akTj e_akRg m_akTk a_akTl. Via (Error' G e_akRg) (Tagger G new_akTj) m_akTk a_akTl -> m_akTk a_akTl
+ Control.Effect.Error: tagError' :: forall new_akTG e_akRD m_akTH a_akTI. Via (Error' G e_akRD) (Tagger G new_akTG) m_akTH a_akTI -> m_akTH a_akTI
- Control.Effect.Error: throwError :: Error e_akRg m_akRh => e_akRg -> m_akRh a_akRi
+ Control.Effect.Error: throwError :: Error e_akRD m_akRE => e_akRD -> m_akRE a_akRF
- Control.Effect.Error: type Error e_akRg = Error' G e_akRg
+ Control.Effect.Error: type Error e_akRD = Error' G e_akRD
- Control.Effect.Error: untagError' :: forall tag_akTi e_akRg m_akTo a_akTp. Via (Error' tag_akTi e_akRg) (Tagger tag_akTi G) m_akTo a_akTp -> m_akTo a_akTp
+ Control.Effect.Error: untagError' :: forall tag_akTF e_akRD m_akTL a_akTM. Via (Error' tag_akTF e_akRD) (Tagger tag_akTF G) m_akTL a_akTM -> m_akTL a_akTM
- Control.Effect.Managed: manage :: Managed m_apCK => m_apCK a_apCL -> (a_apCL -> m_apCK b_apCM) -> m_apCK a_apCL
+ Control.Effect.Managed: manage :: Managed m_apD7 => m_apD7 a_apD8 -> (a_apD8 -> m_apD7 b_apD9) -> m_apD7 a_apD8
- Control.Effect.Managed: retagManaged' :: forall tag_apEa new_apEb m_apEe a_apEf. Via (Managed' tag_apEa) (Tagger tag_apEa new_apEb) m_apEe a_apEf -> m_apEe a_apEf
+ Control.Effect.Managed: retagManaged' :: forall tag_apEx new_apEy m_apEB a_apEC. Via (Managed' tag_apEx) (Tagger tag_apEx new_apEy) m_apEB a_apEC -> m_apEB a_apEC
- Control.Effect.Managed: tagManaged' :: forall new_apEb m_apEc a_apEd. Via (Managed' G) (Tagger G new_apEb) m_apEc a_apEd -> m_apEc a_apEd
+ Control.Effect.Managed: tagManaged' :: forall new_apEy m_apEz a_apEA. Via (Managed' G) (Tagger G new_apEy) m_apEz a_apEA -> m_apEz a_apEA
- Control.Effect.Managed: untagManaged' :: forall tag_apEa m_apEg a_apEh. Via (Managed' tag_apEa) (Tagger tag_apEa G) m_apEg a_apEh -> m_apEg a_apEh
+ Control.Effect.Managed: untagManaged' :: forall tag_apEx m_apED a_apEE. Via (Managed' tag_apEx) (Tagger tag_apEx G) m_apED a_apEE -> m_apED a_apEE
- Control.Effect.Map: clear :: Map k_arYR v_arYS m_arYT => m_arYT ()
+ Control.Effect.Map: clear :: Map k_arZe v_arZf m_arZg => m_arZg ()
- Control.Effect.Map: lookup :: Map k_arYR v_arYS m_arYT => k_arYR -> m_arYT (Maybe v_arYS)
+ Control.Effect.Map: lookup :: Map k_arZe v_arZf m_arZg => k_arZe -> m_arZg (Maybe v_arZf)
- Control.Effect.Map: retagMap' :: forall tag_as0T new_as0U k_arYR v_arYS m_as0X a_as0Y. Via (Map' tag_as0T k_arYR v_arYS) (Tagger tag_as0T new_as0U) m_as0X a_as0Y -> m_as0X a_as0Y
+ Control.Effect.Map: retagMap' :: forall tag_as1g new_as1h k_arZe v_arZf m_as1k a_as1l. Via (Map' tag_as1g k_arZe v_arZf) (Tagger tag_as1g new_as1h) m_as1k a_as1l -> m_as1k a_as1l
- Control.Effect.Map: tagMap' :: forall new_as0U k_arYR v_arYS m_as0V a_as0W. Via (Map' G k_arYR v_arYS) (Tagger G new_as0U) m_as0V a_as0W -> m_as0V a_as0W
+ Control.Effect.Map: tagMap' :: forall new_as1h k_arZe v_arZf m_as1i a_as1j. Via (Map' G k_arZe v_arZf) (Tagger G new_as1h) m_as1i a_as1j -> m_as1i a_as1j
- Control.Effect.Map: type Map k_arYR v_arYS = Map' G k_arYR v_arYS
+ Control.Effect.Map: type Map k_arZe v_arZf = Map' G k_arZe v_arZf
- Control.Effect.Map: untagMap' :: forall tag_as0T k_arYR v_arYS m_as0Z a_as10. Via (Map' tag_as0T k_arYR v_arYS) (Tagger tag_as0T G) m_as0Z a_as10 -> m_as0Z a_as10
+ Control.Effect.Map: untagMap' :: forall tag_as1g k_arZe v_arZf m_as1m a_as1n. Via (Map' tag_as1g k_arZe v_arZf) (Tagger tag_as1g G) m_as1m a_as1n -> m_as1m a_as1n
- Control.Effect.Map: update :: Map k_arYR v_arYS m_arYT => k_arYR -> Maybe v_arYS -> m_arYT ()
+ Control.Effect.Map: update :: Map k_arZe v_arZf m_arZg => k_arZe -> Maybe v_arZf -> m_arZg ()
- Control.Effect.Reader: ask :: Reader r_auHW m_auHX => m_auHX r_auHW
+ Control.Effect.Reader: ask :: Reader r_auIj m_auIk => m_auIk r_auIj
- Control.Effect.Reader: local :: Reader r_auHW m_auHX => (r_auHW -> r_auHW) -> m_auHX a_auHY -> m_auHX a_auHY
+ Control.Effect.Reader: local :: Reader r_auIj m_auIk => (r_auIj -> r_auIj) -> m_auIk a_auIl -> m_auIk a_auIl
- Control.Effect.Reader: reader :: Reader r_auHW m_auHX => (r_auHW -> a_auHZ) -> m_auHX a_auHZ
+ Control.Effect.Reader: reader :: Reader r_auIj m_auIk => (r_auIj -> a_auIm) -> m_auIk a_auIm
- Control.Effect.Reader: retagReader' :: forall tag_auKI new_auKJ r_auHW m_auKM a_auKN. Via (Reader' tag_auKI r_auHW) (Tagger tag_auKI new_auKJ) m_auKM a_auKN -> m_auKM a_auKN
+ Control.Effect.Reader: retagReader' :: forall tag_auL5 new_auL6 r_auIj m_auL9 a_auLa. Via (Reader' tag_auL5 r_auIj) (Tagger tag_auL5 new_auL6) m_auL9 a_auLa -> m_auL9 a_auLa
- Control.Effect.Reader: tagReader' :: forall new_auKJ r_auHW m_auKK a_auKL. Via (Reader' G r_auHW) (Tagger G new_auKJ) m_auKK a_auKL -> m_auKK a_auKL
+ Control.Effect.Reader: tagReader' :: forall new_auL6 r_auIj m_auL7 a_auL8. Via (Reader' G r_auIj) (Tagger G new_auL6) m_auL7 a_auL8 -> m_auL7 a_auL8
- Control.Effect.Reader: type Reader r_auHW = Reader' G r_auHW
+ Control.Effect.Reader: type Reader r_auIj = Reader' G r_auIj
- Control.Effect.Reader: untagReader' :: forall tag_auKI r_auHW m_auKO a_auKP. Via (Reader' tag_auKI r_auHW) (Tagger tag_auKI G) m_auKO a_auKP -> m_auKO a_auKP
+ Control.Effect.Reader: untagReader' :: forall tag_auL5 r_auIj m_auLb a_auLc. Via (Reader' tag_auL5 r_auIj) (Tagger tag_auL5 G) m_auLb a_auLc -> m_auLb a_auLc
- Control.Effect.Resource: bracket :: Resource m_aw0P => m_aw0P a_aw0Q -> (a_aw0Q -> m_aw0P c_aw0R) -> (a_aw0Q -> m_aw0P b_aw0S) -> m_aw0P b_aw0S
+ Control.Effect.Resource: bracket :: Resource m_aw1c => m_aw1c a_aw1d -> (a_aw1d -> m_aw1c c_aw1e) -> (a_aw1d -> m_aw1c b_aw1f) -> m_aw1c b_aw1f
- Control.Effect.Resource: bracketOnError :: Resource m_aw0P => m_aw0P a_aw0T -> (a_aw0T -> m_aw0P c_aw0U) -> (a_aw0T -> m_aw0P b_aw0V) -> m_aw0P b_aw0V
+ Control.Effect.Resource: bracketOnError :: Resource m_aw1c => m_aw1c a_aw1g -> (a_aw1g -> m_aw1c c_aw1h) -> (a_aw1g -> m_aw1c b_aw1i) -> m_aw1c b_aw1i
- Control.Effect.Resource: retagResource' :: forall tag_aw45 new_aw46 m_aw49 a_aw4a. Via (Resource' tag_aw45) (Tagger tag_aw45 new_aw46) m_aw49 a_aw4a -> m_aw49 a_aw4a
+ Control.Effect.Resource: retagResource' :: forall tag_aw4s new_aw4t m_aw4w a_aw4x. Via (Resource' tag_aw4s) (Tagger tag_aw4s new_aw4t) m_aw4w a_aw4x -> m_aw4w a_aw4x
- Control.Effect.Resource: tagResource' :: forall new_aw46 m_aw47 a_aw48. Via (Resource' G) (Tagger G new_aw46) m_aw47 a_aw48 -> m_aw47 a_aw48
+ Control.Effect.Resource: tagResource' :: forall new_aw4t m_aw4u a_aw4v. Via (Resource' G) (Tagger G new_aw4t) m_aw4u a_aw4v -> m_aw4u a_aw4v
- Control.Effect.Resource: untagResource' :: forall tag_aw45 m_aw4b a_aw4c. Via (Resource' tag_aw45) (Tagger tag_aw45 G) m_aw4b a_aw4c -> m_aw4b a_aw4c
+ Control.Effect.Resource: untagResource' :: forall tag_aw4s m_aw4y a_aw4z. Via (Resource' tag_aw4s) (Tagger tag_aw4s G) m_aw4y a_aw4z -> m_aw4y a_aw4z
- Control.Effect.State: get :: State s_ayZQ m_ayZR => m_ayZR s_ayZQ
+ Control.Effect.State: get :: State s_az0d m_az0e => m_az0e s_az0d
- Control.Effect.State: put :: State s_ayZQ m_ayZR => s_ayZQ -> m_ayZR ()
+ Control.Effect.State: put :: State s_az0d m_az0e => s_az0d -> m_az0e ()
- Control.Effect.State: retagState' :: forall tag_az2I new_az2J s_ayZQ m_az2M a_az2N. Via (State' tag_az2I s_ayZQ) (Tagger tag_az2I new_az2J) m_az2M a_az2N -> m_az2M a_az2N
+ Control.Effect.State: retagState' :: forall tag_az35 new_az36 s_az0d m_az39 a_az3a. Via (State' tag_az35 s_az0d) (Tagger tag_az35 new_az36) m_az39 a_az3a -> m_az39 a_az3a
- Control.Effect.State: state :: State s_ayZQ m_ayZR => (s_ayZQ -> (s_ayZQ, a_ayZS)) -> m_ayZR a_ayZS
+ Control.Effect.State: state :: State s_az0d m_az0e => (s_az0d -> (s_az0d, a_az0f)) -> m_az0e a_az0f
- Control.Effect.State: tagState' :: forall new_az2J s_ayZQ m_az2K a_az2L. Via (State' G s_ayZQ) (Tagger G new_az2J) m_az2K a_az2L -> m_az2K a_az2L
+ Control.Effect.State: tagState' :: forall new_az36 s_az0d m_az37 a_az38. Via (State' G s_az0d) (Tagger G new_az36) m_az37 a_az38 -> m_az37 a_az38
- Control.Effect.State: type State s_ayZQ = State' G s_ayZQ
+ Control.Effect.State: type State s_az0d = State' G s_az0d
- Control.Effect.State: untagState' :: forall tag_az2I s_ayZQ m_az2O a_az2P. Via (State' tag_az2I s_ayZQ) (Tagger tag_az2I G) m_az2O a_az2P -> m_az2O a_az2P
+ Control.Effect.State: untagState' :: forall tag_az35 s_az0d m_az3b a_az3c. Via (State' tag_az35 s_az0d) (Tagger tag_az35 G) m_az3b a_az3c -> m_az3b a_az3c
- Control.Effect.Writer: censor :: Writer w_aAGx m_aAGy => (w_aAGx -> w_aAGx) -> m_aAGy a_aAGA -> m_aAGy a_aAGA
+ Control.Effect.Writer: censor :: Writer w_aAGU m_aAGV => (w_aAGU -> w_aAGU) -> m_aAGV a_aAGX -> m_aAGV a_aAGX
- Control.Effect.Writer: listen :: Writer w_aAGx m_aAGy => m_aAGy a_aAGz -> m_aAGy (w_aAGx, a_aAGz)
+ Control.Effect.Writer: listen :: Writer w_aAGU m_aAGV => m_aAGV a_aAGW -> m_aAGV (w_aAGU, a_aAGW)
- Control.Effect.Writer: retagWriter' :: forall tag_aAIY new_aAIZ w_aAGx m_aAJ2 a_aAJ3. Via (Writer' tag_aAIY w_aAGx) (Tagger tag_aAIY new_aAIZ) m_aAJ2 a_aAJ3 -> m_aAJ2 a_aAJ3
+ Control.Effect.Writer: retagWriter' :: forall tag_aAJl new_aAJm w_aAGU m_aAJp a_aAJq. Via (Writer' tag_aAJl w_aAGU) (Tagger tag_aAJl new_aAJm) m_aAJp a_aAJq -> m_aAJp a_aAJq
- Control.Effect.Writer: tagWriter' :: forall new_aAIZ w_aAGx m_aAJ0 a_aAJ1. Via (Writer' G w_aAGx) (Tagger G new_aAIZ) m_aAJ0 a_aAJ1 -> m_aAJ0 a_aAJ1
+ Control.Effect.Writer: tagWriter' :: forall new_aAJm w_aAGU m_aAJn a_aAJo. Via (Writer' G w_aAGU) (Tagger G new_aAJm) m_aAJn a_aAJo -> m_aAJn a_aAJo
- Control.Effect.Writer: tell :: Writer w_aAGx m_aAGy => w_aAGx -> m_aAGy ()
+ Control.Effect.Writer: tell :: Writer w_aAGU m_aAGV => w_aAGU -> m_aAGV ()
- Control.Effect.Writer: type Writer w_aAGx = Writer' G w_aAGx
+ Control.Effect.Writer: type Writer w_aAGU = Writer' G w_aAGU
- Control.Effect.Writer: untagWriter' :: forall tag_aAIY w_aAGx m_aAJ4 a_aAJ5. Via (Writer' tag_aAIY w_aAGx) (Tagger tag_aAIY G) m_aAJ4 a_aAJ5 -> m_aAJ4 a_aAJ5
+ Control.Effect.Writer: untagWriter' :: forall tag_aAJl w_aAGU m_aAJr a_aAJs. Via (Writer' tag_aAJl w_aAGU) (Tagger tag_aAJl G) m_aAJr a_aAJs -> m_aAJr a_aAJs
Files
- ChangeLog.md +5/−1
- README.md +2/−1
- effet.cabal +36/−2
- examples/Example/Cont.hs +36/−0
- examples/Example/Embed.hs +87/−0
- examples/Example/Error.hs +85/−0
- examples/Example/FileSystem.hs +129/−0
- examples/Example/Logger.hs +113/−0
- examples/Example/Managed.hs +79/−0
- examples/Example/Map.hs +71/−0
- examples/Example/RWS.hs +52/−0
- examples/Example/Reader.hs +59/−0
- examples/Example/Resource.hs +71/−0
- examples/Example/State.hs +66/−0
- examples/Example/Writer.hs +63/−0
- examples/Hspec.hs +25/−0
- examples/Main.hs +35/−0
- src/Control/Effect/Identity.hs +27/−0
ChangeLog.md view
@@ -17,4 +17,8 @@ ## 0.3.0.1 (2020-10-14) -* Fixed some compilation issues with GHC 8.6+* Fixed some compilation issues with GHC 8.6 + +## 0.3.0.2 (2020-10-21) + +* Added Control.Effect.Identity for pure effect interpretations.
README.md view
@@ -41,6 +41,8 @@ ## Quick-Start Guide +Examples can be found in the [examples](/examples/Example) folder. The following sections give a quick overview of the most important features.+ ### Defining Effects When defining effects or effect handlers, the module *Control.Effect.Machinery* provides everything we need:@@ -285,4 +287,3 @@ * `TemplateHaskell`-based code generation can yield code that does not compile if you go crazy with `m`-based parameters in higher-order effect methods (where `m` is the monad type parameter of the effect type class). In such cases, one has to write the necessary type class instances by hand. They are explained in the documentation of the module `Control.Effect.Machinery.TH`. * Effect type classes that are based on other effect type classes (like `RWS`) are possible, but cannot be used with the provided code generation infrastructure yet (not to be confused with writing an effect *handler* based on other effects, which is possible). * The performance should be `mtl`-like, but this has not been verified yet.-* The library needs some tests.
effet.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: cd058ddcf2f87961e00a8942c5ac3ebcda5ea45c798d1fdcd2b73cbe43c5f949+-- hash: fd88a66a694dc0a14a3ea183cf0b921a1df3c88288a96e0410b5f548c9b3ff5d name: effet-version: 0.3.0.1+version: 0.3.0.2 synopsis: An Effect System based on Type Classes description: Please see the README on GitHub at <https://github.com/typedbyte/effet#readme> category: Control@@ -32,6 +32,7 @@ Control.Effect.Cont Control.Effect.Embed Control.Effect.Error+ Control.Effect.Identity Control.Effect.Machinery Control.Effect.Machinery.Tagger Control.Effect.Machinery.TH@@ -60,6 +61,39 @@ build-depends: base >=4.7 && <5 , containers >=0.6.2.1 && <0.7+ , monad-control >=1.0.2.3 && <1.1+ , template-haskell >=2.14.0.0 && <3+ , transformers >=0.5.6.2 && <0.6+ , transformers-base >=0.4.5.2 && <0.5+ default-language: Haskell2010++test-suite examples+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Example.Cont+ Example.Embed+ Example.Error+ Example.FileSystem+ Example.Logger+ Example.Managed+ Example.Map+ Example.Reader+ Example.Resource+ Example.RWS+ Example.State+ Example.Writer+ Hspec+ Paths_effet+ hs-source-dirs:+ examples+ default-extensions: AllowAmbiguousTypes ConstraintKinds DataKinds DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators UndecidableInstances+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5+ , containers >=0.6.2.1 && <0.7+ , effet+ , hspec >=2.6.0 && <3 , monad-control >=1.0.2.3 && <1.1 , template-haskell >=2.14.0.0 && <3 , transformers >=0.5.6.2 && <0.6
+ examples/Example/Cont.hs view
@@ -0,0 +1,36 @@+-- | Examples of the continuation effect. +module Example.Cont where + +-- hspec +import Test.Hspec (Spec, it, shouldBe) + +-- effet +import Control.Effect.Cont +import Control.Effect.Identity + +import Example.Logger + +--- Example Programs ----------------------------------------------------------- + +fiveTimesCont :: (Cont m, Logger m) => m () +fiveTimesCont = do + logStr "x" + (k, num) <- callCC $ \k -> let f x = k (f, x) + in pure (f, 0::Int) + logStr "y" + logStr "z" + if num < 5 + then k (num + 1) >> pure () + else logStr $ show num + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "evaluates fiveTimesCont" $ + ( runIdentity -- result: ((), [String]) + . runCollectLogger -- result: Monad m => m ((), [String]) + . evalCont -- effects: Logger + $ fiveTimesCont -- effects: Cont, Logger + ) `shouldBe` + ((), ["5","z","y","z","y","z","y","z","y","z","y","z","y","x"])
+ examples/Example/Embed.hs view
@@ -0,0 +1,87 @@+-- | Examples of the embed effect. +module Example.Embed where + +-- base +import Control.Monad (guard) +import Data.Maybe (listToMaybe, maybeToList) +import Prelude hiding (print) + +-- hspec +import Test.Hspec (Spec, it, shouldBe) + +-- effet +import Control.Effect.Embed +import Control.Effect.Reader + +import Hspec (print, shouldPrint) + +--- Example Programs ----------------------------------------------------------- + +-- | Find shared numbers of two reader-based lists using the list monad. +intersect :: (Reader' "xs" [Int] m, Reader' "ys" [Int] m, Embed [] m) => m Int +intersect = do + xs <- ask' @"xs" + ys <- ask' @"ys" + embed $ do + x <- xs + y <- ys + guard $ x == y + pure x + +-- | Divide two numbers using the maybe monad. +divide :: Embed Maybe m => Maybe Int -> Maybe Int -> m Int +divide mx my = embed $ do + x <- mx + y <- my + guard $ y /= 0 + pure $ x `div` y + +-- | Performs multiple divisions. +divisions :: Embed [] m => Maybe Int -> m Int +divisions divisor = do + a <- runEmbed maybeToList $ divide (Just 3) (Just 1) + b <- runEmbed maybeToList $ divide (Just 2) divisor + c <- runEmbed maybeToList $ divide (Just 5) divisor + d <- runEmbed maybeToList $ divide (Just 9) (Just 4) + embed [a,b,c,d] + +-- | Uses embed instead of liftIO to print texts with prefix and suffix (reader). +simulateLiftIO :: (Embed IO m, Reader String m) => String -> m () +simulateLiftIO prefix = do + suffix <- ask + embed $ do + print $ prefix ++ "Hello" ++ suffix + print $ prefix ++ "World" ++ suffix + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "evaluates intersect with []" $ + ( runReader' @"ys" [2,3,4] -- effects: Embed [], result: [Int] + . runReader' @"xs" [1,2,3] -- effects: Reader' "ys" [Int], Embed [] + $ intersect ) -- effects: Reader' "xs" [Int], Reader' "ys" [Int], Embed [] + `shouldBe` [2,3] + it "evaluates intersect with Maybe" $ + ( runEmbed listToMaybe -- effects: Embed Maybe, result: Maybe Int + . runReader' @"ys" [2,3,4] -- effects: Embed [] + . runReader' @"xs" [1,2,3] -- effects: Reader' "ys" [Int], Embed [] + $ intersect ) -- effects: Reader' "xs" [Int], Reader' "ys" [Int], Embed [] + `shouldBe` Just 2 + it "evaluates division" $ + ( divide (Just 10) (Just 3) ) -- effects: Embed Maybe, result: Maybe Int + `shouldBe` Just 3 + it "evaluates division by zero" $ + ( divide (Just 2) (Just 0) ) -- effects: Embed Maybe, result: Maybe Int + `shouldBe` Nothing + it "evaluates divisions" $ + ( divisions (Just 2) ) -- effects: Embed [], result: [Int] + `shouldBe` [3,1,2,2] + it "evaluates divisions by zero" $ + ( divisions Nothing ) -- effects: Embed Maybe, result: Maybe [Int] + `shouldBe` [] + it "evaluates simulateLiftIO" $ + ( runReader " [S]" -- effects: Embed IO, result: IO () + $ simulateLiftIO "[P] " ) -- effects: Embed IO, Reader String + `shouldPrint` + "\"[P] Hello [S]\"\n\"[P] World [S]\"\n"
+ examples/Example/Error.hs view
@@ -0,0 +1,85 @@+-- | Examples of the error effect. +module Example.Error where + +-- base +import Control.Monad.IO.Class (MonadIO, liftIO) +import Prelude hiding (print) + +-- hspec +import Test.Hspec (Spec, it, shouldBe) + +-- effet +import Control.Effect.Error +import Control.Effect.Identity +import Control.Effect.Reader + +import Hspec (print, shouldPrint) + +--- Example Programs ----------------------------------------------------------- + +data DivideByZero = DivideByZero + deriving (Eq, Show) + +-- | Divides two numbers, may yield an error when dividing by zero. +divide :: Error DivideByZero m => Int -> Int -> m Int +divide _ 0 = throwError DivideByZero +divide x y = pure $ x `div` y + +-- | Divides two numbers and returns a default value in case of zero division. +catchDivide :: Error DivideByZero m => Int -> Int -> m Int +catchDivide x y = + catchError + ( divide x y ) + ( \_ -> pure 1337 ) + +-- | Divides two numbers found in the readers, catches the division by zero +-- error and prints a String describing the result. +divideByReader :: ( Error DivideByZero m + , MonadIO m + , Reader' "numerator" Int m + , Reader' "divisor" Int m ) + => m () +divideByReader = do + n <- ask' @"numerator" + d <- ask' @"divisor" + catchError + ( do r <- divide n d + liftIO . print $ "Result: " ++ show r ) + ( \e -> + liftIO . print $ "Error: " ++ show e ) + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "divides normally" $ + ( runIdentity -- result: Either DivideByZero Int + . runError -- result: Monad m => m (Either DivideByZero Int) + $ divide 8 3 ) -- effects: Error DivideByZero + `shouldBe` Right 2 + it "divides by zero" $ + ( runIdentity -- result: Either DivideByZero Int + . runError -- result: Monad m => m (Either DivideByZero Int) + $ divide 5 0 ) -- effects: Error DivideByZero + `shouldBe` Left DivideByZero + it "catches division by zero" $ + ( runIdentity -- result: Either DivideByZero Int + . runError -- result: Monad m => m (Either DivideByZero Int) + $ catchDivide 5 0 ) -- effects: Error DivideByZero + `shouldBe` Right 1337 + it "catches normally" $ + ( runReader' @"divisor" 3 -- result: MonadIO m => m (Either DivideByZero ()), + -- unified with IO (Either DivideByZero ()) + . runReader' @"numerator" 17 -- effects: Reader' "divisor", MonadIO + . runError -- effects: Reader' "numerator", Reader' "divisor", MonadIO + $ divideByReader ) -- effects: Error DivideByZero, Reader' "numerator", + -- Reader' "divisor", MonadIO + `shouldPrint` "\"Result: 5\"\n" + it "catches division by zero" $ + ( runReader' @"divisor" 0 -- result: MonadIO m => m (Either DivideByZero ()), + -- unified with IO (Either DivideByZero ()) + . runReader' @"numerator" 17 -- effects: Reader' "divisor", MonadIO + . runError -- effects: Reader' "numerator", Reader' "divisor", MonadIO + $ divideByReader ) -- effects: Error DivideByZero, Reader' "numerator", + -- Reader' "divisor", MonadIO + `shouldPrint` "\"Error: DivideByZero\"\n"
+ examples/Example/FileSystem.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE TemplateHaskell #-} +-- | Example of a custom effect for file systems access. +module Example.FileSystem where + +-- base +import Data.Coerce (coerce) +import Data.Maybe (fromMaybe) +import Prelude hiding (lookup, readFile, writeFile) +import qualified System.IO as IO + +-- hspec +import Test.Hspec (Spec, it, shouldBe) + +-- effet +import Control.Effect.Identity +import Control.Effect.Machinery +import Control.Effect.Map +import Control.Effect.Map.Strict + +import Example.Logger +import Hspec (shouldPrint) + +--- Custom Effects ------------------------------------------------------------- + +-- | An effect for representing file system access. +class Monad m => FileSystem m where + readFile :: FilePath -> m String + writeFile :: FilePath -> String -> m () + +makeEffect ''FileSystem + +--- Effect Interpretations ----------------------------------------------------- + +-- | An effect handler for 'FileSystem' which touches the actual file system. +newtype LocalFS m a = + LocalFS { runLocalFS :: m a } + deriving (Applicative, Functor, Monad, MonadIO) + deriving (MonadTrans, MonadTransControl) via IdentityT + deriving (MonadBase b, MonadBaseControl b) + +instance MonadIO m => FileSystem (LocalFS m) where + readFile path = liftIO $ IO.readFile path + writeFile path txt = liftIO $ IO.writeFile path txt + +runLocalFileSystem :: (FileSystem `Via` LocalFS) m a -> m a +runLocalFileSystem = coerce + +-- | An effect handler for 'FileSystem' which provides a virtual file system. +newtype VirtualFS m a = + VirtualFS { runVirtualFS :: m a } + deriving (Applicative, Functor, Monad, MonadIO) + deriving (MonadTrans, MonadTransControl) via IdentityT + deriving (MonadBase b, MonadBaseControl b) + +instance Map FilePath String m => FileSystem (VirtualFS m) where + readFile path = VirtualFS $ fromMaybe "" <$> lookup path + writeFile path txt = VirtualFS $ insert path txt + +runVirtualFileSystem :: (FileSystem `Via` VirtualFS) m a -> m a +runVirtualFileSystem = coerce + +-- | An effect handler for 'FileSystem' which intercepts the access to files +-- and logs the actions using the 'Logger' effect. +newtype Interceptor m a = + Interceptor { unInterceptor :: m a } + deriving (Applicative, Functor, Monad, MonadIO) + deriving (MonadTrans, MonadTransControl) via IdentityT + deriving (MonadBase b, MonadBaseControl b) + +instance (FileSystem m, Logger m) => FileSystem (Interceptor m) where + readFile path = Interceptor $ + logStr ("READ: " ++ path) >> readFile path + writeFile path txt = Interceptor $ + logStr ("WRITE: " ++ path ++ " [" ++ txt ++ "]") >> writeFile path txt + +runInterceptor :: (FileSystem `Via` Interceptor) m a -> m a +runInterceptor = coerce + +--- Example Programs ----------------------------------------------------------- + +-- | Simple program which writes a file and reads it afterwards and returns the +-- old and new file content. +writeRead :: FileSystem m => FilePath -> String -> m (String, String) +writeRead path txt = do + old <- readFile path + writeFile path txt + new <- readFile path + pure (old, new) + +-- | Appends a text to a file given by a specific file path, and returns the old +-- and new lengths of the file. +append :: FileSystem m => FilePath -> String -> m (Int, Int) +append path txt = do + content <- readFile path + let size = length content + seq size $ writeFile path (content ++ txt) + pure (size, size + length txt) + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "evaluates writeRead virtually" $ + ( runIdentity -- result: (String, String) + . runMap -- result: Monad m => m (String, String) + . runVirtualFileSystem -- effects: Map FilePath String + $ writeRead "tmp" "hello" -- effects: FileSystem + ) `shouldBe` ("", "hello") + it "evaluates append virtually" $ + ( runIdentity -- result: (Int, Int) + . runMap -- result: Monad m => m (Int, Int) + . runVirtualFileSystem -- effects: Map FilePath String + $ append "tmp" "hello" -- effects: FileSystem + ) `shouldBe` (0, 5) + it "intercepts append by printing" $ + ( runPrintLogger -- result: MonadIO m => m (), unified with IO () + . runMap -- effects: Logger + . runVirtualFileSystem -- effects: Map FilePath String, Logger + . runInterceptor -- effects: FileSystem, Logger + $ append "tmp" "hello" -- effects: FileSystem + ) `shouldPrint` "\"READ: tmp\"\n\"WRITE: tmp [hello]\"\n" + it "intercepts append by collecting" $ + ( runIdentity -- result: ((Int, Int), [String]) + . runCollectLogger -- result: Monad m => m ((Int, Int), [String]) + . runMap -- effects: Logger + . runVirtualFileSystem -- effects: Map FilePath String, Logger + . runInterceptor -- effects: FileSystem, Logger + $ append "tmp" "hello" -- effects: FileSystem + ) `shouldBe` ((0, 5), ["WRITE: tmp [hello]", "READ: tmp"])
+ examples/Example/Logger.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE TemplateHaskell #-} +-- | Example of a custom effect for logging. +module Example.Logger where + +-- base +import Data.Coerce (coerce) +import Prelude hiding (print) + +-- hspec +import Test.Hspec (Spec, it, shouldBe) + +-- effet +import Control.Effect.Identity +import Control.Effect.Machinery +import Control.Effect.Reader + +-- transformers +import qualified Control.Monad.Trans.State.Strict as S + +import Hspec (print, shouldPrint) + +--- Custom Effects ------------------------------------------------------------- + +-- | An effect for logging. +class Monad m => Logger m where + logStr :: String -> m () + +makeEffect ''Logger + +--- Effect Interpretations ----------------------------------------------------- + +-- | An effect handler for 'Logger' which prints the logged strings. +newtype PrintLogger m a = + PrintLogger { unPrintLogger :: m a } + deriving (Applicative, Functor, Monad, MonadIO) + deriving (MonadTrans, MonadTransControl) via IdentityT + deriving (MonadBase b, MonadBaseControl b) + +instance MonadIO m => Logger (PrintLogger m) where + logStr = print + +runPrintLogger :: (Logger `Via` PrintLogger) m a -> m a +runPrintLogger = coerce + +-- | An effect handler for 'Logger' which collects the logged strings in reverse +-- order (newest comes first). +newtype CollectLogger m a = + CollectLogger { unCollectLogger :: S.StateT [String] m a } + deriving (Applicative, Functor, Monad, MonadIO) + deriving (MonadTrans, MonadTransControl) + deriving (MonadBase b, MonadBaseControl b) + +instance Monad m => Logger (CollectLogger m) where + logStr txt = CollectLogger $ S.modify (txt :) + +runCollectLogger :: (Logger `Via` CollectLogger) m a -> m (a, [String]) +runCollectLogger = flip S.runStateT [] . coerce + +-- | An effect handler for 'Logger' which suppresses logging. +newtype NoLogger m a = + NoLogger { unNoLogger :: m a } + deriving (Applicative, Functor, Monad, MonadIO) + deriving (MonadTrans, MonadTransControl) via IdentityT + deriving (MonadBase b, MonadBaseControl b) + +instance Monad m => Logger (NoLogger m) where + logStr _ = pure () + +runNoLogger :: (Logger `Via` NoLogger) m a -> m a +runNoLogger = coerce + +--- Example Programs ----------------------------------------------------------- + +-- | Simple program which logs some steps. +logging :: (Logger m, MonadIO m) => m () +logging = do + print "A" + logStr $ "Done A" + print "B" + logStr $ "Done B" + print "C" + logStr $ "Done C" + +-- | Logs and returns the sum of a number and the reader value. +adding :: (Reader Int m, Logger m) => Int -> m Int +adding offset = do + num <- ask + logStr $ "Asked: " ++ show num + let result = offset + num + logStr $ "Sum: " ++ show result + pure result + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "evaluates logging by suppression" $ + ( runNoLogger -- result: MonadIO m => m (), unified with IO () + $ logging -- effects: Logger, MonadIO + ) `shouldPrint` + "\"A\"\n\"B\"\n\"C\"\n" + it "evaluates logging by printing" $ + ( runPrintLogger -- result: MonadIO m => m (), unified with IO () + $ logging -- effects: Logger, MonadIO + ) `shouldPrint` + "\"A\"\n\"Done A\"\n\"B\"\n\"Done B\"\n\"C\"\n\"Done C\"\n" + it "evaluates logging by collecting" $ + ( runIdentity -- result: (Int, [String]) + . runCollectLogger -- result: Monad m => m (Int, [String]) + . runReader 1327 -- effects: Logger + $ adding 10 -- effects: Reader Int, Logger + ) `shouldBe` + (1337, ["Sum: 1337", "Asked: 1327"])
+ examples/Example/Managed.hs view
@@ -0,0 +1,79 @@+-- | Examples of the managed effect. +module Example.Managed where + +-- base +import Control.Monad.IO.Class (MonadIO) +import Prelude hiding (print) + +-- hspec +import Test.Hspec (Spec, it) + +-- effet +import Control.Effect.Error +import Control.Effect.Managed + +import Hspec (print, shouldPrint) + +--- Example Programs ----------------------------------------------------------- + +-- | Type used here as virtual handle. +newtype Handle = Handle { nameOf :: String } + +-- | Gets a managed virtual handle specified by a name. +getHandle :: (Managed m, MonadIO m) => String -> m Handle +getHandle name = manage + ( print ("Alloc " ++ name) >> pure (Handle name) ) + ( \handle -> print $ "Free " ++ nameOf handle ) + +-- | Simple program that makes use of two handles. Handles are destroyed +-- automatically at the end of the program. +useHandles :: (Managed m, MonadIO m) => m () +useHandles = do + a <- getHandle "A" + b <- getHandle "B" + print $ "Use " ++ nameOf a + print $ "Use " ++ nameOf b + +-- | Allocates some handlers, then throws an error. +throwCheck :: (Error String m, Managed m, MonadIO m) => m () +throwCheck = do + a <- getHandle "A" + b <- getHandle "B" + print $ "Use " ++ nameOf a + _ <- throwError "Some error" + print $ "Use " ++ nameOf b + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "manages a handle" $ + ( runManaged -- result: (MonadBaseControl IO m, MonadIO m) => m (), + -- unified with IO () + $ getHandle "X" ) -- effects: Managed, MonadIO + `shouldPrint` + "\"Alloc X\"\n\"Free X\"\n" + it "manages multiple handles" $ + ( runManaged -- result: (MonadBaseControl IO m, MonadIO m) => m (), + -- unified with IO () + $ useHandles ) -- effects: Managed, MonadIO + `shouldPrint` + ( "\"Alloc A\"\n" + ++ "\"Alloc B\"\n" + ++ "\"Use A\"\n" + ++ "\"Use B\"\n" + ++ "\"Free B\"\n" + ++ "\"Free A\"\n" + ) + it "manages multiple handles with an error" $ + ( runManaged -- result: (MonadBaseControl IO m, MonadIO m) => m (Either String ()), + -- unified with IO (Either String ()) + . runError -- effects: Managed, MonadIO + $ throwCheck ) -- effects: Error String, Managed, MonadIO + `shouldPrint` + ( "\"Alloc A\"\n" + ++ "\"Alloc B\"\n" + ++ "\"Use A\"\n" + ++ "\"Free B\"\n" + ++ "\"Free A\"\n" + )
+ examples/Example/Map.hs view
@@ -0,0 +1,71 @@+-- | Examples of the map effect. +module Example.Map where + +-- base +import Prelude hiding (lookup) + +-- hspec +import Test.Hspec (Spec, it, shouldBe) + +-- effet +import Control.Effect.Identity +import Control.Effect.Map +import qualified Control.Effect.Map.Lazy as L +import qualified Control.Effect.Map.Strict as S + +--- Example Programs ----------------------------------------------------------- + +-- | Performs some inserts on the map and checks if their removal works. +removal :: Map Int String m => m Bool +removal = do + insert 1 "Hello" + beforeClear <- exists 1 + clear + afterClear <- exists 1 + insert 2 "World" + beforeDelete <- exists 2 + delete 2 + afterDelete <- exists 2 + pure $ beforeClear && not afterClear && beforeDelete && not afterDelete + +-- | Performs some modifications on the map and checks the changes. +modification :: Map Int String m => m (Maybe String, Maybe String, Maybe String) +modification = do + insert 1 "Hello" + modify "" (++ " World") 1 + modify "N/A" (++ " here?") 2 + h <- lookup 1 + n <- lookup 2 + x <- lookup 3 + pure (h, n, x) + +multiMaps :: (Map' "a" Int String m, Map' "b" String Int m) => m (Maybe String) +multiMaps = do + insert' @"a" 1 "Hello" + insert' @"b" "World" 1 + maybeOne <- lookup' @"b" "World" + case maybeOne of + Nothing -> pure Nothing + Just one -> lookup' @"a" one + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "evaluates removal" $ + ( runIdentity -- result: Bool + . L.runMap -- result: Monad m => m Bool + $ removal ) -- effects: Map Int String + `shouldBe` True + it "evaluates modification" $ + ( runIdentity -- result: (Maybe String, Maybe String, Maybe String) + . S.runMap -- result: Monad m => m (Maybe String, Maybe String, Maybe String) + $ modification ) -- effects: Map Int String + `shouldBe` + (Just "Hello World", Just "N/A here?", Nothing) + it "evaluates multiple maps" $ + ( runIdentity -- result: Maybe String + . L.runMap' @"b" -- result: Monad m => m (Maybe String) + . S.runMap' @"a" -- effects: Map' "b" String Int + $ multiMaps ) -- effects: Map' "a" Int String, Map' "b" String Int + `shouldBe` Just "Hello"
+ examples/Example/RWS.hs view
@@ -0,0 +1,52 @@+-- | Examples of the RWS effect. +module Example.RWS where + +-- base +import Data.Monoid (Sum(Sum)) + +-- hspec +import Test.Hspec (Spec, it, shouldBe) + +-- effet +import Control.Effect.Identity +import Control.Effect.Reader +import Control.Effect.RWS +import Control.Effect.State +import qualified Control.Effect.State.Lazy as L +import qualified Control.Effect.Writer.Strict as S +import qualified Control.Effect.RWS.Lazy as L + +import Example.Reader (triple) +import Example.State (increment) +import Example.Writer (sumWriter) + +--- Example Programs ----------------------------------------------------------- + +-- | Combine reader, writer and state examples from the other test cases. +combineRWS :: RWS Int (Sum Int) Int m => m (Int, Int, Int) +combineRWS = do + r <- triple + w <- sumWriter + increment + s <- get + pure (r, w, s) + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "combines reader/write/state test cases" $ + ( runIdentity -- result: (Sum Int, Int, (Int, Int, Int)) + . L.runRWS 20 5 -- result: Monad m => m (Sum Int, Int, (Int, Int, Int)) + $ combineRWS ) -- effects: RWS Int (Sum Int) Int + `shouldBe` + (Sum 18, 6, (60, 13, 6)) + it "separates reader/write/state components" $ + ( runIdentity -- result: (Int, (Sum Int, (Int, Int, Int))) + . L.runState 3 -- result: Monad m => m (Int, (Sum Int, (Int, Int, Int))) + . S.runWriter -- effects: State Int + . runReader 15 -- effects: Writer (Sum Int), State Int + . runSeparatedRWS -- effects: Reader Int, Writer (Sum Int), State Int + $ combineRWS ) -- effects: RWS Int (Sum Int) Int + `shouldBe` + (4, (Sum 18, (45, 13, 4)))
+ examples/Example/Reader.hs view
@@ -0,0 +1,59 @@+-- | Examples of the reader effect. +module Example.Reader where + +-- base +import Control.Monad.IO.Class (MonadIO) +import Prelude hiding (print) + +-- hspec +import Test.Hspec (Spec, it, shouldBe) + +-- effet +import Control.Effect.Identity +import Control.Effect.Reader + +import Hspec (print, shouldPrint) + +--- Example Programs ----------------------------------------------------------- + +-- | Returns the triple of the number in the reader. +triple :: Reader Int m => m Int +triple = do + single <- ask + double <- asks (*2) + pure $ single + double + +-- | Prints the triple and sixfold of the number in the reader. +printTripleSix :: (MonadIO m, Reader Int m) => m () +printTripleSix = do + t <- triple + s <- local (*2) triple + print t + print s + +-- | Prints the double of reader "bar" and the triple of reader "foo". +printFooBar :: (MonadIO m, Reader' "bar" Int m, Reader' "foo" Int m) => m () +printFooBar = + local' @"bar" (*2) $ + local' @"foo" (*3) $ do + ask' @"bar" >>= print + ask' @"foo" >>= print + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "evaluates triple" $ + ( runIdentity -- result: Int + . runReader 22 -- result: Monad m => m Int + $ triple ) -- effects: Reader Int + `shouldBe` 66 + it "evaluates printTripleSix" $ + runReader 10 -- result: MonadIO m => m (), unified with IO () + printTripleSix -- effects: MonadIO, Reader Int + `shouldPrint` "30\n60\n" + it "evaluates printFooBar" $ + ( runReader' @"bar" 20 -- result: MonadIO m => m (), unified with IO () + . runReader' @"foo" 50 -- effects: MonadIO, Reader' "bar" Int + $ printFooBar -- effects: MonadIO, Reader' "bar" Int, Reader' "foo" Int + ) `shouldPrint` "40\n150\n"
+ examples/Example/Resource.hs view
@@ -0,0 +1,71 @@+-- | Examples of the resource effect. +module Example.Resource where + +-- base +import qualified Control.Exception as E +import Control.Monad.IO.Class (MonadIO) +import Prelude hiding (print) + +-- hspec +import Test.Hspec (Spec, it) + +-- effet +import Control.Effect.Error +import Control.Effect.Resource + +import Hspec (print, shouldPrint) + +--- Example Programs ----------------------------------------------------------- + +-- | Type used here as virtual handle. +newtype Handle = Handle { nameOf :: String } + +-- | Simple bracket with print outputs. +aBracket :: (MonadIO m, Resource m) => String -> m () +aBracket name = do + bracket + ( print ("Alloc " ++ name) >> pure (Handle name) ) + ( \handle -> print $ "Free " ++ nameOf handle ) + ( \handle -> print $ "Use " ++ nameOf handle ) + +-- | Simple bracket with print outputs. +aBracketOnError :: (MonadIO m, Resource m) => String -> m () +aBracketOnError name = do + bracketOnError + ( print ("Alloc " ++ name) >> pure (Handle name) ) + ( \handle -> print $ "Free " ++ nameOf handle ) + ( \handle -> print $ "Use " ++ nameOf handle ) + +-- | Bracket where the usage function throws an ArrayException. +errorBracket :: (Error String m, MonadIO m, Resource m) => String -> m () +errorBracket name = do + bracket + ( print ("Alloc " ++ name) >> pure (Handle name) ) + ( \handle -> print $ "Free " ++ nameOf handle ) + ( \handle -> E.throw (E.UndefinedElement $ nameOf handle ) ) + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "evaluates a bracket" $ + ( runResourceIO -- result: (MonadBaseControl IO m, MonadIO m) => m (), + -- unified with IO () + $ aBracket "X" ) -- effects: MonadIO, Resource + `shouldPrint` + "\"Alloc X\"\n\"Use X\"\n\"Free X\"\n" + it "evaluates a bracket without freeing" $ + ( runResourceIO -- result: (MonadBaseControl IO m, MonadIO m) => m (), + -- unified with IO () + $ aBracketOnError "X" ) -- effects: MonadIO, Resource + `shouldPrint` + "\"Alloc X\"\n\"Use X\"\n" + it "evaluates a bracket with an error" $ + ( runResourceIO -- result: (MonadBaseControl IO m, MonadIO m) => m (Either String ()), + -- unified with IO (Either String ()) + . runError -- effects: MonadIO, Resource + $ errorBracket "X" ) -- effects: Error String, MonadIO, Resource + `E.catch` + ( \(_ :: E.ArrayException) -> pure (Left "Intended error") ) + `shouldPrint` + "\"Alloc X\"\n\"Free X\"\n"
+ examples/Example/State.hs view
@@ -0,0 +1,66 @@+-- | Examples of the state effect. +module Example.State where + +-- hspec +import Test.Hspec (Spec, it, shouldBe) + +-- effet +import Control.Effect.Identity +import Control.Effect.State +import qualified Control.Effect.State.Lazy as L +import qualified Control.Effect.State.Strict as S + +--- Example Programs ----------------------------------------------------------- + +-- | Increments the state. +increment :: (Num n, State n m) => m () +increment = modify (+1) + +-- | Increments the state tagged "s" by 3 and adds up the old and new values. +incrementWithResult :: State' "s" Int m => m String +incrementWithResult = do + before <- get' @"s" + modify' @"s" (+3) + after <- get' @"s" + pure . show $ before + after + +-- | Increments two elements in a tuple. +incrementBoth :: (Num n1, Num n2, State (n1,n2) m) => m () +incrementBoth = modify (\(x,y) -> (x+1, y+1)) + +-- | Increments the state tagged "foo" by 1, +-- increments the state tagged "bar" by 2, +-- then adds up the two states. +twoStates :: (State' "foo" Int m, State' "bar" Int m) => m Int +twoStates = do + tagState' @"foo" $ increment + tagState' @"bar" $ increment >> increment + foo <- get' @"foo" + bar <- get' @"bar" + pure $ foo + bar + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "evaluates increment" $ + ( runIdentity -- result: Int + . L.execState 5 -- result: (Num n, Monad m) => m n + $ increment -- effects: Num n => State n + ) `shouldBe` (6::Int) + it "evaluates incrementWithResult" $ + ( runIdentity -- result: (Int, String) + . S.runState' @"s" 5 -- result: Monad m => m (Int, String) + $ incrementWithResult -- effects: State' "s" Int + ) `shouldBe` (8, "13") + it "evaluates incrementBoth" $ + ( runIdentity -- result: (Int, Int) + . L.execState (1,2) -- result: (Num n1, Num n2, Monad m) => m (n1, n2) + $ incrementBoth -- effects: (Num n1, Num n2) => State (n1, n2) + ) `shouldBe` (2::Int, 3::Int) + it "evaluates twoStates" $ + ( runIdentity -- result: (Int, (Int, Int)) + . L.runState' @"foo" 3 -- result: Monad m => m (Int, (Int, Int)) + . S.runState' @"bar" 5 -- effects: State' "foo" Int + $ twoStates -- effects: State' "foo" Int, State' "bar" Int + ) `shouldBe` (4, (7, 11))
+ examples/Example/Writer.hs view
@@ -0,0 +1,63 @@+-- | Examples of the writer effect. +module Example.Writer where + +-- base +import Data.Monoid (Sum(Sum), getSum) + +-- hspec +import Test.Hspec (Spec, it, shouldBe) + +-- effet +import Control.Effect.Identity +import Control.Effect.State +import Control.Effect.Writer +import qualified Control.Effect.State.Lazy as L +import qualified Control.Effect.Writer.Lazy as L +import qualified Control.Effect.Writer.Strict as S + +--- Example Programs ----------------------------------------------------------- + +-- | Write something in a sub-action, capture it and tell something again. +sumWriter :: Writer (Sum Int) m => m Int +sumWriter = do + (w,a) <- listen $ do tell 5 + pure 8 + tell w + tell a + pure $ getSum (w + a) + +-- | Combines the state and writer effect. +stateWriter :: (State Int m, Writer [Int] m) => m Int +stateWriter = do + tell [1,2,3] + num <- get + tell [num, num + 1, num + 2] + pure num + +-- | Censors (modifies) the output of sumWriter. +censorWriter :: Writer (Sum Int) m => m Int +censorWriter = censor (fmap (+1)) sumWriter + +--- Test Cases ----------------------------------------------------------------- + +spec :: Spec +spec = do + it "listens to sub-action writings" $ + ( runIdentity -- result: (Sum Int, Int) + . S.runWriter -- result: Monad m => m (Sum Int, Int) + $ sumWriter ) -- effects: Writer (Sum Int) + `shouldBe` + (Sum 18, 13) + it "combines state and writer" $ + ( runIdentity -- result: ([Int], Int) + . L.runWriter -- result: Monad m => m ([Int], Int) + . L.execState 4 -- effects: Writer [Int] + $ stateWriter ) -- effects: State Int, Writer [Int] + `shouldBe` + ([1,2,3,4,5,6], 4) + it "censors/modifies output" $ + ( runIdentity -- result: (Sum Int, Int) + . L.runWriter -- result: Monad m => m (Sum Int, Int) + $ censorWriter ) -- effects: Writer (Sum Int) + `shouldBe` + (Sum 19, 13)
+ examples/Hspec.hs view
@@ -0,0 +1,25 @@+module Hspec (print, shouldPrint) where + +-- base +import Control.Exception (bracket) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef) +import Prelude hiding (print) +import System.IO.Unsafe (unsafePerformIO) + +-- hspec +import Test.Hspec (shouldBe) + +stdoutMock :: IORef String +stdoutMock = unsafePerformIO (newIORef "") + +print :: (MonadIO m, Show a) => a -> m () +print txt = liftIO $ + modifyIORef stdoutMock (++ show txt ++ "\n") + +shouldPrint :: IO a -> String -> IO () +shouldPrint action expectedOutput = + bracket + ( action ) + ( \_ -> writeIORef stdoutMock "" ) + ( \_ -> readIORef stdoutMock >>= (`shouldBe` expectedOutput) )
+ examples/Main.hs view
@@ -0,0 +1,35 @@+module Main where + +-- hspec +import Test.Hspec (Spec, describe, hspec) + +import qualified Example.Cont +import qualified Example.Embed +import qualified Example.Error +import qualified Example.FileSystem +import qualified Example.Logger +import qualified Example.Managed +import qualified Example.Map +import qualified Example.Reader +import qualified Example.Resource +import qualified Example.RWS +import qualified Example.State +import qualified Example.Writer + +spec :: Spec +spec = do + describe "Cont" Example.Cont.spec + describe "Embed" Example.Embed.spec + describe "Error" Example.Error.spec + describe "FileSystem" Example.FileSystem.spec + describe "Logger" Example.Logger.spec + describe "Managed" Example.Managed.spec + describe "Map" Example.Map.spec + describe "Reader" Example.Reader.spec + describe "Resource" Example.Resource.spec + describe "RWS" Example.RWS.spec + describe "State" Example.State.spec + describe "Writer" Example.Writer.spec + +main :: IO () +main = hspec spec
+ src/Control/Effect/Identity.hs view
@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Module : Control.Effect.Identity+-- Copyright : (c) Michael Szvetits, 2020+-- License : BSD3 (see the file LICENSE)+-- Maintainer : typedbyte@qualified.name+-- Stability : stable+-- Portability : portable+--+-- This module provides the function 'runIdentity' for extracting the final+-- result of pure effect interpretations.+-----------------------------------------------------------------------------+module Control.Effect.Identity+ ( -- * Interpretations+ runIdentity+ ) where++-- base+import qualified Data.Functor.Identity as I++-- | Runs a computation using the 'I.Identity' monad.+--+-- You usually need this when an expression of type @Monad m => m a@ remains+-- after handling all the effects and you want to extract its pure result.+runIdentity :: I.Identity a -> a+runIdentity = I.runIdentity+{-# INLINE runIdentity #-}