git.iko.soy/typeable/ether
on master help sign in
swap
7b3583a46 ahead, 0 behind
78 files changed+2275−2391
since splitsnapshots
unifiedsplit
.gitignore+18−2 .travis.yml+25−18 ether/CHANGELOG.md → CHANGELOG.md+17−3 ether-flatten/LICENSE → LICENSE README.md−16 ether-flatten/Setup.hs → Setup.hs bench/Bench.hs+203 bench/TupleInstances.hs+9 ether-flatten/CHANGELOG.md ether-flatten/ether-flatten.cabal−44 ether-flatten/src/Control/Ether/Flatten.hs−89 ether-flatten/src/Control/Monad/Ether/Reader/Flatten.hs−78 ether-flatten/src/Control/Monad/Ether/State/Flatten.hs−81 ether-suite/Setup.hs−2 ether-suite/bench/Bench.hs−183 ether-suite/ether-suite.cabal−70 ether-zoom/CHANGELOG.md ether-zoom/LICENSE−30 ether-zoom/Setup.hs−2 ether-zoom/ether-zoom.cabal−40 ether-zoom/src/Control/Monad/Ether/State/Zoom.hs−45 ether.cabal+237 ether/LICENSE−30 ether/Setup.hs−2 ether/ether.cabal−82 ether/src/Control/Ether/Abbr.hs−60 ether/src/Control/Ether/Implicit/Abbr.hs−25 ether/src/Control/Monad/Ether.hs−14 ether/src/Control/Monad/Ether/Except.hs−88 ether/src/Control/Monad/Ether/Except/Class.hs−31 ether/src/Control/Monad/Ether/Implicit.hs−14 ether/src/Control/Monad/Ether/Implicit/Except.hs−60 ether/src/Control/Monad/Ether/Implicit/Reader.hs−59 ether/src/Control/Monad/Ether/Implicit/State.hs−8 ether/src/Control/Monad/Ether/Implicit/State/Lazy.hs−84 ether/src/Control/Monad/Ether/Implicit/State/Strict.hs−84 ether/src/Control/Monad/Ether/Implicit/Writer.hs−79 ether/src/Control/Monad/Ether/Reader.hs−107 ether/src/Control/Monad/Ether/Reader/Class.hs−47 ether/src/Control/Monad/Ether/State.hs−8 ether/src/Control/Monad/Ether/State/Class.hs−43 ether/src/Control/Monad/Ether/State/Common.hs−35 ether/src/Control/Monad/Ether/State/Lazy.hs−95 ether/src/Control/Monad/Ether/State/Strict.hs−95 ether/src/Control/Monad/Ether/TagAttach.hs−72 ether/src/Control/Monad/Ether/TagReplace.hs−67 ether/src/Control/Monad/Ether/Writer.hs−119 ether/src/Control/Monad/Ether/Writer/Class.hs−49 ether/src/Control/Monad/Trans/Ether/Dispatch.hs−150 shell.nix+22 src/Ether.hs+25 src/Ether/Except.hs+127 src/Ether/Internal.hs+68 src/Ether/Internal/HasLens.hs+24 src/Ether/Internal/TH_TupleInstances.hs+79 src/Ether/Internal/TH_Utils.hs+14 src/Ether/Internal/Tags.hs+18 src/Ether/Internal/TupleInstances.hs+24 src/Ether/Reader.hs+236 src/Ether/State.hs+415 src/Ether/TagDispatch.hs+138 src/Ether/TaggedTrans.hs+206 src/Ether/Writer.hs+287 stack.yaml−7 ether-suite/test/Regression.hs → test/Regression.hs ether-suite/test/Regression/T1.hs → test/Regression/T1.hs+16−5 ether-suite/test/Regression/T10.hs → test/Regression/T10.hs+11−10 ether-suite/test/Regression/T11.hs → test/Regression/T11.hs+4−4 ether-suite/test/Regression/T12.hs → test/Regression/T12.hs+3−4 ether-suite/test/Regression/T2.hs → test/Regression/T2.hs+7−9 ether-suite/test/Regression/T3.hs → test/Regression/T3.hs+2−3 ether-suite/test/Regression/T4.hs → test/Regression/T4.hs+2−3 ether-suite/test/Regression/T5.hs → test/Regression/T5.hs+8−11 ether-suite/test/Regression/T6.hs → test/Regression/T6.hs+14−16 ether-suite/test/Regression/T7.hs → test/Regression/T7.hs+1−1 ether-suite/test/Regression/T8.hs → test/Regression/T8.hs+2−3 ether-suite/test/Regression/T9.hs → test/Regression/T9.hs+4−5 test/TupleInstances.hs+9
.gitignore+18−2
@@ -1,5 +1,21 @@
1−tags
1+# Cabal
22dist
3−.stack-work
3+dist-newstyle
44.cabal-sandbox/
55cabal.sandbox.config
6+cabal.project.local
7+.ghc.environment*
8+
9+# Profiling
10+*.prof
11+
12+# Stack
13+.stack-work
14+
15+# Emacs
16+TAGS
17+.dir-locals.el
18+
19+# Vim
20+tags
21+*.swp
.travis.yml+25−18
@@ -1,24 +1,31 @@
1−sudo: false
1+language: nix
22
3−cache:
4− directories:
5− - $HOME/.stack/
3+os:
4+ - linux
5+ - osx
66
7−before_install:
8− - mkdir -p ~/.local/bin
9− - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
10− - export PATH=~/.local/bin:$PATH
11− - stack --version
12− - stack setup
7+env:
8+ - HC=ghc822
9+ - HC=ghc844
10+ - HC=ghc861
1311
14−install:
15− - stack install --only-dependencies --no-terminal
12+before_install:
13+ - curl https://raw.githubusercontent.com/monadfix/nix-cabal/master/nix-cabal -o nix-cabal && chmod u+x nix-cabal
14+ - travis_retry ./nix-cabal new-update
1615
1716script:
18− - stack test ether-suite:regression --no-terminal --ghc-options -Werror
19− - stack bench ether-suite:bench --no-terminal --ghc-options -Werror
17+ - ./nix-cabal new-test ether:regression
18+ - ./nix-cabal new-bench ether:bench
19+
20+cache:
21+ directories:
22+ - ~/.cabal
23+ - ~/.ghc
2024
21−addons:
22− apt:
23− packages:
24− - libgmp-dev
25+matrix:
26+ # broken at the moment
27+ exclude:
28+ - os: osx
29+ env: HC=ghc822
30+ - os: osx
31+ env: HC=ghc861
ether/CHANGELOG.md → CHANGELOG.mdrenamed+17−3
@@ -1,11 +1,25 @@
1+0.5.1.0
2+-------
3+
4+* Disable `HasLens` for tuples via cabal flag.
5+
160.5.0.0
27-------
38
4−* Support GHC 8.0 only.
5−* Utilize the `TypeApplications` extension.
9+* Support only GHC 8.0 and higher.
10+* Use the `TypeApplications` extension to get rid of `Proxy`.
611* Remove `Control.Ether.TH`.
7−* Use `Proxy#` in class methods.
12+* Remove `Control.Ether.Abbr`.
13+* Unify `Dispatch` and `TaggedTrans`.
14+* Better `MonadBase` and `MonadBaseControl` instances.
15+* Add flattening for `ReaderT` and `StateT`.
16+* Add zooming for `MonadState`.
17+* Simpler module structure.
18+
19+0.4.1.0
20+-------
821
22+* Export DispatchT newtype constructor.
923
10240.4.0.0
1125-------
ether-flatten/LICENSE → LICENSErenamed

The content is the same.

