├── .gitignore
├── LICENSE
├── README.md
├── bower.json
├── generated-docs
    └── Control
    │   ├── Comonad
    │       └── Transformerless
    │       │   ├── Env.md
    │       │   ├── Store.md
    │       │   └── Traced.md
    │   └── Monad
    │       └── Transformerless
    │           ├── Cont.md
    │           ├── Except.md
    │           ├── RWS.md
    │           ├── Reader.md
    │           ├── State.md
    │           └── Writer.md
├── psc-package.json
├── src
    ├── Control
    │   ├── Comonad
    │   │   └── Transformerless
    │   │   │   ├── Env.purs
    │   │   │   ├── Store.purs
    │   │   │   └── Traced.purs
    │   └── Monad
    │   │   └── Transformerless
    │   │       ├── Cont.purs
    │   │       ├── Except.purs
    │   │       ├── RWS.purs
    │   │       ├── Reader.purs
    │   │       ├── State.purs
    │   │       └── Writer.purs
    └── Data
    │   └── Functor
    │       └── Pairing
    │           └── Transformerless.purs
└── test
    ├── Main.js
    └── Main.purs


/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /.psc*
6 | /src/.webpack.js
7 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | The MIT License (MIT)
 2 | 
 3 | Copyright (c) 2017 Thimoteus (https://github.com/Thimoteus)
 4 | 
 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of
 6 | this software and associated documentation files (the "Software"), to deal in
 7 | the Software without restriction, including without limitation the rights to
 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
 9 | the Software, and to permit persons to whom the Software is furnished to do so,
10 | subject to the following conditions:
11 | 
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 | 
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | # purescript-transformerless
  2 | 
  3 | ## Why?
  4 | In Haskell and Purescript, the standard `Writer`, `Reader`, `State` and `RWS`
  5 | monads are implemented in terms of their monad *transformer* versions over the
  6 | `Identity` monad. Depending on how you learned about monad transformers, you might
  7 | remember reading something like the following:
  8 | 
  9 | > The State/Reader/Writer monad is ...
 10 | >
 11 | > A monad transformer is ...
 12 | >
 13 | > The StateT/ReaderT/WriterT monad transformer is ...
 14 | >
 15 | > In fact, the State/Reader/Writer monad from section {3 lines ago} is actually
 16 | defined as StateT s Identity/ReaderT r Identity/WriterT w Identity!
 17 | 
 18 | Wow, what a plot twist!
 19 | 
 20 | However, for all the theoretical cleanliness, it's "common knowledge" among
 21 | Purescripters that transformer stacks are slow and generate some funky Javascript.
 22 | 
 23 | ## Usage
 24 | 
 25 | The same as a normal `State`, `Reader`, etc. However, you should know that
 26 | none of these types have instances for their respective transformer counterparts:
 27 | there is no instance for `..State.Class.MonadState s (..Transformerless.State s)`
 28 | or its buddies. Wouldn't it be weird for a package called "transformerless" to
 29 | depend on a package called "transformers"?
 30 | 
 31 | As a result, a "transformers" typeclass function is just a normal function in
 32 | the transformerless counterpart's module.
 33 | 
 34 | ## Scrap Your Typeclasses
 35 | 
 36 | Each module also exports normal functions corresponding to typeclass members for
 37 | each typeclass instance in the module.
 38 | 
 39 | `Control.Monad.Transformerless.Reader` exports `mapR, applyR, pureR, bindR`
 40 | as well as infix aliases `|->, ~, >>-` for `mapR, applyR, bindR` respectively.
 41 | 
 42 | `Writer` and `State` are similar, but `RWS` exports `map_, apply_, pure_, bind_`.
 43 | However, the aliases are the same in each module.
 44 | 
 45 | Using these instead of their overloaded versions avoids passing typeclass
 46 | dictionaries, and could result in a speedup.
 47 | 
 48 | ## Questions I'll Ask and Answer for You
 49 | 
 50 | ### You mentioned code generation. Is it really better for this package?
 51 | 
 52 | Examples:
 53 | 
 54 | Generating code for this transformers code:
 55 | ```purescript
 56 | loop :: Int -> RWST String (Array String) Int Identity Unit
 57 | loop n = tailRecM go n
 58 |   where
 59 |   go 0 = do
 60 |     tell [ "Done!" ]
 61 |     pure (Right unit)
 62 |   go n = do
 63 |     x <- get
 64 |     put (x + 1)
 65 |     pure (Left (n - 1))
 66 | ```
 67 | 
 68 | results in this javascript:
 69 | 
 70 | ```javascript
 71 | var loop = function (n) {
 72 |     var go = function (v) {
 73 |         if (v === 0) {
 74 |             return Control_Bind.discard(Control_Bind.discardUnit)(Control_Monad_RWS_Trans.bindRWST(Data_Identity.bindIdentity)(Data_Monoid.monoidArray))(Control_Monad_Writer_Class.tell(Control_Monad_RWS_Trans.monadTellRWST(Data_Identity.monadIdentity)(Data_Monoid.monoidArray))([ "Done!" ]))(function () {
 75 |                 return Control_Applicative.pure(Control_Monad_RWS_Trans.applicativeRWST(Data_Identity.monadIdentity)(Data_Monoid.monoidArray))(new Control_Monad_Rec_Class.Done(Data_Unit.unit));
 76 |             });
 77 |         };
 78 |         return Control_Bind.bind(Control_Monad_RWS_Trans.bindRWST(Data_Identity.bindIdentity)(Data_Monoid.monoidArray))(Control_Monad_State_Class.get(Control_Monad_RWS_Trans.monadStateRWST(Data_Identity.monadIdentity)(Data_Monoid.monoidArray)))(function (v1) {
 79 |             return Control_Bind.discard(Control_Bind.discardUnit)(Control_Monad_RWS_Trans.bindRWST(Data_Identity.bindIdentity)(Data_Monoid.monoidArray))(Control_Monad_State_Class.put(Control_Monad_RWS_Trans.monadStateRWST(Data_Identity.monadIdentity)(Data_Monoid.monoidArray))(v1 + 1 | 0))(function () {
 80 |                 return Control_Applicative.pure(Control_Monad_RWS_Trans.applicativeRWST(Data_Identity.monadIdentity)(Data_Monoid.monoidArray))(new Control_Monad_Rec_Class.Loop(v - 1 | 0));
 81 |             });
 82 |         });
 83 |     };
 84 |     return Control_Monad_Rec_Class.tailRecM(Control_Monad_RWS_Trans.monadRecRWST(Control_Monad_Rec_Class.monadRecIdentity)(Data_Monoid.monoidArray))(go)(n);
 85 | };
 86 | ```
 87 | 
 88 | vs this transformerless code:
 89 | ```purescript
 90 | loop :: Int -> RWS.RWS String (Array String) Int Unit
 91 | loop n = RWS.tailRec_ go n where
 92 |   go 0 = do
 93 |     _ <- RWS.tell ["Done!"]
 94 |     RWS.pure_ (Done unit)
 95 |       where
 96 |         bind = RWS.bind_
 97 |   go m = do
 98 |     x <- RWS.get
 99 |     _ <- RWS.put (x + 1)
100 |     RWS.pure_ (Loop (m - 1))
101 |       where
102 |         bind = RWS.bind_
103 | ```
104 | 
105 | with this javascript:
106 | ```javascript
107 | var loop = function (n) {
108 |     var go = function (v) {
109 |         if (v === 0) {
110 |             return Control_Monad_Transformerless_RWS.bind_(Data_Semigroup.semigroupArray)(Control_Monad_Transformerless_RWS.tell([ "Done!" ]))(function (v1) {
111 |                 return Control_Monad_Transformerless_RWS.pure_(Data_Monoid.monoidArray)(new Control_Monad_Rec_Class.Done(Data_Unit.unit));
112 |             });
113 |         };
114 |         return Control_Monad_Transformerless_RWS.bind_(Data_Semigroup.semigroupArray)(Control_Monad_Transformerless_RWS.get(Data_Monoid.monoidArray))(function (v1) {
115 |             return Control_Monad_Transformerless_RWS.bind_(Data_Semigroup.semigroupArray)(Control_Monad_Transformerless_RWS.put(Data_Monoid.monoidArray)(v1 + 1 | 0))(function (v2) {
116 |                 return Control_Monad_Transformerless_RWS.pure_(Data_Monoid.monoidArray)(new Control_Monad_Rec_Class.Loop(v - 1 | 0));
117 |             });
118 |         });
119 |     };
120 |     return Control_Monad_Transformerless_RWS.tailRec_(Data_Monoid.monoidArray)(go)(n);
121 | };
122 | ```
123 | 
124 | ### What about speed?
125 | 
126 | On my computer, testing the above `loop` functions 10,000,000 times. The transformerless version is on the right, and
127 | timing the `loop` function is labeled "RWS". The transformer version is labeled "RWST":
128 | 
129 | ![test](http://i.imgur.com/Fww56is.png)
130 | 
131 | And if you can't read my font, it says `RWST: 38929.0` and `RWS: 15048.0`.
132 | 
133 | ## Installing
134 | `bower i purescript-transformerless`
135 | 


--------------------------------------------------------------------------------
/bower.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "name": "purescript-transformerless",
 3 |   "license": "MIT",
 4 |   "repository": {
 5 |     "type": "git",
 6 |     "url": "git://github.com/thimoteus/purescript-transformerless.git"
 7 |   },
 8 |   "ignore": [
 9 |     "**/.*",
10 |     "node_modules",
11 |     "bower_components",
12 |     "output"
13 |   ],
14 |   "dependencies": {
15 |     "purescript-tailrec": "^4.0.0",
16 |     "purescript-tuples": "^5.0.0"
17 |   },
18 |   "devDependencies": {
19 |     "purescript-console": "^4.1.0",
20 |     "purescript-psci-support": "^4.0.0"
21 |   }
22 | }
23 | 


--------------------------------------------------------------------------------
/generated-docs/Control/Comonad/Transformerless/Env.md:
--------------------------------------------------------------------------------
 1 | ## Module Control.Comonad.Transformerless.Env
 2 | 
 3 | #### `Env`
 4 | 
 5 | ``` purescript
 6 | newtype Env e a
 7 |   = Env (Tuple e a)
 8 | ```
 9 | 
10 | ##### Instances
11 | ``` purescript
12 | Newtype (Env e a) _
13 | Functor (Env e)
14 | Extend (Env e)
15 | Comonad (Env e)
16 | ```
17 | 
18 | #### `runEnv`
19 | 
20 | ``` purescript
21 | runEnv :: forall e a. Env e a -> Tuple e a
22 | ```
23 | 
24 | #### `withEnv`
25 | 
26 | ``` purescript
27 | withEnv :: forall e1 e2 a. (e1 -> e2) -> Env e1 a -> Env e2 a
28 | ```
29 | 
30 | #### `mapEnv`
31 | 
32 | ``` purescript
33 | mapEnv :: forall a b e. (a -> b) -> Env e a -> Env e b
34 | ```
35 | 
36 | #### `env`
37 | 
38 | ``` purescript
39 | env :: forall a e. e -> a -> Env e a
40 | ```
41 | 
42 | #### `ask`
43 | 
44 | ``` purescript
45 | ask :: forall a e. Env e a -> e
46 | ```
47 | 
48 | #### `asks`
49 | 
50 | ``` purescript
51 | asks :: forall a e1 e2. (e1 -> e2) -> Env e1 a -> e2
52 | ```
53 | 
54 | #### `local`
55 | 
56 | ``` purescript
57 | local :: forall e a. (e -> e) -> Env e a -> Env e a
58 | ```
59 | 
60 | 
61 | 


--------------------------------------------------------------------------------
/generated-docs/Control/Comonad/Transformerless/Store.md:
--------------------------------------------------------------------------------
 1 | ## Module Control.Comonad.Transformerless.Store
 2 | 
 3 | #### `Store`
 4 | 
 5 | ``` purescript
 6 | newtype Store s a
 7 |   = Store (Tuple (s -> a) s)
 8 | ```
 9 | 
10 | ##### Instances
11 | ``` purescript
12 | Newtype (Store s a) _
13 | Functor (Store s)
14 | Extend (Store s)
15 | Comonad (Store s)
16 | ```
17 | 
18 | #### `runStore`
19 | 
20 | ``` purescript
21 | runStore :: forall s a. Store s a -> Tuple (s -> a) s
22 | ```
23 | 
24 | #### `store`
25 | 
26 | ``` purescript
27 | store :: forall s a. Tuple (s -> a) s -> Store s a
28 | ```
29 | 
30 | #### `peek`
31 | 
32 | ``` purescript
33 | peek :: forall s a. s -> Store s a -> a
34 | ```
35 | 
36 | 1. Law: peek (pos x) x = extract x
37 | 2. Proof:
38 | 3. RHS := extract (f, s) = f s
39 | 4. LHS := peek (pos (f, s)) (f, s) =
40 | 5. peek s (f, s) =
41 | 6. peek s (f, _) = f s
42 | 
43 | #### `pos`
44 | 
45 | ``` purescript
46 | pos :: forall s a. Store s a -> s
47 | ```
48 | 
49 | 1. Law: pos (extend _ x) = pos x
50 | 2. Proof:
51 | 3. RHS := pos (_, s)
52 | 4. LHS := pos (extend _ (f, s)) =
53 | 5. pos (extend _ (_, s)) =
54 | 6. pos (_, s)
55 | 
56 | 
57 | 


--------------------------------------------------------------------------------
/generated-docs/Control/Comonad/Transformerless/Traced.md:
--------------------------------------------------------------------------------
 1 | ## Module Control.Comonad.Transformerless.Traced
 2 | 
 3 | #### `Traced`
 4 | 
 5 | ``` purescript
 6 | newtype Traced m a
 7 |   = Traced (m -> a)
 8 | ```
 9 | 
10 | ##### Instances
11 | ``` purescript
12 | Newtype (Traced w a) _
13 | Functor (Traced m)
14 | (Semigroup m) => Extend (Traced m)
15 | (Monoid m) => Comonad (Traced m)
16 | ```
17 | 
18 | #### `runTraced`
19 | 
20 | ``` purescript
21 | runTraced :: forall m a. Traced m a -> m -> a
22 | ```
23 | 
24 | #### `traced`
25 | 
26 | ``` purescript
27 | traced :: forall m a. (m -> a) -> Traced m a
28 | ```
29 | 
30 | #### `track`
31 | 
32 | ``` purescript
33 | track :: forall a m. Monoid m => m -> Traced m a -> a
34 | ```
35 | 
36 | 1. Law: track mempty = extract
37 | 2. Proof:
38 | 3. First, rewrite as: track mempty f = extract f
39 | 4. RHS := f mempty
40 | 5. LHS := f mempty
41 | 6. Law: (track s =<= track t) x = track (s <> t) x
42 | 7. Proof:
43 | 8. RHS := track (s <> t) x = x (s <> t)
44 | 9. LHS := composeCoKliesliFlipped (track s) (track t) x =
45 | 10. track s (track t <<= x) =
46 | 11. track s (extend (track t) x) =
47 | 12. track s (\ t' -> (track t) \ t'' -> x (t' <> t'')) =
48 | 13. track s (\ t' -> x (t' <> t)) =
49 | 14. x (s <> t)
50 | 
51 | #### `tracks`
52 | 
53 | ``` purescript
54 | tracks :: forall a m. Monoid m => (a -> m) -> Traced m a -> a
55 | ```
56 | 
57 | #### `listen`
58 | 
59 | ``` purescript
60 | listen :: forall a m. Traced m a -> Traced m (Tuple a m)
61 | ```
62 | 
63 | #### `listens`
64 | 
65 | ``` purescript
66 | listens :: forall a b m. (m -> b) -> Traced m a -> Traced m (Tuple a b)
67 | ```
68 | 
69 | #### `censor`
70 | 
71 | ``` purescript
72 | censor :: forall a m. (m -> m) -> Traced m a -> Traced m a
73 | ```
74 | 
75 | 
76 | 


