git.iko.soy/typeable/ether
on master help sign in
swap
7b3583a49 ahead, 0 behind
78 files changed+2277−2384
since splitsnapshots
unifiedsplit
.gitignore+18−2 .travis.yml+25−19 ether/CHANGELOG.md → CHANGELOG.md+17−3 ether-zoom/LICENSE → LICENSE+2−2 README.md−16 ether-flatten/Setup.hs → Setup.hs bench/Bench.hs+203 bench/TupleInstances.hs+9 ether-flatten/CHANGELOG.md ether-flatten/LICENSE−30 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/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−140 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−19
@@ -1,25 +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://github.com/commercialhaskell/stack/releases/download/v1.1.2/stack-1.1.2-linux-x86_64.tar.gz | tar -xvz
10− - mv stack-1.1.2-linux-x86_64/stack ~/.local/bin
11− - export PATH=~/.local/bin:$PATH
12− - stack --version
13− - stack setup
7+env:
8+ - HC=ghc822
9+ - HC=ghc844
10+ - HC=ghc861
1411
15−install:
16− - 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
1715
1816script:
19− - stack test ether-suite:regression --no-terminal --ghc-options -Werror
20− - 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
2124
22−addons:
23− apt:
24− packages:
25− - 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-zoom/LICENSE → LICENSErenamed+2−2
@@ -1,4 +1,4 @@
1−Copyright (c) 2016, Index Int
1+Copyright (c) 2017, Vladislav Zavialov
22
33All rights reserved.
44
@@ -13,7 +13,7 @@ modification, are permitted provided that the following conditions are met:
1313 disclaimer in the documentation and/or other materials provided
1414 with the distribution.
1515
16− * Neither the name of Index Int nor the names of other
16+ * Neither the name of Vladislav Zavialov nor the names of other
1717 contributors may be used to endorse or promote products derived
1818 from this software without specific prior written permission.
1919
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/LICENSEdeleted−30
@@ -1,30 +0,0 @@
1−Copyright (c) 2016, Index Int
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 Index Int 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-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: Index Int
11−maintainer: Index Int <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/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: Index Int
11−maintainer: Index Int <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) 2015, Index Int
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 Index Int 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: Index Int
14−maintainer: Index Int <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−140
@@ -1,140 +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−type instance Lift.StT (Dispatch dp trans) a = Lift.StT trans a
73−
74−instance Lift.LiftLocal trans => Lift.LiftLocal (Dispatch dp trans) where
75− liftLocal = Lift.defaultLiftLocal pack unpack
76−
77−instance Lift.LiftCatch trans => Lift.LiftCatch (Dispatch dp trans) where
78− liftCatch = Lift.defaultLiftCatch pack unpack
79−
80−instance Lift.LiftListen trans => Lift.LiftListen (Dispatch dp trans) where
81− liftListen = Lift.defaultLiftListen pack unpack
82−
83−instance Lift.LiftPass trans => Lift.LiftPass (Dispatch dp trans) where
84− liftPass = Lift.defaultLiftPass pack unpack
85−
86−instance Lift.LiftCallCC trans => Lift.LiftCallCC (Dispatch dp trans) where
87− liftCallCC = Lift.defaultLiftCallCC pack unpack
88− liftCallCC' = Lift.defaultLiftCallCC' pack unpack
89−
90−
91−-- Instances for mtl classes
92−
93−instance {-# OVERLAPPABLE #-}
94− ( Class.MonadCont m
95− , Lift.LiftCallCC trans
96− , Monad (trans m)
97− ) => Class.MonadCont (Dispatch dp trans m)
98− where
99− callCC = Lift.liftCallCC' Class.callCC
100−
101−instance {-# OVERLAPPABLE #-}
102− ( Class.MonadReader r m
103− , Lift.LiftLocal trans
104− , Monad (trans m)
105− ) => Class.MonadReader r (Dispatch dp trans m)
106− where
107− ask = lift Class.ask
108− local = Lift.liftLocal Class.ask Class.local
109− reader = lift . Class.reader
110−
111−instance {-# OVERLAPPABLE #-}
112− ( Class.MonadState s m
113− , MonadTrans trans
114− , Monad (trans m)
115− ) => Class.MonadState s (Dispatch dp trans m)
116− where
117− get = lift Class.get
118− put = lift . Class.put
119− state = lift . Class.state
120−
121−instance {-# OVERLAPPABLE #-}
122− ( Class.MonadWriter w m
123− , Lift.LiftListen trans
124− , Lift.LiftPass trans
125− , Monad (trans m)
126− ) => Class.MonadWriter w (Dispatch dp trans m)
127− where
128− writer = lift . Class.writer
129− tell = lift . Class.tell
130− listen = Lift.liftListen Class.listen
131− pass = Lift.liftPass Class.pass
132−
133−instance {-# OVERLAPPABLE #-}
134− ( Class.MonadError e m
135− , Lift.LiftCatch trans
136− , Monad (trans m)
137− ) => Class.MonadError e (Dispatch dp trans m)
138− where
139− throwError = lift . Class.throwError
140− 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: nightly-2016-06-21
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