README.md−16
@@ -2,24 +2,8 @@
22
33[![Build Status](https://img.shields.io/travis/int-index/ether.svg)](https://travis-ci.org/int-index/ether)
44[![Hackage](https://img.shields.io/hackage/v/ether.svg)](https://hackage.haskell.org/package/ether)
5−[![Gitter](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/int-index/ether)
65
76
87Ether is a Haskell library that extends [mtl](https://hackage.haskell.org/package/mtl)
98and [transformers](https://hackage.haskell.org/package/transformers) with tagged
109monad transformers and classes in a compatible way.
11−
12−## Installation
13−
14−You can install `ether 0.4.0.0`
15−
16−1. using Cabal, from Hackage;
17−2. using Stack, from Stackage;
18−3. using Portage, from Gentoo Haskell Overlay.
19−
20−If unsure, use [Stack](https://github.com/commercialhaskell/stack).
21−
22−## Getting Started
23−
24−To get started, read the introduction on the [homepage](https://int-index.github.io/ether/).
25−If you need help with Ether or if you have any questions about it, ask me in the Gitter chat.
ether-flatten/Setup.hs → Setup.hsrenamed

The content is the same.

bench/Bench.hsnew file+203
@@ -0,0 +1,203 @@
1+{-# OPTIONS -fno-warn-partial-type-signatures #-}
2+
3+module Main (main) where
4+
5+import Control.DeepSeq
6+import qualified Control.Lens as L
7+import qualified Control.Monad.Reader as M
8+import qualified Control.Monad.State as M
9+import Criterion.Main
10+import Ether
11+import TupleInstances ()
12+
13+id' :: a -> a
14+id' = id
15+{-# NOINLINE id' #-}
16+
17+readerCombinerMTL_flat_9
18+ :: M.MonadReader (Int, Int, Int, Int, Int, Int, Int, Int, Int) m
19+ => m ()
20+readerCombinerMTL_flat_9 = do
21+ rnf <$> sequenceA
22+ [ L.view L._1
23+ , L.view L._2
24+ , L.view L._3
25+ , L.view L._4
26+ , L.view L._5
27+ , L.view L._6
28+ , L.view L._7
29+ , L.view L._8
30+ , L.view L._9 ]
31+{-# NOINLINE readerCombinerMTL_flat_9 #-}
32+
33+stateCombinerMTL_flat_9
34+ :: M.MonadState (Int, Int, Int, Int, Int, Int, Int, Int, Int) m
35+ => m ()
36+stateCombinerMTL_flat_9 = do
37+ M.modify (L.over L._1 id')
38+ M.modify (L.over L._2 id')
39+ M.modify (L.over L._3 id')
40+ M.modify (L.over L._4 id')
41+ M.modify (L.over L._5 id')
42+ M.modify (L.over L._6 id')
43+ M.modify (L.over L._7 id')
44+ M.modify (L.over L._8 id')
45+ M.modify (L.over L._9 id')
46+ rnf <$> sequenceA
47+ [ L.use L._1
48+ , L.use L._2
49+ , L.use L._3
50+ , L.use L._4
51+ , L.use L._5
52+ , L.use L._6
53+ , L.use L._7
54+ , L.use L._8
55+ , L.use L._9 ]
56+{-# NOINLINE stateCombinerMTL_flat_9 #-}
57+
58+run_readerCombinerMTL_flat_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> ()
59+run_readerCombinerMTL_flat_9
60+ (a1, a2, a3, a4, a5, a6, a7, a8, a9) =
61+ M.runReader readerCombinerMTL_flat_9 (a9, a8, a7, a6, a5, a4, a3, a2, a1)
62+
63+run_stateCombinerMTL_flat_9 ::
64+ (Int, Int, Int, Int, Int, Int, Int, Int, Int) ->
65+ ((), (Int, Int, Int, Int, Int, Int, Int, Int, Int))
66+run_stateCombinerMTL_flat_9
67+ (a1, a2, a3, a4, a5, a6, a7, a8, a9) =
68+ M.runState stateCombinerMTL_flat_9 (a9, a8, a7, a6, a5, a4, a3, a2, a1)
69+
70+readerCombinerEther_sep_9
71+ :: ( MonadReader 1 Int m
72+ , MonadReader 2 Int m
73+ , MonadReader 3 Int m
74+ , MonadReader 4 Int m
75+ , MonadReader 5 Int m
76+ , MonadReader 6 Int m
77+ , MonadReader 7 Int m
78+ , MonadReader 8 Int m
79+ , MonadReader 9 Int m )
80+ => m ()
81+readerCombinerEther_sep_9 = rnf <$> sequenceA
82+ [ ask @1
83+ , ask @2
84+ , ask @3
85+ , ask @4
86+ , ask @5
87+ , ask @6
88+ , ask @7
89+ , ask @8
90+ , ask @9 ]
91+{-# NOINLINE readerCombinerEther_sep_9 #-}
92+
93+stateCombinerEther_sep_9
94+ :: ( MonadState 1 Int m
95+ , MonadState 2 Int m
96+ , MonadState 3 Int m
97+ , MonadState 4 Int m
98+ , MonadState 5 Int m
99+ , MonadState 6 Int m
100+ , MonadState 7 Int m
101+ , MonadState 8 Int m
102+ , MonadState 9 Int m )
103+ => m ()
104+stateCombinerEther_sep_9 = do
105+ modify @1 id'
106+ modify @2 id'
107+ modify @3 id'
108+ modify @4 id'
109+ modify @5 id'
110+ modify @6 id'
111+ modify @7 id'
112+ modify @8 id'
113+ modify @9 id'
114+ rnf <$> sequenceA
115+ [ get @1
116+ , get @2
117+ , get @3
118+ , get @4
119+ , get @5
120+ , get @6
121+ , get @7
122+ , get @8
123+ , get @9 ]
124+{-# NOINLINE stateCombinerEther_sep_9 #-}
125+
126+run_readerCombinerEther_nested_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> ()
127+run_readerCombinerEther_nested_9
128+ (a1, a2, a3, a4, a5, a6, a7, a8, a9)
129+ = flip (runReader @9) a1
130+ . flip (runReaderT @8) a2
131+ . flip (runReaderT @7) a3
132+ . flip (runReaderT @6) a4
133+ . flip (runReaderT @5) a5
134+ . flip (runReaderT @4) a6
135+ . flip (runReaderT @3) a7
136+ . flip (runReaderT @2) a8
137+ . flip (runReaderT @1) a9
138+ $ readerCombinerEther_sep_9
139+
140+run_readerCombinerEther_flatten_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> ()
141+run_readerCombinerEther_flatten_9
142+ (a1, a2, a3, a4, a5, a6, a7, a8, a9)
143+ =
144+ runReaders
145+ readerCombinerEther_sep_9
146+ ( Tagged @1 a9,
147+ Tagged @2 a8,
148+ Tagged @3 a7,
149+ Tagged @4 a6,
150+ Tagged @5 a5,
151+ Tagged @6 a4,
152+ Tagged @7 a3,
153+ Tagged @8 a2,
154+ Tagged @9 a1 )
155+
156+run_readerCombinerEther_flattenhalf_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> ()
157+run_readerCombinerEther_flattenhalf_9
158+ (a1, a2, a3, a4, a5, a6, a7, a8, a9) =
159+ flip runReaders
160+ ( Tagged @1 a9,
161+ Tagged @2 a8,
162+ Tagged @3 a7,
163+ Tagged @4 a6 ) .
164+ flip runReadersT
165+ ( Tagged @5 a5,
166+ Tagged @6 a4,
167+ Tagged @7 a3,
168+ Tagged @8 a2,
169+ Tagged @9 a1 ) $
170+ readerCombinerEther_sep_9
171+
172+run_stateCombinerEther_flatten_9 ::
173+ (Int, Int, Int, Int, Int, Int, Int, Int, Int) ->
174+ ((), _)
175+run_stateCombinerEther_flatten_9
176+ (a1, a2, a3, a4, a5, a6, a7, a8, a9)
177+ =
178+ runStates
179+ stateCombinerEther_sep_9
180+ ( Tagged @1 a9,
181+ Tagged @2 a8,
182+ Tagged @3 a7,
183+ Tagged @4 a6,
184+ Tagged @5 a5,
185+ Tagged @6 a4,
186+ Tagged @7 a3,
187+ Tagged @8 a2,
188+ Tagged @9 a1 )
189+
190+tuple_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int)
191+tuple_9 = (1, -2, 3, -4, 5, -6, 7, -8, 9)
192+
193+main :: IO ()
194+main = do
195+ defaultMain
196+ [ bench "readerCombinerMTL_flat_9" $ nf run_readerCombinerMTL_flat_9 tuple_9
197+ , bench "readerCombinerEther_nested_9" $ nf run_readerCombinerEther_nested_9 tuple_9
198+ , bench "readerCombinerEther_flatten_9" $ nf run_readerCombinerEther_flatten_9 tuple_9
199+ , bench "readerCombinerEther_flattenhalf_9" $
200+ nf run_readerCombinerEther_flattenhalf_9 tuple_9
201+ , bench "stateCombinerMTL_flat_9" $ nf run_stateCombinerMTL_flat_9 tuple_9
202+ , bench "stateCombinerEther_flatten_9" $ nf run_stateCombinerEther_flatten_9 tuple_9
203+ ]
bench/TupleInstances.hsnew file+9
@@ -0,0 +1,9 @@
1+{-# OPTIONS -fno-warn-orphans #-}
2+{-# LANGUAGE CPP #-}
3+
4+module TupleInstances () where
5+
6+#ifdef DISABLE_TUP_INSTANCES
7+import Ether.Internal (makeTupleInstancesHasLens)
8+makeTupleInstancesHasLens [4,5,9]
9+#endif
ether-flatten/CHANGELOG.mddeleted

No changes to the content.

ether-flatten/ether-flatten.cabaldeleted−44
@@ -1,44 +0,0 @@
1−name: ether-flatten
2−version: 0.1.0.0
3−synopsis: Flatten nested monad transformers
4−description:
5− Flatten nested monad transformers to gain performance.
6−
7−category: Control
8−license: BSD3
9−license-file: LICENSE
10−author: Vladislav Zavialov
11−maintainer: Vladislav Zavialov <vlad.z.4096@gmail.com>
12−homepage: https://int-index.github.io/ether/
13−bug-reports: https://github.com/int-index/ether/issues
14−build-type: Simple
15−cabal-version: >=1.18
16−extra-source-files: CHANGELOG.md
17−
18−source-repository head
19−
20− type: git
21− location: git@github.com:int-index/ether.git
22−
23−
24−library
25−
26− exposed-modules: Control.Monad.Ether.Reader.Flatten
27− , Control.Monad.Ether.State.Flatten
28− , Control.Ether.Flatten
29− build-depends: base >=4.9 && <4.10
30− , ether >=0.5 && <0.6
31− , transformers >=0.4.2
32− , transformers-lift >=0.1.0.1
33− , ghc-prim >=0.3
34− , lens >=4.14
35− , deepseq >= 1.4
36−
37− default-language: Haskell2010
38− default-extensions: PolyKinds
39− ScopedTypeVariables
40− FunctionalDependencies
41− TypeApplications
42−
43− hs-source-dirs: src
44− ghc-options: -Wall
ether-flatten/src/Control/Ether/Flatten.hsdeleted−89
@@ -1,89 +0,0 @@
1−{-# LANGUAGE RankNTypes #-}
2−{-# LANGUAGE TypeSynonymInstances #-}
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE TypeOperators #-}
5−{-# LANGUAGE UndecidableInstances #-}
6−{-# LANGUAGE FlexibleInstances #-}
7−{-# LANGUAGE GADTs #-}
8−{-# LANGUAGE TypeFamilies #-}
9−{-# LANGUAGE MagicHash #-}
10−
11−module Control.Ether.Flatten
12− ( HasLens(..)
13− , Product
14− , load
15− , type (++)
16− , (<+>)
17− ) where
18−
19−import Control.Lens
20−import Control.DeepSeq
21−import GHC.Prim (Proxy#)
22−
23−class HasLens tag outer inner | tag outer -> inner where
24− lensOf :: Proxy# tag -> Lens' outer inner
25−
26−data Product (ts :: [k]) (as :: [*]) where
27− Nil :: Product '[] '[]
28− Cons :: a -> !(Product ts as) -> Product (t ': ts) (a ': as)
29−
30−instance NFData (Product '[] '[]) where
31− rnf Nil = ()
32−
33−instance
34− ( NFData a
35− , NFData (Product ts as)
36− ) => NFData (Product (t ': ts) (a ': as))
37− where
38− rnf (Cons a as) = rnf a `seq` rnf as
39−
40−load :: forall tag a . a -> Product '[tag] '[a]
41−load a = Cons a Nil
42−{-# INLINE load #-}
43−
44−type family (xs1 :: [k]) ++ (xs2 :: [k]) :: [k] where
45− '[] ++ xs2 = xs2
46− (a ': xs1) ++ xs2 = a ': (xs1 ++ xs2)
47−
48−(<+>)
49− :: Product ts1 as1
50− -> Product ts2 as2
51− -> Product (ts1 ++ ts2) (as1 ++ as2)
52−Nil <+> as2 = as2
53−Cons a as1 <+> as2 = Cons a (as1 <+> as2)
54−{-# INLINE (<+>) #-}
55−
56−productHead ::
57− Lens
58− (Product (t1 ': ts) (a ': as))
59− (Product (t2 ': ts) (b ': as))
60− a
61− b
62−productHead =
63− lens
64− (\(Cons a _) -> a)
65− (\(Cons _ as) a -> Cons a as)
66−{-# INLINE productHead #-}
67−
68−productTail ::
69− Lens
70− (Product (t ': ts1) (a ': as))
71− (Product (t ': ts2) (a ': bs))
72− (Product ts1 as)
73− (Product ts2 bs)
74−productTail =
75− lens
76− (\(Cons _ as) -> as)
77− (\(Cons a _) as -> Cons a as)
78−{-# INLINE productTail #-}
79−
80−instance a ~ b => HasLens tag (Product (tag ': tags) (a ': as)) b where
81− lensOf _ = productHead
82− {-# INLINE lensOf #-}
83−
84−instance {-# OVERLAPPABLE #-}
85− ( HasLens tag (Product tags as) a
86− ) => HasLens tag (Product (t ': tags) (b ': as)) a
87− where
88− lensOf t = productTail . lensOf t
89− {-# INLINE lensOf #-}
ether-flatten/src/Control/Monad/Ether/Reader/Flatten.hsdeleted−78
@@ -1,78 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
3−{-# LANGUAGE RankNTypes #-}
4−{-# LANGUAGE TypeSynonymInstances #-}
5−{-# LANGUAGE DataKinds #-}
6−{-# LANGUAGE TypeOperators #-}
7−{-# LANGUAGE UndecidableInstances #-}
8−{-# LANGUAGE FlexibleInstances #-}
9−{-# LANGUAGE GADTs #-}
10−{-# LANGUAGE TypeFamilies #-}
11−{-# LANGUAGE MagicHash #-}
12−
13−module Control.Monad.Ether.Reader.Flatten
14− ( runReader
15− , runReaderT
16− ) where
17−
18−import qualified Control.Monad.Trans.Lift.Local as Lift
19−
20−import Data.Functor.Identity
21−import Control.Monad.Ether.Reader.Class as C
22−import Control.Monad.Trans.Ether.Dispatch
23−import qualified Control.Monad.Trans.Reader as T
24−import Control.Lens
25−import Control.Ether.Flatten
26−
27−data READER (ts :: [k])
28−
29−type ReaderT ts r = Dispatch (READER ts) (T.ReaderT r)
30−
31−type Reader ts r = ReaderT ts r Identity
32−
33−reflatten
34− :: forall tagsOld tagsNew r m a
35− . ReaderT tagsOld r m a
36− -> ReaderT tagsNew r m a
37−reflatten = repack
38−{-# INLINE reflatten #-}
39−
40−instance
41− ( Monad m, Monad (trans m)
42− , Lift.MonadTrans trans
43− , Lift.LiftLocal trans
44− , C.MonadReader tag r m
45− ) => C.MonadReader tag r (Dispatch (READER '[]) trans m)
46− where
47− ask t = Lift.lift (ask t)
48− local t = Lift.liftLocal (ask t) (local t)
49−
50−instance
51− ( Monad m, HasLens tag payload r
52− , trans ~ T.ReaderT payload
53− ) => C.MonadReader tag r (Dispatch (READER (tag ': tags)) trans m)
54− where
55− ask t = pack $ view (lensOf t)
56− {-# INLINE ask #-}
57− local t f = pack . T.local (over (lensOf t) f) . unpack
58− {-# INLINE local #-}
59−
60−instance {-# OVERLAPPABLE #-}
61− ( Monad m
62− , C.MonadReader tag r (Dispatch (READER tags) trans m)
63− , trans ~ T.ReaderT payload
64− ) => C.MonadReader tag r (Dispatch (READER (t ': tags)) trans m)
65− where
66− ask t = reflatten @tags @(t ': tags) (C.ask t)
67− {-# INLINE ask #-}
68− local t f
69− = reflatten @tags @(t ': tags)
70− . C.local t f
71− . reflatten @(t ': tags) @tags
72− {-# INLINE local #-}
73−
74−runReaderT :: ReaderT tags (Product tags as) m a -> Product tags as -> m a
75−runReaderT m = T.runReaderT (unpack m)
76−
77−runReader :: Reader tags (Product tags as) a -> Product tags as -> a
78−runReader m = T.runReader (unpack m)
ether-flatten/src/Control/Monad/Ether/State/Flatten.hsdeleted−81
@@ -1,81 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
3−{-# LANGUAGE RankNTypes #-}
4−{-# LANGUAGE TypeSynonymInstances #-}
5−{-# LANGUAGE DataKinds #-}
6−{-# LANGUAGE TypeOperators #-}
7−{-# LANGUAGE UndecidableInstances #-}
8−{-# LANGUAGE FlexibleInstances #-}
9−{-# LANGUAGE GADTs #-}
10−{-# LANGUAGE TypeFamilies #-}
11−{-# LANGUAGE MagicHash #-}
12−
13−module Control.Monad.Ether.State.Flatten
14− ( runState
15− , runStateT
16− ) where
17−
18−import qualified Control.Monad.Trans.Class as Lift
19−
20−import Data.Functor.Identity
21−import Control.Monad.Ether.State.Class as C
22−import Control.Monad.Trans.Ether.Dispatch
23−import qualified Control.Monad.Trans.State as T
24−import Control.Lens
25−import Control.Ether.Flatten
26−
27−data STATE (ts :: [k])
28−
29−type StateT ts s = Dispatch (STATE ts) (T.StateT s)
30−
31−type State ts s = StateT ts s Identity
32−
33−reflatten
34− :: forall tagsOld tagsNew s m a
35− . StateT tagsOld s m a
36− -> StateT tagsNew s m a
37−reflatten = repack
38−{-# INLINE reflatten #-}
39−
40−instance
41− ( Monad m, Monad (trans m)
42− , Lift.MonadTrans trans
43− , C.MonadState tag s m
44− ) => C.MonadState tag s (Dispatch (STATE '[]) trans m)
45− where
46− get t = Lift.lift (get t)
47− put t = Lift.lift . put t
48− state t = Lift.lift . state t
49−
50−instance
51− ( Monad m, HasLens tag payload s
52− , trans ~ T.StateT payload
53− ) => C.MonadState tag s (Dispatch (STATE (tag ': tags)) trans m)
54− where
55− get t = pack $ use (lensOf t)
56− {-# INLINE get #-}
57− put t s = pack $ zoom (lensOf t) (T.put s)
58− {-# INLINE put #-}
59−
60−instance {-# OVERLAPPABLE #-}
61− ( Monad m
62− , C.MonadState tag s (Dispatch (STATE tags) trans m)
63− , trans ~ T.StateT payload
64− ) => C.MonadState tag s (Dispatch (STATE (t ': tags)) trans m)
65− where
66− get t = reflatten @tags @(t ': tags) (C.get t)
67− {-# INLINE get #-}
68− put t = reflatten @tags @(t ': tags) . C.put t
69− {-# INLINE put #-}
70−
71−runStateT
72− :: StateT tags (Product tags as) m a
73− -> Product tags as
74− -> m (a, Product tags as)
75−runStateT m = T.runStateT (unpack m)
76−
77−runState
78− :: State tags (Product tags as) a
79− -> Product tags as
80− -> (a, Product tags as)
81−runState m = T.runState (unpack m)
ether-suite/Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
ether-suite/bench/Bench.hsdeleted−183
@@ -1,183 +0,0 @@
1−{-# LANGUAGE TypeApplications #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE FunctionalDependencies #-}
4−{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE DataKinds #-}
6−
7−module Main (main) where
8−
9−import Criterion.Main
10−import qualified Control.Monad.Reader as M
11−import qualified Control.Monad.State as M
12−import qualified Control.Monad.Ether.Reader as E
13−import qualified Control.Monad.Ether.State as E
14−import qualified Control.Monad.Ether.Reader.Flatten as E.F
15−import qualified Control.Monad.Ether.State.Flatten as E.F
16−import Control.Ether.Flatten
17−import qualified Control.Lens as L
18−
19−readerSummatorMTL_flat_9
20− :: M.MonadReader (Int, Int, Int, Int, Int, Int, Int, Int, Int) m
21− => m String
22−readerSummatorMTL_flat_9 = do
23− concat <$> sequenceA
24− [ show <$> L.view L._1
25− , show <$> L.view L._2
26− , show <$> L.view L._3
27− , show <$> L.view L._4
28− , show <$> L.view L._5
29− , show <$> L.view L._6
30− , show <$> L.view L._7
31− , show <$> L.view L._8
32− , show <$> L.view L._9 ]
33−{-# NOINLINE readerSummatorMTL_flat_9 #-}
34−
35−stateSummatorMTL_flat_9
36− :: M.MonadState (Int, Int, Int, Int, Int, Int, Int, Int, Int) m
37− => m String
38−stateSummatorMTL_flat_9 = do
39− M.modify (L.over L._1 (+1))
40− M.modify (L.over L._2 (+2))
41− M.modify (L.over L._3 (+3))
42− M.modify (L.over L._4 (+4))
43− M.modify (L.over L._5 (+5))
44− M.modify (L.over L._6 (+6))
45− M.modify (L.over L._7 (+7))
46− M.modify (L.over L._8 (+8))
47− M.modify (L.over L._9 (+9))
48− concat <$> sequenceA
49− [ show <$> L.use L._1
50− , show <$> L.use L._2
51− , show <$> L.use L._3
52− , show <$> L.use L._4
53− , show <$> L.use L._5
54− , show <$> L.use L._6
55− , show <$> L.use L._7
56− , show <$> L.use L._8
57− , show <$> L.use L._9 ]
58−{-# NOINLINE stateSummatorMTL_flat_9 #-}
59−
60−run_readerSummatorMTL_flat_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> String
61−run_readerSummatorMTL_flat_9
62− (a1, a2, a3, a4, a5, a6, a7, a8, a9) =
63− M.runReader readerSummatorMTL_flat_9 (a9, a8, a7, a6, a5, a4, a3, a2, a1)
64−
65−run_stateSummatorMTL_flat_9 ::
66− (Int, Int, Int, Int, Int, Int, Int, Int, Int) ->
67− (String, (Int, Int, Int, Int, Int, Int, Int, Int, Int))
68−run_stateSummatorMTL_flat_9
69− (a1, a2, a3, a4, a5, a6, a7, a8, a9) =
70− M.runState stateSummatorMTL_flat_9 (a9, a8, a7, a6, a5, a4, a3, a2, a1)
71−
72−readerSummatorEther_sep_9
73− :: ( E.MonadReader 1 Int m
74− , E.MonadReader 2 Int m
75− , E.MonadReader 3 Int m
76− , E.MonadReader 4 Int m
77− , E.MonadReader 5 Int m
78− , E.MonadReader 6 Int m
79− , E.MonadReader 7 Int m
80− , E.MonadReader 8 Int m
81− , E.MonadReader 9 Int m )
82− => m String
83−readerSummatorEther_sep_9 = concat <$> sequenceA
84− [ show <$> E.ask @1
85− , show <$> E.ask @2
86− , show <$> E.ask @3
87− , show <$> E.ask @4
88− , show <$> E.ask @5
89− , show <$> E.ask @6
90− , show <$> E.ask @7
91− , show <$> E.ask @8
92− , show <$> E.ask @9 ]
93−{-# NOINLINE readerSummatorEther_sep_9 #-}
94−
95−stateSummatorEther_sep_9
96− :: ( E.MonadState 1 Int m
97− , E.MonadState 2 Int m
98− , E.MonadState 3 Int m
99− , E.MonadState 4 Int m
100− , E.MonadState 5 Int m
101− , E.MonadState 6 Int m
102− , E.MonadState 7 Int m
103− , E.MonadState 8 Int m
104− , E.MonadState 9 Int m )
105− => m String
106−stateSummatorEther_sep_9 = do
107− E.modify @1 (+1)
108− E.modify @2 (+2)
109− E.modify @3 (+3)
110− E.modify @4 (+4)
111− E.modify @5 (+5)
112− E.modify @6 (+6)
113− E.modify @7 (+7)
114− E.modify @8 (+8)
115− E.modify @9 (+9)
116− concat <$> sequenceA
117− [ show <$> E.get @1
118− , show <$> E.get @2
119− , show <$> E.get @3
120− , show <$> E.get @4
121− , show <$> E.get @5
122− , show <$> E.get @6
123− , show <$> E.get @7
124− , show <$> E.get @8
125− , show <$> E.get @9 ]
126−
127−run_readerSummatorEther_nested_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> String
128−run_readerSummatorEther_nested_9
129− (a1, a2, a3, a4, a5, a6, a7, a8, a9)
130− = flip (E.runReader @9) a1
131− . flip (E.runReaderT @8) a2
132− . flip (E.runReaderT @7) a3
133− . flip (E.runReaderT @6) a4
134− . flip (E.runReaderT @5) a5
135− . flip (E.runReaderT @4) a6
136− . flip (E.runReaderT @3) a7
137− . flip (E.runReaderT @2) a8
138− . flip (E.runReaderT @1) a9
139− $ readerSummatorEther_sep_9
140−
141−run_readerSummatorEther_flatten_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> String
142−run_readerSummatorEther_flatten_9
143− (a1, a2, a3, a4, a5, a6, a7, a8, a9)
144− =
145− E.F.runReader
146− readerSummatorEther_sep_9
147− ( load @1 a9 <+> load @2 a8 <+> load @3 a7 <+> load @4 a6 <+>
148− load @5 a5 <+> load @6 a4 <+> load @7 a3 <+> load @8 a2 <+>
149− load @9 a1 )
150−
151−run_readerSummatorEther_flattenhalf_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> String
152−run_readerSummatorEther_flattenhalf_9
153− (a1, a2, a3, a4, a5, a6, a7, a8, a9)
154− = flip E.F.runReader (load @1 a9 <+> load @2 a8 <+> load @3 a7 <+> load @4 a6)
155− . flip E.F.runReaderT (load @5 a5 <+> load @6 a4 <+> load @7 a3 <+> load @8 a2 <+> load @9 a1)
156− $ readerSummatorEther_sep_9
157−
158−run_stateSummatorEther_flatten_9 ::
159− (Int, Int, Int, Int, Int, Int, Int, Int, Int) ->
160− (String, Product '[1,2,3,4,5,6,7,8,9] '[Int,Int,Int,Int,Int,Int,Int,Int,Int])
161−run_stateSummatorEther_flatten_9
162− (a1, a2, a3, a4, a5, a6, a7, a8, a9)
163− =
164− E.F.runState
165− stateSummatorEther_sep_9
166− ( load @1 a9 <+> load @2 a8 <+> load @3 a7 <+> load @4 a6 <+>
167− load @5 a5 <+> load @6 a4 <+> load @7 a3 <+> load @8 a2 <+>
168− load @9 a1 )
169−
170−tuple_9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int)
171−tuple_9 = (1, -2, 3, -4, 5, -6, 7, -8, 9)
172−
173−main :: IO ()
174−main = do
175− defaultMain
176− [ bench "readerSummatorMTL_flat_9" $ nf run_readerSummatorMTL_flat_9 tuple_9
177− , bench "readerSummatorEther_nested_9" $ nf run_readerSummatorEther_nested_9 tuple_9
178− , bench "readerSummatorEther_flatten_9" $ nf run_readerSummatorEther_flatten_9 tuple_9
179− , bench "readerSummatorEther_flattenhalf_9" $
180− nf run_readerSummatorEther_flattenhalf_9 tuple_9
181− , bench "stateSummatorMTL_flat_9" $ nf run_stateSummatorMTL_flat_9 tuple_9
182− , bench "stateSummatorEther_flatten_9" $ nf run_stateSummatorEther_flatten_9 tuple_9
183− ]
ether-suite/ether-suite.cabaldeleted−70
@@ -1,70 +0,0 @@
1−name: ether-suite
2−version: 0.1.0.0
3−build-type: Simple
4−cabal-version: >=1.18
5−
6−library
7− -- Dummy section.
8− default-language: Haskell2010
9−
10−test-suite regression
11−
12− build-depends: base >=4.9 && <4.10
13− , transformers >=0.4.2
14− , mtl >=2.2.1
15− , tasty >=0.10
16− , tasty-quickcheck >=0.8
17− , QuickCheck >=2.8
18− , ghc-prim >=0.3
19− , lens >=4.14
20− , ether
21− , ether-zoom
22−
23− main-is: Regression.hs
24− other-modules: Regression.T1
25− Regression.T2
26− Regression.T3
27− Regression.T4
28− Regression.T5
29− Regression.T6
30− Regression.T7
31− Regression.T8
32− Regression.T9
33− Regression.T10
34− Regression.T11
35− Regression.T12
36−
37− type: exitcode-stdio-1.0
38− hs-source-dirs: test
39− default-language: Haskell2010
40− default-extensions: ConstraintKinds
41− DataKinds
42− EmptyDataDecls
43− FlexibleContexts
44− GeneralizedNewtypeDeriving
45− LambdaCase
46− PolyKinds
47− ScopedTypeVariables
48− TypeApplications
49− TypeFamilies
50− TypeOperators
51− ghc-options: -Wall -fno-warn-missing-signatures
52−
53−
54−benchmark bench
55−
56− build-depends: base >=4.9 && <4.10
57− , mtl >=2.2.1
58− , transformers >=0.4.2
59− , criterion >=1.1
60− , lens >=4.14
61− , ether
62− , ether-flatten
63−
64− main-is: Bench.hs
65−
66− type: exitcode-stdio-1.0
67− hs-source-dirs: bench
68− default-language: Haskell2010
69− ghc-options: -Wall -O2
70− ghc-prof-options: -fprof-auto
ether-zoom/CHANGELOG.mddeleted

No changes to the content.

ether-zoom/LICENSEdeleted−30
@@ -1,30 +0,0 @@
1−Copyright (c) 2017, Vladislav Zavialov
2−
3−All rights reserved.
4−
5−Redistribution and use in source and binary forms, with or without
6−modification, are permitted provided that the following conditions are met:
7−
8− * Redistributions of source code must retain the above copyright
9− notice, this list of conditions and the following disclaimer.
10−
11− * Redistributions in binary form must reproduce the above
12− copyright notice, this list of conditions and the following
13− disclaimer in the documentation and/or other materials provided
14− with the distribution.
15−
16− * Neither the name of Vladislav Zavialov nor the names of other
17− contributors may be used to endorse or promote products derived
18− from this software without specific prior written permission.
19−
20−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
ether-zoom/Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
ether-zoom/ether-zoom.cabaldeleted−40
@@ -1,40 +0,0 @@
1−name: ether-zoom
2−version: 0.1.0.0
3−synopsis: Zoom for the state monad
4−description:
5− Zoom into parts of a state using a lens.
6−
7−category: Control
8−license: BSD3
9−license-file: LICENSE
10−author: Vladislav Zavialov
11−maintainer: Vladislav Zavialov <vlad.z.4096@gmail.com>
12−homepage: https://int-index.github.io/ether/
13−bug-reports: https://github.com/int-index/ether/issues
14−build-type: Simple
15−cabal-version: >=1.18
16−extra-source-files: CHANGELOG.md
17−
18−source-repository head
19−
20− type: git
21− location: git@github.com:int-index/ether.git
22−
23−
24−library
25−
26− exposed-modules: Control.Monad.Ether.State.Zoom
27− build-depends: base >=4.9 && <4.10
28− , ether >=0.5 && <0.6
29− , transformers >=0.5
30− , lens >=4.14
31− , reflection >=2.1
32−
33− default-language: Haskell2010
34− default-extensions: PolyKinds
35− ScopedTypeVariables
36− FunctionalDependencies
37− TypeApplications
38−
39− hs-source-dirs: src
40− ghc-options: -Wall
ether-zoom/src/Control/Monad/Ether/State/Zoom.hsdeleted−45
@@ -1,45 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE RankNTypes #-}
5−{-# LANGUAGE TypeSynonymInstances #-}
6−{-# LANGUAGE FlexibleInstances #-}
7−{-# LANGUAGE FlexibleContexts #-}
8−{-# LANGUAGE UndecidableInstances #-}
9−{-# LANGUAGE TypeFamilies #-}
10−
11−module Control.Monad.Ether.State.Zoom
12− ( TAG_ZOOM
13− , TagZoomT
14− , tagZoom
15− ) where
16−
17−import Control.Lens
18−import Data.Reflection
19−import Control.Monad.Trans.Ether.Dispatch
20−import Control.Monad.Trans.Identity
21−import Control.Monad.Ether.State.Class
22−import Data.Proxy
23−
24−-- | Encode type-level information for 'tagZoom'.
25−data TAG_ZOOM t z
26−
27−type TagZoomT t (z :: *) = Dispatch (TAG_ZOOM t z) IdentityT
28−
29−-- | Zoom into a part of a state using a lens.
30−tagZoom
31− :: forall tag sOuter sInner m a
32− . Lens' sOuter sInner
33− -> (forall z . Reifies z (ReifiedLens' sOuter sInner) => TagZoomT tag z m a)
34− -> m a
35−tagZoom l m = reify (Lens l) (\(_ :: Proxy z) -> (runIdentityT . unpack) (m @z))
36−
37−instance
38− ( MonadState tag sOuter m
39− , Reifies z (ReifiedLens' sOuter sInner)
40− , trans ~ IdentityT
41− ) => MonadState tag sInner (Dispatch (TAG_ZOOM tag z) trans m)
42− where
43− state t =
44− let Lens l = reflect (Proxy :: Proxy z)
45− in pack . IdentityT . state t . l
ether.cabalnew file+237
@@ -0,0 +1,237 @@
1+cabal-version: 2.2
2+name: ether
3+version: 0.5.2.0
4+synopsis: Monad transformers and classes
5+description: Lib
6+license: BSD-3-Clause
7+-- ^ unfortunately have to change this line due to the issue with cabal2nix
8+license-file: LICENSE
9+category: Control
10+author: Vladislav Zavialov
11+maintainer: Vladislav Zavialov <vlad.z.4096@gmail.com>
12+homepage: https://int-index.github.io/ether/
13+bug-reports: https://github.com/int-index/ether/issues
14+build-type: Simple
15+extra-source-files: CHANGELOG.md
16+
17+source-repository head
18+
19+ type: git
20+ location: git@github.com:int-index/ether.git
21+
22+
23+flag disable-tup-instances
24+
25+ description:
26+ Disable auto-generated 'HasLens' instances for tuples. The reason one
27+ might want to do this is to reduce the size of .hi-files, as well as the
28+ time and memory GHC needs to build Ether. To recover flattening with
29+ tuples, use 'Ether.Internal.makeTupleInstancesHasLens' at specific tuple
30+ sizes you need in your application.
31+
32+ This is a build-time performance hack, enable this flag at your own risk.
33+
34+ default: False
35+ manual: True
36+
37+library
38+
39+ exposed-modules:
40+ Ether
41+ Ether.Reader
42+ Ether.State
43+ Ether.Writer
44+ Ether.Except
45+ Ether.TaggedTrans
46+ Ether.TagDispatch
47+ Ether.Internal
48+
49+ other-modules:
50+ Ether.Internal.Tags
51+ Ether.Internal.HasLens
52+ Ether.Internal.TH_Utils
53+ Ether.Internal.TH_TupleInstances
54+ Ether.Internal.TupleInstances
55+
56+ build-depends:
57+ base >=4.9 && <4.13,
58+ transformers >=0.5.2.0,
59+ transformers-lift >=0.2.0.1,
60+ mtl >=2.2.2,
61+ mmorph >=1.0.4,
62+ monad-control >=1.0.0.4,
63+ transformers-base >=0.4.4,
64+ writer-cps-mtl >= 0.1.1.4,
65+ exceptions >=0.8,
66+ template-haskell >=2.11,
67+ tagged >=0.8.5,
68+ reflection >=2.1
69+
70+ default-language:
71+ Haskell2010
72+
73+ default-extensions:
74+ AllowAmbiguousTypes
75+ ConstraintKinds
76+ DataKinds
77+ DeriveGeneric
78+ EmptyDataDecls
79+ FlexibleContexts
80+ FlexibleInstances
81+ FunctionalDependencies
82+ GADTs
83+ GeneralizedNewtypeDeriving
84+ PartialTypeSignatures
85+ PolyKinds
86+ ScopedTypeVariables
87+ RankNTypes
88+ TemplateHaskell
89+ TupleSections
90+ TypeApplications
91+ TypeFamilies
92+ TypeInType
93+ TypeOperators
94+ TypeSynonymInstances
95+ UndecidableInstances
96+ UndecidableSuperClasses
97+
98+ hs-source-dirs:
99+ src
100+
101+ ghc-options:
102+ -Wall -O2
103+
104+ if flag(disable-tup-instances)
105+ cpp-options: -DDISABLE_TUP_INSTANCES
106+
107+test-suite regression
108+
109+ build-depends:
110+ base >=4.9 && <4.13,
111+ transformers >=0.4.2,
112+ mtl >=2.2.1,
113+ tasty >=0.10,
114+ tasty-quickcheck >=0.8,
115+ QuickCheck >=2.8,
116+ ghc-prim >=0.3,
117+ lens >=4.14,
118+ ether
119+
120+ main-is:
121+ Regression.hs
122+
123+ other-modules:
124+ TupleInstances
125+ Regression.T1
126+ Regression.T2
127+ Regression.T3
128+ Regression.T4
129+ Regression.T5
130+ Regression.T6
131+ Regression.T7
132+ Regression.T8
133+ Regression.T9
134+ Regression.T10
135+ Regression.T11
136+ Regression.T12
137+
138+ type:
139+ exitcode-stdio-1.0
140+
141+ hs-source-dirs:
142+ test
143+
144+ default-language:
145+ Haskell2010
146+
147+ default-extensions:
148+ AllowAmbiguousTypes
149+ ConstraintKinds
150+ DataKinds
151+ DeriveGeneric
152+ EmptyDataDecls
153+ FlexibleContexts
154+ FlexibleInstances
155+ FunctionalDependencies
156+ GADTs
157+ GeneralizedNewtypeDeriving
158+ PartialTypeSignatures
159+ PolyKinds
160+ ScopedTypeVariables
161+ RankNTypes
162+ TemplateHaskell
163+ TupleSections
164+ TypeApplications
165+ TypeFamilies
166+ TypeInType
167+ TypeOperators
168+ TypeSynonymInstances
169+ UndecidableInstances
170+ UndecidableSuperClasses
171+
172+ ghc-options:
173+ -Wall -fno-warn-missing-signatures
174+
175+ if flag(disable-tup-instances)
176+ cpp-options: -DDISABLE_TUP_INSTANCES
177+
178+
179+benchmark bench
180+
181+ build-depends:
182+ base >=4.9 && <4.13,
183+ mtl >=2.2.1,
184+ transformers >=0.4.2,
185+ criterion >=1.1,
186+ deepseq >=1.4,
187+ lens >=4.14,
188+ ether
189+
190+ main-is:
191+ Bench.hs
192+
193+ other-modules:
194+ TupleInstances
195+
196+ type:
197+ exitcode-stdio-1.0
198+
199+ hs-source-dirs:
200+ bench
201+
202+ default-language:
203+ Haskell2010
204+
205+ default-extensions:
206+ AllowAmbiguousTypes
207+ ConstraintKinds
208+ DataKinds
209+ DeriveGeneric
210+ EmptyDataDecls
211+ FlexibleContexts
212+ FlexibleInstances
213+ FunctionalDependencies
214+ GADTs
215+ GeneralizedNewtypeDeriving
216+ PartialTypeSignatures
217+ PolyKinds
218+ ScopedTypeVariables
219+ RankNTypes
220+ TemplateHaskell
221+ TupleSections
222+ TypeApplications
223+ TypeFamilies
224+ TypeInType
225+ TypeOperators
226+ TypeSynonymInstances
227+ UndecidableInstances
228+ UndecidableSuperClasses
229+
230+ ghc-options:
231+ -Wall -O2
232+
233+ ghc-prof-options:
234+ -fprof-auto
235+
236+ if flag(disable-tup-instances)
237+ cpp-options: -DDISABLE_TUP_INSTANCES
ether/LICENSEdeleted−30
@@ -1,30 +0,0 @@
1−Copyright (c) 2017, Vladislav Zavialov
2−
3−All rights reserved.
4−
5−Redistribution and use in source and binary forms, with or without
6−modification, are permitted provided that the following conditions are met:
7−
8− * Redistributions of source code must retain the above copyright
9− notice, this list of conditions and the following disclaimer.
10−
11− * Redistributions in binary form must reproduce the above
12− copyright notice, this list of conditions and the following
13− disclaimer in the documentation and/or other materials provided
14− with the distribution.
15−
16− * Neither the name of Vladislav Zavialov nor the names of other
17− contributors may be used to endorse or promote products derived
18− from this software without specific prior written permission.
19−
20−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
ether/Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
ether/ether.cabaldeleted−82
@@ -1,82 +0,0 @@
1−name: ether
2−version: 0.5.0.0
3−synopsis: Monad transformers and classes
4−description:
5− Ether is a Haskell library that extends @mtl@ and @transformers@ with
6− tagged monad transformers and classes in a compatible way.
7−
8− Introduction <https://int-index.github.io/ether/>
9−
10−category: Control
11−license: BSD3
12−license-file: LICENSE
13−author: Vladislav Zavialov
14−maintainer: Vladislav Zavialov <vlad.z.4096@gmail.com>
15−homepage: https://int-index.github.io/ether/
16−bug-reports: https://github.com/int-index/ether/issues
17−build-type: Simple
18−cabal-version: >=1.18
19−extra-source-files: CHANGELOG.md
20−
21−source-repository head
22−
23− type: git
24− location: git@github.com:int-index/ether.git
25−
26−
27−library
28−
29− exposed-modules: Control.Ether.Abbr
30− Control.Ether.Implicit.Abbr
31− Control.Monad.Trans.Ether.Dispatch
32− Control.Monad.Ether
33− Control.Monad.Ether.TagAttach
34− Control.Monad.Ether.TagReplace
35− Control.Monad.Ether.Reader
36− Control.Monad.Ether.Reader.Class
37− Control.Monad.Ether.Writer
38− Control.Monad.Ether.Writer.Class
39− Control.Monad.Ether.State
40− Control.Monad.Ether.State.Class
41− Control.Monad.Ether.State.Lazy
42− Control.Monad.Ether.State.Strict
43− Control.Monad.Ether.Except
44− Control.Monad.Ether.Except.Class
45− Control.Monad.Ether.Implicit
46− Control.Monad.Ether.Implicit.Reader
47− Control.Monad.Ether.Implicit.Writer
48− Control.Monad.Ether.Implicit.State
49− Control.Monad.Ether.Implicit.State.Lazy
50− Control.Monad.Ether.Implicit.State.Strict
51− Control.Monad.Ether.Implicit.Except
52−
53− other-modules: Control.Monad.Ether.State.Common
54−
55− build-depends: base >=4.9 && <4.10
56− , transformers >=0.4.2
57− , transformers-lift >=0.1.0.1
58− , mtl >=2.2.1
59− , mmorph >=1.0.4
60− , monad-control >=1.0.0.4
61− , transformers-base >=0.4.4
62− , exceptions >=0.8
63− , ghc-prim >=0.3
64−
65− default-language: Haskell2010
66− default-extensions: PolyKinds
67− ScopedTypeVariables
68− FunctionalDependencies
69− TypeApplications
70− other-extensions: ConstraintKinds
71− DataKinds
72− DefaultSignatures
73− DeriveGeneric
74− FlexibleInstances
75− GeneralizedNewtypeDeriving
76− MagicHash
77− TypeFamilies
78− TypeOperators
79− UndecidableInstances
80−
81− hs-source-dirs: src
82− ghc-options: -Wall
ether/src/Control/Ether/Abbr.hsdeleted−60
@@ -1,60 +0,0 @@
1−{-# LANGUAGE EmptyDataDecls #-}
2−{-# LANGUAGE TypeOperators #-}
3−{-# LANGUAGE ConstraintKinds #-}
4−{-# LANGUAGE DataKinds #-}
5−{-# LANGUAGE TypeFamilies #-}
6−
7−-- | Abbreviations for constraints.
8−
9−module Control.Ether.Abbr
10− ( type (-->)
11− , type (<--)
12− , type (<->)
13− , type (-!-)
14− , Ether
15− , ReifyAbbr
16− ) where
17−
18−import GHC.Exts (Constraint)
19−
20−import Control.Monad.Ether
21−
22−-- | Turns an abbreviation into an actual constraint.
23−type family ReifyAbbr (abbr :: *) (m :: * -> *) :: Constraint
24−
25−-- | Denotes 'MonadReader'. The mnemonic is that you read values of type @r@
26−-- from the reader environment tagged by @tag@, thus the arrows points
27−-- from @tag@ to @r@.
28−data tag --> r
29−type instance ReifyAbbr (tag --> r) m = MonadReader tag r m
30−
31−-- | Denotes 'MonadWriter'. The mnemonic is that you write values of type @w@
32−-- to the writer accumulator tagged by @tag@, thus the arrows points
33−-- from @w@ to @tag@.
34−data tag <-- w
35−type instance ReifyAbbr (tag <-- w) m = MonadWriter tag w m
36−
37−-- | Denotes 'MonadState'. The mnemonic is that you can both read from and
38−-- write into the state, thus the arrow points in both directions.
39−data tag <-> s
40−type instance ReifyAbbr (tag <-> s) m = MonadState tag s m
41−
42−-- | Denotes 'MonadExcept'.
43−data tag -!- e
44−type instance ReifyAbbr (tag -!- e) m = MonadExcept tag e m
45−
46−-- | Reify a list of constraint abbreviations.
47−--
48−-- > f :: Ether '[Foo --> r, Bar <-- w, Baz <-> s, Quux -!- e] m => m a
49−--
50−-- expands into
51−--
52−-- > f :: ( MonadReader Foo r m
53−-- > , MonadWriter Bar w m
54−-- > , MonadState Baz s m
55−-- > , MonadExcept Quux e m
56−-- > ) => m a
57−
58−type family Ether (abbrs :: [*]) m :: Constraint where
59− Ether '[] m = ()
60− Ether (abbr ': abbrs) m = (ReifyAbbr abbr m, Ether abbrs m)
ether/src/Control/Ether/Implicit/Abbr.hsdeleted−25
@@ -1,25 +0,0 @@
1−{-# LANGUAGE TypeFamilies #-}
2−
3−-- | See "Control.Ether.Abbr".
4−
5−module Control.Ether.Implicit.Abbr (R, W, S, E) where
6−
7−import Control.Ether.Abbr (ReifyAbbr)
8−import Control.Monad.Ether.Implicit
9−
10−-- | Denotes 'MonadReader'.
11−data R r
12−type instance ReifyAbbr (R r) m = MonadReader r m
13−
14−-- | Denotes 'MonadWriter'.
15−data W w
16−type instance ReifyAbbr (W w) m = MonadWriter w m
17−
18−-- | Denotes 'MonadState'.
19−data S s
20−type instance ReifyAbbr (S s) m = MonadState s m
21−
22−-- | Denotes 'MonadExcept'.
23−data E e
24−type instance ReifyAbbr (E e) m = MonadExcept e m
25−
ether/src/Control/Monad/Ether.hsdeleted−14
@@ -1,14 +0,0 @@
1−
2−-- | This module provides convenience exports of all
3−-- tagged monad classes from Ether.
4−
5−module Control.Monad.Ether (module X) where
6−
7−import Control.Monad as X
8−import Control.Monad.Fix as X
9−import Control.Monad.Ether.Reader as X
10−import Control.Monad.Ether.Writer as X
11−import Control.Monad.Ether.State as X
12−import Control.Monad.Ether.Except as X
13−import Control.Monad.Ether.TagAttach as X
14−import Control.Monad.Ether.TagReplace as X
ether/src/Control/Monad/Ether/Except.hsdeleted−88
@@ -1,88 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE UndecidableInstances #-}
6−{-# LANGUAGE TypeFamilies #-}
7−{-# LANGUAGE AllowAmbiguousTypes #-}
8−{-# LANGUAGE MagicHash #-}
9−
10−-- | See "Control.Monad.Except".
11−
12−module Control.Monad.Ether.Except
13− (
14− -- * MonadExcept class
15− MonadExcept
16− , throw
17− , catch
18− -- * The Except monad
19− , Except
20− , runExcept
21− -- * The ExceptT monad transformer
22− , ExceptT
23− , exceptT
24− , runExceptT
25− -- * Handle functions
26− , handleT
27− , handle
28− ) where
29−
30−import GHC.Prim (Proxy#, proxy#)
31−import Control.Monad.Ether.Except.Class (MonadExcept)
32−import qualified Control.Monad.Ether.Except.Class as C
33−import qualified Control.Monad.Trans.Ether.Dispatch as D
34−import qualified Control.Monad.Trans.Except as T
35−import Data.Functor.Identity
36−
37−-- | Is used within a monadic computation to begin exception processing.
38−throw :: forall tag e m a . MonadExcept tag e m => e -> m a
39−throw = C.throw (proxy# :: Proxy# tag)
40−
41−-- | A handler function to handle previous exceptions and return to
42−-- normal execution.
43−catch :: forall tag e m a . MonadExcept tag e m => m a -> (e -> m a) -> m a
44−catch = C.catch (proxy# :: Proxy# tag)
45−
46−-- | Runs an 'Except' and handles the exception with the given function.
47−handle :: forall tag e a . (e -> a) -> Except tag e a -> a
48−handle h m = runIdentity (handleT @tag h m)
49−
50−-- | Runs an 'ExceptT' and handles the exception with the given function.
51−handleT :: forall tag e m a . Functor m => (e -> a) -> ExceptT tag e m a -> m a
52−handleT h m = fmap (either h id) (runExceptT @tag m)
53−
54−-- | Encode type-level information for 'ExceptT'.
55−data EXCEPT t e
56−
57−-- | The parameterizable exception monad.
58−--
59−-- Computations are either exceptions or normal values.
60−--
61−-- The 'return' function returns a normal value, while '>>=' exits on
62−-- the first exception.
63−type Except tag e = ExceptT tag e Identity
64−
65−-- | The exception monad transformer.
66−--
67−-- The 'return' function returns a normal value, while '>>=' exits on
68−-- the first exception.
69−type ExceptT tag e = D.Dispatch (EXCEPT tag e) (T.ExceptT e)
70−
71−-- | Runs an 'Except' and returns either an exception or a normal value.
72−runExcept :: forall tag e a . Except tag e a -> Either e a
73−runExcept = T.runExcept . D.unpack
74−
75−-- | Runs an 'ExceptT' and returns either an exception or a normal value.
76−runExceptT :: forall tag e m a . ExceptT tag e m a -> m (Either e a)
77−runExceptT = T.runExceptT . D.unpack
78−
79−-- | Constructor for computations in the exception monad transformer.
80−exceptT :: forall tag e m a . m (Either e a) -> ExceptT tag e m a
81−exceptT = D.pack . T.ExceptT
82−
83−instance
84− ( Monad m, e ~ e', trans ~ T.ExceptT e
85− ) => MonadExcept tag e (D.Dispatch (EXCEPT tag e') trans m)
86− where
87− throw _ = D.pack . T.throwE
88− catch _ m h = D.pack $ T.catchE (D.unpack m) (D.unpack . h)
ether/src/Control/Monad/Ether/Except/Class.hsdeleted−31
@@ -1,31 +0,0 @@
1−{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE UndecidableInstances #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE MagicHash #-}
5−
6−-- | See "Control.Monad.Except".
7−
8−module Control.Monad.Ether.Except.Class
9− ( MonadExcept(..)
10− ) where
11−
12−import GHC.Prim (Proxy#)
13−import qualified Control.Monad.Trans.Lift.Catch as Lift
14−
15−-- | See 'Control.Monad.Except.MonadError'.
16−class Monad m => MonadExcept tag e m | m tag -> e where
17−
18− -- | Is used within a monadic computation to begin exception processing.
19− throw :: Proxy# tag -> e -> m a
20−
21− -- | A handler function to handle previous exceptions and return to
22− -- normal execution.
23− catch :: Proxy# tag -> m a -> (e -> m a) -> m a
24−
25−instance {-# OVERLAPPABLE #-}
26− ( Lift.LiftCatch t
27− , Monad (t m)
28− , MonadExcept tag e m
29− ) => MonadExcept tag e (t m) where
30− throw t = Lift.lift . throw t
31− catch t = Lift.liftCatch (catch t)
ether/src/Control/Monad/Ether/Implicit.hsdeleted−14
@@ -1,14 +0,0 @@
1−
2−-- | This module provides convenience exports of all
3−-- implicitly tagged monad classes from Ether.
4−
5−module Control.Monad.Ether.Implicit (module X) where
6−
7−import Control.Monad as X
8−import Control.Monad.Fix as X
9−import Control.Monad.Ether.Implicit.Reader as X
10−import Control.Monad.Ether.Implicit.Writer as X
11−import Control.Monad.Ether.Implicit.State as X
12−import Control.Monad.Ether.Implicit.Except as X
13−import Control.Monad.Ether.TagAttach as X
14−import Control.Monad.Ether.TagReplace as X
ether/src/Control/Monad/Ether/Implicit/Except.hsdeleted−60
@@ -1,60 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−
3−-- | See "Control.Monad.Ether.Except".
4−
5−module Control.Monad.Ether.Implicit.Except
6− (
7− -- * MonadExcept class
8− MonadExcept
9− , throw
10− , catch
11− -- * The Except monad
12− , Except
13− , runExcept
14− -- * The ExceptT monad transformer
15− , ExceptT
16− , exceptT
17− , runExceptT
18− -- * Handle functions
19− , handle
20− , handleT
21− ) where
22−
23−import qualified Control.Monad.Ether.Except as A
24−
25−-- | See 'Control.Monad.Ether.Except.MonadExcept'.
26−type MonadExcept e = A.MonadExcept e e
27−
28−-- | See 'Control.Monad.Ether.Except.throw'.
29−throw :: forall e m a . MonadExcept e m => e -> m a
30−throw = A.throw @e
31−
32−-- | See 'Control.Monad.Ether.Except.catch'.
33−catch :: forall e m a . MonadExcept e m => m a -> (e -> m a) -> m a
34−catch = A.catch @e
35−
36−-- | See 'Control.Monad.Ether.Except.Except'.
37−type Except e = A.Except e e
38−
39−-- | See 'Control.Monad.Ether.Except.runExcept'.
40−runExcept :: Except e a -> Either e a
41−runExcept = A.runExcept
42−
43−-- | See 'Control.Monad.Ether.Except.ExceptT'.
44−type ExceptT e = A.ExceptT e e
45−
46−-- | See 'Control.Monad.Ether.Except.exceptT'.
47−exceptT :: m (Either e a) -> ExceptT e m a
48−exceptT = A.exceptT
49−
50−-- | See 'Control.Monad.Ether.Except.runExceptT'.
51−runExceptT :: ExceptT e m a -> m (Either e a)
52−runExceptT = A.runExceptT
53−
54−-- | See 'Control.Monad.Ether.Except.handle'.
55−handle :: (e -> a) -> Except e a -> a
56−handle = A.handle
57−
58−-- | See 'Control.Monad.Ether.Except.handleT'.
59−handleT :: Functor m => (e -> a) -> ExceptT e m a -> m a
60−handleT = A.handleT
ether/src/Control/Monad/Ether/Implicit/Reader.hsdeleted−59
@@ -1,59 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−
3−-- | See "Control.Monad.Ether.Reader".
4−
5−module Control.Monad.Ether.Implicit.Reader
6− (
7− -- * MonadReader class
8− MonadReader
9− , local
10− , ask
11− , reader
12− , asks
13− -- * The Reader monad
14− , Reader
15− , runReader
16− -- * The ReaderT monad transformer
17− , ReaderT
18− , readerT
19− , runReaderT
20− ) where
21−
22−import qualified Control.Monad.Ether.Reader as A
23−
24−-- | See 'Control.Monad.Ether.Reader.ReaderT'.
25−type ReaderT r = A.ReaderT r r
26−
27−-- | See 'Control.Monad.Ether.Reader.readerT'.
28−readerT :: (r -> m a) -> ReaderT r m a
29−readerT = A.readerT
30−
31−-- | See 'Control.Monad.Ether.Reader.runReaderT'.
32−runReaderT :: ReaderT r m a -> r -> m a
33−runReaderT = A.runReaderT
34−
35−-- | See 'Control.Monad.Ether.Reader.Reader'.
36−type Reader r = A.Reader r r
37−
38−-- | See 'Control.Monad.Ether.Reader.runReader'.
39−runReader :: Reader r a -> r -> a
40−runReader = A.runReader
41−
42−-- | See 'Control.Monad.Ether.Reader.MonadReader'.
43−type MonadReader r = A.MonadReader r r
44−
45−-- | See 'Control.Monad.Ether.Reader.local'.
46−local :: forall r m a . MonadReader r m => (r -> r) -> m a -> m a
47−local = A.local @r
48−
49−-- | See 'Control.Monad.Ether.Reader.ask'.
50−ask :: forall r m . MonadReader r m => m r
51−ask = A.ask @r
52−
53−-- | See 'Control.Monad.Ether.Reader.reader'.
54−reader :: forall r m a . MonadReader r m => (r -> a) -> m a
55−reader = A.reader @r
56−
57−-- | See 'Control.Monad.Ether.Reader.asks'.
58−asks :: forall r m a . MonadReader r m => (r -> a) -> m a
59−asks = A.asks @r
ether/src/Control/Monad/Ether/Implicit/State.hsdeleted−8
@@ -1,8 +0,0 @@
1−
2−-- | See "Control.Monad.Ether.State".
3−
4−module Control.Monad.Ether.Implicit.State
5− ( module Control.Monad.Ether.Implicit.State.Lazy
6− ) where
7−
8−import Control.Monad.Ether.Implicit.State.Lazy
ether/src/Control/Monad/Ether/Implicit/State/Lazy.hsdeleted−84
@@ -1,84 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−
3−-- | See "Control.Monad.Ether.State.Lazy".
4−
5−module Control.Monad.Ether.Implicit.State.Lazy
6− (
7− -- * MonadState class
8− MonadState
9− , get
10− , put
11− , state
12− , modify
13− , gets
14− -- * The State monad
15− , State
16− , runState
17− , evalState
18− , execState
19− -- * The StateT monad transformer
20− , StateT
21− , stateT
22− , runStateT
23− , evalStateT
24− , execStateT
25− ) where
26−
27−import qualified Control.Monad.Ether.State.Lazy as A
28−
29−-- | See 'Control.Monad.Ether.State.Lazy.StateT'.
30−type StateT s = A.StateT s s
31−
32−-- | See 'Control.Monad.Ether.State.Lazy.stateT'.
33−stateT :: (s -> m (a, s)) -> StateT s m a
34−stateT = A.stateT
35−
36−-- | See 'Control.Monad.Ether.State.Lazy.runStateT'.
37−runStateT :: StateT s m a -> s -> m (a, s)
38−runStateT = A.runStateT
39−
40−-- | See 'Control.Monad.Ether.State.Lazy.runState'.
41−runState :: State s a -> s -> (a, s)
42−runState = A.runState
43−
44−-- | See 'Control.Monad.Ether.State.Lazy.evalStateT'.
45−evalStateT :: Monad m => StateT s m a -> s -> m a
46−evalStateT = A.evalStateT
47−
48−-- | See 'Control.Monad.Ether.State.Lazy.State'.
49−type State s = A.State s s
50−
51−-- | See 'Control.Monad.Ether.State.Lazy.evalState'.
52−evalState :: State s a -> s -> a
53−evalState = A.evalState
54−
55−-- | See 'Control.Monad.Ether.State.Lazy.execStateT'.
56−execStateT :: Monad m => StateT s m a -> s -> m s
57−execStateT = A.execStateT
58−
59−-- | See 'Control.Monad.Ether.State.Lazy.execState'.
60−execState :: State s a -> s -> s
61−execState = A.execState
62−
63−-- | See 'Control.Monad.Ether.State.Lazy.MonadState'.
64−type MonadState s = A.MonadState s s
65−
66−-- | See 'Control.Monad.Ether.State.Lazy.get'.
67−get :: forall s m . MonadState s m => m s
68−get = A.get @s
69−
70−-- | See 'Control.Monad.Ether.State.Lazy.gets'.
71−gets :: forall s m a . MonadState s m => (s -> a) -> m a
72−gets = A.gets @s
73−
74−-- | See 'Control.Monad.Ether.State.Lazy.put'.
75−put :: forall s m . MonadState s m => s -> m ()
76−put = A.put @s
77−
78−-- | See 'Control.Monad.Ether.State.Lazy.state'.
79−state :: forall s m a . MonadState s m => (s -> (a, s)) -> m a
80−state = A.state @s
81−
82−-- | See 'Control.Monad.Ether.State.Lazy.modify'.
83−modify :: forall s m . MonadState s m => (s -> s) -> m ()
84−modify = A.modify @s
ether/src/Control/Monad/Ether/Implicit/State/Strict.hsdeleted−84
@@ -1,84 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−
3−-- | See "Control.Monad.Ether.State.Strict".
4−
5−module Control.Monad.Ether.Implicit.State.Strict
6− (
7− -- * MonadState class
8− MonadState
9− , get
10− , put
11− , state
12− , modify
13− , gets
14− -- * The State monad
15− , State
16− , runState
17− , evalState
18− , execState
19− -- * The StateT monad transformer
20− , StateT
21− , stateT
22− , runStateT
23− , evalStateT
24− , execStateT
25− ) where
26−
27−import qualified Control.Monad.Ether.State.Strict as A
28−
29−-- | See 'Control.Monad.Ether.State.Strict.StateT'.
30−type StateT s = A.StateT s s
31−
32−-- | See 'Control.Monad.Ether.State.Strict.stateT'.
33−stateT :: (s -> m (a, s)) -> StateT s m a
34−stateT = A.stateT
35−
36−-- | See 'Control.Monad.Ether.State.Strict.runStateT'.
37−runStateT :: StateT s m a -> s -> m (a, s)
38−runStateT = A.runStateT
39−
40−-- | See 'Control.Monad.Ether.State.Strict.runState'.
41−runState :: State s a -> s -> (a, s)
42−runState = A.runState
43−
44−-- | See 'Control.Monad.Ether.State.Strict.evalStateT'.
45−evalStateT :: Monad m => StateT s m a -> s -> m a
46−evalStateT = A.evalStateT
47−
48−-- | See 'Control.Monad.Ether.State.Strict.State'.
49−type State s = A.State s s
50−
51−-- | See 'Control.Monad.Ether.State.Strict.evalState'.
52−evalState :: State s a -> s -> a
53−evalState = A.evalState
54−
55−-- | See 'Control.Monad.Ether.State.Strict.execStateT'.
56−execStateT :: Monad m => StateT s m a -> s -> m s
57−execStateT = A.execStateT
58−
59−-- | See 'Control.Monad.Ether.State.Strict.execState'.
60−execState :: State s a -> s -> s
61−execState = A.execState
62−
63−-- | See 'Control.Monad.Ether.State.Strict.MonadState'.
64−type MonadState s = A.MonadState s s
65−
66−-- | See 'Control.Monad.Ether.State.Strict.get'.
67−get :: forall s m . MonadState s m => m s
68−get = A.get @s
69−
70−-- | See 'Control.Monad.Ether.State.Strict.gets'.
71−gets :: forall s m a . MonadState s m => (s -> a) -> m a
72−gets = A.gets @s
73−
74−-- | See 'Control.Monad.Ether.State.Strict.put'.
75−put :: forall s m . MonadState s m => s -> m ()
76−put = A.put @s
77−
78−-- | See 'Control.Monad.Ether.State.Strict.state'.
79−state :: forall s m a . MonadState s m => (s -> (a, s)) -> m a
80−state = A.state @s
81−
82−-- | See 'Control.Monad.Ether.State.Strict.modify'.
83−modify :: forall s m . MonadState s m => (s -> s) -> m ()
84−modify = A.modify @s
ether/src/Control/Monad/Ether/Implicit/Writer.hsdeleted−79
@@ -1,79 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−
3−-- | See "Control.Monad.Ether.Writer".
4−
5−module Control.Monad.Ether.Implicit.Writer
6− (
7− -- * MonadWriter class
8− MonadWriter
9− , writer
10− , tell
11− , listen
12− , pass
13− , listens
14− , censor
15− -- * The Writer monad
16− , Writer
17− , runWriter
18− , execWriter
19− -- * The WriterT monad transformer
20− , WriterT
21− , writerT
22− , runWriterT
23− , execWriterT
24− ) where
25−
26−import qualified Control.Monad.Ether.Writer as A
27−
28−-- | See 'Control.Monad.Ether.Writer.MonadWriter'.
29−type MonadWriter w = A.MonadWriter w w
30−
31−-- | See 'Control.Monad.Ether.Writer.writer'.
32−writer :: forall w m a . MonadWriter w m => (a, w) -> m a
33−writer = A.writer @w
34−
35−-- | See 'Control.Monad.Ether.Writer.tell'.
36−tell :: forall w m . MonadWriter w m => w -> m ()
37−tell = A.tell @w
38−
39−-- | See 'Control.Monad.Ether.Writer.listen'.
40−listen :: forall w m a . MonadWriter w m => m a -> m (a, w)
41−listen = A.listen @w
42−
43−-- | See 'Control.Monad.Ether.Writer.pass'.
44−pass :: forall w m a . MonadWriter w m => m (a, w -> w) -> m a
45−pass = A.pass @w
46−
47−-- | See 'Control.Monad.Ether.Writer.listens'.
48−listens :: forall w m a b . MonadWriter w m => (w -> b) -> m a -> m (a, b)
49−listens = A.listens @w
50−
51−-- | See 'Control.Monad.Ether.Writer.censor'.
52−censor :: forall w m a . MonadWriter w m => (w -> w) -> m a -> m a
53−censor = A.censor @w
54−
55−-- | See 'Control.Monad.Ether.Writer.Writer'.
56−type Writer w = A.Writer w w
57−
58−-- | See 'Control.Monad.Ether.Writer.runWriter'.
59−runWriter :: Writer w a -> (a, w)
60−runWriter = A.runWriter
61−
62−-- | See 'Control.Monad.Ether.Writer.execWriter'.
63−execWriter :: Writer w a -> w
64−execWriter = A.execWriter
65−
66−-- | See 'Control.Monad.Ether.Writer.WriterT'.
67−type WriterT w = A.WriterT w w
68−
69−-- | See 'Control.Monad.Ether.Writer.writerT'.
70−writerT :: m (a, w) -> WriterT w m a
71−writerT = A.writerT
72−
73−-- | See 'Control.Monad.Ether.Writer.runWriterT'.
74−runWriterT :: WriterT w m a -> m (a, w)
75−runWriterT = A.runWriterT
76−
77−-- | See 'Control.Monad.Ether.Writer.execWriterT'.
78−execWriterT :: Monad m => WriterT w m a -> m w
79−execWriterT = A.execWriterT
ether/src/Control/Monad/Ether/Reader.hsdeleted−107
@@ -1,107 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE UndecidableInstances #-}
6−{-# LANGUAGE TypeFamilies #-}
7−{-# LANGUAGE AllowAmbiguousTypes #-}
8−{-# LANGUAGE MagicHash #-}
9−
10−-- | See "Control.Monad.Reader".
11−
12−module Control.Monad.Ether.Reader
13− (
14− -- * MonadReader class
15− MonadReader
16− , ask
17− , local
18− , reader
19− , asks
20− -- * The Reader monad
21− , Reader
22− , runReader
23− -- * The ReaderT monad transformer
24− , ReaderT
25− , readerT
26− , runReaderT
27− ) where
28−
29−import GHC.Prim (Proxy#, proxy#)
30−import Control.Monad.Ether.Reader.Class (MonadReader)
31−import qualified Control.Monad.Ether.Reader.Class as C
32−import qualified Control.Monad.Trans.Ether.Dispatch as D
33−import qualified Control.Monad.Trans.Reader as T
34−import Data.Functor.Identity
35−
36−-- | Retrieves the monad environment.
37−ask :: forall tag r m . MonadReader tag r m => m r
38−ask = C.ask (proxy# :: Proxy# tag)
39−
40−-- | Executes a computation in a modified environment.
41−local
42− :: forall tag r m a
43− . MonadReader tag r m
44− => (r -> r)
45− -- ^ The function to modify the environment.
46− -> m a
47− -- ^ @Reader@ to run in the modified environment.
48− -> m a
49−local = C.local (proxy# :: Proxy# tag)
50−
51−-- | Retrieves a function of the current environment.
52−reader
53− :: forall tag r m a
54− . MonadReader tag r m
55− => (r -> a)
56− -- ^ The selector function to apply to the environment.
57− -> m a
58−reader = C.reader (proxy# :: Proxy# tag)
59−
60−-- | Retrieves a function of the current environment.
61−asks
62− :: forall tag r m a
63− . MonadReader tag r m
64− => (r -> a)
65− -- ^ The selector function to apply to the environment.
66− -> m a
67−asks = C.reader (proxy# :: Proxy# tag)
68−
69−-- | Encode type-level information for 'ReaderT'.
70−data READER t r
71−
72−-- | The parameterizable reader monad.
73−--
74−-- Computations are functions of a shared environment.
75−--
76−-- The 'return' function ignores the environment, while '>>=' passes
77−-- the inherited environment to both subcomputations.
78−type Reader tag r = ReaderT tag r Identity
79−
80−-- | The reader monad transformer,
81−-- which adds a read-only environment to the given monad.
82−--
83−-- The 'return' function ignores the environment, while '>>=' passes
84−-- the inherited environment to both subcomputations.
85−type ReaderT tag r = D.Dispatch (READER tag r) (T.ReaderT r)
86−
87−-- | Constructor for computations in the reader monad transformer.
88−readerT :: forall tag r m a . (r -> m a) -> ReaderT tag r m a
89−readerT = D.pack . T.ReaderT
90−
91−-- | Runs a 'ReaderT' with the given environment
92−-- and returns the final value.
93−runReaderT :: forall tag r m a . ReaderT tag r m a -> r -> m a
94−runReaderT = T.runReaderT . D.unpack
95−
96−-- | Runs a 'ReaderT' with the given environment
97−-- and returns the final value.
98−runReader :: forall tag r a . Reader tag r a -> r -> a
99−runReader = T.runReader . D.unpack
100−
101−instance
102− ( Monad m, r ~ r', trans ~ T.ReaderT r
103− ) => MonadReader tag r (D.Dispatch (READER tag r') trans m)
104− where
105− ask _ = D.pack T.ask
106− local _ f = D.pack . T.withReaderT f . D.unpack
107− reader _ = D.pack . T.reader
ether/src/Control/Monad/Ether/Reader/Class.hsdeleted−47
@@ -1,47 +0,0 @@
1−{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE UndecidableInstances #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE MagicHash #-}
5−
6−-- | See "Control.Monad.Reader.Class".
7−
8−module Control.Monad.Ether.Reader.Class
9− ( MonadReader(..)
10− ) where
11−
12−import GHC.Prim (Proxy#)
13−import qualified Control.Monad.Trans.Lift.Local as Lift
14−
15−-- | See 'Control.Monad.Reader.MonadReader'.
16−class Monad m => MonadReader tag r m | m tag -> r where
17−
18− {-# MINIMAL (ask | reader), local #-}
19−
20− -- | Retrieves the monad environment.
21− ask :: Proxy# tag -> m r
22− ask t = reader t id
23−
24− -- | Executes a computation in a modified environment.
25− local
26− :: Proxy# tag
27− -> (r -> r)
28− -- ^ The function to modify the environment.
29− -> m a
30− -- ^ @Reader@ to run in the modified environment.
31− -> m a
32−
33− -- | Retrieves a function of the current environment.
34− reader
35− :: Proxy# tag
36− -> (r -> a)
37− -- ^ The selector function to apply to the environment.
38− -> m a
39− reader t f = fmap f (ask t)
40−
41−instance {-# OVERLAPPABLE #-}
42− ( Lift.LiftLocal t
43− , Monad (t m)
44− , MonadReader tag r m
45− ) => MonadReader tag r (t m) where
46− ask t = Lift.lift (ask t)
47− local t = Lift.liftLocal (ask t) (local t)
ether/src/Control/Monad/Ether/State.hsdeleted−8
@@ -1,8 +0,0 @@
1−
2−-- | See "Control.Monad.State".
3−
4−module Control.Monad.Ether.State
5− ( module Control.Monad.Ether.State.Lazy
6− ) where
7−
8−import Control.Monad.Ether.State.Lazy
ether/src/Control/Monad/Ether/State/Class.hsdeleted−43
@@ -1,43 +0,0 @@
1−{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE UndecidableInstances #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE MagicHash #-}
5−
6−-- | See "Control.Monad.State.Class".
7−
8−module Control.Monad.Ether.State.Class
9− ( MonadState(..)
10− ) where
11−
12−import GHC.Prim (Proxy#)
13−import qualified Control.Monad.Trans as Lift
14−
15−-- | See 'Control.Monad.State.MonadState'.
16−class Monad m => MonadState tag s m | m tag -> s where
17−
18− {-# MINIMAL state | get, put #-}
19−
20− -- | Return the state from the internals of the monad.
21− get :: Proxy# tag -> m s
22− get t = state t (\s -> (s, s))
23−
24− -- | Replace the state inside the monad.
25− put :: Proxy# tag -> s -> m ()
26− put t s = state t (\_ -> ((), s))
27−
28− -- | Embed a simple state action into the monad.
29− state :: Proxy# tag -> (s -> (a, s)) -> m a
30− state t f = do
31− s <- get t
32− let ~(a, s') = f s
33− put t s'
34− return a
35−
36−instance {-# OVERLAPPABLE #-}
37− ( Lift.MonadTrans t
38− , Monad (t m)
39− , MonadState tag s m
40− ) => MonadState tag s (t m) where
41− get t = Lift.lift (get t)
42− put t = Lift.lift . put t
43− state t = Lift.lift . state t
ether/src/Control/Monad/Ether/State/Common.hsdeleted−35
@@ -1,35 +0,0 @@
1−{-# LANGUAGE AllowAmbiguousTypes #-}
2−{-# LANGUAGE MagicHash #-}
3−
4−module Control.Monad.Ether.State.Common
5− ( MonadState
6− , get
7− , put
8− , state
9− , modify
10− , gets
11− ) where
12−
13−import GHC.Prim (Proxy#, proxy#)
14−import Control.Monad.Ether.State.Class (MonadState)
15−import qualified Control.Monad.Ether.State.Class as C
16−
17−-- | Return the state from the internals of the monad.
18−get :: forall tag s m . MonadState tag s m => m s
19−get = C.get (proxy# :: Proxy# tag)
20−
21−-- | Replace the state inside the monad.
22−put :: forall tag s m . MonadState tag s m => s -> m ()
23−put = C.put (proxy# :: Proxy# tag)
24−
25−-- | Embed a simple state action into the monad.
26−state :: forall tag s m a . MonadState tag s m => (s -> (a, s)) -> m a
27−state = C.state (proxy# :: Proxy# tag)
28−
29−-- | Modifies the state inside a state monad.
30−modify :: forall tag s m . MonadState tag s m => (s -> s) -> m ()
31−modify f = state @tag (\s -> ((), f s))
32−
33−-- | Gets specific component of the state, using a projection function supplied.
34−gets :: forall tag s m a . MonadState tag s m => (s -> a) -> m a
35−gets f = fmap f (get @tag)
ether/src/Control/Monad/Ether/State/Lazy.hsdeleted−95
@@ -1,95 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE UndecidableInstances #-}
6−{-# LANGUAGE TypeFamilies #-}
7−
8−-- | See "Control.Monad.State.Lazy".
9−
10−module Control.Monad.Ether.State.Lazy
11− (
12− -- * MonadState class
13− MonadState
14− , get
15− , put
16− , state
17− , modify
18− , gets
19− -- * The State monad
20− , State
21− , runState
22− , evalState
23− , execState
24− -- * The StateT monad transformer
25− , StateT
26− , stateT
27− , runStateT
28− , evalStateT
29− , execStateT
30− ) where
31−
32−import Control.Monad.Ether.State.Common
33−import qualified Control.Monad.Ether.State.Class as C
34−import qualified Control.Monad.Trans.Ether.Dispatch as D
35−import qualified Control.Monad.Trans.State.Lazy as T
36−import Data.Functor.Identity
37−
38−-- | Encode type-level information for 'StateT'.
39−data STATE t s
40−
41−-- | The parametrizable state monad.
42−--
43−-- Computations have access to a mutable state.
44−--
45−-- The 'return' function leaves the state unchanged, while '>>=' uses
46−-- the final state of the first computation as the initial state of the second.
47−type State tag r = StateT tag r Identity
48−
49−-- | The state monad transformer.
50−--
51−-- The 'return' function leaves the state unchanged, while '>>=' uses
52−-- the final state of the first computation as the initial state of the second.
53−type StateT tag s = D.Dispatch (STATE tag s) (T.StateT s)
54−
55−-- | Constructor for computations in the state monad transformer.
56−stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
57−stateT = D.pack . T.StateT
58−
59−-- | Runs a 'StateT' with the given initial state
60−-- and returns both the final value and the final state.
61−runStateT :: forall tag s m a . StateT tag s m a -> s -> m (a, s)
62−runStateT = T.runStateT . D.unpack
63−
64−-- | Runs a 'StateT' with the given initial state
65−-- and returns the final value, discarding the final state.
66−evalStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m a
67−evalStateT = T.evalStateT . D.unpack
68−
69−-- | Runs a 'StateT' with the given initial state
70−-- and returns the final state, discarding the final value.
71−execStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m s
72−execStateT = T.execStateT . D.unpack
73−
74−-- | Runs a 'State' with the given initial state
75−-- and returns both the final value and the final state.
76−runState :: forall tag s a . State tag s a -> s -> (a, s)
77−runState = T.runState . D.unpack
78−
79−-- | Runs a 'State' with the given initial state
80−-- and returns the final value, discarding the final state.
81−evalState :: forall tag s a . State tag s a -> s -> a
82−evalState = T.evalState . D.unpack
83−
84−-- | Runs a 'State' with the given initial state
85−-- and returns the final state, discarding the final value.
86−execState :: forall tag s a . State tag s a -> s -> s
87−execState = T.execState . D.unpack
88−
89−instance
90− ( Monad m, s ~ s', trans ~ T.StateT s
91− ) => MonadState tag s (D.Dispatch (STATE tag s') trans m)
92− where
93− get _ = D.pack T.get
94− put _ = D.pack . T.put
95− state _ = D.pack . T.state
ether/src/Control/Monad/Ether/State/Strict.hsdeleted−95
@@ -1,95 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE UndecidableInstances #-}
6−{-# LANGUAGE TypeFamilies #-}
7−
8−-- | See "Control.Monad.State.Strict".
9−
10−module Control.Monad.Ether.State.Strict
11− (
12− -- * MonadState class
13− MonadState
14− , get
15− , put
16− , state
17− , modify
18− , gets
19− -- * The State monad
20− , State
21− , runState
22− , evalState
23− , execState
24− -- * The StateT monad transformer
25− , StateT
26− , stateT
27− , runStateT
28− , evalStateT
29− , execStateT
30− ) where
31−
32−import Control.Monad.Ether.State.Common
33−import qualified Control.Monad.Ether.State.Class as C
34−import qualified Control.Monad.Trans.Ether.Dispatch as D
35−import qualified Control.Monad.Trans.State.Strict as T
36−import Data.Functor.Identity
37−
38−-- | Encode type-level information for 'StateT'.
39−data STATE t s
40−
41−-- | The parametrizable state monad.
42−--
43−-- Computations have access to a mutable state.
44−--
45−-- The 'return' function leaves the state unchanged, while '>>=' uses
46−-- the final state of the first computation as the initial state of the second.
47−type State tag r = StateT tag r Identity
48−
49−-- | The state monad transformer.
50−--
51−-- The 'return' function leaves the state unchanged, while '>>=' uses
52−-- the final state of the first computation as the initial state of the second.
53−type StateT tag s = D.Dispatch (STATE tag s) (T.StateT s)
54−
55−-- | Constructor for computations in the state monad transformer.
56−stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
57−stateT = D.pack . T.StateT
58−
59−-- | Runs a 'StateT' with the given initial state
60−-- and returns both the final value and the final state.
61−runStateT :: forall tag s m a . StateT tag s m a -> s -> m (a, s)
62−runStateT = T.runStateT . D.unpack
63−
64−-- | Runs a 'StateT' with the given initial state
65−-- and returns the final value, discarding the final state.
66−evalStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m a
67−evalStateT = T.evalStateT . D.unpack
68−
69−-- | Runs a 'StateT' with the given initial state
70−-- and returns the final state, discarding the final value.
71−execStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m s
72−execStateT = T.execStateT . D.unpack
73−
74−-- | Runs a 'State' with the given initial state
75−-- and returns both the final value and the final state.
76−runState :: forall tag s a . State tag s a -> s -> (a, s)
77−runState = T.runState . D.unpack
78−
79−-- | Runs a 'State' with the given initial state
80−-- and returns the final value, discarding the final state.
81−evalState :: forall tag s a . State tag s a -> s -> a
82−evalState = T.evalState . D.unpack
83−
84−-- | Runs a 'State' with the given initial state
85−-- and returns the final state, discarding the final value.
86−execState :: forall tag s a . State tag s a -> s -> s
87−execState = T.execState . D.unpack
88−
89−instance
90− ( Monad m, s ~ s', trans ~ T.StateT s
91− ) => MonadState tag s (D.Dispatch (STATE tag s') trans m)
92− where
93− get _ = D.pack T.get
94− put _ = D.pack . T.put
95− state _ = D.pack . T.state
ether/src/Control/Monad/Ether/TagAttach.hsdeleted−72
@@ -1,72 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE TypeFamilies #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE UndecidableInstances #-}
7−{-# LANGUAGE DataKinds #-}
8−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9−
10−module Control.Monad.Ether.TagAttach
11− ( TAG_ATTACH(..)
12− , TagAttachT
13− , tagAttach
14− ) where
15−
16−import Control.Monad.Trans.Identity
17−
18−import Control.Monad.Ether.Reader.Class
19−import Control.Monad.Ether.State.Class
20−import Control.Monad.Ether.Except.Class
21−import Control.Monad.Ether.Writer.Class
22−
23−import Control.Monad.Ether.Reader as A
24−import Control.Monad.Ether.State.Common as A
25−import Control.Monad.Ether.Except as A
26−import Control.Monad.Ether.Writer as A
27−
28−import qualified Control.Monad.Reader.Class as Class
29−import qualified Control.Monad.State.Class as Class
30−import qualified Control.Monad.Writer.Class as Class
31−import qualified Control.Monad.Error.Class as Class
32−
33−import Control.Monad.Trans.Ether.Dispatch
34−
35−-- | Encode type-level information for 'tagAttach'.
36−data TAG_ATTACH t = TAG_ATTACH t
37−
38−type TagAttachT t = Dispatch (TAG_ATTACH t) IdentityT
39−
40−-- | Attach a tag to untagged transformers.
41−tagAttach :: forall tag m a . TagAttachT tag m a -> m a
42−tagAttach = runIdentityT . unpack
43−
44−instance
45− ( MonadReader tag r m, trans ~ IdentityT
46− ) => Class.MonadReader r (Dispatch (TAG_ATTACH tag) trans m)
47− where
48− ask = A.ask @tag
49− local = A.local @tag
50−
51−instance
52− ( MonadState tag s m, trans ~ IdentityT
53− ) => Class.MonadState s (Dispatch (TAG_ATTACH tag) trans m)
54− where
55− get = A.get @tag
56− put = A.put @tag
57−
58−instance
59− ( MonadExcept tag e m, trans ~ IdentityT
60− ) => Class.MonadError e (Dispatch (TAG_ATTACH tag) trans m)
61− where
62− throwError = A.throw @tag
63− catchError = A.catch @tag
64−
65−instance
66− ( MonadWriter tag w m, trans ~ IdentityT
67− ) => Class.MonadWriter w (Dispatch (TAG_ATTACH tag) trans m)
68− where
69− writer = A.writer @tag
70− tell = A.tell @tag
71− listen = A.listen @tag
72− pass = A.pass @tag
ether/src/Control/Monad/Ether/TagReplace.hsdeleted−67
@@ -1,67 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE TypeFamilies #-}
5−{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE UndecidableInstances #-}
7−{-# LANGUAGE DataKinds #-}
8−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9−
10−module Control.Monad.Ether.TagReplace
11− ( TAG_REPLACE
12− , TagReplaceT
13− , tagReplace
14− ) where
15−
16−import Control.Monad.Trans.Identity
17−
18−import Control.Monad.Ether.Reader.Class
19−import Control.Monad.Ether.State.Class
20−import Control.Monad.Ether.Except.Class
21−import Control.Monad.Ether.Writer.Class
22−
23−import Control.Monad.Ether.Reader as A
24−import Control.Monad.Ether.State.Common as A
25−import Control.Monad.Ether.Except as A
26−import Control.Monad.Ether.Writer as A
27−
28−import Control.Monad.Trans.Ether.Dispatch
29−
30−-- | Encode type-level information for 'tagReplace'.
31−data TAG_REPLACE tOld tNew
32−
33−type TagReplaceT tOld tNew = Dispatch (TAG_REPLACE tOld tNew) IdentityT
34−
35−-- | Replace a tag with another tag.
36−tagReplace :: forall tOld tNew m a . TagReplaceT tOld tNew m a -> m a
37−tagReplace = runIdentityT . unpack
38−
39−instance
40− ( MonadReader tNew r m, trans ~ IdentityT
41− ) => MonadReader tOld r (Dispatch (TAG_REPLACE tOld tNew) trans m)
42− where
43− ask _ = A.ask @tNew
44− local _ = A.local @tNew
45−
46−instance
47− ( MonadState tNew s m, trans ~ IdentityT
48− ) => MonadState tOld s (Dispatch (TAG_REPLACE tOld tNew) trans m)
49− where
50− get _ = A.get @tNew
51− put _ = A.put @tNew
52−
53−instance
54− ( MonadExcept tNew e m, trans ~ IdentityT
55− ) => MonadExcept tOld e (Dispatch (TAG_REPLACE tOld tNew) trans m)
56− where
57− throw _ = A.throw @tNew
58− catch _ = A.catch @tNew
59−
60−instance
61− ( MonadWriter tNew w m, trans ~ IdentityT
62− ) => MonadWriter tOld w (Dispatch (TAG_REPLACE tOld tNew) trans m)
63− where
64− writer _ = A.writer @tNew
65− tell _ = A.tell @tNew
66− listen _ = A.listen @tNew
67− pass _ = A.pass @tNew
ether/src/Control/Monad/Ether/Writer.hsdeleted−119
@@ -1,119 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
2−
3−{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE UndecidableInstances #-}
6−{-# LANGUAGE TypeFamilies #-}
7−{-# LANGUAGE AllowAmbiguousTypes #-}
8−{-# LANGUAGE MagicHash #-}
9−
10−-- | See "Control.Monad.Writer".
11−
12−module Control.Monad.Ether.Writer
13− (
14− -- * MonadWriter class
15− MonadWriter
16− , writer
17− , tell
18− , listen
19− , pass
20− , listens
21− , censor
22− -- * The Writer monad
23− , Writer
24− , runWriter
25− , execWriter
26− -- * The WriterT monad transformer
27− , WriterT
28− , writerT
29− , runWriterT
30− , execWriterT
31− ) where
32−
33−import GHC.Prim (Proxy#, proxy#)
34−import Control.Monad.Ether.Writer.Class (MonadWriter)
35−import qualified Control.Monad.Ether.Writer.Class as C
36−import qualified Control.Monad.Trans.Ether.Dispatch as D
37−import qualified Control.Monad.Trans.Writer as T
38−import Data.Functor.Identity
39−
40−-- | Embed a simple writer action.
41−writer :: forall tag w m a . MonadWriter tag w m => (a, w) -> m a
42−writer = C.writer (proxy# :: Proxy# tag)
43−
44−-- | Append a value to the accumulator within the monad.
45−tell :: forall tag w m . MonadWriter tag w m => w -> m ()
46−tell = C.tell (proxy# :: Proxy# tag)
47−
48−-- | Execute an action and add its accumulator
49−-- to the value of the computation.
50−listen :: forall tag w m a . MonadWriter tag w m => m a -> m (a, w)
51−listen = C.listen (proxy# :: Proxy# tag)
52−
53−-- | Execute an action which returns a value and a function,
54−-- and return the value, applying the function to the accumulator.
55−pass :: forall tag w m a . MonadWriter tag w m => m (a, w -> w) -> m a
56−pass = C.pass (proxy# :: Proxy# tag)
57−
58−-- | Execute an action and add the result of applying the given function to
59−-- its accumulator to the value of the computation.
60−listens :: forall tag w m a b . MonadWriter tag w m => (w -> b) -> m a -> m (a, b)
61−listens f m = do
62− ~(a, w) <- listen @tag m
63− return (a, f w)
64−
65−-- | Execute an action and apply a function to its accumulator.
66−censor :: forall tag w m a . MonadWriter tag w m => (w -> w) -> m a -> m a
67−censor f m = pass @tag $ do
68− a <- m
69− return (a, f)
70−
71−-- | Encode type-level information for 'WriterT'.
72−data WRITER t w
73−
74−-- | The parametrizable writer monad.
75−--
76−-- Computations can accumulate a monoid value.
77−--
78−-- The 'return' function produces the output 'mempty', while '>>=' combines
79−-- the outputs of the subcomputations using 'mappend'.
80−type Writer tag w = WriterT tag w Identity
81−
82−-- | The writer monad transformer.
83−--
84−-- The 'return' function produces the output 'mempty', while '>>=' combines
85−-- the outputs of the subcomputations using 'mappend'.
86−type WriterT tag w = D.Dispatch (WRITER tag w) (T.WriterT w)
87−
88−-- | Constructor for computations in the writer monad transformer.
89−writerT :: forall tag w m a . m (a, w) -> WriterT tag w m a
90−writerT = D.pack . T.WriterT
91−
92−-- | Runs a 'WriterT' and returns both the normal value
93−-- and the final accumulator.
94−runWriterT :: forall tag w m a . WriterT tag w m a -> m (a, w)
95−runWriterT = T.runWriterT . D.unpack
96−
97−-- | Runs a 'Writer' and returns both the normal value
98−-- and the final accumulator.
99−runWriter :: forall tag w a . Writer tag w a -> (a, w)
100−runWriter = T.runWriter . D.unpack
101−
102−-- | Runs a 'WriterT' and returns the final accumulator,
103−-- discarding the normal value.
104−execWriterT :: forall tag w m a . Monad m => WriterT tag w m a -> m w
105−execWriterT = T.execWriterT . D.unpack
106−
107−-- | Runs a 'Writer' and returns the final accumulator,
108−-- discarding the normal value.
109−execWriter :: forall tag w a . Writer tag w a -> w
110−execWriter = T.execWriter . D.unpack
111−
112−instance
113− ( Monoid w, Monad m, w ~ w', trans ~ T.WriterT w
114− ) => MonadWriter tag w (D.Dispatch (WRITER tag w') trans m)
115− where
116− writer _ = D.pack . T.writer
117− tell _ = D.pack . T.tell
118− listen _ = D.pack . T.listen . D.unpack
119− pass _ = D.pack . T.pass . D.unpack
ether/src/Control/Monad/Ether/Writer/Class.hsdeleted−49
@@ -1,49 +0,0 @@
1−{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE UndecidableInstances #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE MagicHash #-}
5−
6−-- | See "Control.Monad.Writer.Class".
7−
8−module Control.Monad.Ether.Writer.Class
9− ( MonadWriter(..)
10− ) where
11−
12−import GHC.Prim (Proxy#)
13−import qualified Control.Monad.Trans.Lift.Listen as Lift
14−import qualified Control.Monad.Trans.Lift.Pass as Lift
15−
16−-- | See 'Control.Monad.Writer.MonadWriter'.
17−class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where
18−
19− {-# MINIMAL (writer | tell), listen, pass #-}
20−
21− -- | Embed a simple writer action.
22− writer :: Proxy# tag -> (a, w) -> m a
23− writer t ~(a, w) = do
24− tell t w
25− return a
26−
27− -- | Append a value to the accumulator within the monad.
28− tell :: Proxy# tag -> w -> m ()
29− tell t w = writer t ((),w)
30−
31− -- | Execute an action and add its accumulator
32− -- to the value of the computation.
33− listen :: Proxy# tag -> m a -> m (a, w)
34−
35− -- | Execute an action which returns a value and a function,
36− -- and return the value, applying the function to the accumulator.
37− pass :: Proxy# tag -> m (a, w -> w) -> m a
38−
39−instance {-# OVERLAPPABLE #-}
40− ( Lift.LiftListen t
41− , Lift.LiftPass t
42− , Monad (t m)
43− , MonadWriter tag w m
44− , Monoid w
45− ) => MonadWriter tag w (t m) where
46− writer t = Lift.lift . writer t
47− tell t = Lift.lift . tell t
48− listen t = Lift.liftListen (listen t)
49− pass t = Lift.liftPass (pass t)
ether/src/Control/Monad/Trans/Ether/Dispatch.hsdeleted−150
@@ -1,150 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE UndecidableInstances #-}
5−{-# LANGUAGE ConstraintKinds #-}
6−{-# LANGUAGE TypeFamilies #-}
7−
8−module Control.Monad.Trans.Ether.Dispatch where
9−
10−import Control.Applicative
11−import Control.Monad (MonadPlus)
12−import Control.Monad.Fix (MonadFix)
13−import Control.Monad.Trans.Class (MonadTrans, lift)
14−import Control.Monad.IO.Class (MonadIO)
15−import Control.Monad.Morph (MFunctor, MMonad)
16−import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
17−
18−import qualified Control.Monad.Base as MB
19−import qualified Control.Monad.Trans.Control as MC
20−
21−import qualified Control.Monad.Trans.Lift.StT as Lift
22−import qualified Control.Monad.Trans.Lift.Local as Lift
23−import qualified Control.Monad.Trans.Lift.Catch as Lift
24−import qualified Control.Monad.Trans.Lift.Listen as Lift
25−import qualified Control.Monad.Trans.Lift.Pass as Lift
26−import qualified Control.Monad.Trans.Lift.CallCC as Lift
27−
28−import qualified Control.Monad.Cont.Class as Class
29−import qualified Control.Monad.Reader.Class as Class
30−import qualified Control.Monad.State.Class as Class
31−import qualified Control.Monad.Writer.Class as Class
32−import qualified Control.Monad.Error.Class as Class
33−
34−import GHC.Generics (Generic)
35−import Data.Coerce (coerce)
36−
37−newtype Dispatch dp trans m a = Dispatch (trans m a)
38− deriving
39− ( Generic
40− , Functor, Applicative, Alternative, Monad, MonadPlus
41− , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
42− , MonadThrow, MonadCatch, MonadMask )
43−
44−pack :: forall dp trans m a . trans m a -> Dispatch dp trans m a
45−pack = coerce
46−{-# INLINE pack #-}
47−
48−unpack :: forall dp trans m a . Dispatch dp trans m a -> trans m a
49−unpack = coerce
50−{-# INLINE unpack #-}
51−
52−repack :: forall dp dp' trans m a . Dispatch dp trans m a -> Dispatch dp' trans m a
53−repack = coerce
54−{-# INLINE repack #-}
55−
56−instance
57− ( MB.MonadBase b m
58− , MonadTrans trans
59− , Monad (trans m)
60− ) => MB.MonadBase b (Dispatch dp trans m)
61− where
62− liftBase = MB.liftBaseDefault
63−
64−instance
65− ( MC.MonadTransControl trans
66− ) => MC.MonadTransControl (Dispatch dp trans)
67− where
68− type StT (Dispatch dp trans) a = MC.StT trans a
69− liftWith = MC.defaultLiftWith pack unpack
70− restoreT = MC.defaultRestoreT pack
71−
72−instance
73− ( MC.MonadBaseControl b m
74− , MC.MonadTransControl trans
75− , Monad (trans m)
76− ) => MC.MonadBaseControl b (Dispatch dp trans m)
77− where
78− type StM (Dispatch dp trans m) a = MC.ComposeSt trans m a
79− liftBaseWith = MC.defaultLiftBaseWith
80− restoreM = MC.defaultRestoreM
81−
82−type instance Lift.StT (Dispatch dp trans) a = Lift.StT trans a
83−
84−instance Lift.LiftLocal trans => Lift.LiftLocal (Dispatch dp trans) where
85− liftLocal = Lift.defaultLiftLocal pack unpack
86−
87−instance Lift.LiftCatch trans => Lift.LiftCatch (Dispatch dp trans) where
88− liftCatch = Lift.defaultLiftCatch pack unpack
89−
90−instance Lift.LiftListen trans => Lift.LiftListen (Dispatch dp trans) where
91− liftListen = Lift.defaultLiftListen pack unpack
92−
93−instance Lift.LiftPass trans => Lift.LiftPass (Dispatch dp trans) where
94− liftPass = Lift.defaultLiftPass pack unpack
95−
96−instance Lift.LiftCallCC trans => Lift.LiftCallCC (Dispatch dp trans) where
97− liftCallCC = Lift.defaultLiftCallCC pack unpack
98− liftCallCC' = Lift.defaultLiftCallCC' pack unpack
99−
100−
101−-- Instances for mtl classes
102−
103−instance {-# OVERLAPPABLE #-}
104− ( Class.MonadCont m
105− , Lift.LiftCallCC trans
106− , Monad (trans m)
107− ) => Class.MonadCont (Dispatch dp trans m)
108− where
109− callCC = Lift.liftCallCC' Class.callCC
110−
111−instance {-# OVERLAPPABLE #-}
112− ( Class.MonadReader r m
113− , Lift.LiftLocal trans
114− , Monad (trans m)
115− ) => Class.MonadReader r (Dispatch dp trans m)
116− where
117− ask = lift Class.ask
118− local = Lift.liftLocal Class.ask Class.local
119− reader = lift . Class.reader
120−
121−instance {-# OVERLAPPABLE #-}
122− ( Class.MonadState s m
123− , MonadTrans trans
124− , Monad (trans m)
125− ) => Class.MonadState s (Dispatch dp trans m)
126− where
127− get = lift Class.get
128− put = lift . Class.put
129− state = lift . Class.state
130−
131−instance {-# OVERLAPPABLE #-}
132− ( Class.MonadWriter w m
133− , Lift.LiftListen trans
134− , Lift.LiftPass trans
135− , Monad (trans m)
136− ) => Class.MonadWriter w (Dispatch dp trans m)
137− where
138− writer = lift . Class.writer
139− tell = lift . Class.tell
140− listen = Lift.liftListen Class.listen
141− pass = Lift.liftPass Class.pass
142−
143−instance {-# OVERLAPPABLE #-}
144− ( Class.MonadError e m
145− , Lift.LiftCatch trans
146− , Monad (trans m)
147− ) => Class.MonadError e (Dispatch dp trans m)
148− where
149− throwError = lift . Class.throwError
150− catchError = Lift.liftCatch Class.catchError
shell.nixnew file+22
@@ -0,0 +1,22 @@
1+{ pkgs ? import <nixpkgs> {},
2+ hc ? "ghc844"
3+}:
4+
5+pkgs.stdenv.mkDerivation rec {
6+ name = "ether";
7+ buildInputs = [
8+ pkgs.haskell.compiler.${hc}
9+ pkgs.git
10+ pkgs.zlib
11+ pkgs.cabal-install
12+ pkgs.pkgconfig
13+ ];
14+ shellHook = ''
15+ export LD_LIBRARY_PATH=${pkgs.lib.makeLibraryPath buildInputs}:$LD_LIBRARY_PATH
16+ export LANG=en_US.UTF-8
17+ '';
18+ LOCALE_ARCHIVE =
19+ if pkgs.stdenv.isLinux
20+ then "${pkgs.glibcLocales}/lib/locale/locale-archive"
21+ else "";
22+}
src/Ether.hsnew file+25
@@ -0,0 +1,25 @@
1+module Ether
2+ ( module Control.Monad
3+ , module Control.Monad.Fix
4+ , module Control.Monad.Trans.Identity
5+ , module Data.Functor.Identity
6+ , module Data.Tagged
7+ , module Ether.Reader
8+ , module Ether.Writer
9+ , module Ether.State
10+ , module Ether.Except
11+ , module Ether.TagDispatch
12+ , module Ether.TaggedTrans
13+ ) where
14+
15+import Control.Monad
16+import Control.Monad.Fix
17+import Control.Monad.Trans.Identity
18+import Data.Functor.Identity
19+import Data.Tagged
20+import Ether.Reader
21+import Ether.Writer
22+import Ether.State
23+import Ether.Except
24+import Ether.TagDispatch
25+import Ether.TaggedTrans
src/Ether/Except.hsnew file+127
@@ -0,0 +1,127 @@
1+module Ether.Except
2+ (
3+ -- * MonadExcept class
4+ MonadExcept
5+ , throw
6+ , catch
7+ -- * The Except monad
8+ , Except
9+ , runExcept
10+ -- * The ExceptT monad transformer
11+ , ExceptT
12+ , exceptT
13+ , runExceptT
14+ -- * MonadExcept class (implicit)
15+ , MonadExcept'
16+ , throw'
17+ , catch'
18+ -- * The Except monad (implicit)
19+ , Except'
20+ , runExcept'
21+ -- * The ExceptT monad transformer (implicit)
22+ , ExceptT'
23+ , exceptT'
24+ , runExceptT'
25+ -- * Internal labels
26+ , TAGGED
27+ , EXCEPT
28+ ) where
29+
30+import qualified Control.Monad.Except as T
31+import Control.Monad.Signatures (Catch)
32+import qualified Control.Monad.Trans.Lift.Catch as Lift
33+import Data.Coerce
34+import Data.Functor.Identity
35+
36+import Ether.TaggedTrans
37+import Ether.Internal
38+
39+class Monad m => MonadExcept tag e m | m tag -> e where
40+
41+ -- | Is used within a monadic computation to begin exception processing.
42+ throw :: e -> m a
43+
44+ -- | A TaggedTrans function to handle previous exceptions and return to
45+ -- normal execution.
46+ catch :: m a -> (e -> m a) -> m a
47+
48+instance {-# OVERLAPPABLE #-}
49+ ( Lift.LiftCatch t
50+ , Monad (t m)
51+ , MonadExcept tag e m
52+ ) => MonadExcept tag e (t m) where
53+ throw = Lift.lift . throw @tag
54+ catch = Lift.liftCatch (catch @tag)
55+
56+-- | Encode type-level information for 'ExceptT'.
57+data EXCEPT
58+
59+-- | The parameterizable exception monad.
60+--
61+-- Computations are either exceptions or normal values.
62+--
63+-- The 'return' function returns a normal value, while '>>=' exits on
64+-- the first exception.
65+type Except tag e = ExceptT tag e Identity
66+
67+-- | The exception monad transformer.
68+--
69+-- The 'return' function returns a normal value, while '>>=' exits on
70+-- the first exception.
71+type ExceptT tag e = TaggedTrans (TAGGED EXCEPT tag) (T.ExceptT e)
72+
73+-- | Runs an 'Except' and returns either an exception or a normal value.
74+runExcept :: forall tag e a . Except tag e a -> Either e a
75+runExcept = coerce (T.runExcept @e @a)
76+
77+-- | Runs an 'ExceptT' and returns either an exception or a normal value.
78+runExceptT :: forall tag e m a . ExceptT tag e m a -> m (Either e a)
79+runExceptT = coerce (T.runExceptT @e @m @a)
80+
81+-- | Constructor for computations in the exception monad transformer.
82+exceptT :: forall tag e m a . m (Either e a) -> ExceptT tag e m a
83+exceptT = coerce (T.ExceptT @e @m @a)
84+
85+type instance HandleSuper EXCEPT e trans = ()
86+type instance HandleConstraint EXCEPT e trans m =
87+ T.MonadError e (trans m)
88+
89+instance Handle EXCEPT e (T.ExceptT e) where
90+ handling r = r
91+
92+instance
93+ ( Handle EXCEPT e trans
94+ , Monad m, Monad (trans m)
95+ ) => MonadExcept tag e (TaggedTrans (TAGGED EXCEPT tag) trans m)
96+ where
97+
98+ throw =
99+ handling @EXCEPT @e @trans @m $
100+ coerce (T.throwError @e @(trans m) @a) ::
101+ forall eff a . e -> TaggedTrans eff trans m a
102+
103+ catch =
104+ handling @EXCEPT @e @trans @m $
105+ coerce (T.catchError @e @(trans m) @a) ::
106+ forall eff a . Catch e (TaggedTrans eff trans m) a
107+
108+type MonadExcept' e = MonadExcept e e
109+
110+throw' :: forall e m a . MonadExcept' e m => e -> m a
111+throw' = throw @e
112+
113+catch' :: forall e m a . MonadExcept' e m => m a -> (e -> m a) -> m a
114+catch' = catch @e
115+
116+type Except' e = Except e e
117+
118+runExcept' :: Except' e a -> Either e a
119+runExcept' = runExcept
120+
121+type ExceptT' e = ExceptT e e
122+
123+exceptT' :: m (Either e a) -> ExceptT' e m a
124+exceptT' = exceptT
125+
126+runExceptT' :: ExceptT' e m a -> m (Either e a)
127+runExceptT' = runExceptT
src/Ether/Internal.hsnew file+68
@@ -0,0 +1,68 @@
1+module Ether.Internal
2+ ( Tagged(..)
3+ , TagsK
4+ , Tags
5+ , HasLens(..)
6+ , LensLike
7+ , Lens
8+ , Lens'
9+ , ReifiedLens(..)
10+ , ReifiedLens'
11+ , view
12+ , over
13+ , HList(..)
14+ , KindOf
15+ , TAGGED
16+ , HandleSuper
17+ , HandleConstraint
18+ , Handle(..)
19+ , makeTupleInstancesHasLens
20+ ) where
21+
22+import Control.Applicative
23+import Data.Coerce
24+import Data.Functor.Identity
25+import Data.Kind
26+import Data.Tagged
27+import GHC.Exts (Constraint)
28+
29+import Ether.Internal.HasLens
30+import Ether.Internal.Tags
31+import Ether.Internal.TH_TupleInstances (makeTupleInstancesHasLens)
32+import Ether.Internal.TupleInstances ()
33+
34+data TAGGED e t
35+
36+type K_Monad = Type -> Type
37+
38+type K_Trans = K_Monad -> K_Monad
39+
40+type family
41+ HandleSuper
42+ (eff :: keff)
43+ (p :: kp)
44+ (trans :: K_Trans)
45+ :: Constraint
46+
47+type family
48+ HandleConstraint
49+ (eff :: keff)
50+ (p :: kp)
51+ (trans :: K_Trans) (m :: K_Monad)
52+ :: Constraint
53+
54+class
55+ HandleSuper eff p trans =>
56+ Handle eff p (trans :: K_Trans) | eff trans -> p
57+ where
58+ handling :: Monad m => (HandleConstraint eff p trans m => r) -> r
59+
60+newtype ReifiedLens s t a b = Lens (Lens s t a b)
61+
62+type ReifiedLens' s a = ReifiedLens s s a a
63+
64+view :: LensLike (Const a) s t a b -> s -> a
65+view l = coerce (l Const)
66+
67+over :: LensLike Identity s t a b -> (a -> b) -> s -> t
68+over = coerce
src/Ether/Internal/HasLens.hsnew file+24
@@ -0,0 +1,24 @@
1+module Ether.Internal.HasLens
2+ ( LensLike
3+ , Lens
4+ , Lens'
5+ , HasLens(..)
6+ ) where
7+
8+import Data.Tagged
9+import Data.Coerce
10+
11+type LensLike f s t a b = (a -> f b) -> s -> f t
12+
13+type Lens s t a b = forall f. Functor f => LensLike f s t a b
14+
15+type Lens' s a = Lens s s a a
16+
17+class HasLens tag outer inner | tag outer -> inner where
18+ lensOf :: Lens' outer inner
19+
20+instance HasLens a a a where
21+ lensOf = id
22+
23+instance HasLens t (Tagged t a) a where
24+ lensOf = \f -> fmap coerce . f . coerce
src/Ether/Internal/TH_TupleInstances.hsnew file+79
@@ -0,0 +1,79 @@
1+module Ether.Internal.TH_TupleInstances
2+ ( makeTupleInstancesTagsK
3+ , makeTupleInstancesTags
4+ , makeTupleInstancesHasLens
5+ ) where
6+
7+import Data.Tagged
8+import Data.Traversable
9+import Data.List as List
10+import qualified Language.Haskell.TH as TH
11+
12+import Ether.Internal.HasLens
13+import Ether.Internal.Tags
14+import Ether.Internal.TH_Utils
15+
16+makeTupleInstancesTagsK :: TH.DecsQ
17+makeTupleInstancesTagsK = do
18+ for [2..tupCount] $ \n -> do
19+ let
20+ tupTy = List.foldl' TH.AppT (TH.ConT (TH.tupleTypeName n)) $
21+ (\k -> TH.ConT ''Tagged `TH.AppT`
22+ TH.VarT (tagName k) `TH.AppT`
23+ TH.VarT (varName k)) <$> [0..n-1]
24+ tagsList = List.foldr
25+ (\a b -> TH.PromotedConsT `TH.AppT` a `TH.AppT` b)
26+ TH.PromotedNilT
27+ (TH.AppT (TH.ConT ''KindOf) . TH.VarT . tagName <$> [0..n-1])
28+ return $
29+ TH.TySynInstD ''TagsK (TH.TySynEqn [tupTy] tagsList)
30+
31+makeTupleInstancesTags :: TH.DecsQ
32+makeTupleInstancesTags = do
33+ for [2..tupCount] $ \n -> do
34+ let
35+ tupTy = List.foldl' TH.AppT (TH.ConT (TH.tupleTypeName n)) $
36+ (\k -> TH.ConT ''Tagged `TH.AppT`
37+ TH.VarT (tagName k) `TH.AppT`
38+ TH.VarT (varName k)) <$> [0..n-1]
39+ tagsList = List.foldr
40+ (\a b -> TH.PromotedT 'HCons `TH.AppT` a `TH.AppT` b)
41+ (TH.PromotedT 'HNil)
42+ (TH.VarT . tagName <$> [0..n-1])
43+ return $
44+ TH.TySynInstD ''Tags (TH.TySynEqn [tupTy] tagsList)
45+
46+makeTupleInstancesHasLens :: [Int] -> TH.DecsQ
47+makeTupleInstancesHasLens range = List.concat <$> do
48+ for range $ \n ->
49+ for [0..n-1] $ \k -> do
50+ let
51+ tag = TH.mkName "tag"
52+ prev = varName <$> [0..k-1]
53+ cur = varName k
54+ next = varName <$> [k+1..n-1]
55+ tupTy = foldl TH.AppT (TH.ConT (TH.tupleTypeName n))
56+ ( map TH.VarT prev ++
57+ [TH.ConT ''Tagged `TH.AppT` TH.VarT tag `TH.AppT` TH.VarT cur] ++
58+ map TH.VarT next )
59+ let
60+ cur' = TH.mkName "x"
61+ f = TH.mkName "f"
62+ return $
63+ TH.InstanceD Nothing []
64+ (TH.ConT ''HasLens `TH.AppT` TH.VarT tag `TH.AppT` tupTy `TH.AppT` TH.VarT cur)
65+ [ TH.FunD 'lensOf
66+ [ TH.Clause
67+ [TH.VarP f, TH.TupP
68+ ( map TH.VarP prev ++
69+ [TH.ConP 'Tagged [TH.VarP cur]] ++
70+ map TH.VarP next )]
71+ (TH.NormalB $
72+ TH.VarE 'fmap `TH.AppE`
73+ (TH.LamE [TH.VarP cur']
74+ (TH.TupE
75+ ( map TH.VarE prev ++
76+ [TH.ConE 'Tagged `TH.AppE` TH.VarE cur'] ++
77+ map TH.VarE next ))) `TH.AppE`
78+ (TH.VarE f `TH.AppE` TH.VarE cur) )
79+ [] ] ]
src/Ether/Internal/TH_Utils.hsnew file+14
@@ -0,0 +1,14 @@
1+module Ether.Internal.TH_Utils
2+ ( tupCount
3+ , varName
4+ , tagName
5+ ) where
6+
7+import qualified Language.Haskell.TH as TH
8+
9+tupCount :: Int
10+tupCount = 62
11+
12+varName, tagName :: Int -> TH.Name
13+varName k = TH.mkName ('a' : show k)
14+tagName k = TH.mkName ('t' : show k)
src/Ether/Internal/Tags.hsnew file+18
@@ -0,0 +1,18 @@
1+module Ether.Internal.Tags
2+ ( Tags
3+ , TagsK
4+ , HList(..)
5+ , KindOf
6+ ) where
7+
8+import Data.Kind
9+
10+data HList xs where
11+ HNil :: HList '[]
12+ HCons :: x -> HList xs -> HList (x ': xs)
13+
14+type KindOf (a :: k) = k
15+
16+type family TagsK (p :: Type) :: [Type]
17+type family Tags (p :: Type) :: HList (TagsK p)
18+
src/Ether/Internal/TupleInstances.hsnew file+24
@@ -0,0 +1,24 @@
1+{-# OPTIONS -fno-warn-orphans #-}
2+{-# LANGUAGE CPP #-}
3+
4+module Ether.Internal.TupleInstances () where
5+
6+import Data.Tagged
7+import Ether.Internal.Tags
8+import Ether.Internal.TH_TupleInstances
9+
10+type instance TagsK () = '[]
11+type instance TagsK (Tagged t a) = '[KindOf t]
12+type instance TagsK (Tagged t0 a, Tagged t1 b) = '[KindOf t0, KindOf t1]
13+
14+makeTupleInstancesTagsK
15+
16+type instance Tags () = 'HNil
17+type instance Tags (Tagged t a) = 'HCons t 'HNil
18+type instance Tags (Tagged t0 a, Tagged t1 b) = 'HCons t0 ('HCons t1 'HNil)
19+
20+makeTupleInstancesTags
21+
22+#ifndef DISABLE_TUP_INSTANCES
23+makeTupleInstancesHasLens [2..62]
24+#endif
src/Ether/Reader.hsnew file+236
@@ -0,0 +1,236 @@
1+module Ether.Reader
2+ (
3+ -- * MonadReader class
4+ MonadReader
5+ , ask
6+ , local
7+ , reader
8+ , asks
9+ -- * The Reader monad
10+ , Reader
11+ , runReader
12+ -- * The ReaderT monad transformer
13+ , ReaderT
14+ , readerT
15+ , runReaderT
16+ -- * The Reader monad (flattened)
17+ , Readers
18+ , runReaders
19+ -- * The ReaderT monad transformer (flattened)
20+ , ReadersT
21+ , runReadersT
22+ -- * MonadReader class (implicit)
23+ , MonadReader'
24+ , local'
25+ , ask'
26+ , reader'
27+ , asks'
28+ -- * The Reader monad (implicit)
29+ , Reader'
30+ , runReader'
31+ -- * The ReaderT monad transformer (implicit)
32+ , ReaderT'
33+ , readerT'
34+ , runReaderT'
35+ -- * Internal labels
36+ , TAGGED
37+ , READER
38+ , READERS
39+ ) where
40+
41+import qualified Control.Monad.Reader as T
42+import qualified Control.Monad.Trans.Lift.Local as Lift
43+import Control.Monad.Trans.Lift.Local (Local)
44+import Data.Coerce
45+import Data.Functor.Identity
46+import Data.Kind
47+
48+import Ether.TaggedTrans
49+import Ether.Internal
50+
51+class Monad m => MonadReader tag r m | m tag -> r where
52+
53+ {-# MINIMAL (ask | reader), local #-}
54+
55+ -- | Retrieves the monad environment.
56+ ask :: m r
57+ ask = reader @tag id
58+
59+ -- | Executes a computation in a modified environment.
60+ local
61+ :: (r -> r)
62+ -- ^ The function to modify the environment.
63+ -> m a
64+ -- ^ @Reader@ to run in the modified environment.
65+ -> m a
66+
67+ -- | Retrieves a function of the current environment.
68+ reader
69+ :: (r -> a)
70+ -- ^ The selector function to apply to the environment.
71+ -> m a
72+ reader f = fmap f (ask @tag)
73+
74+instance {-# OVERLAPPABLE #-}
75+ ( Lift.LiftLocal t
76+ , Monad (t m)
77+ , MonadReader tag r m
78+ ) => MonadReader tag r (t m)
79+ where
80+ ask = Lift.lift (ask @tag)
81+ local = Lift.liftLocal (ask @tag) (local @tag)
82+ reader = Lift.lift . reader @tag
83+
84+instance {-# OVERLAPPABLE #-}
85+ ( Monad (trans m)
86+ , MonadReader tag r (TaggedTrans effs trans m)
87+ ) => MonadReader tag r (TaggedTrans (eff ': effs) trans (m :: Type -> Type))
88+ where
89+
90+ ask =
91+ (coerce ::
92+ TaggedTrans effs trans m r ->
93+ TaggedTrans (eff ': effs) trans m r)
94+ (ask @tag)
95+
96+ local =
97+ (coerce :: forall a .
98+ Lift.Local r (TaggedTrans effs trans m) a ->
99+ Lift.Local r (TaggedTrans (eff ': effs) trans m) a)
100+ (local @tag)
101+
102+ reader =
103+ (coerce :: forall a .
104+ ((r -> a) -> TaggedTrans effs trans m a) ->
105+ ((r -> a) -> TaggedTrans (eff ': effs) trans m a))
106+ (reader @tag)
107+
108+-- | Retrieves a function of the current environment.
109+asks
110+ :: forall tag r m a
111+ . MonadReader tag r m
112+ => (r -> a)
113+ -- ^ The selector function to apply to the environment.
114+ -> m a
115+asks = reader @tag
116+
117+-- | Encode type-level information for 'ReaderT'.
118+data READER
119+
120+-- | The parameterizable reader monad.
121+--
122+-- Computations are functions of a shared environment.
123+--
124+-- The 'return' function ignores the environment, while '>>=' passes
125+-- the inherited environment to both subcomputations.
126+type Reader tag r = ReaderT tag r Identity
127+
128+-- | The reader monad transformer,
129+-- which adds a read-only environment to the given monad.
130+--
131+-- The 'return' function ignores the environment, while '>>=' passes
132+-- the inherited environment to both subcomputations.
133+type ReaderT tag r = TaggedTrans (TAGGED READER tag) (T.ReaderT r)
134+
135+-- | Constructor for computations in the reader monad transformer.
136+readerT :: forall tag r m a . (r -> m a) -> ReaderT tag r m a
137+readerT = coerce (T.ReaderT @r @m @a)
138+
139+-- | Runs a 'ReaderT' with the given environment
140+-- and returns the final value.
141+runReaderT :: forall tag r m a . ReaderT tag r m a -> r -> m a
142+runReaderT = coerce (T.runReaderT @r @m @a)
143+
144+-- | Runs a 'ReaderT' with the given environment
145+-- and returns the final value.
146+runReader :: forall tag r a . Reader tag r a -> r -> a
147+runReader = coerce (T.runReader @r @a)
148+
149+type instance HandleSuper READER r trans = ()
150+type instance HandleConstraint READER r trans m =
151+ T.MonadReader r (trans m)
152+
153+instance Handle READER r (T.ReaderT r) where
154+ handling r = r
155+
156+instance
157+ ( Handle READER r trans
158+ , Monad m, Monad (trans m)
159+ ) => MonadReader tag r (TaggedTrans (TAGGED READER tag) trans m)
160+ where
161+
162+ ask =
163+ handling @READER @r @trans @m $
164+ coerce (T.ask @r @(trans m))
165+
166+ local =
167+ handling @READER @r @trans @m $
168+ coerce (T.local @r @(trans m) @a) ::
169+ forall eff a . Local r (TaggedTrans eff trans m) a
170+
171+ reader =
172+ handling @READER @r @trans @m $
173+ coerce (T.reader @r @(trans m) @a) ::
174+ forall eff a . (r -> a) -> TaggedTrans eff trans m a
175+
176+instance
177+ ( HasLens tag payload r
178+ , Handle READER payload trans
179+ , Monad m, Monad (trans m)
180+ ) => MonadReader tag r (TaggedTrans (TAGGED READER tag ': effs) trans m)
181+ where
182+
183+ ask =
184+ handling @READER @payload @trans @m $
185+ (coerce :: forall eff a .
186+ trans m a ->
187+ TaggedTrans eff trans m a)
188+ (T.asks (view (lensOf @tag @payload @r)))
189+
190+ local f =
191+ handling @READER @payload @trans @m $
192+ (coerce :: forall eff a .
193+ (trans m a -> trans m a) ->
194+ (TaggedTrans eff trans m a -> TaggedTrans eff trans m a))
195+ (T.local (over (lensOf @tag @payload @r) f))
196+
197+type family READERS (ts :: HList xs) :: [Type] where
198+ READERS 'HNil = '[]
199+ READERS ('HCons t ts) = TAGGED READER t ': READERS ts
200+
201+type ReadersT r = TaggedTrans (READERS (Tags r)) (T.ReaderT r)
202+
203+type Readers r = ReadersT r Identity
204+
205+runReadersT :: forall p m a . ReadersT p m a -> p -> m a
206+runReadersT = coerce (T.runReaderT @p @m @a)
207+
208+runReaders :: forall p a . Readers p a -> p -> a
209+runReaders = coerce (T.runReader @p @a)
210+
211+type ReaderT' r = ReaderT r r
212+
213+readerT' :: (r -> m a) -> ReaderT' r m a
214+readerT' = readerT
215+
216+runReaderT' :: ReaderT' r m a -> r -> m a
217+runReaderT' = runReaderT
218+
219+type Reader' r = Reader r r
220+
221+runReader' :: Reader' r a -> r -> a
222+runReader' = runReader
223+
224+type MonadReader' r = MonadReader r r
225+
226+local' :: forall r m a . MonadReader' r m => (r -> r) -> m a -> m a
227+local' = local @r
228+
229+ask' :: forall r m . MonadReader' r m => m r
230+ask' = ask @r
231+
232+reader' :: forall r m a . MonadReader' r m => (r -> a) -> m a
233+reader' = reader @r
234+
235+asks' :: forall r m a . MonadReader' r m => (r -> a) -> m a
236+asks' = asks @r
src/Ether/State.hsnew file+415
@@ -0,0 +1,415 @@
1+module Ether.State
2+ (
3+ -- * MonadState class
4+ MonadState
5+ , get
6+ , put
7+ , state
8+ , modify
9+ , gets
10+ -- * The State monad
11+ , State
12+ , runState
13+ , evalState
14+ , execState
15+ -- * The StateT monad transformer
16+ , StateT
17+ , stateT
18+ , runStateT
19+ , evalStateT
20+ , execStateT
21+ -- * The State monad (lazy)
22+ , LazyState
23+ , runLazyState
24+ , evalLazyState
25+ , execLazyState
26+ -- * The StateT monad transformer (lazy)
27+ , LazyStateT
28+ , lazyStateT
29+ , runLazyStateT
30+ , evalLazyStateT
31+ , execLazyStateT
32+ -- * The State monad (flattened)
33+ , States
34+ , runStates
35+ -- * The StateT monad transformer (flattened)
36+ , StatesT
37+ , runStatesT
38+ -- * MonadState class (implicit)
39+ , MonadState'
40+ , get'
41+ , put'
42+ , state'
43+ , modify'
44+ , gets'
45+ -- * The State monad (implicit)
46+ , State'
47+ , runState'
48+ , evalState'
49+ , execState'
50+ -- * The StateT monad transformer (implicit)
51+ , StateT'
52+ , stateT'
53+ , runStateT'
54+ , evalStateT'
55+ , execStateT'
56+ -- * The State monad (lazy, implicit)
57+ , LazyState'
58+ , runLazyState'
59+ , evalLazyState'
60+ , execLazyState'
61+ -- * The StateT monad transformer (lazy, implicit)
62+ , LazyStateT'
63+ , lazyStateT'
64+ , runLazyStateT'
65+ , evalLazyStateT'
66+ , execLazyStateT'
67+ -- * Zoom
68+ , ZoomT
69+ , zoom
70+ -- * Internal labels
71+ , TAGGED
72+ , STATE
73+ , STATES
74+ , ZOOM
75+ ) where
76+
77+import qualified Control.Monad.State.Class as T
78+import qualified Control.Monad.Trans as Lift
79+import Control.Monad.Trans.Identity
80+import qualified Control.Monad.Trans.State.Lazy as T.Lazy
81+import qualified Control.Monad.Trans.State.Strict as T.Strict
82+import Data.Coerce
83+import Data.Functor.Identity
84+import Data.Kind
85+import Data.Proxy
86+import Data.Reflection
87+
88+import Ether.Internal
89+import Ether.TaggedTrans
90+
91+class Monad m => MonadState tag s m | m tag -> s where
92+
93+ {-# MINIMAL state | get, put #-}
94+
95+ -- | Return the state from the internals of the monad.
96+ get :: m s
97+ get = state @tag (\s -> (s, s))
98+
99+ -- | Replace the state inside the monad.
100+ put :: s -> m ()
101+ put s = state @tag (\_ -> ((), s))
102+
103+ -- | Embed a simple state action into the monad.
104+ state :: (s -> (a, s)) -> m a
105+ state f = do
106+ s <- get @tag
107+ let ~(a, s') = f s
108+ put @tag s'
109+ return a
110+
111+instance {-# OVERLAPPABLE #-}
112+ ( Lift.MonadTrans t
113+ , Monad (t m)
114+ , MonadState tag s m
115+ ) => MonadState tag s (t m)
116+ where
117+ get = Lift.lift (get @tag)
118+ put = Lift.lift . put @tag
119+ state = Lift.lift . state @tag
120+
121+instance {-# OVERLAPPABLE #-}
122+ ( Monad (trans m)
123+ , MonadState tag s (TaggedTrans effs trans m)
124+ ) => MonadState tag s (TaggedTrans (eff ': effs) trans (m :: Type -> Type))
125+ where
126+
127+ get =
128+ (coerce ::
129+ TaggedTrans effs trans m s ->
130+ TaggedTrans (eff ': effs) trans m s)
131+ (get @tag)
132+
133+ put =
134+ (coerce ::
135+ (s -> TaggedTrans effs trans m ()) ->
136+ (s -> TaggedTrans (eff ': effs) trans m ()))
137+ (put @tag)
138+
139+ state =
140+ (coerce :: forall a .
141+ ((s -> (a, s)) -> TaggedTrans effs trans m a) ->
142+ ((s -> (a, s)) -> TaggedTrans (eff ': effs) trans m a))
143+ (state @tag)
144+
145+-- | Modifies the state inside a state monad.
146+modify :: forall tag s m . MonadState tag s m => (s -> s) -> m ()
147+modify f = state @tag (\s -> ((), f s))
148+
149+-- | Gets specific component of the state, using a projection function supplied.
150+gets :: forall tag s m a . MonadState tag s m => (s -> a) -> m a
151+gets f = fmap f (get @tag)
152+
153+-- | Encode type-level information for 'StateT'.
154+data STATE
155+
156+type instance HandleSuper STATE s trans = ()
157+type instance HandleConstraint STATE s trans m =
158+ T.MonadState s (trans m)
159+
160+instance Handle STATE s (T.Strict.StateT s) where
161+ handling r = r
162+
163+instance Handle STATE s (T.Lazy.StateT s) where
164+ handling r = r
165+
166+instance
167+ ( Handle STATE s trans
168+ , Monad m, Monad (trans m)
169+ ) => MonadState tag s (TaggedTrans (TAGGED STATE tag) trans m)
170+ where
171+
172+ get =
173+ handling @STATE @s @trans @m $
174+ coerce (T.get @s @(trans m))
175+
176+ put =
177+ handling @STATE @s @trans @m $
178+ coerce (T.put @s @(trans m))
179+
180+ state =
181+ handling @STATE @s @trans @m $
182+ coerce (T.state @s @(trans m) @a) ::
183+ forall eff a . (s -> (a, s)) -> TaggedTrans eff trans m a
184+
185+instance
186+ ( HasLens tag payload s
187+ , Handle STATE payload trans
188+ , Monad m, Monad (trans m)
189+ ) => MonadState tag s (TaggedTrans (TAGGED STATE tag ': effs) trans m)
190+ where
191+
192+ get =
193+ handling @STATE @payload @trans @m $
194+ (coerce :: forall eff a .
195+ trans m a ->
196+ TaggedTrans eff trans m a)
197+ (T.gets (view (lensOf @tag @payload @s)))
198+
199+ put s =
200+ handling @STATE @payload @trans @m $
201+ (coerce :: forall eff a .
202+ trans m a ->
203+ TaggedTrans eff trans m a)
204+ (T.modify (over (lensOf @tag @payload @s) (const s)))
205+
206+ state f =
207+ handling @STATE @payload @trans @m $
208+ (coerce :: forall eff a .
209+ trans m a ->
210+ TaggedTrans eff trans m a)
211+ (T.state (lensOf @tag @payload @s f))
212+
213+-- | The parametrizable state monad.
214+--
215+-- Computations have access to a mutable state.
216+--
217+-- The 'return' function leaves the state unchanged, while '>>=' uses
218+-- the final state of the first computation as the initial state of the second.
219+type State tag r = StateT tag r Identity
220+
221+-- | The state monad transformer.
222+--
223+-- The 'return' function leaves the state unchanged, while '>>=' uses
224+-- the final state of the first computation as the initial state of the second.
225+type StateT tag s = TaggedTrans (TAGGED STATE tag) (T.Strict.StateT s)
226+
227+-- | Constructor for computations in the state monad transformer.
228+stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
229+stateT = coerce (T.Strict.StateT @s @m @a)
230+
231+-- | Runs a 'StateT' with the given initial state
232+-- and returns both the final value and the final state.
233+runStateT :: forall tag s m a . StateT tag s m a -> s -> m (a, s)
234+runStateT = coerce (T.Strict.runStateT @s @m @a)
235+
236+-- | Runs a 'StateT' with the given initial state
237+-- and returns the final value, discarding the final state.
238+evalStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m a
239+evalStateT = coerce (T.Strict.evalStateT @m @s @a)
240+
241+-- | Runs a 'StateT' with the given initial state
242+-- and returns the final state, discarding the final value.
243+execStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m s
244+execStateT = coerce (T.Strict.execStateT @m @s @a)
245+
246+-- | Runs a 'State' with the given initial state
247+-- and returns both the final value and the final state.
248+runState :: forall tag s a . State tag s a -> s -> (a, s)
249+runState = coerce (T.Strict.runState @s @a)
250+
251+-- | Runs a 'State' with the given initial state
252+-- and returns the final value, discarding the final state.
253+evalState :: forall tag s a . State tag s a -> s -> a
254+evalState = coerce (T.Strict.evalState @s @a)
255+
256+-- | Runs a 'State' with the given initial state
257+-- and returns the final state, discarding the final value.
258+execState :: forall tag s a . State tag s a -> s -> s
259+execState = coerce (T.Strict.execState @s @a)
260+
261+-- | The parametrizable state monad.
262+--
263+-- Computations have access to a mutable state.
264+--
265+-- The 'return' function leaves the state unchanged, while '>>=' uses
266+-- the final state of the first computation as the initial state of the second.
267+type LazyState tag r = LazyStateT tag r Identity
268+
269+-- | The state monad transformer.
270+--
271+-- The 'return' function leaves the state unchanged, while '>>=' uses
272+-- the final state of the first computation as the initial state of the second.
273+type LazyStateT tag s = TaggedTrans (TAGGED STATE tag) (T.Lazy.StateT s)
274+
275+-- | Constructor for computations in the state monad transformer.
276+lazyStateT :: forall tag s m a . (s -> m (a, s)) -> LazyStateT tag s m a
277+lazyStateT = coerce (T.Lazy.StateT @s @m @a)
278+
279+-- | Runs a 'StateT' with the given initial state
280+-- and returns both the final value and the final state.
281+runLazyStateT :: forall tag s m a . LazyStateT tag s m a -> s -> m (a, s)
282+runLazyStateT = coerce (T.Lazy.runStateT @s @m @a)
283+
284+-- | Runs a 'StateT' with the given initial state
285+-- and returns the final value, discarding the final state.
286+evalLazyStateT :: forall tag s m a . Monad m => LazyStateT tag s m a -> s -> m a
287+evalLazyStateT = coerce (T.Lazy.evalStateT @m @s @a)
288+
289+-- | Runs a 'StateT' with the given initial state
290+-- and returns the final state, discarding the final value.
291+execLazyStateT :: forall tag s m a . Monad m => LazyStateT tag s m a -> s -> m s
292+execLazyStateT = coerce (T.Lazy.execStateT @m @s @a)
293+
294+-- | Runs a 'State' with the given initial state
295+-- and returns both the final value and the final state.
296+runLazyState :: forall tag s a . LazyState tag s a -> s -> (a, s)
297+runLazyState = coerce (T.Lazy.runState @s @a)
298+
299+-- | Runs a 'State' with the given initial state
300+-- and returns the final value, discarding the final state.
301+evalLazyState :: forall tag s a . LazyState tag s a -> s -> a
302+evalLazyState = coerce (T.Lazy.evalState @s @a)
303+
304+-- | Runs a 'State' with the given initial state
305+-- and returns the final state, discarding the final value.
306+execLazyState :: forall tag s a . LazyState tag s a -> s -> s
307+execLazyState = coerce (T.Lazy.execState @s @a)
308+
309+type family STATES (ts :: HList xs) :: [Type] where
310+ STATES 'HNil = '[]
311+ STATES ('HCons t ts) = TAGGED STATE t ': STATES ts
312+
313+type StatesT s = TaggedTrans (STATES (Tags s)) (T.Strict.StateT s)
314+
315+type States s = StatesT s Identity
316+
317+runStatesT :: forall p m a . StatesT p m a -> p -> m (a, p)
318+runStatesT = coerce (T.Strict.runStateT @p @m @a)
319+
320+runStates :: forall p a . States p a -> p -> (a, p)
321+runStates = coerce (T.Strict.runState @p @a)
322+
323+type StateT' s = StateT s s
324+
325+stateT' :: (s -> m (a, s)) -> StateT' s m a
326+stateT' = stateT
327+
328+runStateT' :: StateT' s m a -> s -> m (a, s)
329+runStateT' = runStateT
330+
331+runState' :: State' s a -> s -> (a, s)
332+runState' = runState
333+
334+evalStateT' :: Monad m => StateT' s m a -> s -> m a
335+evalStateT' = evalStateT
336+
337+type State' s = State s s
338+
339+evalState' :: State' s a -> s -> a
340+evalState' = evalState
341+
342+execStateT' :: Monad m => StateT' s m a -> s -> m s
343+execStateT' = execStateT
344+
345+execState' :: State' s a -> s -> s
346+execState' = execState
347+
348+type LazyStateT' s = LazyStateT s s
349+
350+lazyStateT' :: (s -> m (a, s)) -> LazyStateT' s m a
351+lazyStateT' = lazyStateT
352+
353+runLazyStateT' :: LazyStateT' s m a -> s -> m (a, s)
354+runLazyStateT' = runLazyStateT
355+
356+runLazyState' :: LazyState' s a -> s -> (a, s)
357+runLazyState' = runLazyState
358+
359+evalLazyStateT' :: Monad m => LazyStateT' s m a -> s -> m a
360+evalLazyStateT' = evalLazyStateT
361+
362+type LazyState' s = LazyState s s
363+
364+evalLazyState' :: LazyState' s a -> s -> a
365+evalLazyState' = evalLazyState
366+
367+execLazyStateT' :: Monad m => LazyStateT' s m a -> s -> m s
368+execLazyStateT' = execLazyStateT
369+
370+execLazyState' :: LazyState' s a -> s -> s
371+execLazyState' = execLazyState
372+
373+type MonadState' s = MonadState s s
374+
375+get' :: forall s m . MonadState' s m => m s
376+get' = get @s
377+
378+gets' :: forall s m a . MonadState' s m => (s -> a) -> m a
379+gets' = gets @s
380+
381+put' :: forall s m . MonadState' s m => s -> m ()
382+put' = put @s
383+
384+state' :: forall s m a . MonadState' s m => (s -> (a, s)) -> m a
385+state' = state @s
386+
387+modify' :: forall s m . MonadState' s m => (s -> s) -> m ()
388+modify' = modify @s
389+
390+-- | Encode type-level information for 'zoom'.
391+data ZOOM t z
392+
393+type ZoomT t (z :: Type) = TaggedTrans (ZOOM t z) IdentityT
394+
395+-- | Zoom into a part of a state using a lens.
396+zoom
397+ :: forall tag sOuter sInner m a
398+ . Lens' sOuter sInner
399+ -> (forall z . Reifies z (ReifiedLens' sOuter sInner) => ZoomT tag z m a)
400+ -> m a
401+zoom l m = reify (Lens l) (\(_ :: Proxy z) -> coerce (m @z))
402+
403+instance
404+ ( MonadState tag sOuter m
405+ , Reifies z (ReifiedLens' sOuter sInner)
406+ , trans ~ IdentityT
407+ ) => MonadState tag sInner (TaggedTrans (ZOOM tag z) trans m)
408+ where
409+ state =
410+ (coerce :: forall eff r a .
411+ (r -> m a) ->
412+ (r -> TaggedTrans eff trans m a))
413+ (state @tag . l)
414+ where
415+ Lens l = reflect (Proxy :: Proxy z)
src/Ether/TagDispatch.hsnew file+138
@@ -0,0 +1,138 @@
1+{- |
2+
3+Type-level machinery to manipulate constraints on the monad
4+transformer stack.
5+
6+Out of the box it provides the following dispatch strategies:
7+
8+* 'tagAttach' to use functions defined using untagged monad classes
9+ as if they were defined using tagged ones.
10+
11+* 'tagReplace' to use functions defined using one tag
12+ as if they were defined using another one.
13+
14+> import Ether
15+> import Control.Monad.State as Mtl
16+>
17+> data Foo
18+> data Bar
19+>
20+> f :: Mtl.MonadState Int m => m String
21+> f = fmap show Mtl.get
22+>
23+> g :: Ether.MonadState Foo Int m => m String
24+> g = tagAttach @Foo f
25+>
26+> h :: Ether.MonadState Bar Int m => m String
27+> h = tagReplace @Foo @Bar g
28+
29+-}
30+
31+module Ether.TagDispatch
32+ (
33+ -- * The Tag Attach monad transformer
34+ TagAttachT
35+ , tagAttach
36+ -- * The Tag Replace monad transformer
37+ , TagReplaceT
38+ , tagReplace
39+ -- * Internal labels
40+ , TAG_ATTACH
41+ , TAG_REPLACE
42+ ) where
43+
44+import qualified Control.Monad.Error.Class as Mtl
45+import qualified Control.Monad.Reader.Class as Mtl
46+import qualified Control.Monad.State.Class as Mtl
47+import qualified Control.Monad.Writer.Class as Mtl
48+
49+import Ether.Except
50+import Ether.Reader
51+import Ether.State
52+import Ether.Writer
53+import Ether.TaggedTrans
54+
55+import Control.Monad.Trans.Identity
56+import Data.Coerce
57+
58+-- | Encode type-level information for 'tagAttach'.
59+data TAG_ATTACH t
60+
61+type TagAttachT t = TaggedTrans (TAG_ATTACH t) IdentityT
62+
63+-- | Attach a tag to untagged transformers.
64+tagAttach :: forall tag m a . TagAttachT tag m a -> m a
65+tagAttach = coerce (runIdentityT @_ @m @a)
66+
67+instance {-# OVERLAPPING #-}
68+ ( MonadReader tag r m, trans ~ IdentityT
69+ ) => Mtl.MonadReader r (TaggedTrans (TAG_ATTACH tag) trans m)
70+ where
71+ ask = ask @tag
72+ local = local @tag
73+ reader = reader @tag
74+
75+instance {-# OVERLAPPING #-}
76+ ( MonadState tag s m, trans ~ IdentityT
77+ ) => Mtl.MonadState s (TaggedTrans (TAG_ATTACH tag) trans m)
78+ where
79+ get = get @tag
80+ put = put @tag
81+ state = state @tag
82+
83+instance {-# OVERLAPPING #-}
84+ ( MonadExcept tag e m, trans ~ IdentityT
85+ ) => Mtl.MonadError e (TaggedTrans (TAG_ATTACH tag) trans m)
86+ where
87+ throwError = throw @tag
88+ catchError = catch @tag
89+
90+instance {-# OVERLAPPING #-}
91+ ( MonadWriter tag w m, trans ~ IdentityT
92+ ) => Mtl.MonadWriter w (TaggedTrans (TAG_ATTACH tag) trans m)
93+ where
94+ writer = writer @tag
95+ tell = tell @tag
96+ listen = listen @tag
97+ pass = pass @tag
98+
99+-- | Encode type-level information for 'tagReplace'.
100+data TAG_REPLACE tOld tNew
101+
102+type TagReplaceT tOld tNew = TaggedTrans (TAG_REPLACE tOld tNew) IdentityT
103+
104+-- | Replace a tag with another tag.
105+tagReplace :: forall tOld tNew m a . TagReplaceT tOld tNew m a -> m a
106+tagReplace = coerce (runIdentityT @_ @m @a)
107+
108+instance
109+ ( MonadReader tNew r m, trans ~ IdentityT
110+ ) => MonadReader tOld r (TaggedTrans (TAG_REPLACE tOld tNew) trans m)
111+ where
112+ ask = ask @tNew
113+ local = local @tNew
114+ reader = reader @tNew
115+
116+instance
117+ ( MonadState tNew s m, trans ~ IdentityT
118+ ) => MonadState tOld s (TaggedTrans (TAG_REPLACE tOld tNew) trans m)
119+ where
120+ get = get @tNew
121+ put = put @tNew
122+ state = state @tNew
123+
124+instance
125+ ( MonadExcept tNew e m, trans ~ IdentityT
126+ ) => MonadExcept tOld e (TaggedTrans (TAG_REPLACE tOld tNew) trans m)
127+ where
128+ throw = throw @tNew
129+ catch = catch @tNew
130+
131+instance
132+ ( MonadWriter tNew w m, trans ~ IdentityT
133+ ) => MonadWriter tOld w (TaggedTrans (TAG_REPLACE tOld tNew) trans m)
134+ where
135+ writer = writer @tNew
136+ tell = tell @tNew
137+ listen = listen @tNew
138+ pass = pass @tNew
src/Ether/TaggedTrans.hsnew file+206
@@ -0,0 +1,206 @@
1+-- The use of ImpredicativeTypes here is safe, see discussion under GitHub issue
2+-- #35. It's only needed to allow the visible type application of a polytype.
3+{-# LANGUAGE ImpredicativeTypes #-}
4+
5+module Ether.TaggedTrans
6+ ( TaggedTrans(..)
7+ ) where
8+
9+import Control.Applicative
10+import Control.Monad (MonadPlus)
11+import Control.Monad.Fix (MonadFix)
12+import Control.Monad.Trans.Class (MonadTrans, lift)
13+import Control.Monad.IO.Class (MonadIO)
14+import Control.Monad.Morph (MFunctor(..), MMonad(..))
15+import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
16+
17+import qualified Control.Monad.Base as MB
18+import qualified Control.Monad.Trans.Control as MC
19+
20+import qualified Control.Monad.Trans.Lift.StT as Lift
21+import qualified Control.Monad.Trans.Lift.Local as Lift
22+import qualified Control.Monad.Trans.Lift.Catch as Lift
23+import qualified Control.Monad.Trans.Lift.Listen as Lift
24+import qualified Control.Monad.Trans.Lift.Pass as Lift
25+import qualified Control.Monad.Trans.Lift.CallCC as Lift
26+
27+import qualified Control.Monad.Cont.Class as Mtl
28+import qualified Control.Monad.Reader.Class as Mtl
29+import qualified Control.Monad.State.Class as Mtl
30+import qualified Control.Monad.Writer.Class as Mtl
31+import qualified Control.Monad.Error.Class as Mtl
32+
33+import GHC.Generics (Generic)
34+import Data.Coerce (coerce)
35+
36+newtype TaggedTrans tag trans m a = TaggedTrans (trans m a)
37+ deriving
38+ ( Generic
39+ , Functor, Applicative, Alternative, Monad, MonadPlus
40+ , MonadFix, MonadTrans, MonadIO
41+ , MonadThrow, MonadCatch, MonadMask )
42+
43+type Pack tag trans m a = trans m a -> TaggedTrans tag trans m a
44+
45+type Unpack tag trans m a = TaggedTrans tag trans m a -> trans m a
46+
47+instance
48+ ( MB.MonadBase b (trans m)
49+ ) => MB.MonadBase b (TaggedTrans tag trans m)
50+ where
51+ liftBase =
52+ (coerce :: forall a .
53+ (b a -> trans m a) ->
54+ (b a -> TaggedTrans tag trans m a))
55+ MB.liftBase
56+
57+instance
58+ ( MC.MonadTransControl trans
59+ ) => MC.MonadTransControl (TaggedTrans tag trans)
60+ where
61+ type StT (TaggedTrans tag trans) a = MC.StT trans a
62+
63+ liftWith = MC.defaultLiftWith
64+ (coerce :: Pack tag trans m a)
65+ (coerce :: Unpack tag trans m a)
66+
67+ restoreT = MC.defaultRestoreT
68+ (coerce :: Pack tag trans m a)
69+
70+type LiftBaseWith b m a = (MC.RunInBase m b -> b a) -> m a
71+
72+newtype LiftBaseWith' b m a = LBW { unLBW :: LiftBaseWith b m a }
73+
74+coerceLiftBaseWith ::
75+ LiftBaseWith b (trans m) a ->
76+ LiftBaseWith b (TaggedTrans tag trans m) a
77+coerceLiftBaseWith lbw =
78+ unLBW (coerce (LBW lbw))
79+
80+instance
81+ ( MC.MonadBaseControl b (trans m)
82+ ) => MC.MonadBaseControl b (TaggedTrans tag trans m)
83+ where
84+ type StM (TaggedTrans tag trans m) a = MC.StM (trans m) a
85+
86+ liftBaseWith = coerceLiftBaseWith MC.liftBaseWith
87+
88+ restoreM =
89+ (coerce :: forall a .
90+ (MC.StM (trans m) a -> trans m a) ->
91+ (MC.StM (trans m) a -> TaggedTrans tag trans m a))
92+ MC.restoreM
93+
94+type instance Lift.StT (TaggedTrans tag trans) a = Lift.StT trans a
95+
96+instance Lift.LiftLocal trans => Lift.LiftLocal (TaggedTrans tag trans) where
97+ liftLocal =
98+ Lift.defaultLiftLocal
99+ (coerce :: Pack tag trans m a)
100+ (coerce :: Unpack tag trans m a)
101+
102+instance Lift.LiftCatch trans => Lift.LiftCatch (TaggedTrans tag trans) where
103+ liftCatch =
104+ Lift.defaultLiftCatch
105+ (coerce :: Pack tag trans m a)
106+ (coerce :: Unpack tag trans m a)
107+
108+instance Lift.LiftListen trans => Lift.LiftListen (TaggedTrans tag trans) where
109+ liftListen =
110+ Lift.defaultLiftListen
111+ (coerce :: Pack tag trans m a)
112+ (coerce :: Unpack tag trans m a)
113+
114+instance Lift.LiftPass trans => Lift.LiftPass (TaggedTrans tag trans) where
115+ liftPass =
116+ Lift.defaultLiftPass
117+ (coerce :: Pack tag trans m a)
118+ (coerce :: Unpack tag trans m a)
119+
120+instance Lift.LiftCallCC trans => Lift.LiftCallCC (TaggedTrans tag trans) where
121+ liftCallCC =
122+ Lift.defaultLiftCallCC
123+ (coerce :: Pack tag trans m a)
124+ (coerce :: Unpack tag trans m a)
125+ liftCallCC' =
126+ Lift.defaultLiftCallCC'
127+ (coerce :: Pack tag trans m a)
128+ (coerce :: Unpack tag trans m a)
129+
130+
131+-- Instances for mtl classes
132+
133+instance
134+ ( Mtl.MonadCont m
135+ , Lift.LiftCallCC trans
136+ , Monad (trans m)
137+ ) => Mtl.MonadCont (TaggedTrans tag trans m)
138+ where
139+ callCC = Lift.liftCallCC' Mtl.callCC
140+
141+instance
142+ ( Mtl.MonadReader r m
143+ , Lift.LiftLocal trans
144+ , Monad (trans m)
145+ ) => Mtl.MonadReader r (TaggedTrans tag trans m)
146+ where
147+ ask = lift Mtl.ask
148+ local = Lift.liftLocal Mtl.ask Mtl.local
149+ reader = lift . Mtl.reader
150+
151+instance
152+ ( Mtl.MonadState s m
153+ , MonadTrans trans
154+ , Monad (trans m)
155+ ) => Mtl.MonadState s (TaggedTrans tag trans m)
156+ where
157+ get = lift Mtl.get
158+ put = lift . Mtl.put
159+ state = lift . Mtl.state
160+
161+instance
162+ ( Mtl.MonadWriter w m
163+ , Lift.LiftListen trans
164+ , Lift.LiftPass trans
165+ , Monad (trans m)
166+ ) => Mtl.MonadWriter w (TaggedTrans tag trans m)
167+ where
168+ writer = lift . Mtl.writer
169+ tell = lift . Mtl.tell
170+ listen = Lift.liftListen Mtl.listen
171+ pass = Lift.liftPass Mtl.pass
172+
173+instance
174+ ( Mtl.MonadError e m
175+ , Lift.LiftCatch trans
176+ , Monad (trans m)
177+ ) => Mtl.MonadError e (TaggedTrans tag trans m)
178+ where
179+ throwError = lift . Mtl.throwError
180+ catchError = Lift.liftCatch Mtl.catchError
181+
182+type Hoist trans =
183+ forall m n b . Monad m =>
184+ (forall a . m a -> n a) -> trans m b -> trans n b
185+
186+-- NB: Don't use GeneralizedNewtypeDeriving to create this instance, as it will
187+-- trigger GHC Trac #11837 on GHC 8.0.1 and older.
188+instance MFunctor trans => MFunctor (TaggedTrans tag trans) where
189+ hoist =
190+ coerce
191+ @(Hoist trans)
192+ @(Hoist (TaggedTrans tag trans))
193+ hoist
194+
195+type Embed trans =
196+ forall n m b . Monad n =>
197+ (forall a . m a -> trans n a) -> trans m b -> trans n b
198+
199+-- NB: Don't use GeneralizedNewtypeDeriving to create this instance, as it will
200+-- trigger GHC Trac #11837 on GHC 8.0.1 and older.
201+instance MMonad trans => MMonad (TaggedTrans tag trans) where
202+ embed =
203+ coerce
204+ @(Embed trans)
205+ @(Embed (TaggedTrans tag trans))
206+ embed
src/Ether/Writer.hsnew file+287
@@ -0,0 +1,287 @@
1+module Ether.Writer
2+ (
3+ -- * MonadWriter class
4+ MonadWriter
5+ , writer
6+ , tell
7+ , listen
8+ , pass
9+ , listens
10+ , censor
11+ -- * The Writer monad
12+ , Writer
13+ , runWriter
14+ , execWriter
15+ -- * The WriterT monad transformer
16+ , WriterT
17+ , writerT
18+ , runWriterT
19+ , execWriterT
20+ -- * The Writer monad (lazy)
21+ , LazyWriter
22+ , runLazyWriter
23+ , execLazyWriter
24+ -- * The WriterT monad transformer (lazy)
25+ , LazyWriterT
26+ , lazyWriterT
27+ , runLazyWriterT
28+ , execLazyWriterT
29+ -- * MonadWriter class (implicit)
30+ , MonadWriter'
31+ , writer'
32+ , tell'
33+ , listen'
34+ , pass'
35+ , listens'
36+ , censor'
37+ -- * The Writer monad (implicit)
38+ , Writer'
39+ , runWriter'
40+ , execWriter'
41+ -- * The WriterT monad transformer (implicit)
42+ , WriterT'
43+ , writerT'
44+ , runWriterT'
45+ , execWriterT'
46+ -- * The Writer monad (lazy, implicit)
47+ , LazyWriter'
48+ , runLazyWriter'
49+ , execLazyWriter'
50+ -- * The WriterT monad transformer (lazy, implicit)
51+ , LazyWriterT'
52+ , lazyWriterT'
53+ , runLazyWriterT'
54+ , execLazyWriterT'
55+ -- * Internal labels
56+ , TAGGED
57+ , WRITER
58+ ) where
59+
60+import Control.Monad.Signatures (Listen, Pass)
61+import qualified Control.Monad.Trans.Lift.Listen as Lift
62+import qualified Control.Monad.Trans.Lift.Pass as Lift
63+import qualified Control.Monad.Writer.Class as T
64+import qualified Control.Monad.Writer.CPS as T.CPS
65+import qualified Control.Monad.Writer.Lazy as T.Lazy
66+import Data.Coerce
67+import Data.Functor.Identity
68+
69+import Ether.Internal
70+import Ether.TaggedTrans
71+
72+class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where
73+
74+ {-# MINIMAL (writer | tell), listen, pass #-}
75+
76+ -- | Embed a simple writer action.
77+ writer :: (a, w) -> m a
78+ writer ~(a, w) = a <$ tell @tag w
79+
80+ -- | Append a value to the accumulator within the monad.
81+ tell :: w -> m ()
82+ tell w = writer @tag ((),w)
83+
84+ -- | Execute an action and add its accumulator
85+ -- to the value of the computation.
86+ listen :: m a -> m (a, w)
87+
88+ -- | Execute an action which returns a value and a function,
89+ -- and return the value, applying the function to the accumulator.
90+ pass :: m (a, w -> w) -> m a
91+
92+instance {-# OVERLAPPABLE #-}
93+ ( Lift.LiftListen t
94+ , Lift.LiftPass t
95+ , Monad (t m)
96+ , MonadWriter tag w m
97+ , Monoid w
98+ ) => MonadWriter tag w (t m) where
99+ writer = Lift.lift . writer @tag
100+ tell = Lift.lift . tell @tag
101+ listen = Lift.liftListen (listen @tag)
102+ pass = Lift.liftPass (pass @tag)
103+
104+-- | Execute an action and add the result of applying the given function to
105+-- its accumulator to the value of the computation.
106+listens :: forall tag w m a b . MonadWriter tag w m => (w -> b) -> m a -> m (a, b)
107+listens f m = do
108+ ~(a, w) <- listen @tag m
109+ return (a, f w)
110+
111+-- | Execute an action and apply a function to its accumulator.
112+censor :: forall tag w m a . MonadWriter tag w m => (w -> w) -> m a -> m a
113+censor f m = pass @tag $ do
114+ a <- m
115+ return (a, f)
116+
117+-- | Encode type-level information for 'WriterT'.
118+data WRITER
119+
120+type instance HandleSuper WRITER w trans = Monoid w
121+type instance HandleConstraint WRITER w trans m =
122+ T.MonadWriter w (trans m)
123+
124+instance Monoid w => Handle WRITER w (T.CPS.WriterT w) where
125+ handling r = r
126+
127+instance Monoid w => Handle WRITER w (T.Lazy.WriterT w) where
128+ handling r = r
129+
130+instance
131+ ( Handle WRITER w trans
132+ , Monad m, Monad (trans m)
133+ ) => MonadWriter tag w (TaggedTrans (TAGGED WRITER tag) trans m)
134+ where
135+
136+ writer =
137+ handling @WRITER @w @trans @m $
138+ coerce (T.writer @w @(trans m) @a) ::
139+ forall eff a . (a, w) -> TaggedTrans eff trans m a
140+
141+ tell =
142+ handling @WRITER @w @trans @m $
143+ coerce (T.tell @w @(trans m))
144+
145+ listen =
146+ handling @WRITER @w @trans @m $
147+ coerce (T.listen @w @(trans m) @a) ::
148+ forall eff a . Listen w (TaggedTrans eff trans m) a
149+
150+ pass =
151+ handling @WRITER @w @trans @m $
152+ coerce (T.pass @w @(trans m) @a) ::
153+ forall eff a . Pass w (TaggedTrans eff trans m) a
154+
155+-- | The parametrizable writer monad.
156+--
157+-- Computations can accumulate a monoid value.
158+--
159+-- The 'return' function produces the output 'mempty', while '>>=' combines
160+-- the outputs of the subcomputations using 'mappend'.
161+type Writer tag w = WriterT tag w Identity
162+
163+-- | The writer monad transformer.
164+--
165+-- The 'return' function produces the output 'mempty', while '>>=' combines
166+-- the outputs of the subcomputations using 'mappend'.
167+type WriterT tag w = TaggedTrans (TAGGED WRITER tag) (T.CPS.WriterT w)
168+
169+-- | Constructor for computations in the writer monad transformer.
170+writerT :: forall tag w m a . (Functor m, Monoid w) => m (a, w) -> WriterT tag w m a
171+writerT = coerce (T.CPS.writerT @m @w @a)
172+
173+-- | Runs a 'WriterT' and returns both the normal value
174+-- and the final accumulator.
175+runWriterT :: forall tag w m a . Monoid w => WriterT tag w m a -> m (a, w)
176+runWriterT = coerce (T.CPS.runWriterT @w @m @a)
177+
178+-- | Runs a 'Writer' and returns both the normal value
179+-- and the final accumulator.
180+runWriter :: forall tag w a . Monoid w => Writer tag w a -> (a, w)
181+runWriter = coerce (T.CPS.runWriter @w @a)
182+
183+-- | Runs a 'WriterT' and returns the final accumulator,
184+-- discarding the normal value.
185+execWriterT :: forall tag w m a . (Monad m, Monoid w) => WriterT tag w m a -> m w
186+execWriterT = coerce (T.CPS.execWriterT @m @w @a)
187+
188+-- | Runs a 'Writer' and returns the final accumulator,
189+-- discarding the normal value.
190+execWriter :: forall tag w a . Monoid w => Writer tag w a -> w
191+execWriter = coerce (T.CPS.execWriter @w @a)
192+
193+-- | The parametrizable writer monad.
194+--
195+-- Computations can accumulate a monoid value.
196+--
197+-- The 'return' function produces the output 'mempty', while '>>=' combines
198+-- the outputs of the subcomputations using 'mappend'.
199+type LazyWriter tag w = LazyWriterT tag w Identity
200+
201+-- | The writer monad transformer.
202+--
203+-- The 'return' function produces the output 'mempty', while '>>=' combines
204+-- the outputs of the subcomputations using 'mappend'.
205+type LazyWriterT tag w = TaggedTrans (TAGGED WRITER tag) (T.Lazy.WriterT w)
206+
207+-- | Constructor for computations in the writer monad transformer.
208+lazyWriterT :: forall tag w m a . m (a, w) -> LazyWriterT tag w m a
209+lazyWriterT = coerce (T.Lazy.WriterT @w @m @a)
210+
211+-- | Runs a 'WriterT' and returns both the normal value
212+-- and the final accumulator.
213+runLazyWriterT :: forall tag w m a . LazyWriterT tag w m a -> m (a, w)
214+runLazyWriterT = coerce (T.Lazy.runWriterT @w @m @a)
215+
216+-- | Runs a 'Writer' and returns both the normal value
217+-- and the final accumulator.
218+runLazyWriter :: forall tag w a . LazyWriter tag w a -> (a, w)
219+runLazyWriter = coerce (T.Lazy.runWriter @w @a)
220+
221+-- | Runs a 'WriterT' and returns the final accumulator,
222+-- discarding the normal value.
223+execLazyWriterT :: forall tag w m a . Monad m => LazyWriterT tag w m a -> m w
224+execLazyWriterT = coerce (T.Lazy.execWriterT @m @w @a)
225+
226+-- | Runs a 'Writer' and returns the final accumulator,
227+-- discarding the normal value.
228+execLazyWriter :: forall tag w a . LazyWriter tag w a -> w
229+execLazyWriter = coerce (T.Lazy.execWriter @w @a)
230+
231+type Writer' w = Writer w w
232+
233+runWriter' :: Monoid w => Writer' w a -> (a, w)
234+runWriter' = runWriter
235+
236+execWriter' :: Monoid w => Writer' w a -> w
237+execWriter' = execWriter
238+
239+type WriterT' w = WriterT w w
240+
241+writerT' :: (Functor m, Monoid w) => m (a, w) -> WriterT' w m a
242+writerT' = writerT
243+
244+runWriterT' :: Monoid w => WriterT' w m a -> m (a, w)
245+runWriterT' = runWriterT
246+
247+execWriterT' :: (Monad m, Monoid w) => WriterT' w m a -> m w
248+execWriterT' = execWriterT
249+
250+type LazyWriter' w = LazyWriter w w
251+
252+runLazyWriter' :: LazyWriter' w a -> (a, w)
253+runLazyWriter' = runLazyWriter
254+
255+execLazyWriter' :: LazyWriter' w a -> w
256+execLazyWriter' = execLazyWriter
257+
258+type LazyWriterT' w = LazyWriterT w w
259+
260+lazyWriterT' :: m (a, w) -> LazyWriterT' w m a
261+lazyWriterT' = lazyWriterT
262+
263+runLazyWriterT' :: LazyWriterT' w m a -> m (a, w)
264+runLazyWriterT' = runLazyWriterT
265+
266+execLazyWriterT' :: Monad m => LazyWriterT' w m a -> m w
267+execLazyWriterT' = execLazyWriterT
268+
269+type MonadWriter' w = MonadWriter w w
270+
271+writer' :: forall w m a . MonadWriter' w m => (a, w) -> m a
272+writer' = writer @w
273+
274+tell' :: forall w m . MonadWriter' w m => w -> m ()
275+tell' = tell @w
276+
277+listen' :: forall w m a . MonadWriter' w m => m a -> m (a, w)
278+listen' = listen @w
279+
280+pass' :: forall w m a . MonadWriter' w m => m (a, w -> w) -> m a
281+pass' = pass @w
282+
283+listens' :: forall w m a b . MonadWriter' w m => (w -> b) -> m a -> m (a, b)
284+listens' = listens @w
285+
286+censor' :: forall w m a . MonadWriter' w m => (w -> w) -> m a -> m a
287+censor' = censor @w
stack.yamldeleted−7
@@ -1,7 +0,0 @@
1−resolver: lts-8.5
2−
3−packages:
4−- 'ether'
5−- 'ether-flatten'
6−- 'ether-zoom'
7−- 'ether-suite'
ether-suite/test/Regression.hs → test/Regression.hsrenamed

The content is the same.

ether-suite/test/Regression/T1.hs → test/Regression/T1.hsrenamed+16−5
@@ -1,7 +1,8 @@
11module Regression.T1 (test1) where
22
3−import Control.Monad.Ether
4−import Control.Ether.Abbr
3+import Ether
4+import TupleInstances ()
5+import Data.List (group)
56
67import Test.Tasty
78import Test.Tasty.QuickCheck
@@ -10,7 +11,7 @@ data Tag1
1011data Tag2
1112
1213testEther
13− :: Ether '[Tag1 --> String, Tag2 --> String] m
14+ :: (MonadReader Tag1 String m, MonadReader Tag2 String m)
1415 => m ((String, String), (String, String))
1516testEther = do
1617 s1 <- ask @Tag1
@@ -24,6 +25,10 @@ testEther = do
2425
2526runner1 s1 s2 = flip (runReader @Tag1) s1 . flip (runReaderT @Tag2) s2
2627runner2 s1 s2 = flip (runReader @Tag2) s2 . flip (runReaderT @Tag1) s1
28+runner3 s1 s2 = flip runReaders (Tagged @Tag1 s1, Tagged @Tag2 s2)
29+
30+same :: Eq a => [a] -> Bool
31+same = (<=1) . length . group
2732
2833test1 :: TestTree
2934test1 = testGroup "T1: Reader local environment"
@@ -33,7 +38,13 @@ test1 = testGroup "T1: Reader local environment"
3338 , testProperty "runner₂ works"
3439 $ \s1 s2 -> property
3540 $ runner2 s1 s2 testEther == ((s1, s2), (s1, map succ s2))
36− , testProperty "runner₁ == runner₂"
41+ , testProperty "runner₃ works"
42+ $ \s1 s2 -> property
43+ $ runner3 s1 s2 testEther == ((s1, s2), (s1, map succ s2))
44+ , testProperty "runner₁ == runner₂ == runner₃"
3745 $ \s1 s2 -> property
38− $ runner1 s1 s2 testEther == runner2 s1 s2 testEther
46+ $ same
47+ [ runner1 s1 s2 testEther
48+ , runner2 s1 s2 testEther
49+ , runner3 s1 s2 testEther ]
3950 ]
ether-suite/test/Regression/T10.hs → test/Regression/T10.hsrenamed+11−10
@@ -2,22 +2,23 @@ module Regression.T10 (test10) where
22
33import Control.Applicative
44import Data.Functor.Identity
5−import qualified Control.Monad.Ether.Implicit as I
5+
6+import Ether
67
78import Test.Tasty
89import Test.Tasty.QuickCheck
910
10−testEther :: Integer -> I.StateT Integer Maybe [Integer]
11+testEther :: Integer -> StateT' Integer Maybe [Integer]
1112testEther m = range
1213 where
1314 range = liftA2 (:) yield (range <|> pure [])
14− yield = I.stateT $ \n -> do
15− I.guard (n <= m)
15+ yield = stateT' $ \n -> do
16+ guard (n <= m)
1617 Just (n, n + 1)
1718
18−testEther' :: Integer -> I.State Integer [Integer]
19+testEther' :: Integer -> State' Integer [Integer]
1920testEther' m =
20− I.stateT $ Identity . maybe ([], m + 1) id . I.runStateT (testEther m)
21+ stateT' $ Identity . maybe ([], m + 1) id . runStateT' (testEther m)
2122
2223next1 :: Integer -> Integer -> Maybe Integer
2324next1 m n
@@ -32,11 +33,11 @@ range1 m n
3233test10 :: TestTree
3334test10 = testGroup "T10: Alternative instance"
3435 [ testProperty "execStateT works"
35− $ \m n -> I.execStateT (testEther m) n == next1 m n
36+ $ \m n -> execStateT' (testEther m) n == next1 m n
3637 , testProperty "evalStateT works"
37− $ \m n -> I.evalStateT (testEther m) n == range1 m n
38+ $ \m n -> evalStateT' (testEther m) n == range1 m n
3839 , testProperty "execState works"
39− $ \m n -> I.execState (testEther' m) n == m + 1
40+ $ \m n -> execState' (testEther' m) n == m + 1
4041 , testProperty "evalState works"
41− $ \m n -> I.evalState (testEther' m) n == [n..m]
42+ $ \m n -> evalState' (testEther' m) n == [n..m]
4243 ]
ether-suite/test/Regression/T11.hs → test/Regression/T11.hsrenamed+4−4
@@ -1,8 +1,8 @@
11module Regression.T11 (test11) where
22
3−import Data.Bool
4−import Control.Monad.Ether
3+import Ether
54
5+import Data.Bool
66import qualified Control.Monad.State as T
77import qualified Control.Monad.Reader as T
88
@@ -28,12 +28,12 @@ model n = zipWith ($) (cycle [id, negate]) [n..]
2828
2929runner1 n
3030 = flip (T.runReader) n
31− . flip (execStateT @STag) []
31+ . flip (execLazyStateT @STag) []
3232 . flip T.evalStateT False
3333
3434runner2 n
3535 = flip T.evalState False
36− . flip (execStateT @STag) []
36+ . flip (execLazyStateT @STag) []
3737 . flip T.runReaderT n
3838
3939test11 :: TestTree
ether-suite/test/Regression/T12.hs → test/Regression/T12.hsrenamed+3−4
@@ -1,7 +1,6 @@
11module Regression.T12 (test12) where
22
3−import Control.Monad.Ether.State
4−import Control.Monad.Ether.State.Zoom
3+import Ether
54import Control.Lens
65
76import Test.Tasty
@@ -14,8 +13,8 @@ succState = modify @Foo succ
1413
1514testEther :: (Enum a, MonadState Foo (a, a) m) => m (a, a)
1615testEther = do
17− tagZoom @Foo _1 succState
18− tagZoom @Foo _2 $ modify @Foo pred
16+ Ether.zoom @Foo _1 succState
17+ Ether.zoom @Foo _2 $ modify @Foo pred
1918 get @Foo
2019
2120model :: Enum a => (a, a) -> (a, a)
ether-suite/test/Regression/T2.hs → test/Regression/T2.hsrenamed+7−9
@@ -1,20 +1,18 @@
11module Regression.T2 (test2) where
22
3−import Control.Ether.Abbr
4−import qualified Control.Monad.Ether.Implicit as I
5−import qualified Control.Ether.Implicit.Abbr as I
3+import Ether
64
75import Test.Tasty
86import Test.Tasty.QuickCheck
97
10−testEther :: Ether '[I.R Integer, I.R Bool] m => m String
11−testEther = I.local (succ :: Integer -> Integer) $ do
12− n :: Integer <- I.asks (*2)
13− b <- I.local not I.ask
8+testEther :: (MonadReader' Integer m, MonadReader' Bool m) => m String
9+testEther = local' (succ :: Integer -> Integer) $ do
10+ n :: Integer <- asks' (*2)
11+ b <- local' not ask'
1412 return (if b then "" else show n)
1513
16−runner1 (n :: Integer) = flip I.runReader n . flip I.runReaderT True
17−runner2 (n :: Integer) = flip I.runReader True . flip I.runReaderT n
14+runner1 (n :: Integer) = flip runReader' n . flip runReaderT' True
15+runner2 (n :: Integer) = flip runReader' True . flip runReaderT' n
1816
1917test2 :: TestTree
2018test2 = testGroup "T2: Implicit tags"
ether-suite/test/Regression/T3.hs → test/Regression/T3.hsrenamed+2−3
@@ -1,7 +1,6 @@
11module Regression.T3 (test3) where
22
3−import Control.Ether.Abbr
4−import Control.Monad.Ether
3+import Ether
54
65import qualified Control.Monad.Reader as T
76import qualified Control.Monad.State as T
@@ -20,7 +19,7 @@ testMTL = do
2019 return (a * b)
2120
2221testEther
23− :: Ether '[STag --> Int, STag <-> Int, RTag --> Int] m
22+ :: (MonadReader STag Int m, MonadState STag Int m, MonadReader RTag Int m)
2423 => m (Int, Int, Int)
2524testEther = local @RTag (*2) $ do
2625 a_mul_b <- tagAttach @STag testMTL
ether-suite/test/Regression/T4.hs → test/Regression/T4.hsrenamed+2−3
@@ -1,14 +1,13 @@
11module Regression.T4 (test4) where
22
3−import Control.Ether.Abbr
4−import Control.Monad.Ether
3+import Ether
54
65import Test.Tasty
76import Test.Tasty.QuickCheck
87
98data RTag
109
11−testEther :: Ether '[RTag --> Int] m => m Int
10+testEther :: MonadReader RTag Int m => m Int
1211testEther = ask @RTag
1312
1413runner r
ether-suite/test/Regression/T5.hs → test/Regression/T5.hsrenamed+8−11
@@ -1,9 +1,6 @@
11module Regression.T5 (test5) where
22
3−import Control.Ether.Abbr
4−
5−import qualified Control.Monad.Ether.Implicit as I
6−import qualified Control.Ether.Implicit.Abbr as I
3+import Ether
74
85import Test.Tasty
96import Test.Tasty.QuickCheck
@@ -16,22 +13,22 @@ incCounter = succ
1613
1714testEther
1815 :: (Num a, Ord a)
19− => Ether '[I.R a, I.S Counter] m
16+ => (MonadReader' a m, MonadState' Counter m)
2017 => m a
2118testEther = do
22− a <- I.ask
19+ a <- ask'
2320 if a <= 0
2421 then do
25− I.put (0 :: Counter)
22+ put' (0 :: Counter)
2623 return 1
2724 else do
28− I.modify incCounter -- overriden in the base case
29− b <- I.runReaderT testEther (a - 1)
30− I.modify incCounter
25+ modify' incCounter -- overriden in the base case
26+ b <- runReaderT' testEther (a - 1)
27+ modify' incCounter
3128 return (a * b)
3229
3330runner :: (Num a, Ord a) => a -> (a, Counter)
34−runner a = I.runState (I.runReaderT testEther a) (0 :: Counter)
31+runner a = runState' (runReaderT' testEther a) (0 :: Counter)
3532
3633factorial :: (Num a, Enum a) => a -> a
3734factorial a = product [1..a]
ether-suite/test/Regression/T6.hs → test/Regression/T6.hsrenamed+14−16
@@ -1,10 +1,7 @@
11module Regression.T6 (test6) where
22
3−import Control.Monad
4−import Control.Ether.Abbr
5−
6−import qualified Control.Monad.Ether.Implicit as I
7−import qualified Control.Ether.Implicit.Abbr as I
3+import Data.Function
4+import Ether
85
96import Test.Tasty
107import Test.Tasty.QuickCheck
@@ -17,32 +14,33 @@ data NegativeLog a = NegativeLog a
1714
1815testEther
1916 :: (Floating a, Ord a)
20− => Ether '[I.E DivideByZero, I.E (NegativeLog a)] m
17+ => (MonadExcept' DivideByZero m, MonadExcept' (NegativeLog a) m)
2118 => a -> a -> m a
2219testEther a b = do
23− when (b == 0) (I.throw DivideByZero)
20+ when (b == 0) (throw' DivideByZero)
2421 let d = a / b
25− when (d < 0) (I.throw (NegativeLog d))
22+ when (d < 0) (throw' (NegativeLog d))
2623 return (log d)
2724
28−-- Copied verbatim from "Data.Function" to support @base < 4.8@.
29−(&) :: a -> (a -> b) -> b
30−x & f = f x
31−
3225handleNegativeLog (NegativeLog (x :: Double)) = "nl: " ++ show x
3326handleDivideByZero DivideByZero = "dz"
3427
28+handleT' :: Functor m => (e -> a) -> ExceptT' e m a -> m a
29+handleT' h m = fmap (either h id) (runExceptT' m)
30+
3531runner1 :: Double -> Double -> String
3632runner1 a b = do
3733 (show `fmap` testEther a b)
38− & I.handleT handleNegativeLog
39− & I.handle handleDivideByZero
34+ & handleT' handleNegativeLog
35+ & handleT' handleDivideByZero
36+ & runIdentity
4037
4138runner2 :: Double -> Double -> String
4239runner2 a b = do
4340 (show `fmap` testEther a b)
44− & I.handleT handleDivideByZero
45− & I.handle handleNegativeLog
41+ & handleT' handleDivideByZero
42+ & handleT' handleNegativeLog
43+ & runIdentity
4644
4745logDiv :: Double -> Double -> String
4846logDiv a b
ether-suite/test/Regression/T7.hs → test/Regression/T7.hsrenamed+1−1
@@ -3,7 +3,7 @@ module Regression.T7 (test7) where
33import Data.Monoid
44import Control.Monad
55
6−import Control.Monad.Ether
6+import Ether
77import qualified Control.Monad.Writer as T
88
99import Test.Tasty
ether-suite/test/Regression/T8.hs → test/Regression/T8.hsrenamed+2−3
@@ -1,7 +1,6 @@
11module Regression.T8 (test8) where
22
3−import Control.Ether.Abbr
4−import Control.Monad.Ether
3+import Ether
54
65import qualified Control.Monad.State as T
76
@@ -18,7 +17,7 @@ testMTL2 :: T.MonadState Bool m => m ()
1817testMTL2 = T.modify not
1918
2019testEther
21− :: Ether '[Foo <-> Int, Bar <-> Bool] m
20+ :: (MonadState Foo Int m, MonadState Bar Bool m)
2221 => m String
2322testEther = do
2423 tagAttach @Foo testMTL1
ether-suite/test/Regression/T9.hs → test/Regression/T9.hsrenamed+4−5
@@ -1,7 +1,6 @@
11module Regression.T9 (test9) where
22
3−import Control.Ether.Abbr
4−import Control.Monad.Ether
3+import Ether
54
65import Test.Tasty
76import Test.Tasty.QuickCheck
@@ -9,16 +8,16 @@ import Test.Tasty.QuickCheck
98data Foo
109data Bar
1110
12−testEther1 :: Ether '[Foo <-> Int] m => m String
11+testEther1 :: MonadState Foo Int m => m String
1312testEther1 = do
1413 modify @Foo negate
1514 gets @Foo show
1615
17−testEther2 :: Ether '[Bar <-> Int] m => m String
16+testEther2 :: MonadState Bar Int m => m String
1817testEther2 = tagReplace @Foo @Bar testEther1
1918
2019testEther
21− :: Ether '[Foo <-> Int, Bar <-> Int] m
20+ :: (MonadState Foo Int m, MonadState Bar Int m)
2221 => m String
2322testEther = do
2423 a <- testEther1
test/TupleInstances.hsnew file+9
@@ -0,0 +1,9 @@
1+{-# OPTIONS -fno-warn-orphans #-}
2+{-# LANGUAGE CPP #-}
3+
4+module TupleInstances () where
5+
6+#ifdef DISABLE_TUP_INSTANCES
7+import Ether.Internal (makeTupleInstancesHasLens)
8+makeTupleInstancesHasLens [2]
9+#endif