--------------------------------------------------------------------------------
/generated-docs/Control/Monad/Transformerless/Cont.md:
--------------------------------------------------------------------------------
 1 | ## Module Control.Monad.Transformerless.Cont
 2 | 
 3 | #### `Cont`
 4 | 
 5 | ``` purescript
 6 | newtype Cont r a
 7 |   = Cont ((a -> r) -> r)
 8 | ```
 9 | 
10 | ##### Instances
11 | ``` purescript
12 | Newtype (Cont r a) _
13 | Functor (Cont r)
14 | Apply (Cont r)
15 | Applicative (Cont r)
16 | Bind (Cont r)
17 | Monad (Cont r)
18 | ```
19 | 
20 | #### `runCont`
21 | 
22 | ``` purescript
23 | runCont :: forall r a. Cont r a -> ((a -> r) -> r)
24 | ```
25 | 
26 | #### `cont`
27 | 
28 | ``` purescript
29 | cont :: forall a r. ((a -> r) -> r) -> Cont r a
30 | ```
31 | 
32 | #### `callCC`
33 | 
34 | ``` purescript
35 | callCC :: forall a r. ((forall b. a -> Cont r b) -> Cont r a) -> Cont r a
36 | ```
37 | 
38 | #### `mapCont`
39 | 
40 | ``` purescript
41 | mapCont :: forall r a. (r -> r) -> Cont r a -> Cont r a
42 | ```
43 | 
44 | #### `withCont`
45 | 
46 | ``` purescript
47 | withCont :: forall a b r. ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b
48 | ```
49 | 
50 | 
51 | 


--------------------------------------------------------------------------------
/generated-docs/Control/Monad/Transformerless/Except.md:
--------------------------------------------------------------------------------
 1 | ## Module Control.Monad.Transformerless.Except
 2 | 
 3 | #### `Except`
 4 | 
 5 | ``` purescript
 6 | newtype Except e a
 7 |   = Except (Either e a)
 8 | ```
 9 | 
10 | ##### Instances
11 | ``` purescript
12 | Newtype (Except e a) _
13 | Invariant (Except e)
14 | Bifunctor Except
15 | Functor (Except e)
16 | Apply (Except e)
17 | Applicative (Except e)
18 | Bind (Except e)
19 | Monad (Except e)
20 | Extend (Except e)
21 | (Eq e, Eq a) => Eq (Except e a)
22 | (Eq e) => Eq1 (Except e)
23 | (Ord e, Ord a) => Ord (Except e a)
24 | (Ord e) => Ord1 (Except e)
25 | (Bounded e, Bounded a) => Bounded (Except e a)
26 | Foldable (Except e)
27 | Bifoldable Except
28 | Traversable (Except e)
29 | Bitraversable Except
30 | (Semigroup a) => Semigroup (Except e a)
31 | (Monoid e) => Alternative (Except e)
32 | (Monoid e) => MonadZero (Except e)
33 | (Monoid e) => MonadPlus (Except e)
34 | (Show e, Show a) => Show (Except e a)
35 | (Semigroup e) => Alt (Except e)
36 | (Monoid e) => Plus (Except e)
37 | ```
38 | 
39 | #### `runExcept`
40 | 
41 | ``` purescript
42 | runExcept :: forall e. (Except e) ~> (Either e)
43 | ```
44 | 
45 | #### `withExcept`
46 | 
47 | ``` purescript
48 | withExcept :: forall e1 e2. (e1 -> e2) -> (Except e1) ~> (Except e2)
49 | ```
50 | 
51 | #### `mapExcept`
52 | 
53 | ``` purescript
54 | mapExcept :: forall e1 e2 a1 a2. (Either e1 a1 -> Either e2 a2) -> Except e1 a1 -> Except e2 a2
55 | ```
56 | 
57 | #### `throwError`
58 | 
59 | ``` purescript
60 | throwError :: forall e a. e -> Except e a
61 | ```
62 | 
63 | #### `catchError`
64 | 
65 | ``` purescript
66 | catchError :: forall e a. Except e a -> (e -> Except e a) -> Except e a
67 | ```
68 | 
69 | #### `except`
70 | 
71 | ``` purescript
72 | except :: forall e a. Either e a -> Except e a
73 | ```
74 | 
75 | 
76 | 


--------------------------------------------------------------------------------
/generated-docs/Control/Monad/Transformerless/RWS.md:
--------------------------------------------------------------------------------
  1 | ## Module Control.Monad.Transformerless.RWS
  2 | 
  3 | #### `RWS`
  4 | 
  5 | ``` purescript
  6 | newtype RWS r w s a
  7 |   = RWS (r -> s -> RWSResult s a w)
  8 | ```
  9 | 
 10 | ##### Instances
 11 | ``` purescript
 12 | Newtype (RWS r w s a) _
 13 | Functor (RWS r w s)
 14 | (Semigroup w) => Apply (RWS r w s)
 15 | (Monoid w) => Applicative (RWS r w s)
 16 | (Semigroup w) => Bind (RWS r w s)
 17 | (Monoid w) => Monad (RWS r w s)
 18 | (Monoid w) => MonadRec (RWS r w s)
 19 | ```
 20 | 
 21 | #### `RWSResult`
 22 | 
 23 | ``` purescript
 24 | data RWSResult s a w
 25 |   = RWSResult s a w
 26 | ```
 27 | 
 28 | #### `runRWS`
 29 | 
 30 | ``` purescript
 31 | runRWS :: forall r w s a. RWS r w s a -> r -> s -> RWSResult s a w
 32 | ```
 33 | 
 34 | #### `evalRWS`
 35 | 
 36 | ``` purescript
 37 | evalRWS :: forall r w s a. RWS r w s a -> r -> s -> Tuple a w
 38 | ```
 39 | 
 40 | #### `execRWS`
 41 | 
 42 | ``` purescript
 43 | execRWS :: forall r w s a. RWS r w s a -> r -> s -> Tuple s w
 44 | ```
 45 | 
 46 | #### `mapRWS`
 47 | 
 48 | ``` purescript
 49 | mapRWS :: forall r w1 w2 s a1 a2. (RWSResult s a1 w1 -> RWSResult s a2 w2) -> RWS r w1 s a1 -> RWS r w2 s a2
 50 | ```
 51 | 
 52 | #### `withRWS`
 53 | 
 54 | ``` purescript
 55 | withRWS :: forall r1 r2 w s a. (r2 -> s -> Tuple r1 s) -> RWS r1 w s a -> RWS r2 w s a
 56 | ```
 57 | 
 58 | #### `map_`
 59 | 
 60 | ``` purescript
 61 | map_ :: forall r w s a b. (a -> b) -> RWS r w s a -> RWS r w s b
 62 | ```
 63 | 
 64 | #### `(|->)`
 65 | 
 66 | ``` purescript
 67 | infixl 4 map_ as |->
 68 | ```
 69 | 
 70 | #### `apply_`
 71 | 
 72 | ``` purescript
 73 | apply_ :: forall r w s a b. Semigroup w => RWS r w s (a -> b) -> RWS r w s a -> RWS r w s b
 74 | ```
 75 | 
 76 | #### `(~)`
 77 | 
 78 | ``` purescript
 79 | infixl 4 apply_ as ~
 80 | ```
 81 | 
 82 | #### `pure_`
 83 | 
 84 | ``` purescript
 85 | pure_ :: forall r w s a. Monoid w => a -> RWS r w s a
 86 | ```
 87 | 
 88 | #### `bind_`
 89 | 
 90 | ``` purescript
 91 | bind_ :: forall r w s a b. Semigroup w => RWS r w s a -> (a -> RWS r w s b) -> RWS r w s b
 92 | ```
 93 | 
 94 | #### `(>>-)`
 95 | 
 96 | ``` purescript
 97 | infixl 1 bind_ as >>-
 98 | ```
 99 | 
100 | #### `tailRec_`
101 | 
102 | ``` purescript
103 | tailRec_ :: forall r w s a b. Monoid w => (a -> RWS r w s (Step a b)) -> a -> RWS r w s b
104 | ```
105 | 
106 | #### `reader`
107 | 
108 | ``` purescript
109 | reader :: forall r w s a. Monoid w => (r -> a) -> RWS r w s a
110 | ```
111 | 
112 | Reader
113 | 
114 | #### `ask`
115 | 
116 | ``` purescript
117 | ask :: forall r w s. Monoid w => RWS r w s r
118 | ```
119 | 
120 | #### `local`
121 | 
122 | ``` purescript
123 | local :: forall r w s a. (r -> r) -> RWS r w s a -> RWS r w s a
124 | ```
125 | 
126 | #### `writer`
127 | 
128 | ``` purescript
129 | writer :: forall r w s a. Tuple a w -> RWS r w s a
130 | ```
131 | 
132 | Writer
133 | 
134 | #### `listen`
135 | 
136 | ``` purescript
137 | listen :: forall r w s a. RWS r w s a -> RWS r w s (Tuple a w)
138 | ```
139 | 
140 | #### `pass`
141 | 
142 | ``` purescript
143 | pass :: forall r w s a. RWS r w s (Tuple a (w -> w)) -> RWS r w s a
144 | ```
145 | 
146 | #### `tell`
147 | 
148 | ``` purescript
149 | tell :: forall r w s. w -> RWS r w s Unit
150 | ```
151 | 
152 | #### `listens`
153 | 
154 | ``` purescript
155 | listens :: forall r w s a b. (w -> b) -> RWS r w s a -> RWS r w s (Tuple a b)
156 | ```
157 | 
158 | #### `censor`
159 | 
160 | ``` purescript
161 | censor :: forall r w s a. Monoid w => (w -> w) -> RWS r w s a -> RWS r w s a
162 | ```
163 | 
164 | #### `state`
165 | 
166 | ``` purescript
167 | state :: forall r w s a. Monoid w => (s -> Tuple a s) -> RWS r w s a
168 | ```
169 | 
170 | State
171 | 
172 | #### `get`
173 | 
174 | ``` purescript
175 | get :: forall r w s. Monoid w => RWS r w s s
176 | ```
177 | 
178 | #### `gets`
179 | 
180 | ``` purescript
181 | gets :: forall r w s a. Monoid w => (s -> a) -> RWS r w s a
182 | ```
183 | 
184 | #### `put`
185 | 
186 | ``` purescript
187 | put :: forall r w s. Monoid w => s -> RWS r w s Unit
188 | ```
189 | 
190 | #### `modify`
191 | 
192 | ``` purescript
193 | modify :: forall r w s. Monoid w => (s -> s) -> RWS r w s Unit
194 | ```
195 | 
196 | 
197 | 


--------------------------------------------------------------------------------
/generated-docs/Control/Monad/Transformerless/Reader.md:
--------------------------------------------------------------------------------
 1 | ## Module Control.Monad.Transformerless.Reader
 2 | 
 3 | #### `Reader`
 4 | 
 5 | ``` purescript
 6 | type Reader r = Function r
 7 | ```
 8 | 
 9 | #### `runReader`
10 | 
11 | ``` purescript
12 | runReader :: forall r a. Reader r a -> r -> a
13 | ```
14 | 
15 | #### `withReader`
16 | 
17 | ``` purescript
18 | withReader :: forall r1 r2 a. (r2 -> r1) -> Reader r1 a -> Reader r2 a
19 | ```
20 | 
21 | #### `mapReader`
22 | 
23 | ``` purescript
24 | mapReader :: forall r a b. (a -> b) -> Reader r a -> Reader r b
25 | ```
26 | 
27 | #### `(|->)`
28 | 
29 | ``` purescript
30 | infixl 4 mapReader as |->
31 | ```
32 | 
33 | #### `applyR`
34 | 
35 | ``` purescript
36 | applyR :: forall r a b. Reader r (a -> b) -> Reader r a -> Reader r b
37 | ```
38 | 
39 | #### `(~)`
40 | 
41 | ``` purescript
42 | infixl 4 applyR as ~
43 | ```
44 | 
45 | #### `pureR`
46 | 
47 | ``` purescript
48 | pureR :: forall r a. a -> Reader r a
49 | ```
50 | 
51 | #### `bindR`
52 | 
53 | ``` purescript
54 | bindR :: forall r a b. Reader r a -> (a -> Reader r b) -> Reader r b
55 | ```
56 | 
57 | #### `(>>-)`
58 | 
59 | ``` purescript
60 | infixl 1 bindR as >>-
61 | ```
62 | 
63 | #### `local`
64 | 
65 | ``` purescript
66 | local :: forall r a. (r -> r) -> Reader r a -> Reader r a
67 | ```
68 | 
69 | #### `ask`
70 | 
71 | ``` purescript
72 | ask :: forall r. Reader r r
73 | ```
74 | 
75 | 
76 | 


--------------------------------------------------------------------------------
/generated-docs/Control/Monad/Transformerless/State.md:
--------------------------------------------------------------------------------
  1 | ## Module Control.Monad.Transformerless.State
  2 | 
  3 | #### `State`
  4 | 
  5 | ``` purescript
  6 | newtype State s a
  7 |   = State (s -> Tuple a s)
  8 | ```
  9 | 
 10 | ##### Instances
 11 | ``` purescript
 12 | Newtype (State s a) _
 13 | Semigroupoid State
 14 | Functor (State s)
 15 | Apply (State s)
 16 | Applicative (State s)
 17 | Alt (State s)
 18 | Bind (State s)
 19 | Monad (State s)
 20 | Lazy (State s a)
 21 | MonadRec (State s)
 22 | ```
 23 | 
 24 | #### `runState`
 25 | 
 26 | ``` purescript
 27 | runState :: forall s a. State s a -> s -> Tuple a s
 28 | ```
 29 | 
 30 | #### `evalState`
 31 | 
 32 | ``` purescript
 33 | evalState :: forall s a. State s a -> s -> a
 34 | ```
 35 | 
 36 | #### `execState`
 37 | 
 38 | ``` purescript
 39 | execState :: forall s a. State s a -> s -> s
 40 | ```
 41 | 
 42 | #### `mapState`
 43 | 
 44 | ``` purescript
 45 | mapState :: forall s a b. (Tuple a s -> Tuple b s) -> State s a -> State s b
 46 | ```
 47 | 
 48 | #### `mapS`
 49 | 
 50 | ``` purescript
 51 | mapS :: forall s a b. (a -> b) -> State s a -> State s b
 52 | ```
 53 | 
 54 | #### `(|->)`
 55 | 
 56 | ``` purescript
 57 | infixl 4 mapS as |->
 58 | ```
 59 | 
 60 | #### `applyS`
 61 | 
 62 | ``` purescript
 63 | applyS :: forall s a b. State s (a -> b) -> State s a -> State s b
 64 | ```
 65 | 
 66 | #### `(~)`
 67 | 
 68 | ``` purescript
 69 | infixl 4 applyS as ~
 70 | ```
 71 | 
 72 | #### `pureS`
 73 | 
 74 | ``` purescript
 75 | pureS :: forall s a. a -> State s a
 76 | ```
 77 | 
 78 | #### `bindS`
 79 | 
 80 | ``` purescript
 81 | bindS :: forall s a b. State s a -> (a -> State s b) -> State s b
 82 | ```
 83 | 
 84 | #### `(>>-)`
 85 | 
 86 | ``` purescript
 87 | infixl 1 bindS as >>-
 88 | ```
 89 | 
 90 | #### `deferS`
 91 | 
 92 | ``` purescript
 93 | deferS :: forall s a. (Unit -> State s a) -> State s a
 94 | ```
 95 | 
 96 | #### `tailRecS`
 97 | 
 98 | ``` purescript
 99 | tailRecS :: forall s a b. (a -> State s (Step a b)) -> a -> State s b
100 | ```
101 | 
102 | #### `get`
103 | 
104 | ``` purescript
105 | get :: forall s. State s s
106 | ```
107 | 
108 | #### `gets`
109 | 
110 | ``` purescript
111 | gets :: forall s a. (s -> a) -> State s a
112 | ```
113 | 
114 | #### `put`
115 | 
116 | ``` purescript
117 | put :: forall s. s -> State s Unit
118 | ```
119 | 
120 | #### `modify`
121 | 
122 | ``` purescript
123 | modify :: forall s. (s -> s) -> State s Unit
124 | ```
125 | 
126 | 
127 | 


--------------------------------------------------------------------------------
/generated-docs/Control/Monad/Transformerless/Writer.md:
--------------------------------------------------------------------------------
  1 | ## Module Control.Monad.Transformerless.Writer
  2 | 
  3 | #### `Writer`
  4 | 
  5 | ``` purescript
  6 | newtype Writer w a
  7 |   = Writer (Tuple a w)
  8 | ```
  9 | 
 10 | ##### Instances
 11 | ``` purescript
 12 | Newtype (Writer w a) _
 13 | Functor (Writer w)
 14 | (Semigroup w) => Apply (Writer w)
 15 | (Monoid w) => Applicative (Writer w)
 16 | (Semigroup w) => Bind (Writer w)
 17 | (Monoid w) => Monad (Writer w)
 18 | ```
 19 | 
 20 | #### `runWriter`
 21 | 
 22 | ``` purescript
 23 | runWriter :: forall w a. Writer w a -> Tuple a w
 24 | ```
 25 | 
 26 | #### `execWriter`
 27 | 
 28 | ``` purescript
 29 | execWriter :: forall w a. Writer w a -> w
 30 | ```
 31 | 
 32 | #### `mapWriter`
 33 | 
 34 | ``` purescript
 35 | mapWriter :: forall w1 w2 a b. (Tuple a w1 -> Tuple b w2) -> Writer w1 a -> Writer w2 b
 36 | ```
 37 | 
 38 | #### `mapW`
 39 | 
 40 | ``` purescript
 41 | mapW :: forall w a b. (a -> b) -> Writer w a -> Writer w b
 42 | ```
 43 | 
 44 | #### `(|->)`
 45 | 
 46 | ``` purescript
 47 | infixl 4 mapW as |->
 48 | ```
 49 | 
 50 | #### `applyW`
 51 | 
 52 | ``` purescript
 53 | applyW :: forall w a b. Semigroup w => Writer w (a -> b) -> Writer w a -> Writer w b
 54 | ```
 55 | 
 56 | #### `(~)`
 57 | 
 58 | ``` purescript
 59 | infixl 4 applyW as ~
 60 | ```
 61 | 
 62 | #### `pureW`
 63 | 
 64 | ``` purescript
 65 | pureW :: forall w a. Monoid w => a -> Writer w a
 66 | ```
 67 | 
 68 | #### `bindW`
 69 | 
 70 | ``` purescript
 71 | bindW :: forall w a b. Semigroup w => Writer w a -> (a -> Writer w b) -> Writer w b
 72 | ```
 73 | 
 74 | #### `(>>-)`
 75 | 
 76 | ``` purescript
 77 | infixl 1 bindW as >>-
 78 | ```
 79 | 
 80 | #### `pass`
 81 | 
 82 | ``` purescript
 83 | pass :: forall w a. Writer w (Tuple a (w -> w)) -> Writer w a
 84 | ```
 85 | 
 86 | #### `listen`
 87 | 
 88 | ``` purescript
 89 | listen :: forall w a. Writer w a -> Writer w (Tuple a w)
 90 | ```
 91 | 
 92 | #### `tell`
 93 | 
 94 | ``` purescript
 95 | tell :: forall w. w -> Writer w Unit
 96 | ```
 97 | 
 98 | #### `listens`
 99 | 
100 | ``` purescript
101 | listens :: forall w a b. Monoid w => (w -> b) -> Writer w a -> Writer w (Tuple a b)
102 | ```
103 | 
104 | #### `censor`
105 | 
106 | ``` purescript
107 | censor :: forall w a. Monoid w => (w -> w) -> Writer w a -> Writer w a
108 | ```
109 | 
110 | 
111 | 


--------------------------------------------------------------------------------
/psc-package.json:
--------------------------------------------------------------------------------
 1 | {
 2 |     "name": "purescript-transformerless",
 3 |     "set": "psc-0.11.7",
 4 |     "source": "https://github.com/purescript/package-sets.git",
 5 |     "depends": [
 6 |         "tuples",
 7 |         "tailrec"
 8 |     ]
 9 | }
10 | 


--------------------------------------------------------------------------------
/src/Control/Comonad/Transformerless/Env.purs:
--------------------------------------------------------------------------------
 1 | module Control.Comonad.Transformerless.Env
 2 |   ( Env(..)
 3 |   , runEnv
 4 |   , withEnv
 5 |   , mapEnv
 6 |   , env
 7 |   , ask
 8 |   , asks
 9 |   , local
10 |   ) where
11 | 
12 | import Prelude
13 | 
14 | import Control.Comonad (class Comonad, class Extend)
15 | import Data.Newtype (class Newtype)
16 | import Data.Tuple (Tuple(..))
17 | 
18 | newtype Env e a = Env (Tuple e a)
19 | 
20 | derive instance newtypeEnv :: Newtype (Env e a) _
21 | 
22 | runEnv :: forall e a. Env e a -> Tuple e a
23 | runEnv (Env t) = t
24 | 
25 | withEnv :: forall e1 e2 a. (e1 -> e2) -> Env e1 a -> Env e2 a
26 | withEnv f (Env (Tuple e a)) = Env (Tuple (f e) a)
27 | 
28 | mapEnv :: forall a b e. (a -> b) -> Env e a -> Env e b
29 | mapEnv f (Env (Tuple e a)) = Env (Tuple e (f a))
30 | 
31 | env :: forall a e. e -> a -> Env e a
32 | env e a = Env (Tuple e a)
33 | 
34 | ask :: forall a e. Env e a -> e
35 | ask (Env (Tuple e _)) = e
36 | 
37 | asks :: forall a e1 e2. (e1 -> e2) -> Env e1 a -> e2
38 | asks f (Env (Tuple e a)) = f e
39 | 
40 | local :: forall e a. (e -> e) -> Env e a -> Env e a
41 | local f (Env (Tuple e a)) = Env (Tuple (f e) a)
42 | 
43 | instance functorEnv :: Functor (Env e) where
44 |   map :: forall a b. (a -> b) -> Env e a -> Env e b
45 |   map f (Env (Tuple e a)) = Env (Tuple e (f a))
46 | 
47 | -- | 1. Law: extend f <<< extend g = extend (f <<< extend g)
48 | -- | 2. Proof:
49 | -- | 3. First, rewrite in pointful form:
50 | -- | 4. (extend f <<< extend g) x = extend (f <<< extend g) x
51 | -- | 5. RHS := extend (f <<< extend g) x =
52 | -- | 6. extend (\ y -> f (extend g y)) x =
53 | -- | 7. extend (\ (y1, y2) -> f (extend g (y1, y2))) (x1, x2) =
54 | -- | 8. extend (\ (y1, y2) -> f (y1, g (y1, y2))) (x1, x2) =
55 | -- | 9. (x1, (\ (y1, y2) -> f (y1, g (y1, y2))) (x1, x2)) =
56 | -- | 10. (x1, f (x1, g (x1, x2)))
57 | -- | 11. LHS := (\ y -> extend f (extend g y)) x =
58 | -- | 12. (\ (y1, y2) -> extend f (extend g (y1, y2))) (x1, x2) =
59 | -- | 13. (\ (y1, y2) -> extend f (y1, g (y1, y2))) (x1, x2) =
60 | -- | 14. (\ (y1, y2) -> (y1, f (y1, g (y1, y2)))) (x1, x2) =
61 | -- | 15. (x1, f (x1, g (x1, x2)))
62 | instance extendEnv :: Extend (Env e) where
63 |   extend :: forall b a. (Env e a -> b) -> Env e a -> Env e b
64 |   extend k en@(Env (Tuple e _)) = Env (Tuple e (k en))
65 | 
66 | -- | 1. Law: extract <<= xs = xs
67 | -- | 2. Proof:
68 | -- | 3. LHS := extend extract xs =
69 | -- | 4. extend extract (x1, x2) =
70 | -- | 5. (x1, extract (x1, x2)) =
71 | -- | 6. (x1, x2)
72 | -- | 7. RHS := (x1, x2)
73 | -- | 8. Law: extract (f <<= xs) = f xs
74 | -- | 9. Proof:
75 | -- | 10. LHS := extract (extend f xs) =
76 | -- | 11. extract (extend f (x1, x2)) =
77 | -- | 12. extract (x1, f (x1, x2)) =
78 | -- | 13. f (x1, x2)
79 | -- | 14. RHS := f (x1, x2)
80 | instance comonadEnv :: Comonad (Env e) where
81 |   extract :: forall a. Env e a -> a
82 |   extract (Env (Tuple _ a)) = a
83 | 


--------------------------------------------------------------------------------
/src/Control/Comonad/Transformerless/Store.purs:
--------------------------------------------------------------------------------
 1 | module Control.Comonad.Transformerless.Store
 2 |   ( Store(..)
 3 |   , runStore
 4 |   , store
 5 |   , peek
 6 |   , pos
 7 |   ) where
 8 | 
 9 | import Prelude
10 | 
11 | import Control.Comonad (class Comonad, class Extend)
12 | import Data.Tuple (Tuple(..))
13 | 
14 | data Store s a = Store (s -> a) s
15 | 
16 | runStore :: forall s a. Store s a -> Tuple (s -> a) s
17 | runStore (Store f s) = Tuple f s
18 | 
19 | store :: forall s a. (s -> a) -> s -> Store s a
20 | store = Store
21 | 
22 | -- | 1. Law: peek (pos x) x = extract x
23 | -- | 2. Proof:
24 | -- | 3. RHS := extract (f, s) = f s
25 | -- | 4. LHS := peek (pos (f, s)) (f, s) =
26 | -- | 5. peek s (f, s) =
27 | -- | 6. peek s (f, _) = f s
28 | peek :: forall s a. s -> Store s a -> a
29 | peek s (Store sa _) = sa s
30 | 
31 | -- | 1. Law: pos (extend _ x) = pos x
32 | -- | 2. Proof:
33 | -- | 3. RHS := pos (_, s)
34 | -- | 4. LHS := pos (extend _ (f, s)) =
35 | -- | 5. pos (extend _ (_, s)) =
36 | -- | 6. pos (_, s)
37 | pos :: forall s a. Store s a -> s
38 | pos (Store _ s) = s
39 | 
40 | -- | 1. Law: experiment f x = flip peek x <$> f (pos x)
41 | -- | 2. Proof:
42 | -- | 3. LHS := experiment f (sa, s) = sa <$> f s
43 | -- | 4. RHS := flip peek (sa, s) <$> f (pos (sa, s)) =
44 | -- | 5. flip peek (sa, s) <$> f s =
45 | -- | 6. (\ x -> peek x (sa, s)) <$> f s =
46 | -- | 7. (\ x -> sa x) <$> f s =
47 | -- | 8. sa <$> f s
48 | experiment :: forall f s a. Functor f => (s -> f s) -> Store s a -> f a
49 | experiment sfs (Store sa s) = sa <$> sfs s
50 | 
51 | -- | 1. Law: peeks f x = peek (f $ pos x) x
52 | -- | 2. Proof:
53 | -- | 3. LHS := peeks f (sa, s) = sa (f s)
54 | -- | 4. RHS := peek (f (pos (sa, s))) (sa, s) =
55 | -- | 5. peek (f s) (sa, s) =
56 | -- | 6. sa (f s)
57 | peeks :: forall s a. (s -> s) -> Store s a -> a
58 | peeks ss (Store sa s) = sa (ss s)
59 | 
60 | -- TODO: Optimize
61 | seek :: forall s a. s -> Store s a -> Store s a
62 | seek s = peek s <<< duplicate
63 | 
64 | -- TODO: Optimize
65 | seeks :: forall s a. (s -> s) -> Store s a -> Store s a
66 | seeks ss = peeks ss <<< duplicate
67 | 
68 | duplicate :: ∀ s a. Store s a -> Store s (Store s a)
69 | duplicate (Store f s) = Store (Store f) s
70 | 
71 | instance functorStore :: Functor (Store s) where
72 |   map :: forall a b. (a -> b) -> Store s a -> Store s b
73 |   map f (Store g s) = Store (f <<< g) s
74 | 
75 | instance extendStore :: Extend (Store s) where
76 |   extend :: forall a b s. (Store s a -> b) -> Store s a -> Store s b
77 |   extend f = map f <<< duplicate
78 | 
79 | instance comonadStore :: Comonad (Store s) where
80 |   extract :: forall a. Store s a -> a
81 |   extract (Store f s) = f s
82 | 


--------------------------------------------------------------------------------
/src/Control/Comonad/Transformerless/Traced.purs:
--------------------------------------------------------------------------------
 1 | module Control.Comonad.Transformerless.Traced
 2 |   ( Traced(..)
 3 |   , runTraced
 4 |   , traced
 5 |   , track
 6 |   , tracks
 7 |   , listen
 8 |   , listens
 9 |   , censor
10 |   ) where
11 | 
12 | import Prelude
13 | 
14 | import Control.Comonad (class Comonad, class Extend)
15 | import Data.Newtype (class Newtype)
16 | import Data.Tuple (Tuple(..))
17 | 
18 | newtype Traced m a = Traced (m -> a)
19 | 
20 | derive instance newtypeTraced :: Newtype (Traced w a) _
21 | 
22 | runTraced :: forall m a. Traced m a -> m -> a
23 | runTraced (Traced f) = f
24 | 
25 | traced :: forall m a. (m -> a) -> Traced m a
26 | traced = Traced
27 | 
28 | -- | 1. Law: track mempty = extract
29 | -- | 2. Proof:
30 | -- | 3. First, rewrite as: track mempty f = extract f
31 | -- | 4. RHS := f mempty
32 | -- | 5. LHS := f mempty
33 | -- | 6. Law: (track s =<= track t) x = track (s <> t) x
34 | -- | 7. Proof:
35 | -- | 8. RHS := track (s <> t) x = x (s <> t)
36 | -- | 9. LHS := composeCoKliesliFlipped (track s) (track t) x =
37 | -- | 10. track s (track t <<= x) =
38 | -- | 11. track s (extend (track t) x) =
39 | -- | 12. track s (\ t' -> (track t) \ t'' -> x (t' <> t'')) =
40 | -- | 13. track s (\ t' -> x (t' <> t)) =
41 | -- | 14. x (s <> t)
42 | track :: forall a m. Monoid m => m -> Traced m a -> a
43 | track m (Traced f) = f m
44 | 
45 | tracks :: forall a m. Monoid m => (a -> m) -> Traced m a -> a
46 | tracks f w@(Traced g) = track (f (g mempty)) w
47 | 
48 | listen :: forall a m. Traced m a -> Traced m (Tuple a m)
49 | listen (Traced ma) = Traced \ m -> Tuple (ma m) m
50 | 
51 | listens :: forall a b m. (m -> b) -> Traced m a -> Traced m (Tuple a b)
52 | listens mb (Traced ma) = Traced \ m -> Tuple (ma m) (mb m)
53 | 
54 | censor :: forall a m. (m -> m) -> Traced m a -> Traced m a
55 | censor mm (Traced ma) = Traced \ m -> ma (mm m)
56 | 
57 | instance functorTraced :: Functor (Traced m) where
58 |   map :: forall a b m. (a -> b) -> Traced m a -> Traced m b
59 |   map f (Traced g) = Traced \ x -> f (g x)
60 | 
61 | -- | 1. Law: extend f <<< extend g = extend (f <<< extend g)
62 | -- | 2. Proof:
63 | -- | 3. Rewrite pointfully:
64 | -- | 4. (extend f <<< extend g) x = extend (f <<< extend g) x
65 | -- | 5. LHS := extend f (extend g x) =
66 | -- | 6. extend f (\ t -> g \ t' -> x (t <> t')) =
67 | -- | 7. \ s -> f (\ s' -> (\ t -> g \ t' -> x (t <> t')) (s <> s')) =
68 | -- | 8. \ s -> f (\ s' -> g \ t' -> x (s <> s' <> t'))
69 | -- | 9. RHS := \ s -> (f <<< extend g) (\ s' -> x (s <> s')) =
70 | -- | 10. \ s -> (\ y -> f (extend g y)) (\ s' -> x (s <> s')) =
71 | -- | 11. \ s -> (\ y -> f (\ t -> g (\ t' -> y (t <> t')))) (\ s' -> x (s <> s')) =
72 | -- | 12. \ s -> f (\ t -> g (\ t' -> (\ s' -> x (s <> s')) (t <> t'))) =
73 | -- | 13. \ s -> f (\ t -> g (\ t' -> x (s <> t <> t'))) = (via renaming)
74 | -- | 14. \ s -> f (\ s' -> g \ t' -> x (s <> s' <> t'))
75 | instance extendTraced :: Semigroup m => Extend (Traced m) where
76 |   extend :: forall b a. (Traced m a -> b) -> Traced m a -> Traced m b
77 |   extend f (Traced g) = Traced \ t -> f (Traced \ t' -> g (t <> t'))
78 | 
79 | -- | 1. Law: extract <<= xs = xs
80 | -- | 2. Proof:
81 | -- | 3. RHS := \ x -> s
82 | -- | 4. LHS := extend extract (\ x -> s) =
83 | -- | 5. \ t -> extract (\ t' -> (\ x -> s) (t <> t')) =
84 | -- | 6. \ t -> (\ x -> s) (t <> mempty) =
85 | -- | 7. \ t -> (\ x -> s) t =
86 | -- | 8. \ x -> s
87 | instance comonadTraced :: Monoid m => Comonad (Traced m) where
88 |   extract :: forall a. Traced m a -> a
89 |   extract (Traced f) = f mempty
90 | 


--------------------------------------------------------------------------------
/src/Control/Monad/Transformerless/Cont.purs:
--------------------------------------------------------------------------------
  1 | module Control.Monad.Transformerless.Cont
  2 |   ( Cont(..)
  3 |   , runCont
  4 |   , cont
  5 |   , callCC
  6 |   , mapCont
  7 |   , withCont
  8 |   ) where
  9 | 
 10 | import Prelude
 11 | 
 12 | import Control.Alt (class Alt)
 13 | import Control.Alternative (class Alternative)
 14 | import Control.Plus (class Plus)
 15 | import Data.Maybe (Maybe(..))
 16 | import Data.Newtype (class Newtype)
 17 | import Effect (Effect)
 18 | import Effect.Ref as Ref
 19 | 
 20 | newtype Cont r a = Cont ((a -> r) -> r)
 21 | 
 22 | derive instance newtypeCont :: Newtype (Cont r a) _
 23 | 
 24 | runCont :: forall r a. Cont r a -> ((a -> r) -> r)
 25 | runCont (Cont f) = f
 26 | 
 27 | cont :: forall a r. ((a -> r) -> r) -> Cont r a
 28 | cont = Cont
 29 | 
 30 | callCC :: forall a r. ((forall b. a -> Cont r b) -> Cont r a) -> Cont r a
 31 | callCC f = Cont \ ar -> (runCont (f \ a -> Cont \_ -> ar a)) ar
 32 | 
 33 | mapCont :: forall r a. (r -> r) -> Cont r a -> Cont r a
 34 | mapCont f (Cont k) = Cont \ ar -> f (k ar)
 35 | 
 36 | withCont :: forall a b r. ((b -> r) -> (a -> r)) -> Cont r a -> Cont r b
 37 | withCont k (Cont f) = Cont \ g -> f (k g)
 38 | 
 39 | instance functorCont :: Functor (Cont r) where
 40 |   map :: forall a b r. (a -> b) -> Cont r a -> Cont r b
 41 |   map f (Cont k) = Cont \ g -> k $ \ a -> g (f a)
 42 | 
 43 | instance applyCont :: Apply (Cont r) where
 44 |   apply :: forall a b r. Cont r (a -> b) -> Cont r a -> Cont r b
 45 |   apply (Cont ff) (Cont fa) = Cont \ fb -> ff (\ f -> fa (\ a -> fb (f a)))
 46 | 
 47 | instance applicativeCont :: Applicative (Cont r) where
 48 |   pure :: forall a r. a -> Cont r a
 49 |   pure x = Cont (_ $ x)
 50 | 
 51 | instance bindCont :: Bind (Cont r) where
 52 |   bind :: forall a b r. Cont r a -> (a -> Cont r b) -> Cont r b
 53 |   bind (Cont fa) k = Cont \ fb -> fa (\ a -> runCont (k a) fb)
 54 | 
 55 | instance monadCont :: Monad (Cont r)
 56 | 
 57 | -- | Parallel Cont
 58 | 
 59 | newtype ParCont a = ParCont (Cont (Effect Unit) a)
 60 | 
 61 | derive instance newtypeParCont :: Newtype (ParCont a) _
 62 | 
 63 | derive instance functorParCont :: Functor ParCont
 64 | 
 65 | instance applyParCont :: Apply ParCont where
 66 |   apply (ParCont cab) (ParCont ca) = ParCont $ Cont \k -> do
 67 |     rab <- Ref.new Nothing
 68 |     ra <- Ref.new Nothing
 69 | 
 70 |     runCont cab \ab -> do
 71 |       ma <- Ref.read ra
 72 |       case ma of
 73 |         Just a -> k (ab a)
 74 |         _ -> Ref.write (Just ab) rab
 75 |     
 76 |     runCont ca \a -> do
 77 |       mab <- Ref.read rab
 78 |       case mab of
 79 |         Just ab -> k (ab a)
 80 |         _ -> Ref.write (Just a) ra
 81 | 
 82 | instance applicativeParCont :: Applicative ParCont where
 83 |   pure = ParCont <<< pure
 84 | 
 85 | instance altParCont :: Alt ParCont where
 86 |   alt (ParCont ca) (ParCont cb) = ParCont $ Cont \k -> do
 87 |     doneRef <- Ref.new false
 88 | 
 89 |     runCont ca \a -> do
 90 |       done <- Ref.read doneRef
 91 |       unless done do
 92 |         Ref.write true doneRef
 93 |         k a
 94 |     
 95 |     runCont cb \b -> do
 96 |       done <- Ref.read doneRef
 97 |       unless done do
 98 |         Ref.write true doneRef
 99 |         k b
100 | 
101 | instance plusParCont :: Plus ParCont where
102 |   empty = ParCont (Cont mempty)
103 | 
104 | instance alternativeParCont :: Alternative ParCont
105 | 
106 | sequential :: ParCont ~> Cont (Effect Unit)
107 | sequential (ParCont c) = c
108 | 
109 | parallel :: Cont (Effect Unit) ~> ParCont
110 | parallel = ParCont


--------------------------------------------------------------------------------
/src/Control/Monad/Transformerless/Except.purs:
--------------------------------------------------------------------------------
 1 | module Control.Monad.Transformerless.Except where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Control.Alt (class Alt)
 6 | import Control.Alternative (class Alternative)
 7 | import Control.Extend (class Extend)
 8 | import Control.MonadPlus (class MonadPlus, class MonadZero)
 9 | import Control.Plus (class Plus)
10 | import Data.Bifoldable (class Bifoldable)
11 | import Data.Bifunctor (class Bifunctor, lmap)
12 | import Data.Bitraversable (class Bitraversable)
13 | import Data.Either (Either(..), either)
14 | import Data.Eq (class Eq1)
15 | import Data.Foldable (class Foldable)
16 | import Data.Functor.Invariant (class Invariant)
17 | import Data.Newtype (class Newtype, over)
18 | import Data.Ord (class Ord1)
19 | import Data.Traversable (class Traversable)
20 | 
21 | newtype Except e a = Except (Either e a)
22 | 
23 | derive instance newtypeExcept :: Newtype (Except e a) _
24 | 
25 | derive newtype instance invariantExcept :: Invariant (Except e)
26 | derive newtype instance bifunctorExcept :: Bifunctor Except
27 | derive newtype instance functorExcept :: Functor (Except e)
28 | derive newtype instance applyExcept :: Apply (Except e)
29 | derive newtype instance applicativeExcept :: Applicative (Except e)
30 | derive newtype instance bindExcept :: Bind (Except e)
31 | derive newtype instance monadExcept :: Monad (Except e)
32 | derive newtype instance extendExcept :: Extend (Except e)
33 | derive newtype instance eqExcept :: (Eq e, Eq a) => Eq (Except e a)
34 | derive newtype instance eq1Except :: Eq e => Eq1 (Except e)
35 | derive newtype instance ordExcept :: (Ord e, Ord a) => Ord (Except e a)
36 | derive newtype instance ord1Except :: Ord e => Ord1 (Except e)
37 | derive newtype instance boundedExcept :: (Bounded e, Bounded a) => Bounded (Except e a)
38 | derive newtype instance foldableExcept :: Foldable (Except e)
39 | derive newtype instance bifoldableExcept :: Bifoldable Except
40 | derive newtype instance traversableExcept :: Traversable (Except e)
41 | derive newtype instance bitraversableExcept :: Bitraversable Except
42 | -- derive newtype instance semiringExcept :: Semiring a => Semiring (Except e a)
43 | derive newtype instance semigroupExcept :: Semigroup a => Semigroup (Except e a)
44 | 
45 | instance alternativeExcept :: Monoid e => Alternative (Except e)
46 | instance monadZeroExcept :: Monoid e => MonadZero (Except e)
47 | instance monadPlusExcept :: Monoid e => MonadPlus (Except e)
48 | 
49 | instance showExcept :: (Show e, Show a) => Show (Except e a) where
50 |   show (Except a) = "(Except " <> show a <> ")"
51 | 
52 | -- | The `Alt` instance differs from that belonging to the underlying `Either`
53 | -- | in that this version collects errors.
54 | instance altExcept :: Semigroup e => Alt (Except e) where
55 |   alt x@(Except (Right _)) _ = x
56 |   alt _ y@(Except (Right _)) = y
57 |   alt (Except (Left e1)) (Except (Left e2)) = Except (Left (e1 <> e2))
58 | 
59 | instance plusExcept :: Monoid e => Plus (Except e) where
60 |   empty = Except (Left mempty)
61 | 
62 | runExcept :: forall e. Except e ~> Either e
63 | runExcept (Except ex) = ex
64 | 
65 | withExcept :: forall e1 e2. (e1 -> e2) -> Except e1 ~> Except e2
66 | withExcept = lmap
67 | 
68 | mapExcept :: forall e1 e2 a1 a2. (Either e1 a1 -> Either e2 a2) -> Except e1 a1 -> Except e2 a2
69 | mapExcept = over Except
70 | 
71 | throwError :: forall e a. e -> Except e a
72 | throwError e = Except (Left e)
73 | 
74 | catchError :: forall e a. Except e a -> (e -> Except e a) -> Except e a
75 | catchError e f = either f pure (runExcept e)
76 | 
77 | except :: forall e a. Either e a -> Except e a
78 | except = Except


--------------------------------------------------------------------------------
/src/Control/Monad/Transformerless/RWS.purs:
--------------------------------------------------------------------------------
  1 | module Control.Monad.Transformerless.RWS
  2 |   ( RWS(..)
  3 |   , RWSResult(..)
  4 |   , runRWS
  5 |   , evalRWS
  6 |   , execRWS
  7 |   , mapRWS
  8 |   , withRWS
  9 |   , map_, (|->)
 10 |   , apply_, (~)
 11 |   , pure_
 12 |   , bind_, (>>-)
 13 |   , tailRec_
 14 |   -- Reader
 15 |   , reader
 16 |   , ask
 17 |   , local
 18 |   -- Writer
 19 |   , writer
 20 |   , listen
 21 |   , pass
 22 |   , tell
 23 |   , listens
 24 |   , censor
 25 |   -- State
 26 |   , state
 27 |   , get
 28 |   , gets
 29 |   , put
 30 |   , modify
 31 |   ) where
 32 | 
 33 | import Prelude
 34 | 
 35 | import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRec)
 36 | import Data.Newtype (class Newtype)
 37 | import Data.Tuple (Tuple(..), fst, snd, uncurry)
 38 | 
 39 | data RWSResult s a w = RWSResult s a w
 40 | 
 41 | rwstate :: forall s a w. RWSResult s a w -> s
 42 | rwstate (RWSResult s _ _) = s
 43 | 
 44 | resultws :: forall s a w. RWSResult s a w -> a
 45 | resultws (RWSResult _ a _) = a
 46 | 
 47 | rwriters :: forall s a w. RWSResult s a w -> w
 48 | rwriters (RWSResult _ _ w) = w
 49 | 
 50 | newtype RWS r w s a = RWS (r -> s -> RWSResult s a w)
 51 | 
 52 | derive instance newtypeRWS :: Newtype (RWS r w s a) _
 53 | 
 54 | runRWS :: forall r w s a. RWS r w s a -> r -> s -> RWSResult s a w
 55 | runRWS (RWS f) = f
 56 | 
 57 | evalRWS :: forall r w s a. RWS r w s a -> r -> s -> Tuple a w
 58 | evalRWS (RWS f) r s =
 59 |   let res = f r s
 60 |    in Tuple (resultws res) (rwriters res)
 61 | 
 62 | execRWS :: forall r w s a. RWS r w s a -> r -> s -> Tuple s w
 63 | execRWS (RWS f) r s =
 64 |   let res = f r s
 65 |    in Tuple (rwstate res) (rwriters res)
 66 | 
 67 | mapRWS :: forall r w1 w2 s a1 a2. (RWSResult s a1 w1 -> RWSResult s a2 w2) -> RWS r w1 s a1 -> RWS r w2 s a2
 68 | mapRWS f (RWS g) = RWS \ r s -> f (g r s)
 69 | 
 70 | withRWS :: forall r1 r2 w s a. (r2 -> s -> Tuple r1 s) -> RWS r1 w s a -> RWS r2 w s a
 71 | withRWS f (RWS g) = RWS \ r2 s -> uncurry g (f r2 s)
 72 | 
 73 | map_ :: forall r w s a b. (a -> b) -> RWS r w s a -> RWS r w s b
 74 | map_ f (RWS g) = RWS \ r s ->
 75 |   let res = g r s
 76 |    in RWSResult (rwstate res) (f (resultws res)) (rwriters res)
 77 | 
 78 | infixl 4 map_ as |->
 79 | 
 80 | apply_ :: forall r w s a b. Semigroup w => RWS r w s (a -> b) -> RWS r w s a -> RWS r w s b
 81 | apply_ (RWS ff) (RWS fa) = RWS \ r s ->
 82 |   let res = ff r s
 83 |       f = resultws res
 84 |       s' = rwstate res
 85 |       w' = rwriters res
 86 |       res' = fa r s'
 87 |       a = resultws res'
 88 |       b = f a
 89 |       s'' = rwstate res'
 90 |       w'' = w' <> rwriters res'
 91 |    in RWSResult s'' b w''
 92 | 
 93 | infixl 4 apply_ as ~
 94 | 
 95 | pure_ :: forall r w s a. Monoid w => a -> RWS r w s a
 96 | pure_ a = RWS \ r s -> RWSResult s a mempty
 97 | 
 98 | bind_ :: forall r w s a b. Semigroup w => RWS r w s a -> (a -> RWS r w s b) -> RWS r w s b
 99 | bind_ (RWS fa) k = RWS \ r s ->
100 |   let res = fa r s
101 |       a = resultws res
102 |       s' = rwstate res
103 |       w' = rwriters res
104 |       res' = runRWS (k a) r s'
105 |       s'' = rwstate res'
106 |       w'' = w' <> rwriters res'
107 |       b = resultws res'
108 |    in RWSResult s'' b w''
109 | 
110 | infixl 1 bind_ as >>-
111 | 
112 | tailRec_ :: forall r w s a b. Monoid w => (a -> RWS r w s (Step a b)) -> a -> RWS r w s b
113 | tailRec_ f a = RWS \ r s -> tailRec (k' r) (RWSResult s a mempty)
114 |   where
115 |   k' r (RWSResult st res wr) =
116 |     let result = runRWS (f res) r st
117 |         res' = resultws result
118 |         st' = rwstate result
119 |         wr' = rwriters result
120 |      in case res' of
121 |              Loop x -> Loop (RWSResult st' x (wr <> wr'))
122 |              Done y -> Done (RWSResult st' y (wr <> wr'))
123 | 
124 | instance functorRWS :: Functor (RWS r w s) where
125 |   map :: forall a b. (a -> b) -> RWS r w s a -> RWS r w s b
126 |   map f (RWS g) = RWS \ r s ->
127 |     let res = g r s
128 |      in RWSResult (rwstate res) (f (resultws res)) (rwriters res)
129 | 
130 | instance applyRWS :: Semigroup w => Apply (RWS r w s) where
131 |   apply :: forall a b. RWS r w s (a -> b) -> RWS r w s a -> RWS r w s b
132 |   apply (RWS ff) (RWS fa) = RWS \ r s ->
133 |     let res = ff r s
134 |         f = resultws res
135 |         s' = rwstate res
136 |         w' = rwriters res
137 |         res' = fa r s'
138 |         a = resultws res'
139 |         b = f a
140 |         s'' = rwstate res'
141 |         w'' = w' <> rwriters res'
142 |      in RWSResult s'' b w''
143 | 
144 | instance applicativeRWS :: Monoid w => Applicative (RWS r w s) where
145 |   pure :: forall a. a -> RWS r w s a
146 |   pure a = RWS \ r s -> RWSResult s a mempty
147 | 
148 | instance bindRWS :: Semigroup w => Bind (RWS r w s) where
149 |   bind :: forall a b. RWS r w s a -> (a -> RWS r w s b) -> RWS r w s b
150 |   bind (RWS fa) k = RWS \ r s ->
151 |     let res = fa r s
152 |         a = resultws res
153 |         s' = rwstate res
154 |         w' = rwriters res
155 |         res' = runRWS (k a) r s'
156 |         s'' = rwstate res'
157 |         w'' = w' <> rwriters res'
158 |         b = resultws res'
159 |      in RWSResult s'' b w''
160 | 
161 | instance monadRWS :: Monoid w => Monad (RWS r w s)
162 | 
163 | instance monadRecRWS :: Monoid w => MonadRec (RWS r w s) where
164 |   tailRecM :: forall a b. (a -> RWS r w s (Step a b)) -> a -> RWS r w s b
165 |   tailRecM f a = RWS \ r s -> tailRec (k' r) (RWSResult s a mempty)
166 |     where
167 |     k' r (RWSResult st res wr) =
168 |       let result = runRWS (f res) r st
169 |           res' = resultws result
170 |           st' = rwstate result
171 |           wr' = rwriters result
172 |        in case res' of
173 |                Loop x -> Loop (RWSResult st' x (wr <> wr'))
174 |                Done y -> Done (RWSResult st' y (wr <> wr'))
175 | 
176 | -- | Reader
177 | 
178 | reader :: forall r w s a. Monoid w => (r -> a) -> RWS r w s a
179 | reader f = RWS \ r s -> RWSResult s (f r) mempty
180 | 
181 | ask :: forall r w s. Monoid w => RWS r w s r
182 | ask = RWS \ r s -> RWSResult s r mempty
183 | 
184 | local :: forall r w s a. (r -> r) -> RWS r w s a -> RWS r w s a
185 | local f (RWS m) = RWS \ r s -> m (f r) s
186 | 
187 | -- | Writer
188 | 
189 | writer :: forall r w s a. Tuple a w -> RWS r w s a
190 | writer (Tuple a w) = RWS \ r s -> RWSResult s a w
191 | 
192 | listen :: forall r w s a. RWS r w s a -> RWS r w s (Tuple a w)
193 | listen (RWS f) = RWS \ r s ->
194 |   let res = f r s
195 |       s' = rwstate res
196 |       a = resultws res
197 |       w = rwriters res
198 |    in RWSResult s' (Tuple a w) w
199 | 
200 | pass :: forall r w s a. RWS r w s (Tuple a (w -> w)) -> RWS r w s a
201 | pass (RWS f) = RWS \ r s ->
202 |   let res = f r s
203 |       s' = rwstate res
204 |       a = resultws res
205 |       w = rwriters res
206 |    in RWSResult s' (fst a) (snd a w)
207 | 
208 | tell :: forall r w s. w -> RWS r w s Unit
209 | tell w = RWS \ r s -> RWSResult s unit w
210 | 
211 | listens :: forall r w s a b. (w -> b) -> RWS r w s a -> RWS r w s (Tuple a b)
212 | listens f (RWS g) = RWS \ r s ->
213 |   let res = g r s
214 |       s' = rwstate res
215 |       a = resultws res
216 |       w = rwriters res
217 |    in RWSResult s' (Tuple a (f w)) w
218 | 
219 | censor :: forall r w s a. Monoid w => (w -> w) -> RWS r w s a -> RWS r w s a
220 | censor f m = pass do
221 |   a <- m
222 |   pure_ (Tuple a f)
223 |     where
224 |       bind = bind_
225 | 
226 | -- | State
227 | 
228 | state :: forall r w s a. Monoid w => (s -> Tuple a s) -> RWS r w s a
229 | state f = RWS \ r s -> case f s of
230 |   Tuple a s' -> RWSResult s' a mempty
231 | 
232 | get :: forall r w s. Monoid w => RWS r w s s
233 | get = RWS \ r s -> RWSResult s s mempty
234 | 
235 | gets :: forall r w s a. Monoid w => (s -> a) -> RWS r w s a
236 | gets f = f |-> get
237 | 
238 | put :: forall r w s. Monoid w => s -> RWS r w s Unit
239 | put s = RWS \ r _ -> RWSResult s unit mempty
240 | 
241 | modify :: forall r w s. Monoid w => (s -> s) -> RWS r w s Unit
242 | modify f = get >>- put <<< f
243 | 


--------------------------------------------------------------------------------
/src/Control/Monad/Transformerless/Reader.purs:
--------------------------------------------------------------------------------
 1 | module Control.Monad.Transformerless.Reader where
 2 | 
 3 | import Prelude
 4 | 
 5 | type Reader r = Function r
 6 | 
 7 | runReader :: forall r a. Reader r a -> r -> a
 8 | runReader = identity
 9 | 
10 | withReader :: forall r1 r2 a. (r2 -> r1) -> Reader r1 a -> Reader r2 a
11 | withReader = (>>>)
12 | 
13 | mapReader :: forall r a b. (a -> b) -> Reader r a -> Reader r b
14 | mapReader = (<<<)
15 | 
16 | infixl 4 mapReader as |->
17 | 
18 | applyR :: forall r a b. Reader r (a -> b) -> Reader r a -> Reader r b
19 | applyR f a = \ r -> f r (a r)
20 | 
21 | infixl 4 applyR as ~
22 | 
23 | pureR :: forall r a. a -> Reader r a
24 | pureR a = \ _ -> a
25 | 
26 | bindR :: forall r a b. Reader r a -> (a -> Reader r b) -> Reader r b
27 | bindR a k = \ r -> k (a r) r
28 | 
29 | infixl 1 bindR as >>-
30 | 
31 | local :: forall r a. (r -> r) -> Reader r a -> Reader r a
32 | local = (>>>)
33 | 
34 | ask :: forall r. Reader r r
35 | ask = identity
36 | 


--------------------------------------------------------------------------------
/src/Control/Monad/Transformerless/State.purs:
--------------------------------------------------------------------------------
  1 | module Control.Monad.Transformerless.State where
  2 | 
  3 | import Prelude
  4 | 
  5 | import Control.Alt (class Alt)
  6 | import Control.Lazy (class Lazy)
  7 | import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRec)
  8 | import Data.Newtype (class Newtype)
  9 | import Data.Tuple (Tuple(..), fst, snd)
 10 | 
 11 | newtype State s a = State (s -> Tuple a s)
 12 | 
 13 | derive instance newtypeState :: Newtype (State s a) _
 14 | 
 15 | runState :: forall s a. State s a -> s -> Tuple a s
 16 | runState (State s) = s
 17 | 
 18 | evalState :: forall s a. State s a -> s -> a
 19 | evalState (State s) i = fst (s i)
 20 | 
 21 | execState :: forall s a. State s a -> s -> s
 22 | execState (State s) i = snd (s i)
 23 | 
 24 | mapState :: forall s a b. (Tuple a s -> Tuple b s) -> State s a -> State s b
 25 | mapState f (State s) = State (f <<< s)
 26 | 
 27 | mapS :: forall s a b. (a -> b) -> State s a -> State s b
 28 | mapS f (State s) = State \ st ->
 29 |   let Tuple a s' = s st
 30 |    in Tuple (f a) s'
 31 | 
 32 | infixl 4 mapS as |->
 33 | 
 34 | applyS :: forall s a b. State s (a -> b) -> State s a -> State s b
 35 | applyS (State ff) (State fa) = State \ s ->
 36 |   let Tuple f s' = ff s
 37 |       Tuple a s'' = fa s'
 38 |    in Tuple (f a) s''
 39 | 
 40 | infixl 4 applyS as ~
 41 | 
 42 | pureS :: forall s a. a -> State s a
 43 | pureS a = State (Tuple a)
 44 | 
 45 | bindS :: forall s a b. State s a -> (a -> State s b) -> State s b
 46 | bindS (State fa) k = State \ s ->
 47 |   let Tuple a s' = fa s
 48 |       Tuple b s'' = runState (k a) s'
 49 |    in Tuple b s''
 50 | 
 51 | infixl 1 bindS as >>-
 52 | 
 53 | deferS :: forall s a. (Unit -> State s a) -> State s a
 54 | deferS f = State \ s -> case f unit of State f' -> f' s
 55 | 
 56 | tailRecS :: forall s a b. (a -> State s (Step a b)) -> a -> State s b
 57 | tailRecS f a = State \ s -> tailRec f' (Tuple a s)
 58 |   where
 59 |   f' (Tuple x s) =
 60 |     let Tuple m s1 = runState (f x) s
 61 |      in case m of
 62 |          Loop l -> Loop (Tuple l s1)
 63 |          Done r -> Done (Tuple r s1)
 64 | 
 65 | -- | This satisfies associativity and `get <<< x` = `x <<< get`, but neither is the same as `x`.
 66 | -- | This is because composition of two `State`s uses neither in the
 67 | -- | computation of the final state.
 68 | instance semigroupoidState :: Semigroupoid State where
 69 |   compose :: forall a b c. State b c -> State a b -> State a c
 70 |   compose (State bc) (State ab) = State \ a -> Tuple (fst (bc (fst (ab a)))) a
 71 | 
 72 | instance functorState :: Functor (State s) where
 73 |   map :: forall a b. (a -> b) -> State s a -> State s b
 74 |   map f (State s) = State \ st ->
 75 |     let Tuple a s' = s st
 76 |      in Tuple (f a) s'
 77 | 
 78 | instance applyState :: Apply (State s) where
 79 |   apply :: forall a b. State s (a -> b) -> State s a -> State s b
 80 |   apply (State ff) (State fa) = State \ s ->
 81 |     let Tuple f s' = ff s
 82 |         Tuple a s'' = fa s'
 83 |      in Tuple (f a) s''
 84 | 
 85 | instance applicativeState :: Applicative (State s) where
 86 |   pure :: forall a. a -> State s a
 87 |   pure a = State (Tuple a)
 88 | 
 89 | instance altState :: Alt (State s) where
 90 |   alt f _ = f
 91 | 
 92 | instance bindState :: Bind (State s) where
 93 |   bind :: forall a b. State s a -> (a -> State s b) -> State s b
 94 |   bind (State fa) k = State \ s ->
 95 |     let Tuple a s' = fa s
 96 |         Tuple b s'' = runState (k a) s'
 97 |      in Tuple b s''
 98 | 
 99 | instance monadState :: Monad (State s)
100 | 
101 | instance lazyState :: Lazy (State s a) where
102 |   defer :: (Unit -> State s a) -> State s a
103 |   defer f = State \ s -> case f unit of State f' -> f' s
104 | 
105 | instance monadrecState :: MonadRec (State s) where
106 |   tailRecM :: forall a b. (a -> State s (Step a b)) -> a -> State s b
107 |   tailRecM f a = State \ s -> tailRec f' (Tuple a s)
108 |     where
109 |     f' (Tuple x s) =
110 |       let Tuple m s1 = runState (f x) s
111 |        in case m of
112 |            Loop l -> Loop (Tuple l s1)
113 |            Done r -> Done (Tuple r s1)
114 | 
115 | get :: forall s. State s s
116 | get = State \ st -> Tuple st st
117 | 
118 | gets :: forall s a. (s -> a) -> State s a
119 | gets f = State \ st -> Tuple (f st) st
120 | 
121 | put :: forall s. s -> State s Unit
122 | put s = State \ _ -> Tuple unit s
123 | 
124 | modify :: forall s. (s -> s) -> State s Unit
125 | modify f = State \ s -> Tuple unit (f s)
126 | 


--------------------------------------------------------------------------------
/src/Control/Monad/Transformerless/Writer.purs:
--------------------------------------------------------------------------------
 1 | module Control.Monad.Transformerless.Writer where
 2 | 
 3 | import Prelude
 4 | 
 5 | import Data.Newtype (class Newtype)
 6 | import Data.Tuple (Tuple(Tuple))
 7 | 
 8 | newtype Writer w a = Writer (Tuple a w)
 9 | 
10 | derive instance newtypeWriter :: Newtype (Writer w a) _
11 | 
12 | runWriter :: forall w a. Writer w a -> Tuple a w
13 | runWriter (Writer t) = t
14 | 
15 | execWriter :: forall w a. Writer w a -> w
16 | execWriter (Writer (Tuple _ w)) = w
17 | 
18 | mapWriter :: forall w1 w2 a b. (Tuple a w1 -> Tuple b w2) -> Writer w1 a -> Writer w2 b
19 | mapWriter f (Writer t) = Writer (f t)
20 | 
21 | mapW :: forall w a b. (a -> b) -> Writer w a -> Writer w b
22 | mapW f (Writer (Tuple a w)) = Writer (Tuple (f a) w)
23 | 
24 | infixl 4 mapW as |->
25 | 
26 | applyW :: forall w a b. Semigroup w => Writer w (a -> b) -> Writer w a -> Writer w b
27 | applyW (Writer (Tuple f w1)) (Writer (Tuple a w2)) = Writer (Tuple (f a) (w1 <> w2))
28 | 
29 | infixl 4 applyW as ~
30 | 
31 | pureW :: forall w a. Monoid w => a -> Writer w a
32 | pureW a = Writer (Tuple a mempty)
33 | 
34 | bindW :: forall w a b. Semigroup w => Writer w a -> (a -> Writer w b) -> Writer w b
35 | bindW (Writer (Tuple a w)) k =
36 |   let Tuple a' w' = runWriter (k a)
37 |    in Writer (Tuple a' (w <> w'))
38 | 
39 | infixl 1 bindW as >>-
40 | 
41 | instance functorWriter :: Functor (Writer w) where
42 |   map :: forall a b. (a -> b) -> Writer w a -> Writer w b
43 |   map f (Writer (Tuple a w)) = Writer (Tuple (f a) w)
44 | 
45 | instance applyWriter :: Semigroup w => Apply (Writer w) where
46 |   apply :: forall a b. Writer w (a -> b) -> Writer w a -> Writer w b
47 |   apply (Writer (Tuple f w1)) (Writer (Tuple a w2)) = Writer (Tuple (f a) (w1 <> w2))
48 | 
49 | instance applicativeWriter :: Monoid w => Applicative (Writer w) where
50 |   pure :: forall a. a -> Writer w a
51 |   pure a = Writer (Tuple a mempty)
52 | 
53 | instance bindWriter :: Semigroup w => Bind (Writer w) where
54 |   bind :: forall a b. Writer w a -> (a -> Writer w b) -> Writer w b
55 |   bind (Writer (Tuple a w)) k =
56 |     let Tuple a' w' = runWriter (k a)
57 |      in Writer (Tuple a' (w <> w'))
58 | 
59 | instance monadWriter :: Monoid w => Monad (Writer w)
60 | 
61 | pass :: forall w a. Writer w (Tuple a (w -> w)) -> Writer w a
62 | pass (Writer (Tuple (Tuple a f) w)) = Writer (Tuple a (f w))
63 | 
64 | listen :: forall w a. Writer w a -> Writer w (Tuple a w)
65 | listen (Writer (Tuple a w)) = Writer (Tuple (Tuple a w) w)
66 | 
67 | tell :: forall w. w -> Writer w Unit
68 | tell w = Writer (Tuple unit w)
69 | 
70 | listens :: forall w a b. Monoid w => (w -> b) -> Writer w a -> Writer w (Tuple a b)
71 | listens f (Writer (Tuple a w)) = Writer (Tuple (Tuple a (f w)) w)
72 | 
73 | censor :: forall w a. Monoid w => (w -> w) -> Writer w a -> Writer w a
74 | censor f m = pass do
75 |   a <- m
76 |   pure (Tuple a f)
77 |     where
78 |       bind = bindW
79 | 


--------------------------------------------------------------------------------
/src/Data/Functor/Pairing/Transformerless.purs:
--------------------------------------------------------------------------------
 1 | module Data.Functor.Pairing.Transformerless where
 2 | 
 3 | import Control.Comonad.Transformerless.Env (Env(..))
 4 | import Control.Comonad.Transformerless.Store (Store(..))
 5 | import Control.Comonad.Transformerless.Traced (Traced(..))
 6 | import Control.Monad.Transformerless.Reader (Reader)
 7 | import Control.Monad.Transformerless.State (State(..))
 8 | import Control.Monad.Transformerless.Writer (Writer(..))
 9 | import Data.Tuple (Tuple(..))
10 | 
11 | stateStore :: ∀ s a b c. (a -> b -> c) -> State s a -> Store s b -> c
12 | stateStore f (State state) (Store get s) = f a (get s')
13 |   where
14 |   Tuple a s' = state s
15 | 
16 | readerEnv :: ∀ r a b c. (a -> b -> c) -> Reader r a -> Env r b -> c
17 | readerEnv f reader (Env (Tuple e a)) = f (reader e) a
18 | 
19 | writerTraced :: ∀ w a b c. (a -> b -> c) -> Writer w a -> Traced w b -> c
20 | writerTraced f (Writer writer) (Traced t) = (\(Tuple a w) f1 -> f a (f1 w)) writer t 


--------------------------------------------------------------------------------
/test/Main.js:
--------------------------------------------------------------------------------
1 | exports.t = function () {
2 |   return new Date().valueOf();
3 | };
4 | 


--------------------------------------------------------------------------------
/test/Main.purs:
--------------------------------------------------------------------------------
  1 | module Test.Main where
  2 | 
  3 | import Prelude
  4 | 
  5 | import Control.Monad.Rec.Class (Step(..))
  6 | import Control.Monad.Transformerless.Cont as Cont
  7 | import Control.Monad.Transformerless.RWS as RWS
  8 | import Control.Monad.Transformerless.Reader as Reader
  9 | import Control.Monad.Transformerless.State as State
 10 | import Control.Monad.Transformerless.Writer as Writer
 11 | import Data.Tuple (Tuple(..))
 12 | import Effect (Effect)
 13 | import Effect.Console (log, logShow)
 14 | 
 15 | foreign import t :: Effect Number
 16 | 
 17 | loop :: Int -> RWS.RWS String (Array String) Int Unit
 18 | loop n = RWS.tailRec_ go n where
 19 |   go 0 = do
 20 |     RWS.tell ["Done!"]
 21 |     RWS.pure_ (Done unit)
 22 |       where
 23 |         bind = RWS.bind_
 24 |         discard = RWS.bind_
 25 |   go m = do
 26 |     x <- RWS.get
 27 |     RWS.put (x + 1)
 28 |     RWS.pure_ (Loop (m - 1))
 29 |       where
 30 |         bind = RWS.bind_
 31 |         discard = RWS.bind_
 32 | 
 33 | loopState :: Int -> State.State Int Unit
 34 | loopState n = State.tailRecS go n where
 35 |   go 0 = State.pureS (Done unit)
 36 |   go m = do
 37 |     x <- State.get
 38 |     State.put (x + 1)
 39 |     State.pureS (Loop (m - 1))
 40 |       where
 41 |         bind = State.bindS
 42 |         discard = State.bindS
 43 | 
 44 | testRWS :: Effect Unit
 45 | testRWS = do
 46 |   t1 <- t
 47 |   let res1 = RWS.runRWS (loop 1000000) "" 0
 48 |   t2 <- t
 49 |   log $ "RWS: " <> show (t2 - t1)
 50 |   t3 <- t
 51 |   let res2 = State.execState (loopState 1000000) 0
 52 |   t4 <- t
 53 |   log $ "State: " <> show (t4 - t3)
 54 | 
 55 | readerTest :: Reader.Reader String String
 56 | readerTest = Reader.local (_ <> "!") Reader.ask
 57 | 
 58 | testReader :: Effect Unit
 59 | testReader = log $ Reader.runReader readerTest "Done"
 60 | 
 61 | incState :: State.State Int Unit
 62 | incState = State.modify (add 1)
 63 | 
 64 | stateTest :: State.State Int String
 65 | stateTest = do
 66 |   incState
 67 |   incState
 68 |   incState
 69 |   incState
 70 |   incState
 71 |   incState
 72 |   pure "Done"
 73 |     where
 74 |       bind = State.bindS
 75 | 
 76 | testState :: Effect Unit
 77 | testState = case State.runState stateTest 0 of
 78 |   Tuple value state -> do
 79 |     log $ "state: " <> show state
 80 |     log $ "value: " <> show value
 81 | 
 82 | writerTest :: Writer.Writer String Int
 83 | writerTest = do
 84 |   Writer.tell "Hello from writerTest"
 85 |   pure 42
 86 |     where
 87 |       bind = Writer.bindW
 88 | 
 89 | testWriter :: Effect Unit
 90 | testWriter = case Writer.runWriter writerTest of
 91 |   Tuple value output -> do
 92 |     log output
 93 |     logShow value
 94 | 
 95 | contTest :: forall r. Cont.Cont r Int
 96 | contTest = Cont.callCC \ return -> do
 97 |   let n = 5
 98 |   return n :: Cont.Cont r Unit
 99 |   pure 15
100 | 
101 | testCont :: Effect Unit
102 | testCont = Cont.runCont contTest logShow
103 | 
104 | main :: Effect Unit
105 | main = do
106 |   testReader
107 |   testState
108 |   testWriter
109 |   testRWS
110 |   testCont
111 | 


--------------------------------------------------------------------------------