free 5.1.10 → 5.2

raw patch · 46 files changed

+7908/−8982 lines, 46 filesdep +bifunctor-classes-compatdep −bifunctorsdep −faildep −semigroupsdep ~basedep ~containersdep ~mtlsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: bifunctor-classes-compat

Dependencies removed: bifunctors, fail, semigroups, transformers-compat

Dependency ranges changed: base, containers, mtl, profunctors, template-haskell, th-abstraction, transformers

API changes (from Hackage documentation)

Files

• .ghci +0/−0
• .gitignore +32/−32
• .hlint.yaml +15/−15
• .vim.custom +31/−31
• CHANGELOG.markdown +238/−228
• LICENSE +30/−30
• README.markdown +15/−15
• Setup.lhs +7/−7
• doc/proof/Control/Comonad/Cofree/instance-Applicative-Cofree.md +6/−6
• doc/proof/Control/Comonad/Cofree/instance-Monad-Cofree.md +6/−6
• doc/proof/Control/Comonad/Cofree/instance-MonadZip-Cofree.md +9/−9
• doc/proof/Control/Comonad/Trans/Cofree/instance-Applicative-CofreeT.md +612/−612
• doc/proof/Control/Comonad/Trans/Cofree/instance-Monad-CofreeT.md +200/−200
• doc/proof/Control/Comonad/Trans/Cofree/instance-MonadTrans-CofreeT.md +88/−88
• doc/proof/Control/Comonad/Trans/Cofree/instance-MonadZip-CofreeT.md +448/−448
• examples/Cabbage.lhs +207/−209
• examples/LICENSE +30/−30
• examples/MandelbrotIter.lhs +137/−137
• examples/NewtonCoiter.lhs +100/−102
• examples/PerfTH.hs +122/−122
• examples/RetryTH.hs +96/−96
• examples/Teletype.lhs +104/−106
• examples/ValidationForm.hs +113/−117
• examples/free-examples.cabal +109/−121
• free.cabal +126/−166
• include/free-common.h +0/−23
• src/Control/Alternative/Free.hs +127/−164
• src/Control/Alternative/Free/Final.hs +73/−73
• src/Control/Applicative/Free.hs +331/−144
• src/Control/Applicative/Free/Fast.hs +121/−169
• src/Control/Applicative/Free/Final.hs +85/−91
• src/Control/Applicative/Trans/Free.hs +191/−233
• src/Control/Comonad/Cofree.hs +400/−507
• src/Control/Comonad/Cofree/Class.hs +55/−60
• src/Control/Comonad/Trans/Cofree.hs +242/−352
• src/Control/Comonad/Trans/Coiter.hs +184/−265
• src/Control/Monad/Free.hs +397/−503
• src/Control/Monad/Free/Ap.hs +349/−449
• src/Control/Monad/Free/Church.hs +249/−253
• src/Control/Monad/Free/Class.hs +160/−170
• src/Control/Monad/Free/TH.hs +441/−475
• src/Control/Monad/Trans/Free.hs +449/−612
• src/Control/Monad/Trans/Free/Ap.hs +443/−600
• src/Control/Monad/Trans/Free/Church.hs +295/−338
• src/Control/Monad/Trans/Iter.hs +435/−523
• src/Data/Functor/Classes/Compat.hs +0/−45

@@ -1,32 +1,32 @@-dist
-dist-newstyle
-docs
-wiki
-TAGS
-tags
-wip
-.DS_Store
-.*.swp
-.*.swo
-*.o
-*.hi
-*~
-*#
-.cabal-sandbox/
-cabal.sandbox.config
-.stack-work/
-cabal-dev
-*.chi
-*.chs.h
-*.dyn_o
-*.dyn_hi
-.hpc
-.hsenv
-*.prof
-*.aux
-*.hp
-*.eventlog
-cabal.project.local
-cabal.project.local~
-.HTF/
-.ghc.environment.*
+dist+dist-newstyle+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#+.cabal-sandbox/+cabal.sandbox.config+.stack-work/+cabal-dev+*.chi+*.chs.h+*.dyn_o+*.dyn_hi+.hpc+.hsenv+*.prof+*.aux+*.hp+*.eventlog+cabal.project.local+cabal.project.local~+.HTF/+.ghc.environment.*

@@ -1,15 +1,15 @@-- arguments: [--cpp-define=HLINT, --cpp-ansi, --cpp-include=include]
-
-- fixity: "infixr 5 :<"
-
-# This affects performance
-- ignore: {name: Redundant lambda}
-
-# This is not valid for improve
-- ignore: {name: Eta reduce}
-
-# DeriveDataTypable noise
-- ignore: {name: Unused LANGUAGE pragma}
-
-# They are clearer in places
-- ignore: {name: Avoid lambda}
+- arguments: [--cpp-define=HLINT, --cpp-ansi, --cpp-include=include]++- fixity: "infixr 5 :<"++# This affects performance+- ignore: {name: Redundant lambda}++# This is not valid for improve+- ignore: {name: Eta reduce}++# DeriveDataTypable noise+- ignore: {name: Unused LANGUAGE pragma}++# They are clearer in places+- ignore: {name: Avoid lambda}

@@ -1,31 +1,31 @@-" Add the following to your .vimrc to automatically load this on startup
-
-" if filereadable(".vim.custom")
-"     so .vim.custom
-" endif
-
-function StripTrailingWhitespace()
-  let myline=line(".")
-  let mycolumn = col(".")
-  silent %s/  *$//
-  call cursor(myline, mycolumn)
-endfunction
-
-" enable syntax highlighting
-syntax on
-
-" search for the tags file anywhere between here and /
-set tags=TAGS;/
-
-" highlight tabs and trailing spaces
-set listchars=tab:‗‗,trail:‗
-set list
-
-" f2 runs hasktags
-map <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>
-
-" strip trailing whitespace before saving
-" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace()
-
-" rebuild hasktags after saving
-au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src"
+" Add the following to your .vimrc to automatically load this on startup++" if filereadable(".vim.custom")+"     so .vim.custom+" endif++function StripTrailingWhitespace()+  let myline=line(".")+  let mycolumn = col(".")+  silent %s/  *$//+  call cursor(myline, mycolumn)+endfunction++" enable syntax highlighting+syntax on++" search for the tags file anywhere between here and /+set tags=TAGS;/++" highlight tabs and trailing spaces+set listchars=tab:‗‗,trail:‗+set list++" f2 runs hasktags+map <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++" strip trailing whitespace before saving+" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace()++" rebuild hasktags after saving+au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src"

@@ -1,228 +1,238 @@-5.1.10 [2022.11.30]
--------------------
-* Add a `MonadFail` instance for `FT`.
-
-5.1.9 [2022.06.26]
-------------------
-* Simplify the `Eq` and `Ord` instances for `FT` to avoid the use of
-  overlapping instances.
-
-5.1.8 [2022.05.07]
-------------------
-* Generalize the `Monad` constraint in the type signatures for
-  `hoistFreeT` in `Control.Monad.Trans.Free` and `Control.Monad.Trans.Free.Ap`
-  to a `Functor` constraint.
-* Allow building with `transformers-0.6.*` and `mtl-2.3.*`.
-
-5.1.7 [2021.04.30]
-------------------
-* Enable `FlexibleContexts` in `Control.Monad.Trans.Free.Church` to allow
-  building with GHC 9.2.
-
-5.1.6 [2020.12.31]
-------------------
-* Explicitly mark modules as `Safe`.
-
-5.1.5 [2020.12.16]
-------------------
-* Move `indexed-traversable` (`FunctorWithIndex` etc) instances from `lens`.
-
-5.1.4 [2020.10.01]
-------------------
-* Allow building with `template-haskell-2.17.0.0` (GHC 9.0).
-
-5.1.3 [2019.11.26]
-------------------
-* Allow building with `template-haskell-2.16` (GHC 8.10).
-* Add `Eq{1,2}`, `Ord{1,2}`, `Read{1,2}`, and `Show{1,2}` instances for
-  `CofreeF`.
-
-5.1.2 [2019.08.27]
-------------------
-* Implement more performant versions of `some` and `many` in the `Alternative`
-  instance for the final `Alt` encoding.
-
-5.1.1 [2019.05.02]
-------------------
-* Allow building with `base-4.13` (GHC 8.8).
-
-5.1 [2018.07.03]
-----------------
-* Generalize the type of `_Free`.
-* Allow building with `containers-0.6`.
-* Avoid incurring some dependencies when using recent GHCs.
-
-5.0.2 [2018.04.25]
-------------------
-* Add `Generic` and `Generic1` instances where possible.
-
-5.0.1 [2018.03.07]
-------------------
-* Fix the build on old GHCs with `transformers-0.4`.
-
-5 [2018.01.28]
---------------
-* Add a `Semigroup` instance for `IterT`.
-* Add `MonadFail` instances for `IterT` and `FreeT`.
-* Add a `Comonad` instance for the free `Applicative`, `Ap`.
-* Add `Control.Monad.Free.Ap` and `Control.Monad.Trans.Free.Ap` modules, based
-  on the "Applicative Effects in Free Monads" series of articles by Will
-  Fancher.
-* Derive `Data` instances for `Free` and `Cofree`.
-* `Control.Monad.Free.TH` now properly supports `template-haskell-2.11.0.0`. In
-  particular, it now supports `GadtC` and `RecGadtC`, which are new
-  `template-haskell` forms for representing GADTs.
-* Add `telescoped_`, `shoots`, and `leaves` to `Control.Comonad.Cofree`
-* Add the `Control.Applicative.Free.Fast` module, based on Dave Menendez's
-  article "Free Applicative Functors in Haskell"
-* Add `foldFreeT` to `Control.Monad.Trans.Free`
-* Improve the `foldMap` and `cutoff` functions for
-  `Control.Monad.Free.Church.F`, and add a `Traversable`
-* Add a `MonadBase` instance for `FreeT`
-* Add a performance test comparing Free and Church interpreters
-* The use of `prelude-extras` has been removed. `free` now uses the
-  `Data.Functor.Classes` module to give `free`'s datatypes instances of `Eq1`,
-  `Ord1`, `Read1`, and `Show1`. Their `Eq`, `Ord`, `Read`, and `Show` instances
-  have also been modified to incorporate these classes. For example, what
-  previously existed as:
-
-  ```haskell
-  instance (Eq (f (Free f a)), Eq a) => Eq (Free f a) where
-  ```
-
-  has now been changed to:
-
-  ```haskell
-  instance (Eq1 f, Eq a) => Eq (Free f a) where
-  ```
-* Remove redundant `Functor` constraints from `Control.Alternative.Free`
-
-4.12.4
-------
-* Removed a number of spurious class constraints.
-* Support GHC 8
-
-4.12.3
-------
-* Support `comonad` 5
-
-4.12.2
-------
-* Add instances for `ExceptT`: like `ErrorT`, but without an `Error` constraint.
-* Support `containers`
-* Support `transformers` 0.5
-
-
-4.12.1
-------
-* Support GHC 7.4
-
-4.12
-----
-* Add instances of `MonadCatch` and `MonadThrow` from `exceptions` to `FT`, `FreeT` and `IterT`.
-* `semigroupoids` 5, `profunctors` 5, and `bifunctors` 5 support.
-
-4.11
------
-* Pass Monad[FreeT].fail into underlying monad
-* Add `retractT`.
-* Added `cutoff` for the church encoded free monad.
-* `cutoff` now accepts negative numbers.
-* Added `intersperseT` and `intercalateT`.
-* Added `foldFree` and `foldF`.
-* Added some new `template-haskell` toys.
-
-4.10.0.1
-------
-* Fix for very old `cabal` versions where the `MIN_VERSION_foo` macros aren't negation friendly.
-
-4.10
-----
-* Redefine `Alternative` and `MonadPlus` instances of `IterT` so that they apply to any underlying `Monad`.
-  `mplus` or `<|>` is Capretta's `race` combinator; `mzero` or `empty` is a non-terminating computation.
-* Redefine `fail s` for `IterT` as `mzero`, for any string `s`.
-* Added `Control.Monad.Trans.Iter.untilJust`, which repeatedly retries a `m (Maybe a)` computation until
-  it produces `Just` a value.
-* Fix things so that we can build with GHC 7.10, which also uses the name `Alt` in `Data.Monoid`, and which exports `Monoid` from `Prelude`.
-
-4.9
----
-* Remove `either` support. Why? It dragged in a large number of dependencies we otherwise don't support, and so is probably best inverted.
-
-4.8.0.1
--------
-* Allow complation with older versions of `base`. (Foldable didn't add foldl' until base 4.6)
-
-4.8
------
-* Added a `MonadFree` instance for `EitherT` (frrom the `either` package).
-* Support for `transformers` 0.4
-
-4.7.1
------
-* Added more versions of `cutoff`.
-
-4.7
----
-* Added `prelude-extras` support. This makes it possible to work without `UndecidableInstances` for most operations.
-* Removed the `GHC_TYPEABLE` flag.
-
-4.6.1
------
-* Added `hoistF`
-
-4.6
----
-* Víctor López Juan and Fabian Ruch added many documentation improvements and a whole host of proofs of correctness.
-* Improvements in the template haskell code generator.
-* Added instances for `MonadWriter` and `MonadCont` where appropriate, thanks to Nickolay Kudasov.
-* Added `cutoff`, `iterTM`, and `never`.
-* Made modifications to some `Typeable` and `Data` instances to work correctly on both GHC 7.8.1rc1 and 7.8.1rc2.
-* Removed `Control.MonadPlus.Free`. Use `FreeT f []` instead and the result will be law-abiding.
-* Replaced `Control.Alternative.Free` with a new approach that is law-abiding for left-distributive Alternatives.
-
-4.5
------
-* Added `Control.Monad.Free.TH` with `makeFree` to make it easier to write free monads.
-* Added missing instances for `MonadFix` and `MonadCont` where appropriate.
-
-4.2
------
-* Added `Control.Monad.Trans.Iter` and `Control.Comonad.Trans.Coiter`.
-
-4.1.1
------
-* Added a default signature to `wrap`, based on a construction by @fizruk.
-
-4.0
----
-* Updated to work with `semigroupoids` and `comonad` 4.0
-* `instance ComonadCofree Maybe NonEmpty`
-* `instance ComonadCofree (Const b) ((,) b)`
-
-3.4.2
------
-* Generalized `liftF`.
-* Added `iterM`
-
-3.4.1
------
-* Added support for GHC 7.7's polykinded `Typeable`
-
-3.4
----
-* Added instance `MonadFree f (ContT r m)`
-
-3.3.1
------
-* Refactored build system
-* Removed upper bounds on my own intra-package dependencies
-
-3.3
----
-* Added `Control.Alternative.Free` and `Control.MonadPlus.Free`
-
-3.2
----
-* Added `Control.Free.Applicative`
-* Moved `Control.Monad.Free.Church` from `kan-extensions` into this package.
+5.2 [2023.03.12]+----------------+* Drop support for GHC 7.10 and earlier.+* Drop redundant `Monad` constraints on many functions and instances. These+  constraints were only present for compatibility with pre-7.10 versions of+  GHC, which `free` no longer supports.+* Add `Eq`, `Eq1`, `Ord`, `Ord1`, and `Foldable` instances for `Ap` in+  `Control.Applicative.Free`.+* Switch out `bifunctors` dependency for `bifunctor-classes-compat`.++5.1.10 [2022.11.30]+-------------------+* Add a `MonadFail` instance for `FT`.++5.1.9 [2022.06.26]+------------------+* Simplify the `Eq` and `Ord` instances for `FT` to avoid the use of+  overlapping instances.++5.1.8 [2022.05.07]+------------------+* Generalize the `Monad` constraint in the type signatures for+  `hoistFreeT` in `Control.Monad.Trans.Free` and `Control.Monad.Trans.Free.Ap`+  to a `Functor` constraint.+* Allow building with `transformers-0.6.*` and `mtl-2.3.*`.++5.1.7 [2021.04.30]+------------------+* Enable `FlexibleContexts` in `Control.Monad.Trans.Free.Church` to allow+  building with GHC 9.2.++5.1.6 [2020.12.31]+------------------+* Explicitly mark modules as `Safe`.++5.1.5 [2020.12.16]+------------------+* Move `indexed-traversable` (`FunctorWithIndex` etc) instances from `lens`.++5.1.4 [2020.10.01]+------------------+* Allow building with `template-haskell-2.17.0.0` (GHC 9.0).++5.1.3 [2019.11.26]+------------------+* Allow building with `template-haskell-2.16` (GHC 8.10).+* Add `Eq{1,2}`, `Ord{1,2}`, `Read{1,2}`, and `Show{1,2}` instances for+  `CofreeF`.++5.1.2 [2019.08.27]+------------------+* Implement more performant versions of `some` and `many` in the `Alternative`+  instance for the final `Alt` encoding.++5.1.1 [2019.05.02]+------------------+* Allow building with `base-4.13` (GHC 8.8).++5.1 [2018.07.03]+----------------+* Generalize the type of `_Free`.+* Allow building with `containers-0.6`.+* Avoid incurring some dependencies when using recent GHCs.++5.0.2 [2018.04.25]+------------------+* Add `Generic` and `Generic1` instances where possible.++5.0.1 [2018.03.07]+------------------+* Fix the build on old GHCs with `transformers-0.4`.++5 [2018.01.28]+--------------+* Add a `Semigroup` instance for `IterT`.+* Add `MonadFail` instances for `IterT` and `FreeT`.+* Add a `Comonad` instance for the free `Applicative`, `Ap`.+* Add `Control.Monad.Free.Ap` and `Control.Monad.Trans.Free.Ap` modules, based+  on the "Applicative Effects in Free Monads" series of articles by Will+  Fancher.+* Derive `Data` instances for `Free` and `Cofree`.+* `Control.Monad.Free.TH` now properly supports `template-haskell-2.11.0.0`. In+  particular, it now supports `GadtC` and `RecGadtC`, which are new+  `template-haskell` forms for representing GADTs.+* Add `telescoped_`, `shoots`, and `leaves` to `Control.Comonad.Cofree`+* Add the `Control.Applicative.Free.Fast` module, based on Dave Menendez's+  article "Free Applicative Functors in Haskell"+* Add `foldFreeT` to `Control.Monad.Trans.Free`+* Improve the `foldMap` and `cutoff` functions for+  `Control.Monad.Free.Church.F`, and add a `Traversable`+* Add a `MonadBase` instance for `FreeT`+* Add a performance test comparing Free and Church interpreters+* The use of `prelude-extras` has been removed. `free` now uses the+  `Data.Functor.Classes` module to give `free`'s datatypes instances of `Eq1`,+  `Ord1`, `Read1`, and `Show1`. Their `Eq`, `Ord`, `Read`, and `Show` instances+  have also been modified to incorporate these classes. For example, what+  previously existed as:++  ```haskell+  instance (Eq (f (Free f a)), Eq a) => Eq (Free f a) where+  ```++  has now been changed to:++  ```haskell+  instance (Eq1 f, Eq a) => Eq (Free f a) where+  ```+* Remove redundant `Functor` constraints from `Control.Alternative.Free`++4.12.4+------+* Removed a number of spurious class constraints.+* Support GHC 8++4.12.3+------+* Support `comonad` 5++4.12.2+------+* Add instances for `ExceptT`: like `ErrorT`, but without an `Error` constraint.+* Support `containers`+* Support `transformers` 0.5+++4.12.1+------+* Support GHC 7.4++4.12+----+* Add instances of `MonadCatch` and `MonadThrow` from `exceptions` to `FT`, `FreeT` and `IterT`.+* `semigroupoids` 5, `profunctors` 5, and `bifunctors` 5 support.++4.11+-----+* Pass Monad[FreeT].fail into underlying monad+* Add `retractT`.+* Added `cutoff` for the church encoded free monad.+* `cutoff` now accepts negative numbers.+* Added `intersperseT` and `intercalateT`.+* Added `foldFree` and `foldF`.+* Added some new `template-haskell` toys.++4.10.0.1+------+* Fix for very old `cabal` versions where the `MIN_VERSION_foo` macros aren't negation friendly.++4.10+----+* Redefine `Alternative` and `MonadPlus` instances of `IterT` so that they apply to any underlying `Monad`.+  `mplus` or `<|>` is Capretta's `race` combinator; `mzero` or `empty` is a non-terminating computation.+* Redefine `fail s` for `IterT` as `mzero`, for any string `s`.+* Added `Control.Monad.Trans.Iter.untilJust`, which repeatedly retries a `m (Maybe a)` computation until+  it produces `Just` a value.+* Fix things so that we can build with GHC 7.10, which also uses the name `Alt` in `Data.Monoid`, and which exports `Monoid` from `Prelude`.++4.9+---+* Remove `either` support. Why? It dragged in a large number of dependencies we otherwise don't support, and so is probably best inverted.++4.8.0.1+-------+* Allow complation with older versions of `base`. (Foldable didn't add foldl' until base 4.6)++4.8+-----+* Added a `MonadFree` instance for `EitherT` (frrom the `either` package).+* Support for `transformers` 0.4++4.7.1+-----+* Added more versions of `cutoff`.++4.7+---+* Added `prelude-extras` support. This makes it possible to work without `UndecidableInstances` for most operations.+* Removed the `GHC_TYPEABLE` flag.++4.6.1+-----+* Added `hoistF`++4.6+---+* Víctor López Juan and Fabian Ruch added many documentation improvements and a whole host of proofs of correctness.+* Improvements in the template haskell code generator.+* Added instances for `MonadWriter` and `MonadCont` where appropriate, thanks to Nickolay Kudasov.+* Added `cutoff`, `iterTM`, and `never`.+* Made modifications to some `Typeable` and `Data` instances to work correctly on both GHC 7.8.1rc1 and 7.8.1rc2.+* Removed `Control.MonadPlus.Free`. Use `FreeT f []` instead and the result will be law-abiding.+* Replaced `Control.Alternative.Free` with a new approach that is law-abiding for left-distributive Alternatives.++4.5+-----+* Added `Control.Monad.Free.TH` with `makeFree` to make it easier to write free monads.+* Added missing instances for `MonadFix` and `MonadCont` where appropriate.++4.2+-----+* Added `Control.Monad.Trans.Iter` and `Control.Comonad.Trans.Coiter`.++4.1.1+-----+* Added a default signature to `wrap`, based on a construction by @fizruk.++4.0+---+* Updated to work with `semigroupoids` and `comonad` 4.0+* `instance ComonadCofree Maybe NonEmpty`+* `instance ComonadCofree (Const b) ((,) b)`++3.4.2+-----+* Generalized `liftF`.+* Added `iterM`++3.4.1+-----+* Added support for GHC 7.7's polykinded `Typeable`++3.4+---+* Added instance `MonadFree f (ContT r m)`++3.3.1+-----+* Refactored build system+* Removed upper bounds on my own intra-package dependencies++3.3+---+* Added `Control.Alternative.Free` and `Control.MonadPlus.Free`++3.2+---+* Added `Control.Free.Applicative`+* Moved `Control.Monad.Free.Church` from `kan-extensions` into this package.

@@ -1,30 +1,30 @@-Copyright 2008-2013 Edward Kmett
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGE.
+Copyright 2008-2013 Edward Kmett++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -1,15 +1,15 @@-free
-====
-
-[![Hackage](https://img.shields.io/hackage/v/free.svg)](https://hackage.haskell.org/package/free) [![Build Status](https://github.com/ekmett/free/workflows/Haskell-CI/badge.svg)](https://github.com/ekmett/free/actions?query=workflow%3AHaskell-CI)
-
-This package provides a common definitions for working with free monads, free applicatives, and cofree comonads in Haskell.
-
-Contact Information
--------------------
-
-Contributions and bug reports are welcome!
-
-Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.
-
--Edward Kmett
+free+====++[![Hackage](https://img.shields.io/hackage/v/free.svg)](https://hackage.haskell.org/package/free) [![Build Status](https://github.com/ekmett/free/workflows/Haskell-CI/badge.svg)](https://github.com/ekmett/free/actions?query=workflow%3AHaskell-CI)++This package provides a common definitions for working with free monads, free applicatives, and cofree comonads in Haskell.++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett

@@ -1,7 +1,7 @@-#!/usr/bin/runhaskell
-> module Main (main) where
-
-> import Distribution.Simple
-
-> main :: IO ()
-> main = defaultMain
+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain

@@ -1,6 +1,6 @@-Instance of Applicative for Cofree
-==================================
-
-See [proof for the transformer version]
-(../Trans/Cofree/instance-Applicative-CofreeT.md) and specialize it for the
-Identity applicative functor.
+Instance of Applicative for Cofree+==================================++See [proof for the transformer version]+(../Trans/Cofree/instance-Applicative-CofreeT.md) and specialize it for the+Identity applicative functor.

@@ -1,6 +1,6 @@-Instance of Monad for Cofree
-==================================
-
-See [proof for the transformer version]
-(../Trans/Cofree/instance-Monad-CofreeT.md) and specialize it for the
-Identity Monad.
+Instance of Monad for Cofree+==================================++See [proof for the transformer version]+(../Trans/Cofree/instance-Monad-CofreeT.md) and specialize it for the+Identity Monad.

@@ -1,9 +1,9 @@-MonadZip instance for Cofree
-============================
-
-For every functor `f` with `Alternative` and `MonadZip` instances,
-`Cofree f` is an instance of `MonadZip`.
-
-The claim follows as a corollary from the [`MonadZip` instance theorem
-for `CofreeT`](../Trans/Cofree/instance-MonadZip-CofreeT.md) when `m` is
-set to be `Identity`, which obviously has an instance of `MonadZip`.
+MonadZip instance for Cofree+============================++For every functor `f` with `Alternative` and `MonadZip` instances,+`Cofree f` is an instance of `MonadZip`.++The claim follows as a corollary from the [`MonadZip` instance theorem+for `CofreeT`](../Trans/Cofree/instance-MonadZip-CofreeT.md) when `m` is+set to be `Identity`, which obviously has an instance of `MonadZip`.

@@ -1,612 +1,612 @@-Applicative instance for CofreeT
-================================
-
-If the underlying functor f is an instance of Alternative, then CofreeT is also
-an applicative functor.
-
-Note that the only required properties of Alternative are associativity and
-existence of an identity element, so one could also use functors that are
-instances of Plus (semigroupoid package).
-
-```haskell
-instance (Alternative f, Applicative w) =>
-         Applicative (CofreeT f w) where
-  pure = CofreeT . pure . (:< empty)
-  
-  (CofreeT wf) <*> aa@(CofreeT wa) = CofreeT $
-    ( \(f :< t) -> 
-      \(a)      ->  
-      let (b :< n) = bimap f (fmap f) a in 
-      b :< (n <|> fmap (<*> aa) t)) <$> wf <*> wa
-```
-
-
-## Identity
-
-```haskell
-
-  pure id <*> (C wa)
-
-== {- definition of <*> -}
-
-   C $
-     ( \(f :< t) -> 
-       \(a)      ->  
-       let (b :< n) = bimap f (fmap f) a in 
-       b :< (n <|> fmap (<*> C wa) t)) <$> (pure $ id :< empty) <*> wa
-
-== {- w is Applicative -}
-  
-  C $
-       \(a)      ->  
-       let (b :< n) = bimap id (fmap id) a in 
-       b :< (n <|> fmap (<*> C wa) empty)) <$> wa
-
-== {- functor preserves identity -}
-
-  C $
-       \(a)      ->  
-       let (b :< n) = bimap id id a in 
-       b :< (n <|> fmap (<*> C wa) empty)) <$> wa
-
-== {- bifunctors preserve identity -}
-
-  C $
-       \(a)      ->  
-       let (b :< n) = a in 
-       b :< (n <|> fmap (<*> C wa) empty)) <$> wa
-
-== {- empty is invariant under fmap -}
- 
-  C $
-       \(a)      ->  
-       let (b :< n) = a in 
-       b :< (n <|> empty) <$> wa
-
-== {- empty is identity, β-reduction -}
-
-  C $ id <$> wa
-
-== {- functor preserves identity -}
-
-  C wa
-
-```
-
-
-## Composition
-
-First, we rewrite the definition of the (<*>) into something simpler:
-
-```haskell
-
-  (C wf) <*> (C wa)
-
-== {- definition of <*> -}
-
-  C $
-      ( \(f :< t) -> 
-        \(a)      ->  
-        let (b :< n) = bimap f (fmap f) a in 
-        b :< (n <|> fmap (<*> C wa) t)) <$> wf <*> wa
-
-== {- pattern match on CofreeF -}
-
-  C $
-      ( \(f :< t) -> 
-        \(a :< m)      ->  
-        let (b :< n) = bimap f (fmap f) (a :< m) in 
-        b :< (n <|> fmap (<*> C wa) t)) <$> wf <*> wa
-
-== {- definition of bimap -}
-
-  C $
-      ( \(f :< t) -> 
-        \(a :< m)      ->  
-        let (b :< n) = f a :< fmap (fmap f) m in 
-        b :< (n <|> fmap (<*> C wa) t)) <$> wf <*> wa
-
-== {- β-equivalence -}
-
-  C $
-      ( \(f :< t) -> 
-        \(a :< m) ->  
-        (f a) :< (fmap (fmap f) m <|> fmap (<*> C wa) t)) <$> wf <*> wa
-
-== {- define star(C wa) ≡ ( \(f :< t) -> … (<*> C wa) … ) -}
-
-  C $ star(C wa) <$> wf <*> wa
-
-== {- fmap for w Applicative -}
-
-  C (pure star(C wa) <*> wf <*> wa)
-
-```
-
-Now, we can prove the law of composition:
-
-```haskell
-
-   pure (.) <*> C u <*> C v <*> C w
-
-== {- definition of <*> -}
-
-   C (pure star(C u) <*> pure ((.) :< empty) <*> u ) <*> C v <*> C w  
-
-== {- definition of <*> -}
-
-   C (pure star(C v) <*> 
-       (pure star(C u) <*> pure ((.) :< empty) <*> u ) <*> 
-       v
-     ) <*> 
-     C w
-
-== {- definition of <*> -}
-
-   C (pure star(C w) <*>
-       (pure star(C v) <*>
-         (pure star(C u) <*> pure ((.) :< empty) <*> u ) <*>
-        v) <*>
-      w)
-
-
-== {- see lemma 1 -}
-
-     C $ (\a :< m -> \b :< n -> c :< p ->
-            (a (b c)) :< (fmap (fmap (a . b)) p <|>
-                          fmap (\x -> pure (.) <*> pure a <*> x <*> C w) n) <|>
-                          fmap (\x -> pure (.) <*> x    <*> C v <*> C w) m))) ==
-
-
-
-
-== {- coinduction on recursive definition (“produce 1, consume 1”) -}
-
-    
-     C $ (\a :< m -> b :< n -> c :< p ->
-          (a (b c) :< (fmap (fmap (a . b)) p) <|>
-                      (fmap (\x -> pure a <*> (x <*> C w)) n) <|>
-                      (fmap (\x -> x<*> (C v <*> C w))    m) )  
-
-
-== {- see lemma 2 -}
-
-  C (pure star(C v <*> C w) <*>
-     u <*>
-     (pure star(C w) <*>
-        v <*>
-        w))
-   
-== {- definition of <*> -}
-
-  C (pure star(C v <*> C w) <*> u <*> unC (C v <*> C w))
-
-== {- definition of <*> -}
-
-   C u <*> (C v <*> C w)
-```
-
-### Lemma 1
-
-To make reasoning easier, we'll use a shortand notation.
-
-```
-U               ≡ star(C v)
-V               ≡ star(C u)
-W               ≡ star(C w)
-!               ≡ (.) :< empty
-p               ≡ pure
-<concatenation> ≡ function application 
-.               ≡ (.)
-```
-
-By repeatedly applying the Applicative laws for the underlying functor, we
-get:
-
-```haskell
-   
-pW <*> (pV <*> (pU <*> p! <*> u) <*> v ) <*> w ==
-
-pW <*> (pV <*> (p(U!) <*> u) <*> v ) <*> w ==
-
-pW <*> (p. <*> pV <*> p(U!) <*> u <*> v ) <*> w ==
-
-pW <*> ( p(.V)(U!) <*> u <*> v ) <*> w ==
-
-p. <*> pW <*> ( p(.V)(U!) <*> u ) <*> v <*> w ==
-
-p(.W) <*> (p(.V)(U!) <*> u) <*> v <*> w ==
-
-p. <*> p(.W) <*> p(.V)(U!) <*> u <*> v <*> w ==
-
-p.(.W)((.V)(U!)) <*> u <*> v <*> w 
-
-```
-
-Undoing the shorthand notation and simplifying:
-
-```haskell
-
-!  == (.) :< empty
-U! == \(a :< m) -> (. a) :< fmap (fmap (.)) m
-V  == \(f :< t) -> \(b :< n) -> (f b) :< (fmap (fmap f) n <|> 
-                                          fmap (<*> C v) t)
-
-
-. V (U!) == \(a :< m) -> V ((. a) :< fmap (fmap (.)) m) ==
-         == \(a :< m) -> \(b :< n) ->
-	          (a . b) :< (fmap (fmap (. a) n) <|>
-                         fmap (<*> C v) ( fmap (fmap (.)) m)
-
-W  == \(f :< t) -> \(c :< p) ->
-          (f c) :< (fmap (fmap f) p <|> fmap (<*> C w) t)
-
-.W == \g -> (\x -> W (g x))
-
-
-   .(.W)(.V(U!))
-
-== \s -> (.W)((.V(U!)) s) ==
-
-== \a :< m -> (.W) ((.V(U!)) a :< m) ==
-
-== \a :< m -> (.W) (\(b :< n) ->
-                       (a . b) :< (fmap (fmap (. a) n) <|>
-                                   fmap (<*> C v) ( fmap (fmap (.)) m))) ==
-
-== \a :< m -> \b :< n ->
-               W ( (a . b) :< (fmap (fmap (. a) n) <|>
-                               fmap (<*> C v) ( fmap (fmap (.)) m))) ==
-
-== \a :< m -> \b :< n -> c :< p ->
-   (a (b c)) :< (fmap (fmap (a . b)) p <|>
-                 fmap (<*> C w)
-		        ((fmap (fmap (. a) n) <|>
-                     fmap (<*> C v) (fmap (fmap (.)) m)))) ==
-
-== \a :< m -> \b :< n -> c :< p ->
-   (a (b c)) :< (fmap (fmap (a . b)) p <|>
-                 fmap (<*> C w) (fmap (fmap (. a)) n) <|>
-                 fmap (<*> C w) (fmap (<*> C v) ( fmap (fmap (.)) m))) ==
-
-== \a :< m -> \b :< n -> c :< p ->
-   (a (b c)) :< (fmap (fmap (a . b)) p <|>
-                 fmap (\x -> pure (.) <*> pure a <*> x <*> C w) n) <|>
-                 fmap (\x -> pure (.) <*> x    <*> C v <*> C w) m))) 
-```
-
-### Lemma 2
-
-We use the following shorthands to make reasoning more readable.
-
-```
-W               ≡ star(C w)
-Y               ≡ star(C v <*> C w)
-p               ≡ pure
-<concatenation> ≡ function application 
-.               ≡ (.)
-$W              ≡ ($ star(C w))
-```
-
-By repeatedly applying composition law for w, we get:
-
-```haskell
-  
-pY <*> u <*> (pW <*> v <*> w) ==
-
-p. <*> (pY <*> u) <*> (pW <*> v) <*> w ==
-
-p. <*> p. <*> pY <*> u <*> (pW <*> v) <*> w ==
-
-p. <*> (p. <*> p. <*> pY <*> u) <*> pW <*> v <*> w ==
-
-p. <*> (p..Y <*> u) <*> pW <*> v <*> w ==
-
-p. <*> p. <*> p..Y <*> u <*> pW <*> v <*> w ==
-
-p..(..Y) <*> u <*> pW <*> v <*> w ==
-
-p($W) <*> (p..(..Y) <*> u) <*> v <*> w ==
-
-p.($W)(..(..Y)) <*> u <*> v <*> w
-
-
-(.)  == \f -> \g -> \x -> f (g x)
-
-($W) == \g -> g W
-
-($W) . (..(..Y)) == \s -> (\g -> g W) ((..(..Y)) s)
-                 == \s -> (..(..Y)) s W
-
-(. . (..Y)) == (\s -> . ((..Y) s))
-
-∴ ($W) . (..(..Y)) == \s -> ((..Y) s) . W
-
-(..Y) == (\y -> (.) (Y y))
-
-∴ ($W) . (..(..Y)) ==  \s -> ((.) (Y s)) . W
-
-                   ==  \s -> \t -> ((.) (Y s)) (W t)
-                   
-                   ==  \s -> \t -> (Y s) . (W t)
-
-                   ==  \s -> \t -> u -> (Y s (W t u))
-```
-
-Undoing shorthands and α-converting, we get:
-
-```haskell
-.($W)(..(..Y)) ==
-
-\a :< m -> b :< n -> c :< p -> (Y (a :< m) (W (b :<n) (c :< p))) ==
-
-\a :< m -> b :< n -> c :< p ->
-   (Y (a :< m) (b c :< (fmap (fmap b) p) <|>
-                       (fmap (<*> C w) n)))     ==
-
-\a :< m -> b :< n -> c :< p ->
-   (Y (a :< m) (b c :< (fmap (fmap b) p) <|>
-                       (fmap (<*> C w) n)))     ==
-
-\a :< m -> b :< n -> c :< p ->
-   (a (b c) :< (fmap (fmap a) ((fmap (fmap b) p) <|>
-	                              (fmap (<*> C w) n)))
-               <|>
-               (fmap (<*> (C v <*> C w)) m))
-               
-== {- fmap distributes over <|>, fmap respects composition -}
-               
-\a :< m -> b :< n -> c :< p ->
-   (a (b c) :< (fmap (fmap (a . b)) p) <|>
-               (fmap ((fmap a) . (<*> C w)) n) <|>
-               (fmap (<*> (C v <*> C w)) m))  
-
-== 
-
-\a :< m -> b :< n -> c :< p ->
-   (a (b c) :< (fmap (fmap (a . b)) p) <|>
-               (fmap (\x -> pure a <*> (x <*> C w)) n) <|>
-               (fmap (\x -> x<*> (C v <*> C w))    m) )  
-```
-
-## Homomorphism
-
-```haskell
-
-  pure f <*> pure x
-
-== {- definition of <*> -}
-
-  C $
-    ( \(f :< t) -> 
-      \(a)      ->  
-      let (b :< n) = bimap f (fmap f) a in 
-      b :< (n <|> fmap (<*> pure x) t)) <$>
-        pure (f :< empty) <*> pure (x :< empty)
-
-== {- homomorphism law for w, twice -}
-
-  C $ pure $
-      let (b :< n) = bimap f (fmap f) (x :< empty) in 
-      b :< (n <|> fmap (<*> pure x) empty)) 
-
-== {- bimap -}
-
-  C $ pure $
-      let (b :< n) = (f x :< (fmap f empty)) in 
-      b :< (n <|> fmap (<*> pure x) empty)) 
-
-== {- empty invariant under fmap -}
-  
-  C $ pure $ (f x) :< (empty <|> empty) 
-
-== {- definition -}
-
-  pure (f x)
-
-```
-
-## Interchange
-
-```haskell
-
-   u <*> pure y
-
-== {- definition of <*>, pure -}
-
-   C $     
-     ( \(f :< t) ->
-       \(a)      ->                                 
-       let (b :< n) = bimap f (fmap f) a in
-       b :< (n <|> fmap (<*> (pure y)) t)) <$> u <*> (pure (y :< empty))
-
-== {- interchange law for w -}
-
-   C $
-      pure ($ y :< empty) <*>
-      (pure
-        ( \(f :< t) ->
-          \(a)      ->                                 
-          let (b :< n) = bimap f (fmap f) a in
-          b :< (n <|> fmap (<*> (pure y)) t))) <*> u)
-
-== {- composition -}
-
-   C $
-      pure (.) <*>
-      pure ($ y :< empty) <*>
-      pure
-         ( \(f :< t) ->
-           \(a)      ->                                 
-           let (b :< n) = bimap f (fmap f) a in
-           b :< (n <|> fmap (<*> (pure y)) t))
-
-        <*> u)
-
-== {- homomorphism -}
-
-   C $
-      pure (($ y :< empty) .) <*>
-      pure
-         ( \(f :< t) ->
-           \(a)      ->                                 
-           let (b :< n) = bimap f (fmap f) a in
-           b :< (n <|> fmap (<*> (pure y)) t))
-
-        <*> u)
-
-== {- homomorphism -}
-
-   C $
-      pure (($ y :< empty) . 
-         ( \(f :< t) ->
-           \(a)      ->                                 
-           let (b :< n) = bimap f (fmap f) a in
-           b :< (n <|> fmap (<*> (pure y)) t))
-        <*> u)
-
-== {- β-reduction -}
-
-   C $
-      pure (
-         ( \(f :< t) ->
-           let (b :< n) = bimap f (fmap f) (y :< empty) in
-           b :< (n <|> fmap (<*> (pure y)) t))
-        <*> u)
-
-== {- bimap, β-reduction -}
-
-   C $
-      pure (
-         ( \(f :< t) -> f y :< (empty <|> fmap (<*> (pure y)) t))
-        <*> u)
-
-== {- fmap -}
-
-   C $ (\(f :< t) -> f y :< (fmap (<*> pure y) t)) <$> u   
-
-== {- coinduction (consume 1, produce 1) -}
-   
-   C $ (\(f :< t) -> f y :< (fmap ($ y) t)) <$> u
-   
-== {- def. $ -}
-
-   C $ (\(f :< t) -> ($ y) f :< (fmap ($ y) t)) <$> u
-
-== {- def. bimap -}
-
-    C $ bimap ($ y) (fmap ($ y)) <$> u
-
-== {- β,η-expansion -}
-
-    C $     
-     ( 
-       \(a)      ->                                 
-       let (b :< n) = bimap ($ y) (fmap ($ y)) a in
-       b :< n) <$> u
-
-== {- empty inviariant under fmap -}
-
-    C $     
-     ( 
-       \(a)      ->                                 
-       let (b :< n) = bimap ($ y) (fmap ($ y)) a in
-       b :< (n <|> fmap (<*> u) empty)) <$> u
-
-== {- fmap over pure -} 
-
-   C $     
-     ( \(f :< t) ->
-       \(a)      ->                                 
-       let (b :< n) = bimap f (fmap f) a in
-       b :< (n <|> fmap (<*> u) t)) <$> (pure (($ y) :< empty)) <*> u
-
-== {- definition -}
-
-pure ($ y) <*> u
-```
-
-## Consistency with Monad definition
-
-```haskell
-instance (Alternative f, Monad w) => Monad (CofreeT f w) where
-  return = CofreeT . return . (:< empty)
-  (CofreeT cx) >>= f = CofreeT $ do
-    (a :< m) <- cx
-    (b :< n) <- runCofreeT $ f a
-    return $ b :< (n <|> fmap (>>= f) m)
-```
-
-If w is also a monad, then ```(<*>) == ap```.
- 
-The proof uses coinduction for the case “produce one, consume one”.
- 
-_Remark:_ If ```g = (\f -> (CofreeT wa) >>= (\a -> return $ f a))```, then
-        ```(`ap` a) == (>>= g)```.
-
-```haskell
-
-(C wf) `ap` (C wa)
-
-== {- definition -}
-
-(C wf) >>= (\f -> (C wa) >>= (\a -> f a))
-
-== {- definition -}
-
-                                  wf >>= \(f :< t) ->
- unC (C wa >>= (\a -> return $ f a)) >>= \(b :< n) ->
-                              return $ b :< (n <|> fmap (>>= g) t)
-
-== {- coinductive step -}
-
-                                  wf >>= \(f :< t) ->
- unC (C wa >>= (\a -> return $ f a)) >>= \(b :< n) ->
-                              return $ b :< (n <|> fmap (<*> C wa) t)
-== {- definition of fmap for monads -}
-
-
-                                  wf >>= \(f :< t) ->
-                 unC (fmap f (C wa)) >>= \(b :< n) ->
-                              return $ b :< (n <|> fmap (<*> C wa) t)
-
-== {- definition of fmap for C -}
-
-                                            wf >>= \(f :< t) ->
-                    fmap (bimap f (fmap f)) wa >>= \(b :< n) ->
-                              return $ b :< (n <|> fmap (<*> C wa) t)
-      
-== {- definition of fmap for monads -}
-
-                                            wf >>= \(f :< t) ->
-   (wa >>= (\a -> return (bimap f (fmap f) a)  >>= \(b :< n) ->
-                              return $ b :< (n <|> fmap (<*> C wa) t)
-
-== {- associativity of monads -}
-
-                                  wf >>= \(f :< t) ->
-                                  wa >>= \a        ->
-       (return (bimap f (fmap f a))) >>= \(b :< n) -> 
-                          return $ b :< (n <|> fmap (<*> a) m)
-
-== {- Left identity of monads -}
-
-                                  wf >>= \(f :< t) ->
-                                  wa >>= \(a       ->
-                          let b :< n = bimap f (fmap f a)) in
-                          return $ b :< (n <|> fmap (<*> a) m))
-
-== {- Equivalence of (>>=) and (<*>) for monad w. -}
-
-                                         \(f :< t) ->
-                                         \(a       ->
-                          let b :< n = bimap f (fmap f a)) in
-                          return $ b :< (n <|> fmap (<*> a) m)))
-
-== {- definition of (<*>) -}
-
-(CofreeT wf) <*> (CofreeT wa)
-
-```
- 
-
+Applicative instance for CofreeT+================================++If the underlying functor f is an instance of Alternative, then CofreeT is also+an applicative functor.++Note that the only required properties of Alternative are associativity and+existence of an identity element, so one could also use functors that are+instances of Plus (semigroupoid package).++```haskell+instance (Alternative f, Applicative w) =>+         Applicative (CofreeT f w) where+  pure = CofreeT . pure . (:< empty)+  +  (CofreeT wf) <*> aa@(CofreeT wa) = CofreeT $+    ( \(f :< t) -> +      \(a)      ->  +      let (b :< n) = bimap f (fmap f) a in +      b :< (n <|> fmap (<*> aa) t)) <$> wf <*> wa+```+++## Identity++```haskell++  pure id <*> (C wa)++== {- definition of <*> -}++   C $+     ( \(f :< t) -> +       \(a)      ->  +       let (b :< n) = bimap f (fmap f) a in +       b :< (n <|> fmap (<*> C wa) t)) <$> (pure $ id :< empty) <*> wa++== {- w is Applicative -}+  +  C $+       \(a)      ->  +       let (b :< n) = bimap id (fmap id) a in +       b :< (n <|> fmap (<*> C wa) empty)) <$> wa++== {- functor preserves identity -}++  C $+       \(a)      ->  +       let (b :< n) = bimap id id a in +       b :< (n <|> fmap (<*> C wa) empty)) <$> wa++== {- bifunctors preserve identity -}++  C $+       \(a)      ->  +       let (b :< n) = a in +       b :< (n <|> fmap (<*> C wa) empty)) <$> wa++== {- empty is invariant under fmap -}+ +  C $+       \(a)      ->  +       let (b :< n) = a in +       b :< (n <|> empty) <$> wa++== {- empty is identity, β-reduction -}++  C $ id <$> wa++== {- functor preserves identity -}++  C wa++```+++## Composition++First, we rewrite the definition of the (<*>) into something simpler:++```haskell++  (C wf) <*> (C wa)++== {- definition of <*> -}++  C $+      ( \(f :< t) -> +        \(a)      ->  +        let (b :< n) = bimap f (fmap f) a in +        b :< (n <|> fmap (<*> C wa) t)) <$> wf <*> wa++== {- pattern match on CofreeF -}++  C $+      ( \(f :< t) -> +        \(a :< m)      ->  +        let (b :< n) = bimap f (fmap f) (a :< m) in +        b :< (n <|> fmap (<*> C wa) t)) <$> wf <*> wa++== {- definition of bimap -}++  C $+      ( \(f :< t) -> +        \(a :< m)      ->  +        let (b :< n) = f a :< fmap (fmap f) m in +        b :< (n <|> fmap (<*> C wa) t)) <$> wf <*> wa++== {- β-equivalence -}++  C $+      ( \(f :< t) -> +        \(a :< m) ->  +        (f a) :< (fmap (fmap f) m <|> fmap (<*> C wa) t)) <$> wf <*> wa++== {- define star(C wa) ≡ ( \(f :< t) -> … (<*> C wa) … ) -}++  C $ star(C wa) <$> wf <*> wa++== {- fmap for w Applicative -}++  C (pure star(C wa) <*> wf <*> wa)++```++Now, we can prove the law of composition:++```haskell++   pure (.) <*> C u <*> C v <*> C w++== {- definition of <*> -}++   C (pure star(C u) <*> pure ((.) :< empty) <*> u ) <*> C v <*> C w  ++== {- definition of <*> -}++   C (pure star(C v) <*> +       (pure star(C u) <*> pure ((.) :< empty) <*> u ) <*> +       v+     ) <*> +     C w++== {- definition of <*> -}++   C (pure star(C w) <*>+       (pure star(C v) <*>+         (pure star(C u) <*> pure ((.) :< empty) <*> u ) <*>+        v) <*>+      w)+++== {- see lemma 1 -}++     C $ (\a :< m -> \b :< n -> c :< p ->+            (a (b c)) :< (fmap (fmap (a . b)) p <|>+                          fmap (\x -> pure (.) <*> pure a <*> x <*> C w) n) <|>+                          fmap (\x -> pure (.) <*> x    <*> C v <*> C w) m))) ==+++++== {- coinduction on recursive definition (“produce 1, consume 1”) -}++    +     C $ (\a :< m -> b :< n -> c :< p ->+          (a (b c) :< (fmap (fmap (a . b)) p) <|>+                      (fmap (\x -> pure a <*> (x <*> C w)) n) <|>+                      (fmap (\x -> x<*> (C v <*> C w))    m) )  +++== {- see lemma 2 -}++  C (pure star(C v <*> C w) <*>+     u <*>+     (pure star(C w) <*>+        v <*>+        w))+   +== {- definition of <*> -}++  C (pure star(C v <*> C w) <*> u <*> unC (C v <*> C w))++== {- definition of <*> -}++   C u <*> (C v <*> C w)+```++### Lemma 1++To make reasoning easier, we'll use a shortand notation.++```+U               ≡ star(C v)+V               ≡ star(C u)+W               ≡ star(C w)+!               ≡ (.) :< empty+p               ≡ pure+<concatenation> ≡ function application +.               ≡ (.)+```++By repeatedly applying the Applicative laws for the underlying functor, we+get:++```haskell+   +pW <*> (pV <*> (pU <*> p! <*> u) <*> v ) <*> w ==++pW <*> (pV <*> (p(U!) <*> u) <*> v ) <*> w ==++pW <*> (p. <*> pV <*> p(U!) <*> u <*> v ) <*> w ==++pW <*> ( p(.V)(U!) <*> u <*> v ) <*> w ==++p. <*> pW <*> ( p(.V)(U!) <*> u ) <*> v <*> w ==++p(.W) <*> (p(.V)(U!) <*> u) <*> v <*> w ==++p. <*> p(.W) <*> p(.V)(U!) <*> u <*> v <*> w ==++p.(.W)((.V)(U!)) <*> u <*> v <*> w ++```++Undoing the shorthand notation and simplifying:++```haskell++!  == (.) :< empty+U! == \(a :< m) -> (. a) :< fmap (fmap (.)) m+V  == \(f :< t) -> \(b :< n) -> (f b) :< (fmap (fmap f) n <|> +                                          fmap (<*> C v) t)+++. V (U!) == \(a :< m) -> V ((. a) :< fmap (fmap (.)) m) ==+         == \(a :< m) -> \(b :< n) ->+	          (a . b) :< (fmap (fmap (. a) n) <|>+                         fmap (<*> C v) ( fmap (fmap (.)) m)++W  == \(f :< t) -> \(c :< p) ->+          (f c) :< (fmap (fmap f) p <|> fmap (<*> C w) t)++.W == \g -> (\x -> W (g x))+++   .(.W)(.V(U!))++== \s -> (.W)((.V(U!)) s) ==++== \a :< m -> (.W) ((.V(U!)) a :< m) ==++== \a :< m -> (.W) (\(b :< n) ->+                       (a . b) :< (fmap (fmap (. a) n) <|>+                                   fmap (<*> C v) ( fmap (fmap (.)) m))) ==++== \a :< m -> \b :< n ->+               W ( (a . b) :< (fmap (fmap (. a) n) <|>+                               fmap (<*> C v) ( fmap (fmap (.)) m))) ==++== \a :< m -> \b :< n -> c :< p ->+   (a (b c)) :< (fmap (fmap (a . b)) p <|>+                 fmap (<*> C w)+		        ((fmap (fmap (. a) n) <|>+                     fmap (<*> C v) (fmap (fmap (.)) m)))) ==++== \a :< m -> \b :< n -> c :< p ->+   (a (b c)) :< (fmap (fmap (a . b)) p <|>+                 fmap (<*> C w) (fmap (fmap (. a)) n) <|>+                 fmap (<*> C w) (fmap (<*> C v) ( fmap (fmap (.)) m))) ==++== \a :< m -> \b :< n -> c :< p ->+   (a (b c)) :< (fmap (fmap (a . b)) p <|>+                 fmap (\x -> pure (.) <*> pure a <*> x <*> C w) n) <|>+                 fmap (\x -> pure (.) <*> x    <*> C v <*> C w) m))) +```++### Lemma 2++We use the following shorthands to make reasoning more readable.++```+W               ≡ star(C w)+Y               ≡ star(C v <*> C w)+p               ≡ pure+<concatenation> ≡ function application +.               ≡ (.)+$W              ≡ ($ star(C w))+```++By repeatedly applying composition law for w, we get:++```haskell+  +pY <*> u <*> (pW <*> v <*> w) ==++p. <*> (pY <*> u) <*> (pW <*> v) <*> w ==++p. <*> p. <*> pY <*> u <*> (pW <*> v) <*> w ==++p. <*> (p. <*> p. <*> pY <*> u) <*> pW <*> v <*> w ==++p. <*> (p..Y <*> u) <*> pW <*> v <*> w ==++p. <*> p. <*> p..Y <*> u <*> pW <*> v <*> w ==++p..(..Y) <*> u <*> pW <*> v <*> w ==++p($W) <*> (p..(..Y) <*> u) <*> v <*> w ==++p.($W)(..(..Y)) <*> u <*> v <*> w+++(.)  == \f -> \g -> \x -> f (g x)++($W) == \g -> g W++($W) . (..(..Y)) == \s -> (\g -> g W) ((..(..Y)) s)+                 == \s -> (..(..Y)) s W++(. . (..Y)) == (\s -> . ((..Y) s))++∴ ($W) . (..(..Y)) == \s -> ((..Y) s) . W++(..Y) == (\y -> (.) (Y y))++∴ ($W) . (..(..Y)) ==  \s -> ((.) (Y s)) . W++                   ==  \s -> \t -> ((.) (Y s)) (W t)+                   +                   ==  \s -> \t -> (Y s) . (W t)++                   ==  \s -> \t -> u -> (Y s (W t u))+```++Undoing shorthands and α-converting, we get:++```haskell+.($W)(..(..Y)) ==++\a :< m -> b :< n -> c :< p -> (Y (a :< m) (W (b :<n) (c :< p))) ==++\a :< m -> b :< n -> c :< p ->+   (Y (a :< m) (b c :< (fmap (fmap b) p) <|>+                       (fmap (<*> C w) n)))     ==++\a :< m -> b :< n -> c :< p ->+   (Y (a :< m) (b c :< (fmap (fmap b) p) <|>+                       (fmap (<*> C w) n)))     ==++\a :< m -> b :< n -> c :< p ->+   (a (b c) :< (fmap (fmap a) ((fmap (fmap b) p) <|>+	                              (fmap (<*> C w) n)))+               <|>+               (fmap (<*> (C v <*> C w)) m))+               +== {- fmap distributes over <|>, fmap respects composition -}+               +\a :< m -> b :< n -> c :< p ->+   (a (b c) :< (fmap (fmap (a . b)) p) <|>+               (fmap ((fmap a) . (<*> C w)) n) <|>+               (fmap (<*> (C v <*> C w)) m))  ++== ++\a :< m -> b :< n -> c :< p ->+   (a (b c) :< (fmap (fmap (a . b)) p) <|>+               (fmap (\x -> pure a <*> (x <*> C w)) n) <|>+               (fmap (\x -> x<*> (C v <*> C w))    m) )  +```++## Homomorphism++```haskell++  pure f <*> pure x++== {- definition of <*> -}++  C $+    ( \(f :< t) -> +      \(a)      ->  +      let (b :< n) = bimap f (fmap f) a in +      b :< (n <|> fmap (<*> pure x) t)) <$>+        pure (f :< empty) <*> pure (x :< empty)++== {- homomorphism law for w, twice -}++  C $ pure $+      let (b :< n) = bimap f (fmap f) (x :< empty) in +      b :< (n <|> fmap (<*> pure x) empty)) ++== {- bimap -}++  C $ pure $+      let (b :< n) = (f x :< (fmap f empty)) in +      b :< (n <|> fmap (<*> pure x) empty)) ++== {- empty invariant under fmap -}+  +  C $ pure $ (f x) :< (empty <|> empty) ++== {- definition -}++  pure (f x)++```++## Interchange++```haskell++   u <*> pure y++== {- definition of <*>, pure -}++   C $     +     ( \(f :< t) ->+       \(a)      ->                                 +       let (b :< n) = bimap f (fmap f) a in+       b :< (n <|> fmap (<*> (pure y)) t)) <$> u <*> (pure (y :< empty))++== {- interchange law for w -}++   C $+      pure ($ y :< empty) <*>+      (pure+        ( \(f :< t) ->+          \(a)      ->                                 +          let (b :< n) = bimap f (fmap f) a in+          b :< (n <|> fmap (<*> (pure y)) t))) <*> u)++== {- composition -}++   C $+      pure (.) <*>+      pure ($ y :< empty) <*>+      pure+         ( \(f :< t) ->+           \(a)      ->                                 +           let (b :< n) = bimap f (fmap f) a in+           b :< (n <|> fmap (<*> (pure y)) t))++        <*> u)++== {- homomorphism -}++   C $+      pure (($ y :< empty) .) <*>+      pure+         ( \(f :< t) ->+           \(a)      ->                                 +           let (b :< n) = bimap f (fmap f) a in+           b :< (n <|> fmap (<*> (pure y)) t))++        <*> u)++== {- homomorphism -}++   C $+      pure (($ y :< empty) . +         ( \(f :< t) ->+           \(a)      ->                                 +           let (b :< n) = bimap f (fmap f) a in+           b :< (n <|> fmap (<*> (pure y)) t))+        <*> u)++== {- β-reduction -}++   C $+      pure (+         ( \(f :< t) ->+           let (b :< n) = bimap f (fmap f) (y :< empty) in+           b :< (n <|> fmap (<*> (pure y)) t))+        <*> u)++== {- bimap, β-reduction -}++   C $+      pure (+         ( \(f :< t) -> f y :< (empty <|> fmap (<*> (pure y)) t))+        <*> u)++== {- fmap -}++   C $ (\(f :< t) -> f y :< (fmap (<*> pure y) t)) <$> u   ++== {- coinduction (consume 1, produce 1) -}+   +   C $ (\(f :< t) -> f y :< (fmap ($ y) t)) <$> u+   +== {- def. $ -}++   C $ (\(f :< t) -> ($ y) f :< (fmap ($ y) t)) <$> u++== {- def. bimap -}++    C $ bimap ($ y) (fmap ($ y)) <$> u++== {- β,η-expansion -}++    C $     +     ( +       \(a)      ->                                 +       let (b :< n) = bimap ($ y) (fmap ($ y)) a in+       b :< n) <$> u++== {- empty inviariant under fmap -}++    C $     +     ( +       \(a)      ->                                 +       let (b :< n) = bimap ($ y) (fmap ($ y)) a in+       b :< (n <|> fmap (<*> u) empty)) <$> u++== {- fmap over pure -} ++   C $     +     ( \(f :< t) ->+       \(a)      ->                                 +       let (b :< n) = bimap f (fmap f) a in+       b :< (n <|> fmap (<*> u) t)) <$> (pure (($ y) :< empty)) <*> u++== {- definition -}++pure ($ y) <*> u+```++## Consistency with Monad definition++```haskell+instance (Alternative f, Monad w) => Monad (CofreeT f w) where+  return = CofreeT . return . (:< empty)+  (CofreeT cx) >>= f = CofreeT $ do+    (a :< m) <- cx+    (b :< n) <- runCofreeT $ f a+    return $ b :< (n <|> fmap (>>= f) m)+```++If w is also a monad, then ```(<*>) == ap```.+ +The proof uses coinduction for the case “produce one, consume one”.+ +_Remark:_ If ```g = (\f -> (CofreeT wa) >>= (\a -> return $ f a))```, then+        ```(`ap` a) == (>>= g)```.++```haskell++(C wf) `ap` (C wa)++== {- definition -}++(C wf) >>= (\f -> (C wa) >>= (\a -> f a))++== {- definition -}++                                  wf >>= \(f :< t) ->+ unC (C wa >>= (\a -> return $ f a)) >>= \(b :< n) ->+                              return $ b :< (n <|> fmap (>>= g) t)++== {- coinductive step -}++                                  wf >>= \(f :< t) ->+ unC (C wa >>= (\a -> return $ f a)) >>= \(b :< n) ->+                              return $ b :< (n <|> fmap (<*> C wa) t)+== {- definition of fmap for monads -}+++                                  wf >>= \(f :< t) ->+                 unC (fmap f (C wa)) >>= \(b :< n) ->+                              return $ b :< (n <|> fmap (<*> C wa) t)++== {- definition of fmap for C -}++                                            wf >>= \(f :< t) ->+                    fmap (bimap f (fmap f)) wa >>= \(b :< n) ->+                              return $ b :< (n <|> fmap (<*> C wa) t)+      +== {- definition of fmap for monads -}++                                            wf >>= \(f :< t) ->+   (wa >>= (\a -> return (bimap f (fmap f) a)  >>= \(b :< n) ->+                              return $ b :< (n <|> fmap (<*> C wa) t)++== {- associativity of monads -}++                                  wf >>= \(f :< t) ->+                                  wa >>= \a        ->+       (return (bimap f (fmap f a))) >>= \(b :< n) -> +                          return $ b :< (n <|> fmap (<*> a) m)++== {- Left identity of monads -}++                                  wf >>= \(f :< t) ->+                                  wa >>= \(a       ->+                          let b :< n = bimap f (fmap f a)) in+                          return $ b :< (n <|> fmap (<*> a) m))++== {- Equivalence of (>>=) and (<*>) for monad w. -}++                                         \(f :< t) ->+                                         \(a       ->+                          let b :< n = bimap f (fmap f a)) in+                          return $ b :< (n <|> fmap (<*> a) m)))++== {- definition of (<*>) -}++(CofreeT wf) <*> (CofreeT wa)++```+ +

@@ -1,200 +1,200 @@-Monad instance for CofreeT
-==========================
-
-If the underlying functor f is an instance of Alternative, then CofreeT is also
-a Monad.
-
-Note that the only required properties of Alternative are associativity and
-identity element, so one could also use functors that are instances of Plus
-(semigroupoid package).
-
-```haskell
-instance (Alternative f, Monad w) => Monad (CofreeT f w) where
-  return = CofreeT . return . (:< empty)
-  (CofreeT cx) >>= f = CofreeT $ do
-    (a :< m) <- cx
-    (b :< n) <- runCofreeT $ f a
-    return $ b :< (n <|> fmap (>>= f) m)
-```
-
-This definition is equivalent to that of the Cofree module if 'w' is
-identity. 
-
-The tokens `CofreeT` and `runCofreeT` are abbreviated as `C` and `unC`, 
-respectively, for readability.
-
-## Left identity
-
-```haskell
-return x >>= f
-
-== {- definition of return -}
-
-C (return (x :< empty)) >>= f
-
-== {- definition of bind -}
-
-C $ (return (x :< empty)) >>= (\a :< m ->
-                unC (f a) >>= (\b :< n ->
-                return $ b :< (n <|> fmap (>>= f) m)
-
-== {- Left identity for 'w' -}
-
-            C $ unC (f x) >>= (\b :< n ->
-                return $ b :< (n <|> fmap (>>= f) empty)
-
-== {- fmap over empty -}
-
-            C $ unC (f x) >>= (\b :< n ->
-                return $ b :< (n <|> fmap (>>= f) empty)
-
-== {- empty is identity for <|> -} == 
-
-            C $ unC (f x) >>= (\b :< n ->
-                return $ b :< n
-  
-== {- η-reduction, right identity for w -}
-
-            C $ unC (f x)
-==
-
-f x
-```
-
-## Right identity 
-
-```haskell
-
-  (C wx) >>= return
-
-== {- definition of return -}
-
-  (C wx) >>= (\x -> C $ return $ (x :< empty))
-
-== {- definition of bind -}
-
-  C $ wx >>= (\a :< m -> unC (C $ return $ a :< empty)
-         >>= (\b :< n -> return $ b :< (n <|> fmap (>>= return) m)
-
-== {- coinduction (“produce 1, consume 1”) -}
-
-  C $ wx >>= (\a :< m -> unC (C $ return $ a :< empty)
-         >>= (\b :< n -> return $ b :< (n <|> fmap id m)
-
-== {- fmap id == id -}
-
-  C $                            wx >>= (\a :< m ->
-      unC (C $ return $ a :< empty) >>= (\b :< n ->
-                           return $ b :< (n <|> m)
-
-== {- unC . C == id, left identity for w -}
-
-  C $ wx >>= (\a :< m ->
-      let b :< n = a :< empty in
-      return $ b :< (n <|> m)
-
-== {- β-equivalence -}
-
-  C $ wx >>= (\a :< m -> return $ a :< (empty <|> m))
-
-== {- empty is identity for <|> -}
-
-  C $ wx >>= (\a :< m -> return $ a :< m))
-
-== {- right identity for w -}
-
-  C wx
-```
-
-## Associativity
-
-```haskell
-  (C wa  >>= g) >>= h
-  
-== {- definition -}
-  
-  C $ do
-        unC (C wa >>= g) >>= \(c :< o) ->
-         unC $ h c       >>= \(d :< p) _>
-         return $ d :< (p <|> fmap (>>= h) o)
-  
-== {- definition -}
-  
-  C $ do
-       (wa             >>=   \(a :< m) ->
-        unC (g a)        >>= \(b :< n) ->
-        return $ b :< (m <|> fmap (>>= g) n)
-                       ) >>= \(c :< o) ->
-         unC $ h c       >>= \(d :< p) _>
-         return $ d :< (p <|> fmap (>>= h) o)
-  
-== {- associativity of 'w' -}
-  
-  C $ do
-                                     wa  >>= \(a :< m) ->
-                               unC (g a) >>= \(b :< n) ->
-   return $ b :< (m <|> fmap (>>= g) m)  >>= \(c :< o) ->
-                         unC $ h c       >>= \(d :< p) _>
-         return $ d :< (p <|> fmap (>>= h) o)
-  
-== {- left identity -}
-  C $ do
-                                     wa  >>= \(a :< m) ->
-                               unC (g a) >>= \(b :< n) ->
-                               unC (h b) >>= \(d :< p) _>
-         return $ d :< (p <|> fmap (>>= h) (n <|> fmap (>>= g) m))
-  
-== {- fmap distributes over (<|>), <|> is associative -}
-  
-  C $ do
-              wa     >>= \(a :< m) ->
-       unC (g a)     >>= \(b :< n) ->
-       unC (h b)     >>= \(d :< p) 
-    return $ d :< (p <|> (fmap (>>= h) n) <|> fmap (>>= h) (fmap (>>= g)  m))
-  
-== {- ∀f ∀g . fmap (f . g) == fmap f . fmap g -}
-  C $ do
-              wa     >>= \(a :< m) ->
-       unC (g a)     >>= \(b :< n) ->
-       unC (h b)     >>= \(d :< p) 
-    return $ d :< (p <|> (fmap (>>= h) n) <|> fmap ((>>= h) . (>>= g))  m)
-  
-== {- coinduction -}
-   
-  C $ do
-              wa     >>= \(a :< m) ->
-       unC (g a)     >>= \(b :< n) ->
-       unC (h b)     >>= \(d :< p) 
-    return $ d :< (p <|> (fmap (>>= h) n) <|> fmap (>>= (\x -> g x >>= h)) m)
-  
-== {- associativity of <|> -}
-  
-  c $ do
-              wa     >>= \(a :< m) ->
-       unC (g a)     >>= \(b :< n) ->
-       unC (h b)     >>= \(d :< p) 
-    return $ d :< ((p <|> fmap (>>=h) n) <|> fmap (>>= (\x -> g x >>= h)) m
-  
-== {- associativity, right identity for monads -}
-  c $ do
-              (wa    >>= \(a :< m) ->
-       unC (g a)     >>= \(b :< n) ->
-       unC (h b)     >>= \(d :< p) 
-       return (d :< (p <|> (fmap >>= h) n))) >>= \(c :< o) ->
-    return $ c :< (o <|> fmap (>>= (\x -> g x >>= h)) m
-	
-== {- definition of bind -}
-
-  C $ do
-         wa          >>= \(a :< m) ->
-    unC (g a >>= h)  >>= \(c :< o) ->
-    return $ c :< (o <|> fmap (>>= (\x -> g x >>= h)) m)
-	
-== {- definition of bind -}
-
-  (C wa) >>= (\x -> g x >>= h)
-```
-
-## Consistency with Applicative definition
-
-See [proof for applicative instance](instance-Applicative-CofreeT.md#consistency-with-monad-definition).
+Monad instance for CofreeT+==========================++If the underlying functor f is an instance of Alternative, then CofreeT is also+a Monad.++Note that the only required properties of Alternative are associativity and+identity element, so one could also use functors that are instances of Plus+(semigroupoid package).++```haskell+instance (Alternative f, Monad w) => Monad (CofreeT f w) where+  return = CofreeT . return . (:< empty)+  (CofreeT cx) >>= f = CofreeT $ do+    (a :< m) <- cx+    (b :< n) <- runCofreeT $ f a+    return $ b :< (n <|> fmap (>>= f) m)+```++This definition is equivalent to that of the Cofree module if 'w' is+identity. ++The tokens `CofreeT` and `runCofreeT` are abbreviated as `C` and `unC`, +respectively, for readability.++## Left identity++```haskell+return x >>= f++== {- definition of return -}++C (return (x :< empty)) >>= f++== {- definition of bind -}++C $ (return (x :< empty)) >>= (\a :< m ->+                unC (f a) >>= (\b :< n ->+                return $ b :< (n <|> fmap (>>= f) m)++== {- Left identity for 'w' -}++            C $ unC (f x) >>= (\b :< n ->+                return $ b :< (n <|> fmap (>>= f) empty)++== {- fmap over empty -}++            C $ unC (f x) >>= (\b :< n ->+                return $ b :< (n <|> fmap (>>= f) empty)++== {- empty is identity for <|> -} == ++            C $ unC (f x) >>= (\b :< n ->+                return $ b :< n+  +== {- η-reduction, right identity for w -}++            C $ unC (f x)+==++f x+```++## Right identity ++```haskell++  (C wx) >>= return++== {- definition of return -}++  (C wx) >>= (\x -> C $ return $ (x :< empty))++== {- definition of bind -}++  C $ wx >>= (\a :< m -> unC (C $ return $ a :< empty)+         >>= (\b :< n -> return $ b :< (n <|> fmap (>>= return) m)++== {- coinduction (“produce 1, consume 1”) -}++  C $ wx >>= (\a :< m -> unC (C $ return $ a :< empty)+         >>= (\b :< n -> return $ b :< (n <|> fmap id m)++== {- fmap id == id -}++  C $                            wx >>= (\a :< m ->+      unC (C $ return $ a :< empty) >>= (\b :< n ->+                           return $ b :< (n <|> m)++== {- unC . C == id, left identity for w -}++  C $ wx >>= (\a :< m ->+      let b :< n = a :< empty in+      return $ b :< (n <|> m)++== {- β-equivalence -}++  C $ wx >>= (\a :< m -> return $ a :< (empty <|> m))++== {- empty is identity for <|> -}++  C $ wx >>= (\a :< m -> return $ a :< m))++== {- right identity for w -}++  C wx+```++## Associativity++```haskell+  (C wa  >>= g) >>= h+  +== {- definition -}+  +  C $ do+        unC (C wa >>= g) >>= \(c :< o) ->+         unC $ h c       >>= \(d :< p) _>+         return $ d :< (p <|> fmap (>>= h) o)+  +== {- definition -}+  +  C $ do+       (wa             >>=   \(a :< m) ->+        unC (g a)        >>= \(b :< n) ->+        return $ b :< (m <|> fmap (>>= g) n)+                       ) >>= \(c :< o) ->+         unC $ h c       >>= \(d :< p) _>+         return $ d :< (p <|> fmap (>>= h) o)+  +== {- associativity of 'w' -}+  +  C $ do+                                     wa  >>= \(a :< m) ->+                               unC (g a) >>= \(b :< n) ->+   return $ b :< (m <|> fmap (>>= g) m)  >>= \(c :< o) ->+                         unC $ h c       >>= \(d :< p) _>+         return $ d :< (p <|> fmap (>>= h) o)+  +== {- left identity -}+  C $ do+                                     wa  >>= \(a :< m) ->+                               unC (g a) >>= \(b :< n) ->+                               unC (h b) >>= \(d :< p) _>+         return $ d :< (p <|> fmap (>>= h) (n <|> fmap (>>= g) m))+  +== {- fmap distributes over (<|>), <|> is associative -}+  +  C $ do+              wa     >>= \(a :< m) ->+       unC (g a)     >>= \(b :< n) ->+       unC (h b)     >>= \(d :< p) +    return $ d :< (p <|> (fmap (>>= h) n) <|> fmap (>>= h) (fmap (>>= g)  m))+  +== {- ∀f ∀g . fmap (f . g) == fmap f . fmap g -}+  C $ do+              wa     >>= \(a :< m) ->+       unC (g a)     >>= \(b :< n) ->+       unC (h b)     >>= \(d :< p) +    return $ d :< (p <|> (fmap (>>= h) n) <|> fmap ((>>= h) . (>>= g))  m)+  +== {- coinduction -}+   +  C $ do+              wa     >>= \(a :< m) ->+       unC (g a)     >>= \(b :< n) ->+       unC (h b)     >>= \(d :< p) +    return $ d :< (p <|> (fmap (>>= h) n) <|> fmap (>>= (\x -> g x >>= h)) m)+  +== {- associativity of <|> -}+  +  c $ do+              wa     >>= \(a :< m) ->+       unC (g a)     >>= \(b :< n) ->+       unC (h b)     >>= \(d :< p) +    return $ d :< ((p <|> fmap (>>=h) n) <|> fmap (>>= (\x -> g x >>= h)) m+  +== {- associativity, right identity for monads -}+  c $ do+              (wa    >>= \(a :< m) ->+       unC (g a)     >>= \(b :< n) ->+       unC (h b)     >>= \(d :< p) +       return (d :< (p <|> (fmap >>= h) n))) >>= \(c :< o) ->+    return $ c :< (o <|> fmap (>>= (\x -> g x >>= h)) m+	+== {- definition of bind -}++  C $ do+         wa          >>= \(a :< m) ->+    unC (g a >>= h)  >>= \(c :< o) ->+    return $ c :< (o <|> fmap (>>= (\x -> g x >>= h)) m)+	+== {- definition of bind -}++  (C wa) >>= (\x -> g x >>= h)+```++## Consistency with Applicative definition++See [proof for applicative instance](instance-Applicative-CofreeT.md#consistency-with-monad-definition).

@@ -1,88 +1,88 @@-MonadTrans instance for CofreeT
-===============================
-
-If the ```Functor f``` is an instance of ```Plus``` (or of ```Alternative```)
-then CofreeT is a monad transformer.
-
-## Lift `return`
-
-```haskell
-lift (return x)
-
-== {- definition lift -}
-
-C $ (liftM (:< empty) (return x))
-
-== {- definition liftM -}
-
-C $ (return x) >>= (\a -> return $ a :< empty)
-
-== {- monad left identity -}
-
-C $ return $ x :< empty
-
-== {- definition -}
-
-return x
-```
-
-## Lift distributes over `bind`
-
-```haskell
-lift (m >>= f)
-
-== {- definition lift -}
-
-C $ (liftM (:< empty) (m >>= f))
-
-== {- definition liftM -}
-
-C $ (m >>= f) >>= (\a -> return $ a :< empty)
-
-== {- α-equivalence  -}
-
-C $ m >>= f >>= (\b -> return $ b :< empty)
-
-== {- η-equivalence  -}
-
-C $  m                     >>= \a ->
-     f a                   >>= \b ->
-     return $ b :< empty
-
-== {- empty invariant under fmap, empty identity  -}
-
-C $  m                     >>= \a ->
-     f a                   >>= \b ->
-     return $ b :< (empty <|> fmap (>>= …) empty)
-
-== {- left identity -}
-
-C $  m                     >>= \a ->
-     return (a :< empty)   >>= \a :< n ->
-     f a                   >>= \b ->
-     return (b :< empty)   >>= \b :< m ->
-     return $ b :< (n <|> fmap (>>= …) m)
-
-
-== {- associativity of >>= -}
-
-C $ (m >>= (\a -> return $ a :< empty)) >>= \a :< n ->
-    ((f a) >>= (\b -> return $ b :< empty)) >>= \b :< m ->
-    return $ b :< (n <|> fmap (>>= …) m)
-
-== {- pattern matching on CofreeF -}
-
-(C (m >>= (\a -> return $ a :< empty)) >>= (\x -> C ((f x) >>= (\b -> return b :< empty)))
-
-== {- definition lift -}
-
-(C (m >>= (\a -> return $ a :< empty)) >>= (\x -> lift (f x))
-
-== {- definition lift -}
-
-lift m >>= (lift . f)
-```
-
-
-
-
+MonadTrans instance for CofreeT+===============================++If the ```Functor f``` is an instance of ```Plus``` (or of ```Alternative```)+then CofreeT is a monad transformer.++## Lift `return`++```haskell+lift (return x)++== {- definition lift -}++C $ (liftM (:< empty) (return x))++== {- definition liftM -}++C $ (return x) >>= (\a -> return $ a :< empty)++== {- monad left identity -}++C $ return $ x :< empty++== {- definition -}++return x+```++## Lift distributes over `bind`++```haskell+lift (m >>= f)++== {- definition lift -}++C $ (liftM (:< empty) (m >>= f))++== {- definition liftM -}++C $ (m >>= f) >>= (\a -> return $ a :< empty)++== {- α-equivalence  -}++C $ m >>= f >>= (\b -> return $ b :< empty)++== {- η-equivalence  -}++C $  m                     >>= \a ->+     f a                   >>= \b ->+     return $ b :< empty++== {- empty invariant under fmap, empty identity  -}++C $  m                     >>= \a ->+     f a                   >>= \b ->+     return $ b :< (empty <|> fmap (>>= …) empty)++== {- left identity -}++C $  m                     >>= \a ->+     return (a :< empty)   >>= \a :< n ->+     f a                   >>= \b ->+     return (b :< empty)   >>= \b :< m ->+     return $ b :< (n <|> fmap (>>= …) m)+++== {- associativity of >>= -}++C $ (m >>= (\a -> return $ a :< empty)) >>= \a :< n ->+    ((f a) >>= (\b -> return $ b :< empty)) >>= \b :< m ->+    return $ b :< (n <|> fmap (>>= …) m)++== {- pattern matching on CofreeF -}++(C (m >>= (\a -> return $ a :< empty)) >>= (\x -> C ((f x) >>= (\b -> return b :< empty)))++== {- definition lift -}++(C (m >>= (\a -> return $ a :< empty)) >>= (\x -> lift (f x))++== {- definition lift -}++lift m >>= (lift . f)+```++++

@@ -1,448 +1,448 @@-MonadZip instance for CofreeT
-=============================
-
-For every monad `m` with a `MonadZip` instance and functor `f` with
-`Alternative` and `MonadZip` instances, `CofreeT f m` is an instance of
-`MonadZip`.
-
-```haskell
-instance (Alternative f, MonadZip f, MonadZip m) => MonadZip (CofreeT f m) where
-  mzip (CofreeT ma) (CofreeT mb) = CofreeT $ do
-    (a :< fa, b :< fb) <- mzip ma mb
-    return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-```
-
-This definition is equivalent to that of the `Cofree` module if `m` is
-chosen to be the `Identity` monad.
-
-The claim follows directly from the two lemmata below, which establish
-the `MonadZip` laws for naturality and information preservation
-respectively, and the [`Monad` instance theorem for
-`CofreeT`](instance-Monad-CofreeT.md).
-
-In the following, the tokens `CofreeT` and `runCofreeT` are abbreviated
-as `C` and `unC` respectively.
-
-## Naturality
-
-```haskell
-liftM (f *** g) (mzip ma mb) == mzip (liftM f ma) (liftM g mb)
-```
-
-### Proof.
-
-```haskell
-   liftM (f *** g) (mzip ma mb)
-
-== {- Definition of `liftM` -}
-
-   mzip ma mb >>= return . (f *** g)
-
-== {- Definition of `mzip` -}
-
-   C $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-   >>= return . (f *** g)
-
-== {- Definition of `(>>=)` -}
-
-   C $ do  c  :< m  <- do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-                           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-           d  :< n  <- unC $ return $ (f *** g) c
-           return $ d :< (n <|> fmap (>>= return . f *** g) m)
-
-== {- `Monad` law `m >>= (\x -> k x >>= h) == (m >>= k) >>= h` -}
-
-   C $ do  a  :< fa  <- unC ma
-           c  :< m   <- do  b :< fb <- unC mb
-                            return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-           d  :< n   <- unC $ return $ (f *** g) c
-           return $ d :< (n <|> fmap (>>= return . f *** g) m)
-
-== {- `Monad` law `m >>= (\x -> k x >>= h) == (m >>= k) >>= h` -}
-
-   C $ do  a  :< fa  <- unC ma
-           b  :< fb  <- unC mb
-           c  :< m   <- return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-           d  :< n   <- unC $ return $ (f *** g) c
-           return $ d :< (n <|> fmap (>>= return . f *** g) m)
-
-== {- `Monad` law `return a >>= k == k a` -}
-
-   C $ do  a  :< fa  <- unC ma
-           b  :< fb  <- unC mb
-           d  :< n   <- unC $ return $ (f *** g) (a, b)
-           return $ d :< (n <|> fmap (>>= return . f *** g) (uncurry mzip <$> mzip fa fb))
-
-== {- Definition of `return` -}
-
-   C $ do  a  :< fa  <- unC ma
-           b  :< fb  <- unC mb
-           d  :< n   <- unC $ C $ return $ (f *** g) (a, b) :< empty
-           return $ d :< (n <|> fmap (>>= return . f *** g) (uncurry mzip <$> mzip fa fb))
-
-== {- Unpack -}
-
-   C $ do  a  :< fa  <- unC ma
-           b  :< fb  <- unC mb
-           d  :< n   <- return $ (f *** g) (a, b) :< empty
-           return $ d :< (n <|> fmap (>>= return . f *** g) (uncurry mzip <$> mzip fa fb))
-
-== {- `Monad` law `return a >>= k == k a` -}
-
-   C $ do  a  :< fa  <- unC ma
-           b  :< fb  <- unC mb
-           return $ (f *** g) (a, b) :< (empty <|> fmap (>>= return . f *** g) (uncurry mzip <$> mzip fa fb))
-
-== {- Identity of `<|>` -}
-
-   C $ do  a  :< fa  <- unC ma
-           b  :< fb  <- unC mb
-           return $ (f *** g) (a, b) :< fmap (>>= return . f *** g) (uncurry mzip <$> mzip fa fb)
-
-== {- Definition of `liftM` -}
-
-   C $ do  a  :< fa  <- unC ma
-           b  :< fb  <- unC mb
-           return $ (f *** g) (a, b) :< fmap (liftM (f *** g)) (uncurry mzip <$> mzip fa fb)
-
-== {- Definition of `<$>` -}
-
-   C $ do  a  :< fa  <- unC ma
-           b  :< fb  <- unC mb
-           return $ (f *** g) (a, b) :< fmap (liftM (f *** g)) (fmap (uncurry mzip) $ mzip fa fb)
-
-== {- `Functor` composition -}
-
-   C $ do  a  :< fa  <- unC ma
-           b  :< fb  <- unC mb
-           return $ (f *** g) (a, b) :< fmap (liftM (f *** g) . uncurry mzip) $ mzip fa fb
-
-== {- Coinduction hypothesis -}
-
-   C $ do  a  :< fa  <- unC ma
-           b  :< fb  <- unC mb
-           return $ (f *** g) (a, b) :< fmap (uncurry mzip . liftM f *** liftM g) $ mzip fa fb
-
-== {- `Functor` composition -}
-
-   C $ do  c  :< m   <- unC ma
-           k  :< o   <- unC mb
-           return $ (f c, g k) :< fmap (uncurry mzip) $ fmap (liftM f *** liftM g) $ mzip m o
-
-== {- `MonadZip` naturality -}
-
-   C $ do  c  :< m   <- unC ma
-           k  :< o   <- unC mb
-           return $ (f c, g k) :< fmap (uncurry mzip) $ mzip (fmap (liftM f) m) (fmap (liftM g) o))
-
-== {- Definition of `<$>` -}
-
-   C $ do  c  :< m   <- unC ma
-           k  :< o   <- unC mb
-           return $ (f c, g k) :< (uncurry mzip <$> mzip (fmap (liftM f) m) (fmap (liftM g) o))
-
-== {- Definition of `liftM` -}
-
-   C $ do  c  :< m   <- unC ma
-           k  :< o   <- unC mb
-           return $ (f c, g k) :< (uncurry mzip <$> mzip (fmap (>>= return . f) m) (fmap (>>= return . g) o))
-
-== {- `Monad` law `return a >>= k == k a` -}
-
-   C $ do  c  :< m   <- unC ma
-           a  :< fa  <- return $ f c :< fmap (>>= return . f) m
-           k  :< o   <- unC mb
-           b  :< fb  <- return $ g k :< fmap (>>= return . g) o
-           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-
-== {- `Alternative` identity -}
-
-   C $ do  c  :< m   <- unC ma
-           a  :< fa  <- return $ f c :< (empty <|> fmap (>>= return . f) m)
-           k  :< o   <- unC mb
-           b  :< fb  <- return $ g k :< (empty <|> fmap (>>= return . g) o)
-           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-
-== {- `Monad` law `return a >>= k == k a` -}
-
-   C $ do  c  :< m   <- unC ma
-           d  :< n   <- return $ f c :< empty
-           a  :< fa  <- return $ d :< (n <|> fmap (>>= return . f) m)
-           k  :< o   <- unC mb
-           l  :< p   <- return $ g k :< empty
-           b  :< fb  <- return $ l :< (p <|> fmap (>>= return . g) o)
-           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-
-== {- Unpack -}
-
-   C $ do  c  :< m   <- unC ma
-           d  :< n   <- unC $ C $ return $ f c :< empty
-           a  :< fa  <- unC $ C $ return $ d :< (n <|> fmap (>>= return . f) m)
-           k  :< o   <- unC mb
-           l  :< p   <- unC $ C $ return $ g k :< empty
-           b  :< fb  <- unC $ C $ return $ l :< (p <|> fmap (>>= return . g) o)
-           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-
-== {- Definition of `return` -}
-
-   C $ do  c  :< m   <- unC ma
-           d  :< n   <- unC $ return $ f c
-           a  :< fa  <- unC $ C $ return $ d :< (n <|> fmap (>>= return . f) m)
-           k  :< o   <- unC mb
-           l  :< p   <- unC $ return $ g k
-           b  :< fb  <- unC $ C $ return $ l :< (p <|> fmap (>>= return . g) o)
-           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-
-== {- `Monad` law `m >>= (\x -> k x >>= h) == (m >>= k) >>= h` -}
-
-   C $ do  c  :< m   <- unC ma
-           a  :< fa  <- unC $ C $ do  d :< n <- unC $ return $ return $ f c
-                                      return $ d :< (n <|> fmap (>>= return . f) m)
-           k  :< o   <- unC mb
-           b  :< fb  <- unC $ C $ do  l :< p <- unC $ return $ return g k
-                                      return $ l :< (p <|> fmap (>>= return . g) o)
-           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-
-== {- `Monad` law `m >>= (\x -> k x >>= h) == (m >>= k) >>= h` -}
-
-   C $ do  a  :< fa  <- unC $ C $ do  c  :< m  <- unC ma
-                                      d  :< n  <- unC $ return $ f c
-                                      return $ d :< (n <|> fmap (>>= return . f) m)
-           b  :< fb  <- unC $ C $ do  k  :< o  <- unC mb
-                                      l  :< p  <- unC $ return $ g k
-                                      return $ l :< (p <|> fmap (>>= return . g) o)
-           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-
-== {- Definition of `(>>=)` -}
-
-   C $ do  a  :< fa  <- unC $ ma >>= return . f
-           b  :< fb  <- unC $ mb >>= return . g
-           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-
-== {- Definition of `liftM` -}
-
-   C $ do  a  :< fa  <- unC $ liftM f ma
-           b  :< fb  <- unC $ liftM g mb
-           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)
-
-== {- Definition of `mzip` -}
-
-   mzip (liftM f ma) (liftM g mb)
-
-.
-```
-
-## Information Preservation
-
-```haskell
-liftM (const ()) ma == liftM (const ()) mb --> munzip (mzip ma mb) == (ma, mb)
-```
-
-### Proof.
-
-```haskell
-   munzip (mzip ma mb)
-
-== {- Definition of `munzip` -}
-
-   (,)
-   (liftM fst  $ mzip ma mb)
-   (liftM snd  $ mzip ma mb)
-
-== {- Definition of `mzip` -}
-
-   (,)
-   (liftM fst  $ C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-                          return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb)
-   (liftM snd  $ C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-                          return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb)
-
-== {- Definition of `liftM` -}
-
-   (,)
-   (C $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-            return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb
-    >>= return . fst)
-   (C $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-            return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb
-    >>= return . snd)
-
-== {- Definition of `(>>=)` -}
-
-   (,)
-   (C  $ do  c  :< fc  <- do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-                              return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb
-             d  :< fd  <- unC $ return $ fst c
-             return $ d :< $ fd <|> fmap (>>= return . fst) fc)
-   (C  $ do  c  :< fc  <- do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-                              return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb
-             d  :< fd  <- unC $ return $ snd c
-             return $ d :< $ fd <|> fmap (>>= return . snd) fc)
-
-== {- `Monad` law `m >>= (\x -> k x >>= h) == (m >>= k) >>= h` -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)
-             c  :< fc            <- return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb
-             d  :< fd            <- unC $ return $ fst c
-             return $ d :< $ fd <|> fmap (>>= return . fst) fc)
-   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)
-             c  :< fc            <- return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb
-             d  :< fd            <- unC $ return $ snd c
-             return $ d :< $ fd <|> fmap (>>= return . snd) fc)
-
-== {- `Monad` law `return a >>= k == k a` -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)
-             d  :< fd            <- unC $ return $ fst (a, b)
-             return $ d :< $ fd <|> fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)
-             d  :< fd            <- unC $ return $ snd (a, b)
-             return $ d :< $ fd <|> fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)
-
-== {- Definition of `return` -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)
-             d  :< fd            <- unC $ C $ return $ fst (a, b) :< empty
-             return $ d :< $ fd <|> fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)
-             d  :< fd            <- unC $ C $ return $ snd (a, b) :< empty
-             return $ d :< $ fd <|> fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)
-
-== {- Unpack -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)
-             d  :< fd            <- return $ fst (a, b) :< empty
-             return $ d :< $ fd <|> fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)
-             d  :< fd            <- return $ snd (a, b) :< empty
-             return $ d :< $ fd <|> fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)
-
-== {- `Monad` law `return a >>= k == k a` -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ fst (a, b) :< $ empty <|> fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ snd (a, b) :< $ empty <|> fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)
-
-== {- `Alternative` identity -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ fst (a, b) :< fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ snd (a, b) :< fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)
-
-== {- Definition of `fst` -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ a :< fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ b :< fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)
-
-== {- Definition of `liftM` -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ a :< fmap (liftM fst) $ fmap (uncurry mzip) $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ b :< fmap (liftM snd) $ fmap (uncurry mzip) $ mzip fa fb)
-
-== {- `Functor` composition -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ a :< fmap (liftM fst . uncurry mzip) $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ b :< fmap (liftM snd . uncurry mzip) $ mzip fa fb)
-
-== {- Definition of `unzip` -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ a :< fmap (fst . unzip . uncurry mzip) $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ b :< fmap (snd . unzip . uncurry mzip) $ mzip fa fb)
-
-== {- Coinduction hypothesis -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ a :< fmap fst $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ b :< fmap snd $ mzip fa fb)
-
-== {- `Monad` law `fmap f m == m >>= return . f` and definition of `liftM` -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ a :< liftM fst $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ b :< liftM snd $ mzip fa fb)
-
-== {- Definition of `unzip` -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ a :< fst $ unzip $ mzip fa fb)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ b :< snd $ unzip $ mzip fa fb)
-
-== {- `MonadZip` information preservation -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ a :< fst (fa, fb))
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ b :< snd (fa, fb))
-
-== {- Definition of `fst` and `snd` -}
-
-   (,)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ a :< fa)
-   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)
-             return $ b :< fb)
-
-== {- Definition of `fst` and `snd` -}
-
-   (,)
-   (C  $ mzip (unC ma) (unC mb)  >>= return . fst)
-   (C  $ mzip (unC ma) (unC mb)  >>= return . snd)
-
-== {- Definition of `liftM` -}
-
-   (,)
-   (C  $ liftM fst  $ mzip (unC ma) (unC mb))
-   (C  $ liftM snd  $ mzip (unC ma) (unC mb))
-
-== {- Definition of `unzip` -}
-
-   (,)
-   (C  $ fst  $ unzip  $ mzip (unC ma) (unC mb))
-   (C  $ snd  $ unzip  $ mzip (unC ma) (unC mb))
-
-== {- `MonadZip` information preservation -}
-
-   (,)
-   (C  $ fst  $ (unC ma, unC mb))
-   (C  $ snd  $ (unC ma, unC mb))
-
-== {- Definition of `fst` and `snd` -}
-
-   (,)
-   (C  $ unC ma)
-   (C  $ unC mb)
-
-== {- Pack -}
-
-   (ma, mb)
-
-.
-```
+MonadZip instance for CofreeT+=============================++For every monad `m` with a `MonadZip` instance and functor `f` with+`Alternative` and `MonadZip` instances, `CofreeT f m` is an instance of+`MonadZip`.++```haskell+instance (Alternative f, MonadZip f, MonadZip m) => MonadZip (CofreeT f m) where+  mzip (CofreeT ma) (CofreeT mb) = CofreeT $ do+    (a :< fa, b :< fb) <- mzip ma mb+    return $ (a, b) :< (uncurry mzip <$> mzip fa fb)+```++This definition is equivalent to that of the `Cofree` module if `m` is+chosen to be the `Identity` monad.++The claim follows directly from the two lemmata below, which establish+the `MonadZip` laws for naturality and information preservation+respectively, and the [`Monad` instance theorem for+`CofreeT`](instance-Monad-CofreeT.md).++In the following, the tokens `CofreeT` and `runCofreeT` are abbreviated+as `C` and `unC` respectively.++## Naturality++```haskell+liftM (f *** g) (mzip ma mb) == mzip (liftM f ma) (liftM g mb)+```++### Proof.++```haskell+   liftM (f *** g) (mzip ma mb)++== {- Definition of `liftM` -}++   mzip ma mb >>= return . (f *** g)++== {- Definition of `mzip` -}++   C $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)+   >>= return . (f *** g)++== {- Definition of `(>>=)` -}++   C $ do  c  :< m  <- do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+                           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)+           d  :< n  <- unC $ return $ (f *** g) c+           return $ d :< (n <|> fmap (>>= return . f *** g) m)++== {- `Monad` law `m >>= (\x -> k x >>= h) == (m >>= k) >>= h` -}++   C $ do  a  :< fa  <- unC ma+           c  :< m   <- do  b :< fb <- unC mb+                            return $ (a, b) :< (uncurry mzip <$> mzip fa fb)+           d  :< n   <- unC $ return $ (f *** g) c+           return $ d :< (n <|> fmap (>>= return . f *** g) m)++== {- `Monad` law `m >>= (\x -> k x >>= h) == (m >>= k) >>= h` -}++   C $ do  a  :< fa  <- unC ma+           b  :< fb  <- unC mb+           c  :< m   <- return $ (a, b) :< (uncurry mzip <$> mzip fa fb)+           d  :< n   <- unC $ return $ (f *** g) c+           return $ d :< (n <|> fmap (>>= return . f *** g) m)++== {- `Monad` law `return a >>= k == k a` -}++   C $ do  a  :< fa  <- unC ma+           b  :< fb  <- unC mb+           d  :< n   <- unC $ return $ (f *** g) (a, b)+           return $ d :< (n <|> fmap (>>= return . f *** g) (uncurry mzip <$> mzip fa fb))++== {- Definition of `return` -}++   C $ do  a  :< fa  <- unC ma+           b  :< fb  <- unC mb+           d  :< n   <- unC $ C $ return $ (f *** g) (a, b) :< empty+           return $ d :< (n <|> fmap (>>= return . f *** g) (uncurry mzip <$> mzip fa fb))++== {- Unpack -}++   C $ do  a  :< fa  <- unC ma+           b  :< fb  <- unC mb+           d  :< n   <- return $ (f *** g) (a, b) :< empty+           return $ d :< (n <|> fmap (>>= return . f *** g) (uncurry mzip <$> mzip fa fb))++== {- `Monad` law `return a >>= k == k a` -}++   C $ do  a  :< fa  <- unC ma+           b  :< fb  <- unC mb+           return $ (f *** g) (a, b) :< (empty <|> fmap (>>= return . f *** g) (uncurry mzip <$> mzip fa fb))++== {- Identity of `<|>` -}++   C $ do  a  :< fa  <- unC ma+           b  :< fb  <- unC mb+           return $ (f *** g) (a, b) :< fmap (>>= return . f *** g) (uncurry mzip <$> mzip fa fb)++== {- Definition of `liftM` -}++   C $ do  a  :< fa  <- unC ma+           b  :< fb  <- unC mb+           return $ (f *** g) (a, b) :< fmap (liftM (f *** g)) (uncurry mzip <$> mzip fa fb)++== {- Definition of `<$>` -}++   C $ do  a  :< fa  <- unC ma+           b  :< fb  <- unC mb+           return $ (f *** g) (a, b) :< fmap (liftM (f *** g)) (fmap (uncurry mzip) $ mzip fa fb)++== {- `Functor` composition -}++   C $ do  a  :< fa  <- unC ma+           b  :< fb  <- unC mb+           return $ (f *** g) (a, b) :< fmap (liftM (f *** g) . uncurry mzip) $ mzip fa fb++== {- Coinduction hypothesis -}++   C $ do  a  :< fa  <- unC ma+           b  :< fb  <- unC mb+           return $ (f *** g) (a, b) :< fmap (uncurry mzip . liftM f *** liftM g) $ mzip fa fb++== {- `Functor` composition -}++   C $ do  c  :< m   <- unC ma+           k  :< o   <- unC mb+           return $ (f c, g k) :< fmap (uncurry mzip) $ fmap (liftM f *** liftM g) $ mzip m o++== {- `MonadZip` naturality -}++   C $ do  c  :< m   <- unC ma+           k  :< o   <- unC mb+           return $ (f c, g k) :< fmap (uncurry mzip) $ mzip (fmap (liftM f) m) (fmap (liftM g) o))++== {- Definition of `<$>` -}++   C $ do  c  :< m   <- unC ma+           k  :< o   <- unC mb+           return $ (f c, g k) :< (uncurry mzip <$> mzip (fmap (liftM f) m) (fmap (liftM g) o))++== {- Definition of `liftM` -}++   C $ do  c  :< m   <- unC ma+           k  :< o   <- unC mb+           return $ (f c, g k) :< (uncurry mzip <$> mzip (fmap (>>= return . f) m) (fmap (>>= return . g) o))++== {- `Monad` law `return a >>= k == k a` -}++   C $ do  c  :< m   <- unC ma+           a  :< fa  <- return $ f c :< fmap (>>= return . f) m+           k  :< o   <- unC mb+           b  :< fb  <- return $ g k :< fmap (>>= return . g) o+           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)++== {- `Alternative` identity -}++   C $ do  c  :< m   <- unC ma+           a  :< fa  <- return $ f c :< (empty <|> fmap (>>= return . f) m)+           k  :< o   <- unC mb+           b  :< fb  <- return $ g k :< (empty <|> fmap (>>= return . g) o)+           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)++== {- `Monad` law `return a >>= k == k a` -}++   C $ do  c  :< m   <- unC ma+           d  :< n   <- return $ f c :< empty+           a  :< fa  <- return $ d :< (n <|> fmap (>>= return . f) m)+           k  :< o   <- unC mb+           l  :< p   <- return $ g k :< empty+           b  :< fb  <- return $ l :< (p <|> fmap (>>= return . g) o)+           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)++== {- Unpack -}++   C $ do  c  :< m   <- unC ma+           d  :< n   <- unC $ C $ return $ f c :< empty+           a  :< fa  <- unC $ C $ return $ d :< (n <|> fmap (>>= return . f) m)+           k  :< o   <- unC mb+           l  :< p   <- unC $ C $ return $ g k :< empty+           b  :< fb  <- unC $ C $ return $ l :< (p <|> fmap (>>= return . g) o)+           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)++== {- Definition of `return` -}++   C $ do  c  :< m   <- unC ma+           d  :< n   <- unC $ return $ f c+           a  :< fa  <- unC $ C $ return $ d :< (n <|> fmap (>>= return . f) m)+           k  :< o   <- unC mb+           l  :< p   <- unC $ return $ g k+           b  :< fb  <- unC $ C $ return $ l :< (p <|> fmap (>>= return . g) o)+           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)++== {- `Monad` law `m >>= (\x -> k x >>= h) == (m >>= k) >>= h` -}++   C $ do  c  :< m   <- unC ma+           a  :< fa  <- unC $ C $ do  d :< n <- unC $ return $ return $ f c+                                      return $ d :< (n <|> fmap (>>= return . f) m)+           k  :< o   <- unC mb+           b  :< fb  <- unC $ C $ do  l :< p <- unC $ return $ return g k+                                      return $ l :< (p <|> fmap (>>= return . g) o)+           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)++== {- `Monad` law `m >>= (\x -> k x >>= h) == (m >>= k) >>= h` -}++   C $ do  a  :< fa  <- unC $ C $ do  c  :< m  <- unC ma+                                      d  :< n  <- unC $ return $ f c+                                      return $ d :< (n <|> fmap (>>= return . f) m)+           b  :< fb  <- unC $ C $ do  k  :< o  <- unC mb+                                      l  :< p  <- unC $ return $ g k+                                      return $ l :< (p <|> fmap (>>= return . g) o)+           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)++== {- Definition of `(>>=)` -}++   C $ do  a  :< fa  <- unC $ ma >>= return . f+           b  :< fb  <- unC $ mb >>= return . g+           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)++== {- Definition of `liftM` -}++   C $ do  a  :< fa  <- unC $ liftM f ma+           b  :< fb  <- unC $ liftM g mb+           return $ (a, b) :< (uncurry mzip <$> mzip fa fb)++== {- Definition of `mzip` -}++   mzip (liftM f ma) (liftM g mb)++.+```++## Information Preservation++```haskell+liftM (const ()) ma == liftM (const ()) mb --> munzip (mzip ma mb) == (ma, mb)+```++### Proof.++```haskell+   munzip (mzip ma mb)++== {- Definition of `munzip` -}++   (,)+   (liftM fst  $ mzip ma mb)+   (liftM snd  $ mzip ma mb)++== {- Definition of `mzip` -}++   (,)+   (liftM fst  $ C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+                          return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb)+   (liftM snd  $ C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+                          return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb)++== {- Definition of `liftM` -}++   (,)+   (C $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+            return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb+    >>= return . fst)+   (C $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+            return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb+    >>= return . snd)++== {- Definition of `(>>=)` -}++   (,)+   (C  $ do  c  :< fc  <- do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+                              return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb+             d  :< fd  <- unC $ return $ fst c+             return $ d :< $ fd <|> fmap (>>= return . fst) fc)+   (C  $ do  c  :< fc  <- do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+                              return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb+             d  :< fd  <- unC $ return $ snd c+             return $ d :< $ fd <|> fmap (>>= return . snd) fc)++== {- `Monad` law `m >>= (\x -> k x >>= h) == (m >>= k) >>= h` -}++   (,)+   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)+             c  :< fc            <- return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb+             d  :< fd            <- unC $ return $ fst c+             return $ d :< $ fd <|> fmap (>>= return . fst) fc)+   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)+             c  :< fc            <- return $ (a, b) :< fmap (uncurry mzip) $ mzip fa fb+             d  :< fd            <- unC $ return $ snd c+             return $ d :< $ fd <|> fmap (>>= return . snd) fc)++== {- `Monad` law `return a >>= k == k a` -}++   (,)+   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)+             d  :< fd            <- unC $ return $ fst (a, b)+             return $ d :< $ fd <|> fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)+             d  :< fd            <- unC $ return $ snd (a, b)+             return $ d :< $ fd <|> fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)++== {- Definition of `return` -}++   (,)+   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)+             d  :< fd            <- unC $ C $ return $ fst (a, b) :< empty+             return $ d :< $ fd <|> fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)+             d  :< fd            <- unC $ C $ return $ snd (a, b) :< empty+             return $ d :< $ fd <|> fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)++== {- Unpack -}++   (,)+   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)+             d  :< fd            <- return $ fst (a, b) :< empty+             return $ d :< $ fd <|> fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb)  <- mzip (unC ma) (unC mb)+             d  :< fd            <- return $ snd (a, b) :< empty+             return $ d :< $ fd <|> fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)++== {- `Monad` law `return a >>= k == k a` -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ fst (a, b) :< $ empty <|> fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ snd (a, b) :< $ empty <|> fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)++== {- `Alternative` identity -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ fst (a, b) :< fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ snd (a, b) :< fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)++== {- Definition of `fst` -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ a :< fmap (>>= return . fst) $ fmap (uncurry mzip) $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ b :< fmap (>>= return . snd) $ fmap (uncurry mzip) $ mzip fa fb)++== {- Definition of `liftM` -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ a :< fmap (liftM fst) $ fmap (uncurry mzip) $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ b :< fmap (liftM snd) $ fmap (uncurry mzip) $ mzip fa fb)++== {- `Functor` composition -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ a :< fmap (liftM fst . uncurry mzip) $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ b :< fmap (liftM snd . uncurry mzip) $ mzip fa fb)++== {- Definition of `unzip` -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ a :< fmap (fst . unzip . uncurry mzip) $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ b :< fmap (snd . unzip . uncurry mzip) $ mzip fa fb)++== {- Coinduction hypothesis -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ a :< fmap fst $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ b :< fmap snd $ mzip fa fb)++== {- `Monad` law `fmap f m == m >>= return . f` and definition of `liftM` -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ a :< liftM fst $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ b :< liftM snd $ mzip fa fb)++== {- Definition of `unzip` -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ a :< fst $ unzip $ mzip fa fb)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ b :< snd $ unzip $ mzip fa fb)++== {- `MonadZip` information preservation -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ a :< fst (fa, fb))+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ b :< snd (fa, fb))++== {- Definition of `fst` and `snd` -}++   (,)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ a :< fa)+   (C  $ do  (a :< fa, b :< fb) <- mzip (unC ma) (unC mb)+             return $ b :< fb)++== {- Definition of `fst` and `snd` -}++   (,)+   (C  $ mzip (unC ma) (unC mb)  >>= return . fst)+   (C  $ mzip (unC ma) (unC mb)  >>= return . snd)++== {- Definition of `liftM` -}++   (,)+   (C  $ liftM fst  $ mzip (unC ma) (unC mb))+   (C  $ liftM snd  $ mzip (unC ma) (unC mb))++== {- Definition of `unzip` -}++   (,)+   (C  $ fst  $ unzip  $ mzip (unC ma) (unC mb))+   (C  $ snd  $ unzip  $ mzip (unC ma) (unC mb))++== {- `MonadZip` information preservation -}++   (,)+   (C  $ fst  $ (unC ma, unC mb))+   (C  $ snd  $ (unC ma, unC mb))++== {- Definition of `fst` and `snd` -}++   (,)+   (C  $ unC ma)+   (C  $ unC mb)++== {- Pack -}++   (ma, mb)++.+```

@@ -1,209 +1,207 @@-> {-# LANGUAGE ViewPatterns #-}
-> module Cabbage where
-
-> import Control.Monad
-> import Control.Monad.State
-> import Control.Monad.Trans.Iter
-> import Control.Monad.Writer
-> import Data.Functor.Identity
-> import Data.Maybe
-> import Data.Tuple
-> import Data.List (inits, tails)
-> import Prelude ()
-> import Prelude.Compat
-
-Consider the following problem:
-
-A farmer must cross a river with a wolf, a sheep and a cabbage.
-He owns a boat, which can only carry himself and one other item.
-The sheep must not be left alone with the wolf, or with the cabbage:
-if that happened, one of them would eat the other.
-
-> data Item = Wolf | Sheep | Cabbage | Farmer deriving (Ord, Show, Eq)
->
-> eats :: Item -> Item -> Bool
-> Sheep `eats` Cabbage = True
-> Wolf `eats` Sheep    = True
-> _ `eats` _           = False
-
-The problem can be represented as the set of items on each side of the river.
-
-> type Situation = ([Item],[Item])
-
-> initial :: Situation
-> initial = ([Farmer, Wolf, Sheep, Cabbage], [])
-
-First, some helper functions to extract single elements from lists, leaving the
-rest intact:
-
-> plusTailOf :: [a] -> [a] -> (Maybe a, [a])
-> a `plusTailOf` b = (listToMaybe b,  a ++ drop 1 b)
-
-> singleOut1 :: (a -> Bool) -> [a] -> (Maybe a,[a])
-> singleOut1 sel = uncurry plusTailOf . break sel
-
-@
-*Cabbage> singleOut1 (== Sheep) [Wolf, Sheep, Cabbage]
-(Just Sheep,[Wolf,Cabbage])
-@
-
-> singleOutAll :: [a] -> [(Maybe a,[a])]
-> singleOutAll = zipWith plusTailOf <$> inits <*> tails
-
-@
-*Cabbage> singleOutAll [Wolf, Sheep, Cabbage]
-[(Just Wolf,[Sheep,Cabbage]),(Just Sheep,[Wolf,Cabbage]),(Just Cabbage,[Wolf,Sheep]),(Nothing,[Wolf,Sheep,Cabbage])]
-@
-
-In every move, the farmer goes from one side of the river to the other,
-together with (optionally) one item.
-
-The remaining items must not eat each other for the move to be valid.
-
-> move :: Situation -> [Situation]
-> move = move2
->   where
->   move2 (singleOut1 (== Farmer) -> (Just Farmer,as), bs)  = move1 as bs
->   move2 (bs, singleOut1 (== Farmer) -> (Just Farmer,as))  = map swap $ move1 as bs
->   move2 _                                            = []
->
->   move1 as bs = [(as', [Farmer] ++ maybeToList b ++ bs) |
->                  (b, as') <- singleOutAll as,
->                  and [not $ x `eats` y | x <- as', y <- as']]
-
-@
-*Cabbage> move initial
-[([Wolf,Cabbage],[Farmer,Sheep])]
-@
-
-When the starting side becomes empty, the farmer succeeds.
-
-> success :: Situation -> Bool
-> success ([],_) = True
-> success _      = False
-
-A straightforward implementation to solve the problem could use the
-list monad, trying all possible solutions and
-
-> solution1 :: Situation
-> solution1 = head $ solutions' initial
->             where
->             solutions' a = if success a
->                            then return a
->                            else move a >>= solutions'
-
-However, when it's run, it will get stuck in an infinite loop, as the sheep
-is shuffled back and forth. The solution is being searched in depth.
-
-To guarantee termination, we can use the 'Iter' monad with its MonadPlus instance.
-As long as one of the possible execution paths finds a solution, the program
-will terminate: the solution is looked for _in breadth_.
-
-> solution2 :: Iter Situation
-> solution2 = solution' initial
->             where
->               solution' a =
->                 if success a
->                   then return a
->                   else delay $ msum $ map solution' (move a)
-
-Each of the alternative sequences of movements will be evaluated
-concurrently; and the shortest one will be the result. In case of ties,
-the leftmost solution takes priority.
-
-@
- *Cabbage> solution2
- IterT (Identity (Right ( …
-   (IterT (Identity (Right
-     (IterT (Identity (Left
-       ([],[Farmer,Sheep,Cabbage,Wolf]))))))))))))))))))))))))
-@
-
-For a cleaner display, use 'retract' to escape 'Iter' monad:
-
-@
- *Cabbage> retract solution2
- Identity ([],[Farmer,Sheep,Cabbage,Wolf])
-@
-
-'unsafeIter' will also get rid of the 'Identity' wrapper:
-
-> unsafeIter :: Iter a -> a
-> unsafeIter = runIdentity . retract
-
-@
- *Cabbage> unsafeIter solution2
- ([],[Farmer,Sheep,Cabbage,Wolf])
-@
-
-Suppose that we not only want the solution, but also the steps that we
-took to arrive there. Enter the Writer monad transformer:
-
-> solution3 :: Iter (Situation, [Situation])
-> solution3 = runWriterT $ solution' initial
->             where
->               solution' :: Situation -> WriterT [Situation] Iter Situation
->               solution' a = do
->                 tell [a]
->                 if success a
->                   then return a
->                   else mapWriterT delay $ msum $ map solution' (move a)
-
-The second component contains the complete path to the solution:
-
-@
- *Cabbage> snd $ unsafeIter solution3
- [([Farmer,Wolf,Sheep,Cabbage],[]),
-  ([Wolf,Cabbage],[Farmer,Sheep]),
-  ([Farmer,Wolf,Cabbage],[Sheep]),
-  ([Cabbage],[Farmer,Wolf,Sheep]),
-  ([Farmer,Sheep,Cabbage],[Wolf]),
-  ([Sheep],[Farmer,Cabbage,Wolf]),
-  ([Farmer,Sheep],[Cabbage,Wolf]),
-  ([],[Farmer,Sheep,Cabbage,Wolf])]
-@
-
-When the transformer is applied _over_ the Iter monad, it acts locally for each solution.
-If we apply the IterT transformer over another monad,
-the behaviour for that monad will be shared among all threads.
-
-For example, let's keep track of how many moves we perform. We could
-do so with the writer monad again (numbers form a monoid under addition), but
-we'll use the state monad this time.
-
-> solution4 :: Iter (Situation, Integer)
-> solution4 = flip runStateT 0 $ solution' initial
->             where
->               solution' :: Situation -> StateT Integer Iter Situation
->               solution' a =
->                 if success a
->                   then return a
->                   else do
->                          modify (+1)
->                          mapStateT delay $ msum $ map solution' (move a)
-
-This gives us seven moves (one for each transition between two states).
-
-@
- *Cabbage> unsafeIter solution4
- (([],[Farmer,Sheep,Cabbage,Wolf]),7)
-@
-
-On the other hand, if move the state inside Iter, we get a global count of
-explored nodes until the solution was found.
-
-> solution5 :: State Integer Situation
-> solution5 = retract $ solution' initial
->             where
->               solution' :: Situation -> IterT (State Integer) Situation
->               solution' a =
->                 if success a
->                   then return a
->                   else do
->                          modify (+1)
->                          delay $ msum $ map solution' (move a)
-
-@
- *Cabbage> runState solution5 0
- (([],[Farmer,Sheep,Cabbage,Wolf]),113)
-@
+> {-# LANGUAGE ViewPatterns #-}+> module Cabbage where++> import Control.Monad+> import Control.Monad.State+> import Control.Monad.Trans.Iter+> import Control.Monad.Writer+> import Data.Functor.Identity+> import Data.Maybe+> import Data.Tuple+> import Data.List (inits, tails)++Consider the following problem:++A farmer must cross a river with a wolf, a sheep and a cabbage.+He owns a boat, which can only carry himself and one other item.+The sheep must not be left alone with the wolf, or with the cabbage:+if that happened, one of them would eat the other.++> data Item = Wolf | Sheep | Cabbage | Farmer deriving (Ord, Show, Eq)+>+> eats :: Item -> Item -> Bool+> Sheep `eats` Cabbage = True+> Wolf `eats` Sheep    = True+> _ `eats` _           = False++The problem can be represented as the set of items on each side of the river.++> type Situation = ([Item],[Item])++> initial :: Situation+> initial = ([Farmer, Wolf, Sheep, Cabbage], [])++First, some helper functions to extract single elements from lists, leaving the+rest intact:++> plusTailOf :: [a] -> [a] -> (Maybe a, [a])+> a `plusTailOf` b = (listToMaybe b,  a ++ drop 1 b)++> singleOut1 :: (a -> Bool) -> [a] -> (Maybe a,[a])+> singleOut1 sel = uncurry plusTailOf . break sel++@+*Cabbage> singleOut1 (== Sheep) [Wolf, Sheep, Cabbage]+(Just Sheep,[Wolf,Cabbage])+@++> singleOutAll :: [a] -> [(Maybe a,[a])]+> singleOutAll = zipWith plusTailOf <$> inits <*> tails++@+*Cabbage> singleOutAll [Wolf, Sheep, Cabbage]+[(Just Wolf,[Sheep,Cabbage]),(Just Sheep,[Wolf,Cabbage]),(Just Cabbage,[Wolf,Sheep]),(Nothing,[Wolf,Sheep,Cabbage])]+@++In every move, the farmer goes from one side of the river to the other,+together with (optionally) one item.++The remaining items must not eat each other for the move to be valid.++> move :: Situation -> [Situation]+> move = move2+>   where+>   move2 (singleOut1 (== Farmer) -> (Just Farmer,as), bs)  = move1 as bs+>   move2 (bs, singleOut1 (== Farmer) -> (Just Farmer,as))  = map swap $ move1 as bs+>   move2 _                                            = []+>+>   move1 as bs = [(as', [Farmer] ++ maybeToList b ++ bs) |+>                  (b, as') <- singleOutAll as,+>                  and [not $ x `eats` y | x <- as', y <- as']]++@+*Cabbage> move initial+[([Wolf,Cabbage],[Farmer,Sheep])]+@++When the starting side becomes empty, the farmer succeeds.++> success :: Situation -> Bool+> success ([],_) = True+> success _      = False++A straightforward implementation to solve the problem could use the+list monad, trying all possible solutions and++> solution1 :: Situation+> solution1 = head $ solutions' initial+>             where+>             solutions' a = if success a+>                            then return a+>                            else move a >>= solutions'++However, when it's run, it will get stuck in an infinite loop, as the sheep+is shuffled back and forth. The solution is being searched in depth.++To guarantee termination, we can use the 'Iter' monad with its MonadPlus instance.+As long as one of the possible execution paths finds a solution, the program+will terminate: the solution is looked for _in breadth_.++> solution2 :: Iter Situation+> solution2 = solution' initial+>             where+>               solution' a =+>                 if success a+>                   then return a+>                   else delay $ msum $ map solution' (move a)++Each of the alternative sequences of movements will be evaluated+concurrently; and the shortest one will be the result. In case of ties,+the leftmost solution takes priority.++@+ *Cabbage> solution2+ IterT (Identity (Right ( …+   (IterT (Identity (Right+     (IterT (Identity (Left+       ([],[Farmer,Sheep,Cabbage,Wolf]))))))))))))))))))))))))+@++For a cleaner display, use 'retract' to escape 'Iter' monad:++@+ *Cabbage> retract solution2+ Identity ([],[Farmer,Sheep,Cabbage,Wolf])+@++'unsafeIter' will also get rid of the 'Identity' wrapper:++> unsafeIter :: Iter a -> a+> unsafeIter = runIdentity . retract++@+ *Cabbage> unsafeIter solution2+ ([],[Farmer,Sheep,Cabbage,Wolf])+@++Suppose that we not only want the solution, but also the steps that we+took to arrive there. Enter the Writer monad transformer:++> solution3 :: Iter (Situation, [Situation])+> solution3 = runWriterT $ solution' initial+>             where+>               solution' :: Situation -> WriterT [Situation] Iter Situation+>               solution' a = do+>                 tell [a]+>                 if success a+>                   then return a+>                   else mapWriterT delay $ msum $ map solution' (move a)++The second component contains the complete path to the solution:++@+ *Cabbage> snd $ unsafeIter solution3+ [([Farmer,Wolf,Sheep,Cabbage],[]),+  ([Wolf,Cabbage],[Farmer,Sheep]),+  ([Farmer,Wolf,Cabbage],[Sheep]),+  ([Cabbage],[Farmer,Wolf,Sheep]),+  ([Farmer,Sheep,Cabbage],[Wolf]),+  ([Sheep],[Farmer,Cabbage,Wolf]),+  ([Farmer,Sheep],[Cabbage,Wolf]),+  ([],[Farmer,Sheep,Cabbage,Wolf])]+@++When the transformer is applied _over_ the Iter monad, it acts locally for each solution.+If we apply the IterT transformer over another monad,+the behaviour for that monad will be shared among all threads.++For example, let's keep track of how many moves we perform. We could+do so with the writer monad again (numbers form a monoid under addition), but+we'll use the state monad this time.++> solution4 :: Iter (Situation, Integer)+> solution4 = flip runStateT 0 $ solution' initial+>             where+>               solution' :: Situation -> StateT Integer Iter Situation+>               solution' a =+>                 if success a+>                   then return a+>                   else do+>                          modify (+1)+>                          mapStateT delay $ msum $ map solution' (move a)++This gives us seven moves (one for each transition between two states).++@+ *Cabbage> unsafeIter solution4+ (([],[Farmer,Sheep,Cabbage,Wolf]),7)+@++On the other hand, if move the state inside Iter, we get a global count of+explored nodes until the solution was found.++> solution5 :: State Integer Situation+> solution5 = retract $ solution' initial+>             where+>               solution' :: Situation -> IterT (State Integer) Situation+>               solution' a =+>                 if success a+>                   then return a+>                   else do+>                          modify (+1)+>                          delay $ msum $ map solution' (move a)++@+ *Cabbage> runState solution5 0+ (([],[Farmer,Sheep,Cabbage,Wolf]),113)+@

@@ -1,30 +1,30 @@-Copyright 2008-2013 Edward Kmett
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGE.
+Copyright 2008-2013 Edward Kmett++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -1,137 +1,137 @@-Compiling to an executable file with the @-O2@ optimization level is recommended.
-
-For example: @ghc -o 'mandelbrot_iter' -O2 MandelbrotIter.lhs ; ./mandelbrot_iter@
-
-> {-# LANGUAGE PackageImports #-}
-> module Main where
-
-> import Control.Arrow hiding (loop)
-> import Control.Monad.IO.Class (MonadIO(..))
-> import Control.Monad.Trans.Iter
-> import "mtl" Control.Monad.Reader (ReaderT, runReaderT, asks)
-> import Data.Complex
-> import Graphics.HGL (runGraphics, Window, withPen,
->                      line, RGB (RGB), RedrawMode (DoubleBuffered), openWindowEx,
->                      drawInWindow, mkPen, Style (Solid))
-
-Some fractals can be defined by infinite sequences of complex numbers. For example,
-to render the <https://en.wikipedia.org/wiki/Mandelbrot_set Mandelbrot set>,
-the following sequence is generated for each point @c@ in the complex plane:
-
-@
-z₀ = c
-
-z₁ = z₀² + c
-
-z₂ = z₁² + c
-
-…
-@
-
-If, after some iterations, |z_i| ≥ 2, the point is not in the set. We
-can compute if a point is not in the Mandelbrot set this way:
-
-@
- escaped :: Complex Double -> Int
- escaped c = loop 0 0 where
-   loop z n = if (magnitude z) >= 2 then n
-                                    else loop (z*z + c) (n+1)
-@
-
-If @c@ is not in the Mandelbrot set, we get the number of iterations required to
-prove that fact. But, if @c@ is in the mandelbrot set, 'escaped' will
-run forever.
-
-We can use the 'Iter' monad to delimit this effect. By applying
-'delay' before the recursive call, we decompose the computation into
-terminating steps.
-
-> escaped :: Complex Double -> Iter Int
-> escaped c = loop 0 0 where
->   loop z n = if (magnitude z) >= 2 then return n
->                                    else delay $ loop (z*z + c) (n+1)
->
-
-If we draw each point on a canvas after it escapes, we can get a _negative_
-image of the Mandelbrot set. Drawing pixels is a side-effect, so it
-should happen inside the IO monad. Also, we want to have an
-environment to store the size of the canvas, and the target window.
-
-By using 'IterT', we can add all these behaviours to our non-terminating
-computation.
-
-> data Canvas = Canvas { width :: Int, height :: Int, window :: Window }
->
-> type FractalM a = IterT (ReaderT Canvas IO) a
-
-Any simple, non-terminating computation can be lifted into a richer environment.
-
-> escaped' :: Complex Double -> IterT (ReaderT Canvas IO) Int
-> escaped' = liftIter . escaped
-
-Then, to draw a point, we can just retrieve the number of iterations until it
-finishes, and draw it. The color will depend on the number of iterations.
-
-> mandelbrotPoint :: (Int, Int) -> FractalM ()
-> mandelbrotPoint p = do
->   c <- scale p
->   n <- escaped' c
->   let color =  if (even n) then RGB   0   0 255 -- Blue
->                            else RGB   0   0 127 -- Darker blue
->   drawPoint color p
-
-The pixels on the screen don't match the region in the complex plane where the
-fractal is; we need to map them first. The region we are interested in is
-Im z = [-1,1], Re z = [-2,1].
-
-> scale :: (Int, Int) -> FractalM (Complex Double)
-> scale (xi,yi) = do
->   (w,h) <- asks $ (fromIntegral . width) &&& (fromIntegral . height)
->   let (x,y) = (fromIntegral xi, fromIntegral yi)
->   let im = (-y + h / 2     ) / (h/2)
->   let re = ( x - w * 2 / 3 ) / (h/2)
->   return $ re :+ im
-
-Drawing a point is equivalent to drawing a line of length one.
-
-> drawPoint :: RGB -> (Int,Int) -> FractalM ()
-> drawPoint color (x,y) = do
->   w <- asks window
->   let point = line (x,y) (x+1, y+1)
->   liftIO $ drawInWindow w $ mkPen Solid 1 color (flip withPen point)
-
-We may want to draw more than one point. However, if we just sequence the computations
-monadically, the first point that is not a member of the set will block the whole
-process. We need advance all the points at the same pace, by interleaving the
-computations.
-
-> drawMandelbrot :: FractalM ()
-> drawMandelbrot = do
->   (w,h) <- asks $ width &&& height
->   let ps = [mandelbrotPoint (x,y) | x <- [0 .. (w-1)], y <- [0 .. (h-1)]]
->   interleave_ ps
-
-To run this computation, we can just use @retract@, which will run indefinitely:
-
-> runFractalM :: Canvas -> FractalM a -> IO a
-> runFractalM canvas  = flip runReaderT canvas . retract
-
-Or, we can trade non-termination for getting an incomplete result,
-by cutting off after a certain number of steps.
-
-> runFractalM' :: Integer -> Canvas -> FractalM a -> IO (Maybe a)
-> runFractalM' n canvas  = flip runReaderT canvas . retract . cutoff n
-
-Thanks to the 'IterT' transformer, we can separate timeout concerns from
-computational concerns.
-
-> main :: IO ()
-> main = do
->   let windowWidth = 800
->   let windowHeight = 480
->   runGraphics $ do
->     w <- openWindowEx "Mandelbrot" Nothing (windowWidth, windowHeight) DoubleBuffered (Just 1)
->     let canvas = Canvas windowWidth windowHeight w
->     _ <- runFractalM' 100 canvas drawMandelbrot
->     putStrLn $ "Fin"
-
+Compiling to an executable file with the @-O2@ optimization level is recommended.++For example: @ghc -o 'mandelbrot_iter' -O2 MandelbrotIter.lhs ; ./mandelbrot_iter@++> {-# LANGUAGE PackageImports #-}+> module Main where++> import Control.Arrow hiding (loop)+> import Control.Monad.IO.Class (MonadIO(..))+> import Control.Monad.Trans.Iter+> import "mtl" Control.Monad.Reader (ReaderT, runReaderT, asks)+> import Data.Complex+> import Graphics.HGL (runGraphics, Window, withPen,+>                      line, RGB (RGB), RedrawMode (DoubleBuffered), openWindowEx,+>                      drawInWindow, mkPen, Style (Solid))++Some fractals can be defined by infinite sequences of complex numbers. For example,+to render the <https://en.wikipedia.org/wiki/Mandelbrot_set Mandelbrot set>,+the following sequence is generated for each point @c@ in the complex plane:++@+z₀ = c++z₁ = z₀² + c++z₂ = z₁² + c++…+@++If, after some iterations, |z_i| ≥ 2, the point is not in the set. We+can compute if a point is not in the Mandelbrot set this way:++@+ escaped :: Complex Double -> Int+ escaped c = loop 0 0 where+   loop z n = if (magnitude z) >= 2 then n+                                    else loop (z*z + c) (n+1)+@++If @c@ is not in the Mandelbrot set, we get the number of iterations required to+prove that fact. But, if @c@ is in the mandelbrot set, 'escaped' will+run forever.++We can use the 'Iter' monad to delimit this effect. By applying+'delay' before the recursive call, we decompose the computation into+terminating steps.++> escaped :: Complex Double -> Iter Int+> escaped c = loop 0 0 where+>   loop z n = if (magnitude z) >= 2 then return n+>                                    else delay $ loop (z*z + c) (n+1)+>++If we draw each point on a canvas after it escapes, we can get a _negative_+image of the Mandelbrot set. Drawing pixels is a side-effect, so it+should happen inside the IO monad. Also, we want to have an+environment to store the size of the canvas, and the target window.++By using 'IterT', we can add all these behaviours to our non-terminating+computation.++> data Canvas = Canvas { width :: Int, height :: Int, window :: Window }+>+> type FractalM a = IterT (ReaderT Canvas IO) a++Any simple, non-terminating computation can be lifted into a richer environment.++> escaped' :: Complex Double -> IterT (ReaderT Canvas IO) Int+> escaped' = liftIter . escaped++Then, to draw a point, we can just retrieve the number of iterations until it+finishes, and draw it. The color will depend on the number of iterations.++> mandelbrotPoint :: (Int, Int) -> FractalM ()+> mandelbrotPoint p = do+>   c <- scale p+>   n <- escaped' c+>   let color =  if (even n) then RGB   0   0 255 -- Blue+>                            else RGB   0   0 127 -- Darker blue+>   drawPoint color p++The pixels on the screen don't match the region in the complex plane where the+fractal is; we need to map them first. The region we are interested in is+Im z = [-1,1], Re z = [-2,1].++> scale :: (Int, Int) -> FractalM (Complex Double)+> scale (xi,yi) = do+>   (w,h) <- asks $ (fromIntegral . width) &&& (fromIntegral . height)+>   let (x,y) = (fromIntegral xi, fromIntegral yi)+>   let im = (-y + h / 2     ) / (h/2)+>   let re = ( x - w * 2 / 3 ) / (h/2)+>   return $ re :+ im++Drawing a point is equivalent to drawing a line of length one.++> drawPoint :: RGB -> (Int,Int) -> FractalM ()+> drawPoint color (x,y) = do+>   w <- asks window+>   let point = line (x,y) (x+1, y+1)+>   liftIO $ drawInWindow w $ mkPen Solid 1 color (flip withPen point)++We may want to draw more than one point. However, if we just sequence the computations+monadically, the first point that is not a member of the set will block the whole+process. We need advance all the points at the same pace, by interleaving the+computations.++> drawMandelbrot :: FractalM ()+> drawMandelbrot = do+>   (w,h) <- asks $ width &&& height+>   let ps = [mandelbrotPoint (x,y) | x <- [0 .. (w-1)], y <- [0 .. (h-1)]]+>   interleave_ ps++To run this computation, we can just use @retract@, which will run indefinitely:++> runFractalM :: Canvas -> FractalM a -> IO a+> runFractalM canvas  = flip runReaderT canvas . retract++Or, we can trade non-termination for getting an incomplete result,+by cutting off after a certain number of steps.++> runFractalM' :: Integer -> Canvas -> FractalM a -> IO (Maybe a)+> runFractalM' n canvas  = flip runReaderT canvas . retract . cutoff n++Thanks to the 'IterT' transformer, we can separate timeout concerns from+computational concerns.++> main :: IO ()+> main = do+>   let windowWidth = 800+>   let windowHeight = 480+>   runGraphics $ do+>     w <- openWindowEx "Mandelbrot" Nothing (windowWidth, windowHeight) DoubleBuffered (Just 1)+>     let canvas = Canvas windowWidth windowHeight w+>     _ <- runFractalM' 100 canvas drawMandelbrot+>     putStrLn $ "Fin"+

@@ -1,102 +1,100 @@-Many numerical approximation methods compute infinite sequences of results; each,
-hopefully, more accurate than the previous one.
-
-<https://en.wikipedia.org/wiki/Newton's_method Newton's method>
-to find zeroes of a function is one such algorithm.
-
-> {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
-> module Main where
-
-> import Control.Comonad.Trans.Coiter
-> import Control.Comonad.Env
-> import Data.Foldable (toList, find)
-> import Prelude
-> import Prelude.Compat ()
-
-> data Function = Function {
->   -- Function to find zeroes of
->   function   :: Double -> Double,
->   -- Derivative of the function
->   derivative :: Double -> Double
-> }
->
-> data Result = Result {
->   -- Estimated zero of the function
->   value  :: Double,
->   -- Estimated distance to the actual zero
->   xerror :: Double,
->   -- How far is value from being an actual zero; that is,
->   -- the difference between @0@ and @f value@
->   ferror :: Double
-> } deriving (Show)
->
-> data Outlook = Outlook { result :: Result,
->                          -- Whether the result improves in future steps
->                          progress :: Bool } deriving (Show)
-
-To make our lives easier, we will store the problem at hand using the Env
-environment comonad.
-
-> type Solution a = CoiterT (Env Function) a
-
-Problems consist of a function and its derivative as the environment, and
-an initial value.
-
-> type Problem = Env Function Double
-
-We can express an iterative algorithm using unfold over an initial environment.
-
-> newton :: Problem -> Solution Double
-> newton = unfold (\wd ->
->                     let  f  = asks function wd in
->                     let df  = asks derivative wd in
->                     let  x  = extract wd in
->                     x - f x / df x)
->
->
-
-To estimate the error, we look forward one position in the stream. The next value
-will be much more precise than the current one, so we can consider it as the
-actual result.
-
-We know that the exact value of a function at one of it's zeroes is 0. So,
-@ferror@ can be computed exactly as @abs (f a - f 0) == abs (f a)@
-
-> estimateError :: Solution Double -> Result
-> estimateError s =
->   let (a, s') = extract $ runCoiterT s in
->   let a' = extract s' in
->   let f = asks function s in
->   Result { value = a,
->            xerror = abs $ a - a',
->            ferror = abs $ f a
->          }
-
-To get a sense of when the algorithm is making any progress, we can sample the
-future and check if the result improves at all.
-
-> estimateOutlook :: Int -> Solution Result -> Outlook
-> estimateOutlook sampleSize solution =
->   let sample = map ferror $ take sampleSize $ tail $ toList solution in
->   let result' = extract solution in
->   Outlook { result = result',
->             progress = ferror result' > minimum sample }
-
-To compute the square root of @c@, we solve the equation @x*x - c = 0@. We will
-stop whenever the accuracy of the result doesn't improve in the next 5 steps.
-
-The starting value for our algorithm is @c@ itself. One could compute a better
-estimate, but the algorithm converges fast enough that it's not really worth it.
-
-> squareRoot :: Double -> Maybe Result
-> squareRoot c = let problem = flip env c (Function { function = (\x -> x*x - c),
->                                                     derivative = (\x -> 2*x) })
->                in
->                fmap result $ find (not . progress) $
->                  newton problem =>> estimateError =>> estimateOutlook 5
-
-This program will output the result together with the error.
-
-> main :: IO ()
-> main = putStrLn $ show $ squareRoot 3
-
+Many numerical approximation methods compute infinite sequences of results; each,+hopefully, more accurate than the previous one.++<https://en.wikipedia.org/wiki/Newton's_method Newton's method>+to find zeroes of a function is one such algorithm.++> {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}+> module Main where++> import Control.Comonad.Trans.Coiter+> import Control.Comonad.Env+> import Data.Foldable (toList, find)++> data Function = Function {+>   -- Function to find zeroes of+>   function   :: Double -> Double,+>   -- Derivative of the function+>   derivative :: Double -> Double+> }+>+> data Result = Result {+>   -- Estimated zero of the function+>   value  :: Double,+>   -- Estimated distance to the actual zero+>   xerror :: Double,+>   -- How far is value from being an actual zero; that is,+>   -- the difference between @0@ and @f value@+>   ferror :: Double+> } deriving (Show)+>+> data Outlook = Outlook { result :: Result,+>                          -- Whether the result improves in future steps+>                          progress :: Bool } deriving (Show)++To make our lives easier, we will store the problem at hand using the Env+environment comonad.++> type Solution a = CoiterT (Env Function) a++Problems consist of a function and its derivative as the environment, and+an initial value.++> type Problem = Env Function Double++We can express an iterative algorithm using unfold over an initial environment.++> newton :: Problem -> Solution Double+> newton = unfold (\wd ->+>                     let  f  = asks function wd in+>                     let df  = asks derivative wd in+>                     let  x  = extract wd in+>                     x - f x / df x)+>+>++To estimate the error, we look forward one position in the stream. The next value+will be much more precise than the current one, so we can consider it as the+actual result.++We know that the exact value of a function at one of it's zeroes is 0. So,+@ferror@ can be computed exactly as @abs (f a - f 0) == abs (f a)@++> estimateError :: Solution Double -> Result+> estimateError s =+>   let (a, s') = extract $ runCoiterT s in+>   let a' = extract s' in+>   let f = asks function s in+>   Result { value = a,+>            xerror = abs $ a - a',+>            ferror = abs $ f a+>          }++To get a sense of when the algorithm is making any progress, we can sample the+future and check if the result improves at all.++> estimateOutlook :: Int -> Solution Result -> Outlook+> estimateOutlook sampleSize solution =+>   let sample = map ferror $ take sampleSize $ tail $ toList solution in+>   let result' = extract solution in+>   Outlook { result = result',+>             progress = ferror result' > minimum sample }++To compute the square root of @c@, we solve the equation @x*x - c = 0@. We will+stop whenever the accuracy of the result doesn't improve in the next 5 steps.++The starting value for our algorithm is @c@ itself. One could compute a better+estimate, but the algorithm converges fast enough that it's not really worth it.++> squareRoot :: Double -> Maybe Result+> squareRoot c = let problem = flip env c (Function { function = (\x -> x*x - c),+>                                                     derivative = (\x -> 2*x) })+>                in+>                fmap result $ find (not . progress) $+>                  newton problem =>> estimateError =>> estimateOutlook 5++This program will output the result together with the error.++> main :: IO ()+> main = putStrLn $ show $ squareRoot 3+

@@ -1,122 +1,122 @@-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module Main where
-
-import System.CPUTime.Rdtsc
-import System.IO.Unsafe
-import Data.IORef
-import Data.Word
-import Control.Monad
-import Control.Monad.IO.Class (MonadIO(..))
-import qualified Control.Monad.Fail as Fail (MonadFail)
-import Control.Monad.Free
-import Control.Monad.Free.TH
-import qualified Control.Monad.Free.Church as Church
-import Control.Monad.Trans.State.Strict
-import Text.Printf
-
--- | A data type representing basic commands for our performance-testing eDSL.
-data PerfF next where
-  Output    :: String -> next -> PerfF next
-  Input     :: (Show a, Read a) => (a -> next) -> PerfF next
-
--- | Unfortunately this Functor instance cannot yet be derived
--- automatically by GHC.
-instance Functor PerfF where
-  fmap f (Output s x) = Output s (f x)
-  fmap f (Input g) = Input (f . g)
-
-makeFreeCon 'Output
-makeFreeCon 'Input
-
-type PerfCnt = Word64
-
--- | Unsafe state variable: base CPU cycles
-{-# NOINLINE g_base_counter #-}
-g_base_counter :: IORef PerfCnt
-g_base_counter = unsafePerformIO $ do
-  rdtsc >>= newIORef
-
--- | Prints number of CPU cycles since last call
-g_print_time_since_prev_call :: (MonadIO m) => m ()
-g_print_time_since_prev_call = liftIO $ do
-  cb <- readIORef g_base_counter
-  c <- rdtsc
-  writeIORef g_base_counter c
-  putStr $ printf "\r%-10s" (show $ c - cb)
-
--- | Free-based interpreter
-runPerfFree :: (MonadIO m) => [String] -> Free PerfF () -> m ()
-runPerfFree [] _ = return ()
-runPerfFree (s:ss) x = case x of
-  Free (Output _o next) -> do
-    runPerfFree (s:ss) next
-  Free (Input next) -> do
-    g_print_time_since_prev_call
-    runPerfFree ss (next (read s))
-  Pure a -> do
-    return a
-
--- | Church-based interpreter
-runPerfF :: (Fail.MonadFail m, MonadIO m) => [String] -> Church.F PerfF () -> m ()
-runPerfF [] _ = return ()
-runPerfF ss0 f =
-  fst `liftM` do
-  flip runStateT ss0 $ Church.iterM go f where
-    go (Output _o next) = do
-      next
-    go (Input next) = do
-      g_print_time_since_prev_call
-      (s:ss) <- get
-      put ss
-      next (read s)
-
--- | Test input is the same for all cases
-test_input :: [String]
-test_input = [show i | i<-([1..9999] ++ [0 :: Int])]
-
--- | Tail-recursive program
-test_tail :: (MonadFree PerfF m) => m ()
-test_tail = do
-  output "Enter something"
-  (n :: Int) <- input
-  output $ "Just entered: " ++ (show n)
-  when (n > 0) $ do
-    test_tail
-
-run_tail_free,run_tail_f :: IO ()
-run_tail_free = runPerfFree test_input test_tail
-run_tail_f = runPerfF test_input test_tail
-
-
--- | Deep-recursive program
-test_loop :: (MonadFree PerfF m) => m ()
-test_loop = do
-  output "Enter something"
-  (n :: Int) <- input
-  when (n > 0) $ do
-    test_loop
-  output $ "Just entered: " ++ (show n)
-
-run_loop_free,run_loop_f :: IO ()
-run_loop_free = runPerfFree test_input test_loop
-run_loop_f = runPerfF test_input test_loop
-
-main :: IO ()
-main = do
-  putStr $ unlines [
-      "Running two kinds of FreeMonad programs against two kinds of interpreters.",
-      "Counters represent approx. number of CPU ticks per program iteration" ]
-  putStrLn ">> (1/4) Tail-recursive program/Free interpreter"
-  run_tail_free
-  putStrLn "\n>> (2/4) Tail-recursive program/Church interpreter"
-  run_tail_f
-  putStrLn "\n>> (3/4) Deep-recursive program/Free interpreter (a slower one)"
-  run_loop_free
-  putStrLn "\n>> (4/4) Deep-recursive program/Church interpreter"
-  run_loop_f
-  putStrLn "\n"
-
+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main where++import System.CPUTime.Rdtsc+import System.IO.Unsafe+import Data.IORef+import Data.Word+import Control.Monad+import Control.Monad.IO.Class (MonadIO(..))+import qualified Control.Monad.Fail as Fail (MonadFail)+import Control.Monad.Free+import Control.Monad.Free.TH+import qualified Control.Monad.Free.Church as Church+import Control.Monad.Trans.State.Strict+import Text.Printf++-- | A data type representing basic commands for our performance-testing eDSL.+data PerfF next where+  Output    :: String -> next -> PerfF next+  Input     :: (Show a, Read a) => (a -> next) -> PerfF next++-- | Unfortunately this Functor instance cannot yet be derived+-- automatically by GHC.+instance Functor PerfF where+  fmap f (Output s x) = Output s (f x)+  fmap f (Input g) = Input (f . g)++makeFreeCon 'Output+makeFreeCon 'Input++type PerfCnt = Word64++-- | Unsafe state variable: base CPU cycles+{-# NOINLINE g_base_counter #-}+g_base_counter :: IORef PerfCnt+g_base_counter = unsafePerformIO $ do+  rdtsc >>= newIORef++-- | Prints number of CPU cycles since last call+g_print_time_since_prev_call :: (MonadIO m) => m ()+g_print_time_since_prev_call = liftIO $ do+  cb <- readIORef g_base_counter+  c <- rdtsc+  writeIORef g_base_counter c+  putStr $ printf "\r%-10s" (show $ c - cb)++-- | Free-based interpreter+runPerfFree :: (MonadIO m) => [String] -> Free PerfF () -> m ()+runPerfFree [] _ = return ()+runPerfFree (s:ss) x = case x of+  Free (Output _o next) -> do+    runPerfFree (s:ss) next+  Free (Input next) -> do+    g_print_time_since_prev_call+    runPerfFree ss (next (read s))+  Pure a -> do+    return a++-- | Church-based interpreter+runPerfF :: (Fail.MonadFail m, MonadIO m) => [String] -> Church.F PerfF () -> m ()+runPerfF [] _ = return ()+runPerfF ss0 f =+  fst `liftM` do+  flip runStateT ss0 $ Church.iterM go f where+    go (Output _o next) = do+      next+    go (Input next) = do+      g_print_time_since_prev_call+      (s:ss) <- get+      put ss+      next (read s)++-- | Test input is the same for all cases+test_input :: [String]+test_input = [show i | i<-([1..9999] ++ [0 :: Int])]++-- | Tail-recursive program+test_tail :: (MonadFree PerfF m) => m ()+test_tail = do+  output "Enter something"+  (n :: Int) <- input+  output $ "Just entered: " ++ (show n)+  when (n > 0) $ do+    test_tail++run_tail_free,run_tail_f :: IO ()+run_tail_free = runPerfFree test_input test_tail+run_tail_f = runPerfF test_input test_tail+++-- | Deep-recursive program+test_loop :: (MonadFree PerfF m) => m ()+test_loop = do+  output "Enter something"+  (n :: Int) <- input+  when (n > 0) $ do+    test_loop+  output $ "Just entered: " ++ (show n)++run_loop_free,run_loop_f :: IO ()+run_loop_free = runPerfFree test_input test_loop+run_loop_f = runPerfF test_input test_loop++main :: IO ()+main = do+  putStr $ unlines [+      "Running two kinds of FreeMonad programs against two kinds of interpreters.",+      "Counters represent approx. number of CPU ticks per program iteration" ]+  putStrLn ">> (1/4) Tail-recursive program/Free interpreter"+  run_tail_free+  putStrLn "\n>> (2/4) Tail-recursive program/Church interpreter"+  run_tail_f+  putStrLn "\n>> (3/4) Deep-recursive program/Free interpreter (a slower one)"+  run_loop_free+  putStrLn "\n>> (4/4) Deep-recursive program/Church interpreter"+  run_loop_f+  putStrLn "\n"+

@@ -1,96 +1,96 @@-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleContexts #-}
-module Main where
-
-import Control.Monad
-import Control.Monad.Fail as Fail
-import Control.Monad.Free
-import Control.Monad.Free.TH
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Instances ()
-import Control.Monad.Trans.Maybe
-import qualified Data.Foldable as F
-import Text.Read.Compat (readMaybe)
-
--- | A data type representing basic commands for a retriable eDSL.
-data RetryF next where
-  Output    :: String -> next -> RetryF next
-  Input     :: Read a => (a -> next) -> RetryF next
-  WithRetry :: Retry a -> (a -> next) -> RetryF next
-  Retry     :: RetryF next
-
--- | Unfortunately this Functor instance cannot yet be derived
--- automatically by GHC.
-instance Functor RetryF where
-  fmap f (Output s x) = Output s (f x)
-  fmap f (Input g) = Input (f . g)
-  fmap f (WithRetry block g) = WithRetry block (f . g)
-  fmap _ Retry = Retry
-
--- | The monad for a retriable eDSL.
-type Retry = Free RetryF
-
--- | Simple output command.
-makeFreeCon 'Output
-
--- | Get anything readable from input.
-makeFreeCon 'Input
-
--- | Force retry command (retries innermost retriable block).
-makeFreeCon 'Retry
-
-makeFreeCon_ 'WithRetry
--- | Run a retryable block.
-withRetry :: MonadFree RetryF m =>
-             Retry a  -- ^ Computation to retry.
-          -> m a      -- ^ Computation that retries until succeeds.
-
--- The following functions have been made available:
---
--- output     :: MonadFree RetryF m => String -> m ()
--- input      :: (MonadFree RetryF m, Read a) => m a
--- withRetry  :: MonadFree RetryF m => Retry a -> m a
--- retry      :: MonadFree RetryF m => m a
-
--- | We can run a retriable program in any MonadIO.
-runRetry :: (MonadFail m, MonadIO m) => Retry a -> m a
-runRetry = iterM run
-  where
-    run :: (MonadFail m, MonadIO m) => RetryF (m a) -> m a
-
-    run (Output s next) = do
-      liftIO $ putStrLn s
-      next
-
-    run (Input next) = do
-      s <- liftIO getLine
-      case readMaybe s of
-        Just x  -> next x
-        Nothing -> Fail.fail "invalid input"
-
-    run (WithRetry block next) = do
-      -- Here we use
-      -- runRetry :: MonadIO m => Retry a -> MaybeT (m a)
-      -- to control failure with MaybeT.
-      -- We repeatedly run retriable block until we get it to work.
-      Just x <- runMaybeT . F.msum $ repeat (runRetry block)
-      next x
-
-    run Retry = Fail.fail "forced retry"
-
--- | Sample program.
-test :: Retry ()
-test = do
-  n <- withRetry $ do
-    output "Enter any positive number: "
-    n <- input
-    when (n <= 0) $ do
-      output "The number should be positive."
-      retry
-    return n
-  output $ "You've just entered " ++ show (n :: Int)
-
-main :: IO ()
-main = runRetry test
+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+module Main where++import Control.Monad+import Control.Monad.Fail as Fail+import Control.Monad.Free+import Control.Monad.Free.TH+import Control.Monad.IO.Class+import Control.Monad.Trans.Instances ()+import Control.Monad.Trans.Maybe+import qualified Data.Foldable as F+import Text.Read (readMaybe)++-- | A data type representing basic commands for a retriable eDSL.+data RetryF next where+  Output    :: String -> next -> RetryF next+  Input     :: Read a => (a -> next) -> RetryF next+  WithRetry :: Retry a -> (a -> next) -> RetryF next+  Retry     :: RetryF next++-- | Unfortunately this Functor instance cannot yet be derived+-- automatically by GHC.+instance Functor RetryF where+  fmap f (Output s x) = Output s (f x)+  fmap f (Input g) = Input (f . g)+  fmap f (WithRetry block g) = WithRetry block (f . g)+  fmap _ Retry = Retry++-- | The monad for a retriable eDSL.+type Retry = Free RetryF++-- | Simple output command.+makeFreeCon 'Output++-- | Get anything readable from input.+makeFreeCon 'Input++-- | Force retry command (retries innermost retriable block).+makeFreeCon 'Retry++makeFreeCon_ 'WithRetry+-- | Run a retryable block.+withRetry :: MonadFree RetryF m =>+             Retry a  -- ^ Computation to retry.+          -> m a      -- ^ Computation that retries until succeeds.++-- The following functions have been made available:+--+-- output     :: MonadFree RetryF m => String -> m ()+-- input      :: (MonadFree RetryF m, Read a) => m a+-- withRetry  :: MonadFree RetryF m => Retry a -> m a+-- retry      :: MonadFree RetryF m => m a++-- | We can run a retriable program in any MonadIO.+runRetry :: (MonadFail m, MonadIO m) => Retry a -> m a+runRetry = iterM run+  where+    run :: (MonadFail m, MonadIO m) => RetryF (m a) -> m a++    run (Output s next) = do+      liftIO $ putStrLn s+      next++    run (Input next) = do+      s <- liftIO getLine+      case readMaybe s of+        Just x  -> next x+        Nothing -> Fail.fail "invalid input"++    run (WithRetry block next) = do+      -- Here we use+      -- runRetry :: MonadIO m => Retry a -> MaybeT (m a)+      -- to control failure with MaybeT.+      -- We repeatedly run retriable block until we get it to work.+      Just x <- runMaybeT . F.msum $ repeat (runRetry block)+      next x++    run Retry = Fail.fail "forced retry"++-- | Sample program.+test :: Retry ()+test = do+  n <- withRetry $ do+    output "Enter any positive number: "+    n <- input+    when (n <= 0) $ do+      output "The number should be positive."+      retry+    return n+  output $ "You've just entered " ++ show (n :: Int)++main :: IO ()+main = runRetry test

@@ -1,106 +1,104 @@-> {-# LANGUAGE DeriveFunctor, TemplateHaskell, FlexibleContexts #-} --
-> module Main where
-
-> import qualified Control.Exception as E (catch)
-> import Control.Monad         (mfilter)
-> import Control.Monad.Loops   (unfoldM)
-> import Control.Monad.Free    (liftF, Free, iterM, MonadFree)
-> import Control.Monad.Free.TH (makeFree)
-> import Prelude               ()
-> import Prelude.Compat
-> import System.IO             (isEOF)
-> import System.IO.Error       (ioeGetErrorString)
-> import System.Exit           (exitSuccess)
-
-First, we define a data type with the primitive actions of a teleprinter. The
-@param@ will stand for the next action to execute.
-
-> type Error = String
->
-> data Teletype param = Halt                                  -- Abort (ignore all following instructions)
->                     | NL param                              -- Newline
->                     | Read (Char -> param)                  -- Get a character from the terminal
->                     | ReadOrEOF { onEOF  :: param,
->                                   onChar :: Char -> param } -- GetChar if not end of file
->                     | ReadOrError (Error -> param)
->                                   (Char -> param)           -- GetChar with error code
->                     | param :\^^ String                     -- Write a message to the terminal
->                     | (:%) param String [String]            -- String interpolation
->                     deriving (Functor)
-
-By including a 'makeFree' declaration:
-
-> makeFree ''Teletype
-
-the following functions have been made available:
-
-@
- halt        :: (MonadFree Teletype m) => m a
- nL          :: (MonadFree Teletype m) => m ()
- read        :: (MonadFree Teletype m) => m Char
- readOrEOF   :: (MonadFree Teletype m) => m (Maybe Char)
- readOrError :: (MonadFree Teletype m) => m (Either Error Char)
- (\\^^)      :: (MonadFree Teletype m) => String -> m ()
- (%)         :: (MonadFree Teletype m) => String -> [String] -> m ()
-@
-
-To make use of them, we need an instance of 'MonadFree Teletype'. Since 'Teletype' is a
-'Functor', we can use the one provided in the 'Control.Monad.Free' package.
-
-> type TeletypeM = Free Teletype
-
-Programs can be run in different ways. For example, we can use the
-system terminal through the @IO@ monad.
-
-> runTeletypeIO :: TeletypeM a -> IO a
-> runTeletypeIO = iterM run where
->   run :: Teletype (IO a) -> IO a
->   run Halt                      = do
->     putStrLn "This conversation can serve no purpose anymore. Goodbye."
->     exitSuccess
->
->   run (Read f)                  = getChar >>= f
->   run (ReadOrEOF eof f)         = isEOF >>= \b -> if b then eof
->                                                        else getChar >>= f
->
->   run (ReadOrError ferror f)    = E.catch (getChar >>= f) (ferror . ioeGetErrorString)
->   run (NL rest)                 = putChar '\n' >> rest
->   run (rest :\^^ str)           = putStr str >> rest
->   run ((:%) rest format tokens) = ttFormat format tokens >> rest
->
->   ttFormat :: String -> [String] -> IO ()
->   ttFormat []            _          = return ()
->   ttFormat ('\\':'%':cs) tokens     = putChar '%'  >> ttFormat cs tokens
->   ttFormat ('%':cs)      (t:tokens) = putStr t     >> ttFormat cs tokens
->   ttFormat (c:cs)        tokens     = putChar c    >> ttFormat cs tokens
-
-Now, we can write some helper functions:
-
-> readLine :: TeletypeM String
-> readLine = unfoldM $ mfilter (/= '\n') <$> readOrEOF
-
-And use them to interact with the user:
-
-> hello :: TeletypeM ()
-> hello = do
->           (\^^) "Hello! What's your name?"; nL
->           name <- readLine
->           "Nice to meet you, %." % [name]; nL
->           halt
-
-We can transform any @TeletypeM@ into an @IO@ action, and run it:
-
-> main :: IO ()
-> main = runTeletypeIO hello
-
-@
- Hello! What's your name?
- $ Dave
- Nice to meet you, Dave.
- This conversation can serve no purpose anymore. Goodbye.
-@
-
-When specifying DSLs in this way, we only need to define the semantics
-for each of the actions; the plumbing of values is taken care of by
-the generated monad instance.
-
+> {-# LANGUAGE DeriveFunctor, TemplateHaskell, FlexibleContexts #-} --+> module Main where++> import qualified Control.Exception as E (catch)+> import Control.Monad         (mfilter)+> import Control.Monad.Loops   (unfoldM)+> import Control.Monad.Free    (liftF, Free, iterM, MonadFree)+> import Control.Monad.Free.TH (makeFree)+> import System.IO             (isEOF)+> import System.IO.Error       (ioeGetErrorString)+> import System.Exit           (exitSuccess)++First, we define a data type with the primitive actions of a teleprinter. The+@param@ will stand for the next action to execute.++> type Error = String+>+> data Teletype param = Halt                                  -- Abort (ignore all following instructions)+>                     | NL param                              -- Newline+>                     | Read (Char -> param)                  -- Get a character from the terminal+>                     | ReadOrEOF { onEOF  :: param,+>                                   onChar :: Char -> param } -- GetChar if not end of file+>                     | ReadOrError (Error -> param)+>                                   (Char -> param)           -- GetChar with error code+>                     | param :\^^ String                     -- Write a message to the terminal+>                     | (:%) param String [String]            -- String interpolation+>                     deriving (Functor)++By including a 'makeFree' declaration:++> makeFree ''Teletype++the following functions have been made available:++@+ halt        :: (MonadFree Teletype m) => m a+ nL          :: (MonadFree Teletype m) => m ()+ read        :: (MonadFree Teletype m) => m Char+ readOrEOF   :: (MonadFree Teletype m) => m (Maybe Char)+ readOrError :: (MonadFree Teletype m) => m (Either Error Char)+ (\\^^)      :: (MonadFree Teletype m) => String -> m ()+ (%)         :: (MonadFree Teletype m) => String -> [String] -> m ()+@++To make use of them, we need an instance of 'MonadFree Teletype'. Since 'Teletype' is a+'Functor', we can use the one provided in the 'Control.Monad.Free' package.++> type TeletypeM = Free Teletype++Programs can be run in different ways. For example, we can use the+system terminal through the @IO@ monad.++> runTeletypeIO :: TeletypeM a -> IO a+> runTeletypeIO = iterM run where+>   run :: Teletype (IO a) -> IO a+>   run Halt                      = do+>     putStrLn "This conversation can serve no purpose anymore. Goodbye."+>     exitSuccess+>+>   run (Read f)                  = getChar >>= f+>   run (ReadOrEOF eof f)         = isEOF >>= \b -> if b then eof+>                                                        else getChar >>= f+>+>   run (ReadOrError ferror f)    = E.catch (getChar >>= f) (ferror . ioeGetErrorString)+>   run (NL rest)                 = putChar '\n' >> rest+>   run (rest :\^^ str)           = putStr str >> rest+>   run ((:%) rest format tokens) = ttFormat format tokens >> rest+>+>   ttFormat :: String -> [String] -> IO ()+>   ttFormat []            _          = return ()+>   ttFormat ('\\':'%':cs) tokens     = putChar '%'  >> ttFormat cs tokens+>   ttFormat ('%':cs)      (t:tokens) = putStr t     >> ttFormat cs tokens+>   ttFormat (c:cs)        tokens     = putChar c    >> ttFormat cs tokens++Now, we can write some helper functions:++> readLine :: TeletypeM String+> readLine = unfoldM $ mfilter (/= '\n') <$> readOrEOF++And use them to interact with the user:++> hello :: TeletypeM ()+> hello = do+>           (\^^) "Hello! What's your name?"; nL+>           name <- readLine+>           "Nice to meet you, %." % [name]; nL+>           halt++We can transform any @TeletypeM@ into an @IO@ action, and run it:++> main :: IO ()+> main = runTeletypeIO hello++@+ Hello! What's your name?+ $ Dave+ Nice to meet you, Dave.+ This conversation can serve no purpose anymore. Goodbye.+@++When specifying DSLs in this way, we only need to define the semantics+for each of the actions; the plumbing of values is taken care of by+the generated monad instance.+

@@ -1,117 +1,113 @@-{-# LANGUAGE CPP #-}
-module Main where
-
-#if !(MIN_VERSION_base(4,8,0))
-import Control.Applicative
-#endif
-import Control.Applicative.Free
-import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Trans.State
-
-import Data.Monoid (Sum(..))
-
-import Text.Read.Compat (readEither)
-import Text.Printf
-
-import System.IO
-
--- | Field reader tries to read value or generates error message.
-type FieldReader a = String -> Either String a
-
--- | Convenient synonym for field name.
-type Name = String
-
--- | Convenient synonym for field help message.
-type Help = String
-
--- | A single field of a form.
-data Field a = Field
-  { fName     :: Name           -- ^ Name.
-  , fValidate :: FieldReader a  -- ^ Pure validation function.
-  , fHelp     :: Help           -- ^ Help message.
-  }
-
--- | Validation form is just a free applicative over Field.
-type Form = Ap Field
-
--- | Build a form with a single field.
-field :: Name -> FieldReader a -> Help -> Form a
-field n f h = liftAp $ Field n f h
-
--- | Singleton form accepting any input.
-string :: Name -> Help -> Form String
-string n h = field n Right h
-
--- | Singleton form accepting anything but mentioned values.
-available :: [String] -> Name -> Help -> Form String
-available xs n h = field n check h
-  where
-    check x | x `elem` xs = Left "the value is not available"
-            | otherwise   = Right x
-
--- | Singleton integer field form.
-int :: Name -> Form Int
-int name = field name readEither "an integer value"
-
--- | Generate help message for a form.
-help :: Form a -> String
-help = unlines . runAp_ (\f -> [fieldHelp f])
-
--- | Get help message for a field.
-fieldHelp :: Field a -> String
-fieldHelp (Field name _ msg) = printf "  %-15s - %s" name msg
-
--- | Count fields in a form.
-count :: Form a -> Int
-count = getSum . runAp_ (\_ -> Sum 1)
-
--- | Interactive input of a form.
--- Shows progress on each field.
--- Repeats field input until it passes validation.
--- Show help message on empty input.
-input :: Form a -> IO a
-input m = evalStateT (runAp inputField m) 1
-  where
-    inputField :: Field a -> StateT Int IO a
-    inputField f@(Field n g h) = do
-      i <- get
-      -- get field input with prompt
-      x <- liftIO $ do
-        putStr $ printf "[%d/%d] %s: " i (count m) n
-        hFlush stdout
-        getLine
-      case words x of
-        -- display help message for empty input
-        [] -> do
-          liftIO . putStrLn $ "help: " ++ h
-          inputField f
-        -- validate otherwise
-        _ -> case g x of
-               Right y -> do
-                 modify (+ 1)
-                 return y
-               Left  e -> do
-                 liftIO . putStrLn $ "error: " ++ e
-                 inputField f
-
--- | User datatype.
-data User = User
-  { userName     :: String
-  , userFullName :: String
-  , userAge      :: Int }
-  deriving (Show)
-
--- | Form for User.
-form :: [String] -> Form User
-form us = User
-  <$> available us  "Username"  "any vacant username"
-  <*> string        "Full name" "your full name (e.g. John Smith)"
-  <*> int           "Age"
-
-main :: IO ()
-main = do
-  putStrLn "Creating a new user."
-  putStrLn "Please, fill the form:"
-  user <- input (form ["bob", "alice"])
-  putStrLn $ "Successfully created user \"" ++ userName user ++ "\"!"
-
+module Main where++import Control.Applicative.Free+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Trans.State++import Data.Monoid (Sum(..))++import Text.Read (readEither)+import Text.Printf++import System.IO++-- | Field reader tries to read value or generates error message.+type FieldReader a = String -> Either String a++-- | Convenient synonym for field name.+type Name = String++-- | Convenient synonym for field help message.+type Help = String++-- | A single field of a form.+data Field a = Field+  { fName     :: Name           -- ^ Name.+  , fValidate :: FieldReader a  -- ^ Pure validation function.+  , fHelp     :: Help           -- ^ Help message.+  }++-- | Validation form is just a free applicative over Field.+type Form = Ap Field++-- | Build a form with a single field.+field :: Name -> FieldReader a -> Help -> Form a+field n f h = liftAp $ Field n f h++-- | Singleton form accepting any input.+string :: Name -> Help -> Form String+string n h = field n Right h++-- | Singleton form accepting anything but mentioned values.+available :: [String] -> Name -> Help -> Form String+available xs n h = field n check h+  where+    check x | x `elem` xs = Left "the value is not available"+            | otherwise   = Right x++-- | Singleton integer field form.+int :: Name -> Form Int+int name = field name readEither "an integer value"++-- | Generate help message for a form.+help :: Form a -> String+help = unlines . runAp_ (\f -> [fieldHelp f])++-- | Get help message for a field.+fieldHelp :: Field a -> String+fieldHelp (Field name _ msg) = printf "  %-15s - %s" name msg++-- | Count fields in a form.+count :: Form a -> Int+count = getSum . runAp_ (\_ -> Sum 1)++-- | Interactive input of a form.+-- Shows progress on each field.+-- Repeats field input until it passes validation.+-- Show help message on empty input.+input :: Form a -> IO a+input m = evalStateT (runAp inputField m) 1+  where+    inputField :: Field a -> StateT Int IO a+    inputField f@(Field n g h) = do+      i <- get+      -- get field input with prompt+      x <- liftIO $ do+        putStr $ printf "[%d/%d] %s: " i (count m) n+        hFlush stdout+        getLine+      case words x of+        -- display help message for empty input+        [] -> do+          liftIO . putStrLn $ "help: " ++ h+          inputField f+        -- validate otherwise+        _ -> case g x of+               Right y -> do+                 modify (+ 1)+                 return y+               Left  e -> do+                 liftIO . putStrLn $ "error: " ++ e+                 inputField f++-- | User datatype.+data User = User+  { userName     :: String+  , userFullName :: String+  , userAge      :: Int }+  deriving (Show)++-- | Form for User.+form :: [String] -> Form User+form us = User+  <$> available us  "Username"  "any vacant username"+  <*> string        "Full name" "your full name (e.g. John Smith)"+  <*> int           "Age"++main :: IO ()+main = do+  putStrLn "Creating a new user."+  putStrLn "Please, fill the form:"+  user <- input (form ["bob", "alice"])+  putStrLn $ "Successfully created user \"" ++ userName user ++ "\"!"+

@@ -1,121 +1,109 @@-name:          free-examples
-category:      Control, Monads
-version:       0.1
-license:       BSD3
-cabal-version: 1.18
-license-file:  LICENSE
-author:        Edward A. Kmett
-maintainer:    Edward A. Kmett <ekmett@gmail.com>
-stability:     provisional
-homepage:      http://github.com/ekmett/free/
-bug-reports:   http://github.com/ekmett/free/issues
-copyright:     Copyright (C) 2008-2015 Edward A. Kmett
-tested-with:   GHC == 7.4.2
-             , GHC == 7.6.3
-             , GHC == 7.8.4
-             , GHC == 7.10.3
-             , GHC == 8.0.2
-             , GHC == 8.2.2
-             , GHC == 8.4.4
-             , GHC == 8.6.5
-             , GHC == 8.8.4
-             , GHC == 8.10.7
-             , GHC == 9.0.2
-             , GHC == 9.2.2
-synopsis:      Monads for free
-description:   Examples projects using @free@
-build-type:    Simple
-
-source-repository head
-  type: git
-  location: git://github.com/ekmett/free.git
-
-flag mandelbrot-iter
-  default: True
-
-library
-  hs-source-dirs: .
-  default-language: Haskell2010
-  exposed-modules: Cabbage
-  ghc-options: -Wall
-  build-depends:
-    base         == 4.*,
-    base-compat  >= 0.6,
-    free,
-    mtl          >= 2.0.1 && < 2.4,
-    transformers >= 0.2   && < 0.7
-
-executable free-mandelbrot-iter
-  if !flag(mandelbrot-iter)
-    buildable: False
-  hs-source-dirs: .
-  default-language: Haskell2010
-  main-is: MandelbrotIter.lhs
-  ghc-options: -Wall
-  build-depends:
-    -- This unusually restrictive lower version bound on base is a workaround
-    -- for the fact that X11-1.10 does not build correctly on older versions of
-    -- base (see https://github.com/ekmett/free/runs/3235998897#step:18:237)
-    base >= 4.9 && < 5,
-    free,
-    HGL          >= 3.2.3.2,
-    mtl          >= 2.0.1 && < 2.4,
-    transformers >= 0.2   && < 0.7
-
-executable free-newton-coiter
-  hs-source-dirs: .
-  default-language: Haskell2010
-  main-is: NewtonCoiter.lhs
-  ghc-options: -Wall
-  build-depends:
-    base        == 4.*,
-    base-compat >= 0.6,
-    comonad     >= 4 && < 6,
-    free
-
-executable free-perf-th
-  hs-source-dirs: .
-  default-language: Haskell2010
-  main-is: PerfTH.hs
-  ghc-options: -Wall
-  build-depends:
-    base         == 4.*,
-    fail         == 4.9.*,
-    free,
-    rdtsc,
-    transformers >= 0.2   && < 0.7
-
-executable free-retry-th
-  hs-source-dirs: .
-  default-language: Haskell2010
-  main-is: RetryTH.hs
-  ghc-options: -Wall -fno-warn-orphans
-  build-depends:
-    base                == 4.*,
-    base-compat         >= 0.6,
-    fail                == 4.9.*,
-    free,
-    transformers        >= 0.2   && < 0.7,
-    transformers-compat >= 0.6.4 && < 0.8
-
-executable free-teletype
-  hs-source-dirs: .
-  default-language: Haskell2010
-  main-is: Teletype.lhs
-  ghc-options: -Wall
-  build-depends:
-    base        == 4.*,
-    base-compat >= 0.6,
-    free,
-    monad-loops
-
-executable free-validation-form
-  hs-source-dirs: .
-  default-language: Haskell2010
-  main-is: ValidationForm.hs
-  ghc-options: -Wall
-  build-depends:
-    base        == 4.*,
-    base-compat >= 0.6,
-    free,
-    transformers >= 0.2 && < 0.7
+name:          free-examples+category:      Control, Monads+version:       0.1+license:       BSD3+cabal-version: 1.18+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/ekmett/free/+bug-reports:   http://github.com/ekmett/free/issues+copyright:     Copyright (C) 2008-2015 Edward A. Kmett+tested-with:   GHC == 8.0.2+             , GHC == 8.2.2+             , GHC == 8.4.4+             , GHC == 8.6.5+             , GHC == 8.8.4+             , GHC == 8.10.7+             , GHC == 9.0.2+             , GHC == 9.2.6+             , GHC == 9.4.4+             , GHC == 9.6.1+synopsis:      Monads for free+description:   Examples projects using @free@+build-type:    Simple++source-repository head+  type: git+  location: git://github.com/ekmett/free.git++flag mandelbrot-iter+  default: True++library+  hs-source-dirs: .+  default-language: Haskell2010+  exposed-modules: Cabbage+  ghc-options: -Wall+  build-depends:+    base         >= 4.9 && < 5,+    free,+    mtl          >= 2.0.1 && < 2.4,+    transformers >= 0.2   && < 0.7++executable free-mandelbrot-iter+  if !flag(mandelbrot-iter)+    buildable: False+  hs-source-dirs: .+  default-language: Haskell2010+  main-is: MandelbrotIter.lhs+  ghc-options: -Wall+  build-depends:+    base         >= 4.9 && < 5,+    free,+    HGL          >= 3.2.3.2,+    mtl          >= 2.0.1 && < 2.4,+    transformers >= 0.2   && < 0.7++executable free-newton-coiter+  hs-source-dirs: .+  default-language: Haskell2010+  main-is: NewtonCoiter.lhs+  ghc-options: -Wall+  build-depends:+    base        >= 4.9 && < 5,+    comonad     >= 4 && < 6,+    free++executable free-perf-th+  hs-source-dirs: .+  default-language: Haskell2010+  main-is: PerfTH.hs+  ghc-options: -Wall+  build-depends:+    base         >= 4.9 && < 5,+    free,+    rdtsc,+    transformers >= 0.2   && < 0.7++executable free-retry-th+  hs-source-dirs: .+  default-language: Haskell2010+  main-is: RetryTH.hs+  ghc-options: -Wall -fno-warn-orphans+  build-depends:+    base                >= 4.9 && < 5,+    free,+    transformers        >= 0.2   && < 0.7,+    transformers-compat >= 0.6.4 && < 0.8++executable free-teletype+  hs-source-dirs: .+  default-language: Haskell2010+  main-is: Teletype.lhs+  ghc-options: -Wall+  build-depends:+    base        >= 4.9 && < 5,+    free,+    monad-loops++executable free-validation-form+  hs-source-dirs: .+  default-language: Haskell2010+  main-is: ValidationForm.hs+  ghc-options: -Wall+  build-depends:+    base        >= 4.9 && < 5,+    free,+    transformers >= 0.2 && < 0.7

@@ -1,166 +1,126 @@-name:          free
-category:      Control, Monads
-version:       5.1.10
-license:       BSD3
-cabal-version: 1.18
-license-file:  LICENSE
-author:        Edward A. Kmett
-maintainer:    Edward A. Kmett <ekmett@gmail.com>
-stability:     provisional
-homepage:      http://github.com/ekmett/free/
-bug-reports:   http://github.com/ekmett/free/issues
-copyright:     Copyright (C) 2008-2015 Edward A. Kmett
-tested-with:   GHC == 7.4.2
-             , GHC == 7.6.3
-             , GHC == 7.8.4
-             , GHC == 7.10.3
-             , GHC == 8.0.2
-             , GHC == 8.2.2
-             , GHC == 8.4.4
-             , GHC == 8.6.5
-             , GHC == 8.8.4
-             , GHC == 8.10.7
-             , GHC == 9.0.2
-             , GHC == 9.2.2
-synopsis:      Monads for free
-description:
-  Free monads are useful for many tree-like structures and domain specific languages.
-  .
-  If @f@ is a 'Functor' then the free 'Monad' on @f@ is the type
-  of trees whose nodes are labeled with the constructors of @f@. The word
-  \"free\" is used in the sense of \"unrestricted\" rather than \"zero-cost\":
-  @Free f@ makes no constraining assumptions beyond those given by @f@ and the
-  definition of 'Monad'. As used here it is a standard term from the
-  mathematical theory of adjoint functors.
-  .
-  Cofree comonads are dual to free monads. They provide convenient ways to talk
-  about branching streams and rose-trees, and can be used to annotate syntax
-  trees. The cofree comonad can be seen as a stream parameterized by a 'Functor'
-  that controls its branching factor.
-  .
-  More information on free monads, including examples, can be found in the
-  following blog posts:
-  <http://comonad.com/reader/2008/monads-for-free/>
-  <http://comonad.com/reader/2011/free-monads-for-less/>
-
-build-type:    Simple
-extra-source-files:
-  .ghci
-  .gitignore
-  .hlint.yaml
-  .vim.custom
-  README.markdown
-  CHANGELOG.markdown
-  doc/proof/Control/Comonad/Cofree/*.md
-  doc/proof/Control/Comonad/Trans/Cofree/*.md
-  examples/free-examples.cabal
-  examples/LICENSE
-  examples/*.hs
-  examples/*.lhs
-  include/free-common.h
-extra-doc-files:
-  examples/*.hs
-  examples/*.lhs
-
-source-repository head
-  type: git
-  location: git://github.com/ekmett/free.git
-
-library
-  hs-source-dirs: src
-  include-dirs: include
-  includes: free-common.h
-
-  default-language:   Haskell2010
-  default-extensions: CPP
-  other-extensions:
-    MultiParamTypeClasses
-    FunctionalDependencies
-    FlexibleInstances
-    UndecidableInstances
-    Rank2Types
-    GADTs
-
-  build-depends:
-    base                 >= 4.5     && < 5,
-    comonad              >= 5.0.8   && < 6,
-    containers           >= 0.3     && < 0.7,
-    distributive         >= 0.5.2   && < 1,
-    exceptions           >= 0.10.4  && < 0.11,
-    indexed-traversable  >= 0.1.1   && < 0.2,
-    semigroupoids        >= 5.3.5   && < 6,
-    th-abstraction       >= 0.4.2.0 && < 0.5,
-    transformers         >= 0.3     && < 0.7,
-    transformers-base    >= 0.4.5.2 && < 0.5,
-    template-haskell     >= 2.7.0.0 && < 2.20
-
-  -- GHC-7.8 bundles transformers-0.3,
-  -- mtl-2.2.* requires transformers >=0.4
-  if impl(ghc >=7.10)
-    build-depends:
-      mtl               >= 2.2.2 && < 2.4
-  else
-    build-depends:
-      mtl               >= 2.1.3.1 && < 2.4
-
-  -- recent profunctors dropped support for GHCs older than 7.8
-  if impl(ghc >=7.8)
-    build-depends:
-      profunctors >= 5.6.1 && < 6
-  else
-    build-depends:
-      profunctors >= 5.2.2 && < 5.3
-
-  if !impl(ghc >= 8.2)
-    build-depends: bifunctors >= 5.5.9 && < 6
-
-  if !impl(ghc >= 8.0)
-    build-depends: semigroups >= 0.18.5 && < 1
-
-  -- Ensure Data.Functor.Classes is always available
-  if impl(ghc >= 7.10)
-    build-depends: transformers >= 0.4.2.0
-  else
-    build-depends: transformers-compat >= 0.5.1.0 && <0.8
-
-  exposed-modules:
-    Control.Applicative.Free
-    Control.Applicative.Free.Fast
-    Control.Applicative.Free.Final
-    Control.Applicative.Trans.Free
-    Control.Alternative.Free
-    Control.Alternative.Free.Final
-    Control.Comonad.Cofree
-    Control.Comonad.Cofree.Class
-    Control.Comonad.Trans.Cofree
-    Control.Comonad.Trans.Coiter
-    Control.Monad.Free
-    Control.Monad.Free.Ap
-    Control.Monad.Free.Church
-    Control.Monad.Free.Class
-    Control.Monad.Free.TH
-    Control.Monad.Trans.Free
-    Control.Monad.Trans.Free.Ap
-    Control.Monad.Trans.Free.Church
-    Control.Monad.Trans.Iter
-
-  other-modules:
-    Data.Functor.Classes.Compat
-
-  ghc-options: -Wall
-
-  -- See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#base-4.9.0.0
-  if impl(ghc >= 8.0)
-    ghc-options: -Wcompat -Wnoncanonical-monad-instances
-
-    if !impl(ghc >= 8.8)
-      ghc-options: -Wnoncanonical-monadfail-instances
-  else
-    build-depends: fail == 4.9.*
-
-  if impl(ghc >= 9.0)
-    -- these flags may abort compilation with GHC-8.10
-    -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295
-    ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode
-
-  x-docspec-extra-packages: tagged
+name:          free+category:      Control, Monads+version:       5.2+license:       BSD3+cabal-version: 1.18+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/ekmett/free/+bug-reports:   http://github.com/ekmett/free/issues+copyright:     Copyright (C) 2008-2015 Edward A. Kmett+tested-with:   GHC == 8.0.2+             , GHC == 8.2.2+             , GHC == 8.4.4+             , GHC == 8.6.5+             , GHC == 8.8.4+             , GHC == 8.10.7+             , GHC == 9.0.2+             , GHC == 9.2.6+             , GHC == 9.4.4+             , GHC == 9.6.1+synopsis:      Monads for free+description:+  Free monads are useful for many tree-like structures and domain specific languages.+  .+  If @f@ is a 'Functor' then the free 'Monad' on @f@ is the type+  of trees whose nodes are labeled with the constructors of @f@. The word+  \"free\" is used in the sense of \"unrestricted\" rather than \"zero-cost\":+  @Free f@ makes no constraining assumptions beyond those given by @f@ and the+  definition of 'Monad'. As used here it is a standard term from the+  mathematical theory of adjoint functors.+  .+  Cofree comonads are dual to free monads. They provide convenient ways to talk+  about branching streams and rose-trees, and can be used to annotate syntax+  trees. The cofree comonad can be seen as a stream parameterized by a 'Functor'+  that controls its branching factor.+  .+  More information on free monads, including examples, can be found in the+  following blog posts:+  <https://ekmett.github.io/reader/2008/monads-for-free/>+  <https://ekmett.github.io/reader/2011/free-monads-for-less/>++build-type:    Simple+extra-source-files:+  .gitignore+  .hlint.yaml+  .vim.custom+  README.markdown+  CHANGELOG.markdown+  doc/proof/Control/Comonad/Cofree/*.md+  doc/proof/Control/Comonad/Trans/Cofree/*.md+  examples/free-examples.cabal+  examples/LICENSE+  examples/*.hs+  examples/*.lhs+extra-doc-files:+  examples/*.hs+  examples/*.lhs++source-repository head+  type: git+  location: git://github.com/ekmett/free.git++library+  hs-source-dirs: src++  default-language:   Haskell2010+  other-extensions:+    MultiParamTypeClasses+    FunctionalDependencies+    FlexibleInstances+    UndecidableInstances+    Rank2Types+    GADTs++  build-depends:+    base                 >= 4.9     && < 5,+    comonad              >= 5.0.8   && < 6,+    containers           >= 0.5.7.1 && < 0.7,+    distributive         >= 0.5.2   && < 1,+    exceptions           >= 0.10.4  && < 0.11,+    indexed-traversable  >= 0.1.1   && < 0.2,+    mtl                  >= 2.2.2   && < 2.4,+    profunctors          >= 5.6.1   && < 6,+    semigroupoids        >= 5.3.5   && < 6,+    th-abstraction       >= 0.4.2.0 && < 0.6,+    transformers         >= 0.5     && < 0.7,+    transformers-base    >= 0.4.5.2 && < 0.5,+    template-haskell     >= 2.11    && < 2.21++  if !impl(ghc >= 8.2)+    build-depends: bifunctor-classes-compat >= 0.1 && < 0.2++  exposed-modules:+    Control.Applicative.Free+    Control.Applicative.Free.Fast+    Control.Applicative.Free.Final+    Control.Applicative.Trans.Free+    Control.Alternative.Free+    Control.Alternative.Free.Final+    Control.Comonad.Cofree+    Control.Comonad.Cofree.Class+    Control.Comonad.Trans.Cofree+    Control.Comonad.Trans.Coiter+    Control.Monad.Free+    Control.Monad.Free.Ap+    Control.Monad.Free.Church+    Control.Monad.Free.Class+    Control.Monad.Free.TH+    Control.Monad.Trans.Free+    Control.Monad.Trans.Free.Ap+    Control.Monad.Trans.Free.Church+    Control.Monad.Trans.Iter++  ghc-options: -Wall -Wcompat -Wnoncanonical-monad-instances++  if !impl(ghc >= 8.8)+    ghc-options: -Wnoncanonical-monadfail-instances++  if impl(ghc >= 9.0)+    -- these flags may abort compilation with GHC-8.10+    -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295+    ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode++  x-docspec-extra-packages: tagged

@@ -1,23 +0,0 @@-#ifndef MIN_VERSION_base
-#define MIN_VERSION_base(x,y,z) 1
-#endif
-
-#ifndef MIN_VERSION_mtl
-#define MIN_VERSION_mtl(x,y,z) 1
-#endif
-
-#ifndef MIN_VERSION_transformers_compat
-#define MIN_VERSION_transformers_compat(x,y,z) 0
-#endif
-
-#if MIN_VERSION_base(4,9,0)
-#define LIFTED_FUNCTOR_CLASSES 1
-#else
-#if MIN_VERSION_transformers(0,5,0)
-#define LIFTED_FUNCTOR_CLASSES 1
-#else
-#if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)
-#define LIFTED_FUNCTOR_CLASSES 1
-#endif
-#endif
-#endif

@@ -1,164 +1,127 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-#if __GLASGOW_HASKELL__ >= 707
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE Safe #-}
-#else
--- Manual Typeable instances
-{-# LANGUAGE Trustworthy #-}
-#endif
-#include "free-common.h"
-
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Alternative.Free
--- Copyright   :  (C) 2012 Edward Kmett
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- Stability   :  provisional
--- Portability :  GADTs, Rank2Types
---
--- Left distributive 'Alternative' functors for free, based on a design
--- by Stijn van Drongelen.
-----------------------------------------------------------------------------
-module Control.Alternative.Free
-  ( Alt(..)
-  , AltF(..)
-  , runAlt
-  , liftAlt
-  , hoistAlt
-  ) where
-
-import Control.Applicative
-import Data.Functor.Apply
-import Data.Functor.Alt ((<!>))
-import qualified Data.Functor.Alt as Alt
-import Data.Typeable
-
-#if !(MIN_VERSION_base(4,11,0))
-import Data.Semigroup
-#endif
-
-infixl 3 `Ap`
-
-data AltF f a where
-  Ap     :: f a -> Alt f (a -> b) -> AltF f b
-  Pure   :: a                     -> AltF f a
-#if __GLASGOW_HASKELL__ >= 707
-  deriving Typeable
-#endif
-
-newtype Alt f a = Alt { alternatives :: [AltF f a] }
-#if __GLASGOW_HASKELL__ >= 707
-  deriving Typeable
-#endif
-
-instance Functor (AltF f) where
-  fmap f (Pure a) = Pure $ f a
-  fmap f (Ap x g) = x `Ap` fmap (f .) g
-
-instance Functor (Alt f) where
-  fmap f (Alt xs) = Alt $ map (fmap f) xs
-
-instance Applicative (AltF f) where
-  pure = Pure
-  {-# INLINE pure #-}
-  (Pure f)   <*> y         = fmap f y      -- fmap
-  y          <*> (Pure a)  = fmap ($ a) y  -- interchange
-  (Ap a f)   <*> b         = a `Ap` (flip <$> f <*> (Alt [b]))
-  {-# INLINE (<*>) #-}
-
-instance Applicative (Alt f) where
-  pure a = Alt [pure a]
-  {-# INLINE pure #-}
-
-  (Alt xs) <*> ys = Alt (xs >>= alternatives . (`ap'` ys))
-    where
-      ap' :: AltF f (a -> b) -> Alt f a -> Alt f b
-
-      Pure f `ap'` u      = fmap f u
-      (u `Ap` f) `ap'` v  = Alt [u `Ap` (flip <$> f) <*> v]
-  {-# INLINE (<*>) #-}
-
-liftAltF :: f a -> AltF f a
-liftAltF x = x `Ap` pure id
-{-# INLINE liftAltF #-}
-
--- | A version of 'lift' that can be used with any @f@.
-liftAlt :: f a -> Alt f a
-liftAlt = Alt . (:[]) . liftAltF
-{-# INLINE liftAlt #-}
-
--- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Alt' f@ to @g@.
-runAlt :: forall f g a. Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
-runAlt u xs0 = go xs0 where
-
-  go  :: Alt f b -> g b
-  go (Alt xs) = foldr (\r a -> (go2 r) <|> a) empty xs
-
-  go2 :: AltF f b -> g b
-  go2 (Pure a) = pure a
-  go2 (Ap x f) = flip id <$> u x <*> go f
-{-# INLINABLE runAlt #-}
-
-instance Apply (Alt f) where
-  (<.>) = (<*>)
-  {-# INLINE (<.>) #-}
-
-instance Alt.Alt (Alt f) where
-  (<!>) = (<|>)
-  {-# INLINE (<!>) #-}
-
-instance Alternative (Alt f) where
-  empty = Alt []
-  {-# INLINE empty #-}
-  Alt as <|> Alt bs = Alt (as ++ bs)
-  {-# INLINE (<|>) #-}
-
-instance Semigroup (Alt f a) where
-  (<>) = (<|>)
-  {-# INLINE (<>) #-}
-
-instance Monoid (Alt f a) where
-  mempty = empty
-  {-# INLINE mempty #-}
-  mappend = (<>)
-  {-# INLINE mappend #-}
-  mconcat as = Alt (as >>= alternatives)
-  {-# INLINE mconcat #-}
-
-hoistAltF :: (forall a. f a -> g a) -> AltF f b -> AltF g b
-hoistAltF _ (Pure a) = Pure a
-hoistAltF f (Ap x y) = Ap (f x) (hoistAlt f y)
-{-# INLINE hoistAltF #-}
-
--- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Alt f@ to @Alt g@.
-hoistAlt :: (forall a. f a -> g a) -> Alt f b -> Alt g b
-hoistAlt f (Alt as) = Alt (map (hoistAltF f) as)
-{-# INLINE hoistAlt #-}
-
-#if __GLASGOW_HASKELL__ < 707
-instance Typeable1 f => Typeable1 (Alt f) where
-  typeOf1 t = mkTyConApp altTyCon [typeOf1 (f t)] where
-    f :: Alt f a -> f a
-    f = undefined
-
-instance Typeable1 f => Typeable1 (AltF f) where
-  typeOf1 t = mkTyConApp altFTyCon [typeOf1 (f t)] where
-    f :: AltF f a -> f a
-    f = undefined
-
-altTyCon, altFTyCon :: TyCon
-#if __GLASGOW_HASKELL__ < 704
-altTyCon = mkTyCon "Control.Alternative.Free.Alt"
-altFTyCon = mkTyCon "Control.Alternative.Free.AltF"
-#else
-altTyCon = mkTyCon3 "free" "Control.Alternative.Free" "Alt"
-altFTyCon = mkTyCon3 "free" "Control.Alternative.Free" "AltF"
-#endif
-{-# NOINLINE altTyCon #-}
-{-# NOINLINE altFTyCon #-}
-#endif
+{-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Alternative.Free+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs, Rank2Types+--+-- Left distributive 'Alternative' functors for free, based on a design+-- by Stijn van Drongelen.+----------------------------------------------------------------------------+module Control.Alternative.Free+  ( Alt(..)+  , AltF(..)+  , runAlt+  , liftAlt+  , hoistAlt+  ) where++import Control.Applicative+import Data.Functor.Apply+import Data.Functor.Alt ((<!>))+import qualified Data.Functor.Alt as Alt++#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup+#endif++infixl 3 `Ap`++data AltF f a where+  Ap     :: f a -> Alt f (a -> b) -> AltF f b+  Pure   :: a                     -> AltF f a++newtype Alt f a = Alt { alternatives :: [AltF f a] }++instance Functor (AltF f) where+  fmap f (Pure a) = Pure $ f a+  fmap f (Ap x g) = x `Ap` fmap (f .) g++instance Functor (Alt f) where+  fmap f (Alt xs) = Alt $ map (fmap f) xs++instance Applicative (AltF f) where+  pure = Pure+  {-# INLINE pure #-}+  (Pure f)   <*> y         = fmap f y      -- fmap+  y          <*> (Pure a)  = fmap ($ a) y  -- interchange+  (Ap a f)   <*> b         = a `Ap` (flip <$> f <*> (Alt [b]))+  {-# INLINE (<*>) #-}++instance Applicative (Alt f) where+  pure a = Alt [pure a]+  {-# INLINE pure #-}++  (Alt xs) <*> ys = Alt (xs >>= alternatives . (`ap'` ys))+    where+      ap' :: AltF f (a -> b) -> Alt f a -> Alt f b++      Pure f `ap'` u      = fmap f u+      (u `Ap` f) `ap'` v  = Alt [u `Ap` (flip <$> f) <*> v]+  {-# INLINE (<*>) #-}++liftAltF :: f a -> AltF f a+liftAltF x = x `Ap` pure id+{-# INLINE liftAltF #-}++-- | A version of 'lift' that can be used with any @f@.+liftAlt :: f a -> Alt f a+liftAlt = Alt . (:[]) . liftAltF+{-# INLINE liftAlt #-}++-- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Alt' f@ to @g@.+runAlt :: forall f g a. Alternative g => (forall x. f x -> g x) -> Alt f a -> g a+runAlt u xs0 = go xs0 where++  go  :: Alt f b -> g b+  go (Alt xs) = foldr (\r a -> (go2 r) <|> a) empty xs++  go2 :: AltF f b -> g b+  go2 (Pure a) = pure a+  go2 (Ap x f) = flip id <$> u x <*> go f+{-# INLINABLE runAlt #-}++instance Apply (Alt f) where+  (<.>) = (<*>)+  {-# INLINE (<.>) #-}++instance Alt.Alt (Alt f) where+  (<!>) = (<|>)+  {-# INLINE (<!>) #-}++instance Alternative (Alt f) where+  empty = Alt []+  {-# INLINE empty #-}+  Alt as <|> Alt bs = Alt (as ++ bs)+  {-# INLINE (<|>) #-}++instance Semigroup (Alt f a) where+  (<>) = (<|>)+  {-# INLINE (<>) #-}++instance Monoid (Alt f a) where+  mempty = empty+  {-# INLINE mempty #-}+  mappend = (<>)+  {-# INLINE mappend #-}+  mconcat as = Alt (as >>= alternatives)+  {-# INLINE mconcat #-}++hoistAltF :: (forall a. f a -> g a) -> AltF f b -> AltF g b+hoistAltF _ (Pure a) = Pure a+hoistAltF f (Ap x y) = Ap (f x) (hoistAlt f y)+{-# INLINE hoistAltF #-}++-- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Alt f@ to @Alt g@.+hoistAlt :: (forall a. f a -> g a) -> Alt f b -> Alt g b+hoistAlt f (Alt as) = Alt (map (hoistAltF f) as)+{-# INLINE hoistAlt #-}

@@ -1,73 +1,73 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE Safe #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Alternative.Free.Final
--- Copyright   :  (C) 2012 Edward Kmett
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- Stability   :  provisional
--- Portability :  GADTs, Rank2Types
---
--- Final encoding of free 'Alternative' functors.
-----------------------------------------------------------------------------
-module Control.Alternative.Free.Final
-  ( Alt(..)
-  , runAlt
-  , liftAlt
-  , hoistAlt
-  ) where
-
-import Control.Applicative
-import Data.Functor.Apply
-import Data.Functor.Alt ((<!>))
-import qualified Data.Functor.Alt as Alt
-
-#if !(MIN_VERSION_base(4,11,0))
-import Data.Semigroup
-#endif
-
--- | The free 'Alternative' for any @f@.
-newtype Alt f a = Alt { _runAlt :: forall g. Alternative g => (forall x. f x -> g x) -> g a }
-
-instance Functor (Alt f) where
-  fmap f (Alt g) = Alt (\k -> fmap f (g k))
-
-instance Apply (Alt f) where
-  Alt f <.> Alt x = Alt (\k -> f k <*> x k)
-
-instance Applicative (Alt f) where
-  pure x = Alt (\_ -> pure x)
-  Alt f <*> Alt x = Alt (\k -> f k <*> x k)
-
-instance Alt.Alt (Alt f) where
-  Alt x <!> Alt y = Alt (\k -> x k <|> y k)
-
-instance Alternative (Alt f) where
-  empty = Alt (\_ -> empty)
-  Alt x <|> Alt y = Alt (\k -> x k <|> y k)
-  some (Alt x) = Alt $ \k -> some (x k)
-  many (Alt x) = Alt $ \k -> many (x k)
-
-instance Semigroup (Alt f a) where
-  (<>) = (<|>)
-
-instance Monoid (Alt f a) where
-  mempty = empty
-  mappend = (<>)
-
--- | A version of 'lift' that can be used with @f@.
-liftAlt :: f a -> Alt f a
-liftAlt f = Alt (\k -> k f)
-
--- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Alt' f@ to @g@.
-runAlt :: forall f g a. Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
-runAlt phi g = _runAlt g phi
-
--- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Alt f@ to @Alt g@.
-hoistAlt :: (forall a. f a -> g a) -> Alt f b -> Alt g b
-hoistAlt phi (Alt g) = Alt (\k -> g (k . phi))
-
+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Alternative.Free.Final+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs, Rank2Types+--+-- Final encoding of free 'Alternative' functors.+----------------------------------------------------------------------------+module Control.Alternative.Free.Final+  ( Alt(..)+  , runAlt+  , liftAlt+  , hoistAlt+  ) where++import Control.Applicative+import Data.Functor.Apply+import Data.Functor.Alt ((<!>))+import qualified Data.Functor.Alt as Alt++#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup+#endif++-- | The free 'Alternative' for any @f@.+newtype Alt f a = Alt { _runAlt :: forall g. Alternative g => (forall x. f x -> g x) -> g a }++instance Functor (Alt f) where+  fmap f (Alt g) = Alt (\k -> fmap f (g k))++instance Apply (Alt f) where+  Alt f <.> Alt x = Alt (\k -> f k <*> x k)++instance Applicative (Alt f) where+  pure x = Alt (\_ -> pure x)+  Alt f <*> Alt x = Alt (\k -> f k <*> x k)++instance Alt.Alt (Alt f) where+  Alt x <!> Alt y = Alt (\k -> x k <|> y k)++instance Alternative (Alt f) where+  empty = Alt (\_ -> empty)+  Alt x <|> Alt y = Alt (\k -> x k <|> y k)+  some (Alt x) = Alt $ \k -> some (x k)+  many (Alt x) = Alt $ \k -> many (x k)++instance Semigroup (Alt f a) where+  (<>) = (<|>)++instance Monoid (Alt f a) where+  mempty = empty+  mappend = (<>)++-- | A version of 'lift' that can be used with @f@.+liftAlt :: f a -> Alt f a+liftAlt f = Alt (\k -> k f)++-- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Alt' f@ to @g@.+runAlt :: forall f g a. Alternative g => (forall x. f x -> g x) -> Alt f a -> g a+runAlt phi g = _runAlt g phi++-- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Alt f@ to @Alt g@.+hoistAlt :: (forall a. f a -> g a) -> Alt f b -> Alt g b+hoistAlt phi (Alt g) = Alt (\k -> g (k . phi))+

@@ -1,144 +1,331 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE GADTs #-}
-#if __GLASGOW_HASKELL__ >= 707
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE Safe #-}
-#else
--- Manual Typeable instances
-{-# LANGUAGE Trustworthy #-}
-#endif
-#include "free-common.h"
-
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Applicative.Free
--- Copyright   :  (C) 2012-2013 Edward Kmett
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- Stability   :  provisional
--- Portability :  GADTs, Rank2Types
---
--- 'Applicative' functors for free
-----------------------------------------------------------------------------
-module Control.Applicative.Free
-  (
-  -- | Compared to the free monad, they are less expressive. However, they are also more
-  -- flexible to inspect and interpret, as the number of ways in which
-  -- the values can be nested is more limited.
-  --
-  -- See <http://arxiv.org/abs/1403.0749 Free Applicative Functors>,
-  -- by Paolo Capriotti and Ambrus Kaposi, for some applications.
-
-    Ap(..)
-  , runAp
-  , runAp_
-  , liftAp
-  , iterAp
-  , hoistAp
-  , retractAp
-
-  -- * Examples
-  -- $examples
-  ) where
-
-import Control.Applicative
-import Control.Comonad (Comonad(..))
-import Data.Functor.Apply
-import Data.Typeable
-
-#if !(MIN_VERSION_base(4,8,0))
-import Data.Monoid
-#endif
-
--- | The free 'Applicative' for a 'Functor' @f@.
-data Ap f a where
-  Pure :: a -> Ap f a
-  Ap   :: f a -> Ap f (a -> b) -> Ap f b
-#if __GLASGOW_HASKELL__ >= 707
-  deriving Typeable
-#endif
-
--- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Ap' f@ to @g@.
---
--- prop> runAp t == retractApp . hoistApp t
-runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a
-runAp _ (Pure x) = pure x
-runAp u (Ap f x) = flip id <$> u f <*> runAp u x
-
--- | Perform a monoidal analysis over free applicative value.
---
--- Example:
---
--- @
--- count :: Ap f a -> Int
--- count = getSum . runAp_ (\\_ -> Sum 1)
--- @
-runAp_ :: Monoid m => (forall a. f a -> m) -> Ap f b -> m
-runAp_ f = getConst . runAp (Const . f)
-
-instance Functor (Ap f) where
-  fmap f (Pure a)   = Pure (f a)
-  fmap f (Ap x y)   = Ap x ((f .) <$> y)
-
-instance Apply (Ap f) where
-  Pure f <.> y = fmap f y
-  Ap x y <.> z = Ap x (flip <$> y <.> z)
-
-instance Applicative (Ap f) where
-  pure = Pure
-  Pure f <*> y = fmap f y
-  Ap x y <*> z = Ap x (flip <$> y <*> z)
-
-instance Comonad f => Comonad (Ap f) where
-  extract (Pure a) = a
-  extract (Ap x y) = extract y (extract x)
-  duplicate (Pure a) = Pure (Pure a)
-  duplicate (Ap x y) = Ap (duplicate x) (extend (flip Ap) y)
-  
--- | A version of 'lift' that can be used with just a 'Functor' for @f@.
-liftAp :: f a -> Ap f a
-liftAp x = Ap x (Pure id)
-{-# INLINE liftAp #-}
-
--- | Tear down a free 'Applicative' using iteration.
-iterAp :: Functor g => (g a -> a) -> Ap g a -> a
-iterAp algebra = go
-  where go (Pure a) = a
-        go (Ap underlying apply) = algebra (go . (apply <*>) . pure <$> underlying)
-
--- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Ap f@ to @Ap g@.
-hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b
-hoistAp _ (Pure a) = Pure a
-hoistAp f (Ap x y) = Ap (f x) (hoistAp f y)
-
--- | Interprets the free applicative functor over f using the semantics for
---   `pure` and `<*>` given by the Applicative instance for f.
---
---   prop> retractApp == runAp id
-retractAp :: Applicative f => Ap f a -> f a
-retractAp (Pure a) = pure a
-retractAp (Ap x y) = x <**> retractAp y
-
-#if __GLASGOW_HASKELL__ < 707
-instance Typeable1 f => Typeable1 (Ap f) where
-  typeOf1 t = mkTyConApp apTyCon [typeOf1 (f t)] where
-    f :: Ap f a -> f a
-    f = undefined
-
-apTyCon :: TyCon
-#if __GLASGOW_HASKELL__ < 704
-apTyCon = mkTyCon "Control.Applicative.Free.Ap"
-#else
-apTyCon = mkTyCon3 "free" "Control.Applicative.Free" "Ap"
-#endif
-{-# NOINLINE apTyCon #-}
-
-#endif
-
-{- $examples
-
-<examples/ValidationForm.hs Validation form>
-
--}
+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Applicative.Free+-- Copyright   :  (C) 2012-2013 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs, Rank2Types+--+-- 'Applicative' functors for free+----------------------------------------------------------------------------+module Control.Applicative.Free+  (+  -- | Compared to the free monad, they are less expressive. However, they are also more+  -- flexible to inspect and interpret, as the number of ways in which+  -- the values can be nested is more limited.+  --+  -- See <http://arxiv.org/abs/1403.0749 Free Applicative Functors>,+  -- by Paolo Capriotti and Ambrus Kaposi, for some applications.++    Ap(..)+  , runAp+  , runAp_+  , liftAp+  , iterAp+  , hoistAp+  , retractAp++  -- * Examples+  -- $examples+  ) where++import Control.Applicative+import Control.Comonad (Comonad(..))+import Data.Functor.Apply+import Data.Foldable+import Data.Semigroup.Foldable+import Data.Functor.Classes++import Prelude hiding (null)++-- | The free 'Applicative' for a 'Functor' @f@.+data Ap f a where+  Pure :: a -> Ap f a+  Ap   :: f a -> Ap f (a -> b) -> Ap f b++-- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Ap' f@ to @g@.+--+-- prop> runAp t == retractApp . hoistApp t+runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a+runAp _ (Pure x) = pure x+runAp u (Ap f x) = flip id <$> u f <*> runAp u x++-- | Perform a monoidal analysis over free applicative value.+--+-- Example:+--+-- @+-- count :: Ap f a -> Int+-- count = getSum . runAp_ (\\_ -> Sum 1)+-- @+runAp_ :: Monoid m => (forall a. f a -> m) -> Ap f b -> m+runAp_ f = getConst . runAp (Const . f)++instance Functor (Ap f) where+  fmap f (Pure a)   = Pure (f a)+  fmap f (Ap x y)   = Ap x ((f .) <$> y)++instance Apply (Ap f) where+  Pure f <.> y = fmap f y+  Ap x y <.> z = Ap x (flip <$> y <.> z)++instance Applicative (Ap f) where+  pure = Pure+  Pure f <*> y = fmap f y+  Ap x y <*> z = Ap x (flip <$> y <*> z)++instance Comonad f => Comonad (Ap f) where+  extract (Pure a) = a+  extract (Ap x y) = extract y (extract x)+  duplicate (Pure a) = Pure (Pure a)+  duplicate (Ap x y) = Ap (duplicate x) (extend (flip Ap) y)++-- | @foldMap f == foldMap f . 'runAp' 'Data.Foldable.toList'@+instance Foldable f => Foldable (Ap f) where+  foldMap f (Pure a) = f a+  foldMap f (Ap x y) = foldMap (\a -> foldMap (\g -> f (g a)) y) x++  null (Pure _) = False+  null (Ap x y) = null x || null y++  length = go 1+    where+      -- This type annotation is required to do polymorphic recursion+      go :: Foldable t => Int -> Ap t a -> Int+      go n (Pure _) = n+      go n (Ap x y) = case n * length x of+        0  -> 0+        n' -> go n' y++-- | @foldMap f == foldMap f . 'runAp' 'toNonEmpty'@+instance Foldable1 f => Foldable1 (Ap f) where+  foldMap1 f (Pure a) = f a+  foldMap1 f (Ap x y) = foldMap1 (\a -> foldMap1 (\g -> f (g a)) y) x+++{- $note_eq1++This comment section is an internal documentation, but written in proper+Haddock markup. It is to allow rendering them to ease reading this rather long document.++=== About the definition of @Eq1 (Ap f)@ instance++The @Eq1 (Ap f)@ instance below has a complex definition. This comment+explains why it is defined like that.++The discussion given here also applies to @Ord1 (Ap f)@ instance with a little change.++==== General discussion about @Eq1@ type class++Currently, there isn't a law on the @Eq1@ type class, but the following+properties can be expected.++* If @Eq (f ())@, and @Functor f@ holds, @Eq1 f@ satisfies++    > liftEq (\_ _ -> True) x y == (() <$ x) == (() <$ y)++* If @Foldable f@ holds, @Eq1 f@ satisfies:++    * @boringEq x y@ implies @length (toList x) == length (toList y)@++    * @liftEq eq x y == liftEq (\_ _ -> True) && all (\(a,b) -> eq a b)) (zip (toList x) (toList y))@++Let's define the commonly used function @liftEq (\\_ _ -> True)@ as @boringEq@.++> boringEq :: Eq1 f => f a -> f b -> Bool+> boringEq = liftEq (\_ _ -> True)++Changing the constant @True@ to the constant @False@ in the definition of+@boringEq@, let @emptyEq@ function be defined as:++> emptyEq :: Eq1 f => f a -> f b -> Bool+> emptyEq = liftEq (\_ _ -> False)++From the above properties expectated on a @Eq1@ instance, @emptyEq@ satisfies the following.++> emptyEq x y = boringEq x y && null (zip (toList x) (toList y))++==== About @instance (Eq1 (Ap f))@++If we're to define @Eq1 (Ap f)@ satisfying these properties as expected, @Eq (Ap f ())@ will determine+how @liftEq@ should behave. It's not unreasonable to define equality between @Ap f ()@ as below.++> boringEqAp (Pure _) (Pure _) = True+> boringEqAp (Ap x1 y1) (Ap x2 y2) = boringEq x1 x2 && boringEqAp y1 y2+>    {-  = ((() <$ x1) == (() <$ x2)) && (y1 == y2)  -}+> boringEqAp _ _ = False++Its type can be more general than equality between @Ap f ()@:++> boringEqAp :: Eq1 f => Ap f a -> Ap f b -> Bool++Using @boringEqAp@, the specification of @liftEq@ will be:++> liftEq eq x y = boringEqAp x y && and (zipWith eq (toList x) (toList y))++Then unfold @toList@ to remove the dependency to @Foldable@.++> liftEq eq (Pure a1) (Pure a2)+>   = boringEqAp (Pure a1) (Pure a2) && all (\(a,b) -> eq a b)) (zip (toList (Pure x)) (toList Pure y))+>   = True && all (\(a,b) -> eq a b) (zip [a1] [a2])+>   = eq a1 a2+> liftEq eq (Ap x1 y1) (Ap x2 y2)+>   = boringEqAp (Ap x1 y1) (Ap x2 y2) && all (\(b1, b2) -> eq b1 b2) (zip (toList (Ap x1 y1)) (toList (Ap x2 y2)))+>   = boringEq x1 y1 && boringEqAp y1 y2 && all (\(b1, b2) -> eq b1 b2) (zip (toList x1 <**> toList y1) (toList x2 <**> toList y2))+>   = boringEq x1 y1 && boringEqAp y1 y2 && all (\(b1, b2) -> eq b1 b2) (zip (as1 <**> gs1) (as2 <**> gs2))+>        where as1 = toList x1+>              as2 = toList x2+>              gs1 = toList y1+>              gs2 = toList y2+>   = boringEq x1 y1 && boringEqAp y1 y2 && all (\(a1, a2) -> all (\(g1, g2) -> eq (g1 a1) (g2 a2)) (zip gs1 gs2)) (zip as1 as2)++If @zip as1 as2@ is /not/ empty, the following transformation is valid.++> (...) | not (null (zip as1 as2))+>   = boringEq x1 x2 && boringEqAp y1 y2 && all (\(a1, a2) -> all (\(g1, g2) -> eq (g1 a1) (g2 a2)) (zip gs1 gs2)) (zip as1 as2)+>   = boringEq x1 x2 && all (\(a1, a2) -> boringEqAp y1 y2 && all (\(g1, g2) -> eq (g1 a1) (g2 a2)) (zip gs1 gs2)) (zip as1 as2)+> --                                      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^+>   = boringEq x1 x2 && all (\(a1, a2) -> liftEq (\g1 g2 -> eq (g1 a1) (g2 a2)) y1 y2) (zip as1 as2)+>   = liftEq (\a1 a2 -> liftEq (\g1 g2 -> eq (g1 a1) (g2 a2)) y1 y2)) x1 x2++Because, generally, the following transformation is valid if @xs@ is a nonempty list.++> cond && all p xs = all (\x -> cond && p x) xs -- Only when xs is not empty!++If @zip as1 as2@ is empty, @all (...) (zip as1 as2)@ is vacuously true, so the following transformation is valid.++> (...) | null (zip as1 as2)+>   = boringEq x1 x2 && boringEqAp y1 y2 && all (\(a1, a2) -> all (\(g1, g2) -> eq (g1 a1) (g2 a2)) (zip gs1 gs2)) (zip as1 as2)+>   = boringEq x1 x2 && boringEqAp y1 y2++Combining two cases:++> liftEq eq (Ap x1 y1) (Ap x2 y2)+>   = null (zip as1 as2) && boringEq x1 x2 && boringEqAp y1 y2+>       || not (null (zip as1 as2)) && liftEq (\a1 a2 -> liftEq (\g1 g2 -> eq (g1 a1) (g2 a2)) y1 y2)) x1 x2+>   = null (zip as1 as2) && boringEq x1 x2 && boringEqAp y1 y2+>       || liftEq (\a1 a2 -> liftEq (\g1 g2 -> eq (g1 a1) (g2 a2)) y1 y2)) x1 x2+>   = emptyEq x1 x2 && boringEqAp y1 y2+>       || liftEq (\a1 a2 -> liftEq (\g1 g2 -> eq (g1 a1) (g2 a2)) y1 y2)) x1 x2++The property about @emptyEq@ is used in the last equation.++Hence it's defined as this source code.++-}++-- | Specialized 'boringEq' for @Ap f@.+boringEqAp :: Eq1 f => Ap f a -> Ap f b -> Bool+boringEqAp (Pure _) (Pure _) = True+boringEqAp (Ap x1 y1) (Ap x2 y2) = boringEq x1 x2 && boringEqAp y1 y2+boringEqAp _ _ = False++-- | Implementaion of 'liftEq' for @Ap f@.+liftEqAp :: Eq1 f => (a -> b -> Bool) -> Ap f a -> Ap f b -> Bool+liftEqAp eq (Pure a1) (Pure a2) = eq a1 a2+liftEqAp eq (Ap x1 y1) (Ap x2 y2)+    -- This branching is necessary and not just an optimization.+    -- See the above comment for more+  | emptyEq x1 x2 = boringEqAp y1 y2+  | otherwise =+      liftEq (\a1 a2 -> liftEqAp (\g1 g2 -> eq (g1 a1) (g2 a2)) y1 y2) x1 x2+liftEqAp _ _ _ = False++-- | @boringEq fa fb@ tests if @fa@ and @fb@ are equal ignoring any difference between+--   their content (the values of their last parameters @a@ and @b@.)+--+--   It is named \'boring\' because the type parameters @a@ and @b@ are+--   treated as if they are the most boring type @()@.+boringEq :: Eq1 f => f a -> f b -> Bool+boringEq = liftEq (\_ _ -> True)++-- | @emptyEq fa fb@ tests if @fa@ and @fb@ are equal /and/ they don't have any content+--   (the values of their last parameters @a@ and @b@.)+--+--   It is named \'empty\' because it only tests for values without any content,+--   like an empty list or @Nothing@.+--+--   If @f@ is also @Foldable@, @emptyEq fa fb@ would be equivalent to+--   @null fa && null fb && liftEq eq@ for any @eq :: a -> b -> Bool@.+--+--   (It depends on each instance of @Eq1@. Since @Eq1@ does not have+--   any laws currently, this is not a hard guarantee. But all instances in "base", "transformers",+--   "containers", "array", and "free" satisfy it.)+--+--   Note that @emptyEq@ is not a equivalence relation, since it's possible @emptyEq x x == False@.+emptyEq :: Eq1 f => f a -> f b -> Bool+emptyEq = liftEq (\_ _ -> False)++instance Eq1 f => Eq1 (Ap f) where+  liftEq = liftEqAp++instance (Eq1 f, Eq a) => Eq (Ap f a) where+  (==) = eq1++-- | Specialized 'boringCompare' for @Ap f@.+boringCompareAp :: Ord1 f => Ap f a -> Ap f b -> Ordering+boringCompareAp (Pure _) (Pure _) = EQ+boringCompareAp (Pure _) (Ap _ _) = LT+boringCompareAp (Ap x1 y1) (Ap x2 y2) = boringCompare x1 x2 `mappend` boringCompareAp y1 y2+boringCompareAp (Ap _ _) (Pure _) = GT++-- | Implementation of 'liftCompare' for @Ap f@+liftCompareAp :: Ord1 f => (a -> b -> Ordering) -> Ap f a -> Ap f b -> Ordering+liftCompareAp cmp (Pure a1) (Pure a2) = cmp a1 a2+liftCompareAp _   (Pure _) (Ap _ _) = LT+liftCompareAp cmp (Ap x1 y1) (Ap x2 y2)+    -- This branching is necessary and not just an optimization.+    -- See the above comment for more+  | emptyEq x1 x2 = boringCompareAp y1 y2+  | otherwise     = liftCompare (\a1 a2 -> liftCompareAp (\g1 g2 -> cmp (g1 a1) (g2 a2)) y1 y2) x1 x2+liftCompareAp _   (Ap _ _) (Pure _) = GT++-- | @boringCompare fa fb@ compares @fa@ and @fb@ ignoring any difference between+--   their content (the values of their last parameters @a@ and @b@.)+--+--   It is named \'boring\' because the type parameters @a@ and @b@ are+--   treated as if they are the most boring type @()@.+boringCompare :: Ord1 f => f a -> f b -> Ordering+boringCompare = liftCompare (\_ _ -> EQ)++instance Ord1 f => Ord1 (Ap f) where+  liftCompare = liftCompareAp++instance (Ord1 f, Ord a) => Ord (Ap f a) where+  compare = compare1++-- | A version of 'lift' that can be used with just a 'Functor' for @f@.+liftAp :: f a -> Ap f a+liftAp x = Ap x (Pure id)+{-# INLINE liftAp #-}++-- | Tear down a free 'Applicative' using iteration.+iterAp :: Functor g => (g a -> a) -> Ap g a -> a+iterAp algebra = go+  where go (Pure a) = a+        go (Ap underlying apply) = algebra (go . (apply <*>) . pure <$> underlying)++-- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Ap f@ to @Ap g@.+hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b+hoistAp _ (Pure a) = Pure a+hoistAp f (Ap x y) = Ap (f x) (hoistAp f y)++-- | Interprets the free applicative functor over f using the semantics for+--   `pure` and `<*>` given by the Applicative instance for f.+--+--   prop> retractApp == runAp id+retractAp :: Applicative f => Ap f a -> f a+retractAp (Pure a) = pure a+retractAp (Ap x y) = x <**> retractAp y++{- $examples++<examples/ValidationForm.hs Validation form>++-}

@@ -1,169 +1,121 @@-{-# LANGUAGE CPP                #-}
-{-# LANGUAGE GADTs              #-}
-{-# LANGUAGE RankNTypes         #-}
-#if __GLASGOW_HASKELL__ >= 707
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE Safe #-}
-#else
--- Manual Typeable instances
-{-# LANGUAGE Trustworthy #-}
-#endif
-#include "free-common.h"
-
---------------------------------------------------------------------------------
--- |
--- A faster free applicative.
--- Based on <https://www.eyrie.org/~zednenem/2013/05/27/freeapp Dave Menendez's work>.
---------------------------------------------------------------------------------
-module Control.Applicative.Free.Fast
-  (
-  -- * The Sequence of Effects
-    ASeq(..)
-  , reduceASeq
-  , hoistASeq
-  , traverseASeq
-  , rebaseASeq
-  -- * The Faster Free Applicative
-  , Ap(..)
-  , liftAp
-  , retractAp
-  , runAp
-  , runAp_
-  , hoistAp
-  ) where
-
-import           Control.Applicative
-import           Data.Functor.Apply
-import           Data.Typeable
-
-#if !(MIN_VERSION_base(4,8,0))
-import           Data.Monoid
-#endif
-
--- | The free applicative is composed of a sequence of effects,
--- and a pure function to apply that sequence to.
--- The fast free applicative separates these from each other,
--- so that the sequence may be built up independently,
--- and so that 'fmap' can run in constant time by having immediate access to the pure function.
-data ASeq f a where
-  ANil :: ASeq f ()
-  ACons :: f a -> ASeq f u -> ASeq f (a,u)
-#if __GLASGOW_HASKELL__ >= 707
-  deriving Typeable
-#endif
-
--- | Interprets the sequence of effects using the semantics for
---   `pure` and `<*>` given by the Applicative instance for 'f'.
-reduceASeq :: Applicative f => ASeq f u -> f u
-reduceASeq ANil         = pure ()
-reduceASeq (ACons x xs) = (,) <$> x <*> reduceASeq xs
-
--- | Given a natural transformation from @f@ to @g@ this gives a natural transformation from @ASeq f@ to @ASeq g@.
-hoistASeq :: (forall x. f x -> g x) -> ASeq f a -> ASeq g a
-hoistASeq _ ANil = ANil
-hoistASeq u (ACons x xs) = ACons (u x) (u `hoistASeq` xs)
-
--- | Traverse a sequence with resepect to its interpretation type 'f'.
-traverseASeq :: Applicative h => (forall x. f x -> h (g x)) -> ASeq f a -> h (ASeq g a)
-traverseASeq _ ANil      = pure ANil
-traverseASeq f (ACons x xs) = ACons <$> f x <*> traverseASeq f xs
-
--- | It may not be obvious, but this essentially acts like ++,
--- traversing the first sequence and creating a new one by appending the second sequence.
--- The difference is that this also has to modify the return functions and that the return type depends on the input types.
---
--- See the source of 'hoistAp' as an example usage.
-rebaseASeq :: ASeq f u -> (forall x. (x -> y) -> ASeq f x -> z) ->
-  (v -> u -> y) -> ASeq f v -> z
-rebaseASeq ANil         k f = k (\v -> f v ())
-rebaseASeq (ACons x xs) k f =
-  rebaseASeq xs (\g s -> k (\(a,u) -> g u a) (ACons x s))
-    (\v u a -> f v (a,u))
-
-
--- | The faster free 'Applicative'.
-newtype Ap f a = Ap
-  { unAp :: forall u y z.
-    (forall x. (x -> y) -> ASeq f x -> z) ->
-    (u -> a -> y) -> ASeq f u -> z }
-#if __GLASGOW_HASKELL__ >= 707
-  deriving Typeable
-#endif
-
--- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Ap' f@ to @g@.
---
--- prop> runAp t == retractApp . hoistApp t
-runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a
-runAp u = retractAp . hoistAp u
-
--- | Perform a monoidal analysis over free applicative value.
---
--- Example:
---
--- @
--- count :: Ap f a -> Int
--- count = getSum . runAp_ (\\_ -> Sum 1)
--- @
-runAp_ :: Monoid m => (forall a. f a -> m) -> Ap f b -> m
-runAp_ f = getConst . runAp (Const . f)
-
-instance Functor (Ap f) where
-  fmap g x = Ap (\k f -> unAp x k (\s -> f s . g))
-
-instance Apply (Ap f) where
-  (<.>) = (<*>)
-
-instance Applicative (Ap f) where
-  pure a = Ap (\k f -> k (`f` a))
-  x <*> y = Ap (\k f -> unAp y (unAp x k) (\s a g -> f s (g a)))
-
--- | A version of 'lift' that can be used with just a 'Functor' for @f@.
-liftAp :: f a -> Ap f a
-liftAp a = Ap (\k f s -> k (\(a',s') -> f s' a') (ACons a s))
-{-# INLINE liftAp #-}
-
--- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Ap f@ to @Ap g@.
-hoistAp :: (forall x. f x -> g x) -> Ap f a -> Ap g a
-hoistAp g x = Ap (\k f s ->
-  unAp x
-    (\f' s' ->
-      rebaseASeq (hoistASeq g s') k
-        (\v u -> f v (f' u)) s)
-    (const id)
-    ANil)
-
--- | Interprets the free applicative functor over f using the semantics for
---   `pure` and `<*>` given by the Applicative instance for f.
---
---   prop> retractApp == runAp id
-retractAp :: Applicative f => Ap f a -> f a
-retractAp x = unAp x (\f s -> f <$> reduceASeq s) (\() -> id) ANil
-
-#if __GLASGOW_HASKELL__ < 707
-instance Typeable1 f => Typeable1 (Ap f) where
-  typeOf1 t = mkTyConApp apTyCon [typeOf1 (f t)] where
-    f :: Ap f a -> f a
-    f = undefined
-
-apTyCon :: TyCon
-#if __GLASGOW_HASKELL__ < 704
-apTyCon = mkTyCon "Control.Applicative.Free.Fast.Ap"
-#else
-apTyCon = mkTyCon3 "free" "Control.Applicative.Free.Fast" "Ap"
-#endif
-{-# NOINLINE apTyCon #-}
-
-instance Typeable1 f => Typeable1 (ASeq f) where
-  typeOf1 t = mkTyConApp apTyCon [typeOf1 (f t)] where
-    f :: ASeq f a -> f a
-    f = undefined
-
-apSeqTyCon :: TyCon
-#if __GLASGOW_HASKELL__ < 704
-apSeqTyCon = mkTyCon "Control.Applicative.Free.Fast.ASeq"
-#else
-apSeqTyCon = mkTyCon3 "free" "Control.Applicative.Free.Fast" "ASeq"
-#endif
-{-# NOINLINE apSeqTyCon #-}
-
-#endif
+{-# LANGUAGE GADTs              #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE Safe #-}++--------------------------------------------------------------------------------+-- |+-- A faster free applicative.+-- Based on <https://www.eyrie.org/~zednenem/2013/05/27/freeapp Dave Menendez's work>.+--------------------------------------------------------------------------------+module Control.Applicative.Free.Fast+  (+  -- * The Sequence of Effects+    ASeq(..)+  , reduceASeq+  , hoistASeq+  , traverseASeq+  , rebaseASeq+  -- * The Faster Free Applicative+  , Ap(..)+  , liftAp+  , retractAp+  , runAp+  , runAp_+  , hoistAp+  ) where++import           Control.Applicative+import           Data.Functor.Apply++-- | The free applicative is composed of a sequence of effects,+-- and a pure function to apply that sequence to.+-- The fast free applicative separates these from each other,+-- so that the sequence may be built up independently,+-- and so that 'fmap' can run in constant time by having immediate access to the pure function.+data ASeq f a where+  ANil :: ASeq f ()+  ACons :: f a -> ASeq f u -> ASeq f (a,u)++-- | Interprets the sequence of effects using the semantics for+--   `pure` and `<*>` given by the Applicative instance for 'f'.+reduceASeq :: Applicative f => ASeq f u -> f u+reduceASeq ANil         = pure ()+reduceASeq (ACons x xs) = (,) <$> x <*> reduceASeq xs++-- | Given a natural transformation from @f@ to @g@ this gives a natural transformation from @ASeq f@ to @ASeq g@.+hoistASeq :: (forall x. f x -> g x) -> ASeq f a -> ASeq g a+hoistASeq _ ANil = ANil+hoistASeq u (ACons x xs) = ACons (u x) (u `hoistASeq` xs)++-- | Traverse a sequence with resepect to its interpretation type 'f'.+traverseASeq :: Applicative h => (forall x. f x -> h (g x)) -> ASeq f a -> h (ASeq g a)+traverseASeq _ ANil      = pure ANil+traverseASeq f (ACons x xs) = ACons <$> f x <*> traverseASeq f xs++-- | It may not be obvious, but this essentially acts like ++,+-- traversing the first sequence and creating a new one by appending the second sequence.+-- The difference is that this also has to modify the return functions and that the return type depends on the input types.+--+-- See the source of 'hoistAp' as an example usage.+rebaseASeq :: ASeq f u -> (forall x. (x -> y) -> ASeq f x -> z) ->+  (v -> u -> y) -> ASeq f v -> z+rebaseASeq ANil         k f = k (\v -> f v ())+rebaseASeq (ACons x xs) k f =+  rebaseASeq xs (\g s -> k (\(a,u) -> g u a) (ACons x s))+    (\v u a -> f v (a,u))+++-- | The faster free 'Applicative'.+newtype Ap f a = Ap+  { unAp :: forall u y z.+    (forall x. (x -> y) -> ASeq f x -> z) ->+    (u -> a -> y) -> ASeq f u -> z }++-- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Ap' f@ to @g@.+--+-- prop> runAp t == retractApp . hoistApp t+runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a+runAp u = retractAp . hoistAp u++-- | Perform a monoidal analysis over free applicative value.+--+-- Example:+--+-- @+-- count :: Ap f a -> Int+-- count = getSum . runAp_ (\\_ -> Sum 1)+-- @+runAp_ :: Monoid m => (forall a. f a -> m) -> Ap f b -> m+runAp_ f = getConst . runAp (Const . f)++instance Functor (Ap f) where+  fmap g x = Ap (\k f -> unAp x k (\s -> f s . g))++instance Apply (Ap f) where+  (<.>) = (<*>)++instance Applicative (Ap f) where+  pure a = Ap (\k f -> k (`f` a))+  x <*> y = Ap (\k f -> unAp y (unAp x k) (\s a g -> f s (g a)))++-- | A version of 'lift' that can be used with just a 'Functor' for @f@.+liftAp :: f a -> Ap f a+liftAp a = Ap (\k f s -> k (\(a',s') -> f s' a') (ACons a s))+{-# INLINE liftAp #-}++-- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Ap f@ to @Ap g@.+hoistAp :: (forall x. f x -> g x) -> Ap f a -> Ap g a+hoistAp g x = Ap (\k f s ->+  unAp x+    (\f' s' ->+      rebaseASeq (hoistASeq g s') k+        (\v u -> f v (f' u)) s)+    (const id)+    ANil)++-- | Interprets the free applicative functor over f using the semantics for+--   `pure` and `<*>` given by the Applicative instance for f.+--+--   prop> retractApp == runAp id+retractAp :: Applicative f => Ap f a -> f a+retractAp x = unAp x (\f s -> f <$> reduceASeq s) (\() -> id) ANil

@@ -1,91 +1,85 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE Safe #-}
-#include "free-common.h"
-
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Applicative.Free.Final
--- Copyright   :  (C) 2012-2013 Edward Kmett
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- Stability   :  provisional
--- Portability :  GADTs, Rank2Types
---
--- Final encoding of free 'Applicative' functors.
-----------------------------------------------------------------------------
-module Control.Applicative.Free.Final
-  (
-  -- | Compared to the free monad, they are less expressive. However, they are also more
-  -- flexible to inspect and interpret, as the number of ways in which
-  -- the values can be nested is more limited.
-
-    Ap(..)
-  , runAp
-  , runAp_
-  , liftAp
-  , hoistAp
-  , retractAp
-
-  -- * Examples
-  -- $examples
-  ) where
-
-import Control.Applicative
-import Data.Functor.Apply
-
-#if !(MIN_VERSION_base(4,8,0))
-import Data.Monoid
-#endif
-
--- | The free 'Applicative' for a 'Functor' @f@.
-newtype Ap f a = Ap { _runAp :: forall g. Applicative g => (forall x. f x -> g x) -> g a }
-
--- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Ap' f@ to @g@.
---
--- prop> runAp t == retractApp . hoistApp t
-runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a
-runAp phi m = _runAp m phi
-
--- | Perform a monoidal analysis over free applicative value.
---
--- Example:
---
--- @
--- count :: Ap f a -> Int
--- count = getSum . runAp_ (\\_ -> Sum 1)
--- @
-runAp_ :: Monoid m => (forall a. f a -> m) -> Ap f b -> m
-runAp_ f = getConst . runAp (Const . f)
-
-instance Functor (Ap f) where
-  fmap f (Ap g) = Ap (\k -> fmap f (g k))
-
-instance Apply (Ap f) where
-  Ap f <.> Ap x = Ap (\k -> f k <*> x k)
-
-instance Applicative (Ap f) where
-  pure x = Ap (\_ -> pure x)
-  Ap f <*> Ap x = Ap (\k -> f k <*> x k)
-
--- | A version of 'lift' that can be used with just a 'Functor' for @f@.
-liftAp :: f a -> Ap f a
-liftAp x = Ap (\k -> k x)
-
--- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Ap f@ to @Ap g@.
-hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b
-hoistAp f (Ap g) = Ap (\k -> g (k . f))
-
--- | Interprets the free applicative functor over f using the semantics for
---   `pure` and `<*>` given by the Applicative instance for f.
---
---   prop> retractApp == runAp id
-retractAp :: Applicative f => Ap f a -> f a
-retractAp (Ap g) = g id
-
-{- $examples
-
-<examples/ValidationForm.hs Validation form>
-
--}
+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Applicative.Free.Final+-- Copyright   :  (C) 2012-2013 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs, Rank2Types+--+-- Final encoding of free 'Applicative' functors.+----------------------------------------------------------------------------+module Control.Applicative.Free.Final+  (+  -- | Compared to the free monad, they are less expressive. However, they are also more+  -- flexible to inspect and interpret, as the number of ways in which+  -- the values can be nested is more limited.++    Ap(..)+  , runAp+  , runAp_+  , liftAp+  , hoistAp+  , retractAp++  -- * Examples+  -- $examples+  ) where++import Control.Applicative+import Data.Functor.Apply++-- | The free 'Applicative' for a 'Functor' @f@.+newtype Ap f a = Ap { _runAp :: forall g. Applicative g => (forall x. f x -> g x) -> g a }++-- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Ap' f@ to @g@.+--+-- prop> runAp t == retractApp . hoistApp t+runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a+runAp phi m = _runAp m phi++-- | Perform a monoidal analysis over free applicative value.+--+-- Example:+--+-- @+-- count :: Ap f a -> Int+-- count = getSum . runAp_ (\\_ -> Sum 1)+-- @+runAp_ :: Monoid m => (forall a. f a -> m) -> Ap f b -> m+runAp_ f = getConst . runAp (Const . f)++instance Functor (Ap f) where+  fmap f (Ap g) = Ap (\k -> fmap f (g k))++instance Apply (Ap f) where+  Ap f <.> Ap x = Ap (\k -> f k <*> x k)++instance Applicative (Ap f) where+  pure x = Ap (\_ -> pure x)+  Ap f <*> Ap x = Ap (\k -> f k <*> x k)++-- | A version of 'lift' that can be used with just a 'Functor' for @f@.+liftAp :: f a -> Ap f a+liftAp x = Ap (\k -> k x)++-- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Ap f@ to @Ap g@.+hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b+hoistAp f (Ap g) = Ap (\k -> g (k . f))++-- | Interprets the free applicative functor over f using the semantics for+--   `pure` and `<*>` given by the Applicative instance for f.+--+--   prop> retractApp == runAp id+retractAp :: Applicative f => Ap f a -> f a+retractAp (Ap g) = g id++{- $examples++<examples/ValidationForm.hs Validation form>++-}

@@ -1,233 +1,191 @@-{-# LANGUAGE CPP #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE GADTs #-}
-#if __GLASGOW_HASKELL__ >= 707
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE Safe #-}
-#else
--- Manual Typeable instances
-{-# LANGUAGE Trustworthy #-}
-#endif
-#include "free-common.h"
-
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Applicative.Trans.Free
--- Copyright   :  (C) 2012-2013 Edward Kmett
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Edward Kmett <ekmett@gmail.com>
--- Stability   :  provisional
--- Portability :  GADTs, Rank2Types
---
--- 'Applicative' functor transformers for free
-----------------------------------------------------------------------------
-module Control.Applicative.Trans.Free
-  (
-  -- | Compared to the free monad transformers, they are less expressive. However, they are also more
-  -- flexible to inspect and interpret, as the number of ways in which
-  -- the values can be nested is more limited.
-  --
-  -- See <http://paolocapriotti.com/assets/applicative.pdf Free Applicative Functors>,
-  -- by Paolo Capriotti and Ambrus Kaposi, for some applications.
-    ApT(..)
-  , ApF(..)
-  , liftApT
-  , liftApO
-  , runApT
-  , runApF
-  , runApT_
-  , hoistApT
-  , hoistApF
-  , transApT
-  , transApF
-  , joinApT
-  -- * Free Applicative
-  , Ap
-  , runAp
-  , runAp_
-  , retractAp
-  -- * Free Alternative
-  , Alt
-  , runAlt
-  ) where
-
-import Control.Applicative
-import Control.Monad (liftM)
-import Data.Functor.Apply
-import Data.Functor.Identity
-import Data.Typeable
-#if !(MIN_VERSION_base(4,8,0))
-import Data.Monoid (Monoid)
-#endif
-import qualified Data.Foldable as F
-
--- | The free 'Applicative' for a 'Functor' @f@.
-data ApF f g a where
-  Pure :: a -> ApF f g a
-  Ap   :: f a -> ApT f g (a -> b) -> ApF f g b
-#if __GLASGOW_HASKELL__ >= 707
-  deriving Typeable
-#endif
-
--- | The free 'Applicative' transformer for a 'Functor' @f@ over
--- 'Applicative' @g@.
-newtype ApT f g a = ApT { getApT :: g (ApF f g a) }
-#if __GLASGOW_HASKELL__ >= 707
-  deriving Typeable
-#endif
-
-instance Functor g => Functor (ApF f g) where
-  fmap f (Pure a) = Pure (f a)
-  fmap f (Ap x g) = x `Ap` fmap (f .) g
-
-instance Functor g => Functor (ApT f g) where
-  fmap f (ApT g) = ApT (fmap f <$> g)
-
-instance Applicative g => Applicative (ApF f g) where
-  pure = Pure
-  {-# INLINE pure #-}
-  Pure f   <*> y       = fmap f y      -- fmap
-  y        <*> Pure a  = fmap ($ a) y  -- interchange
-  Ap a f   <*> b       = a `Ap` (flip <$> f <*> ApT (pure b))
-  {-# INLINE (<*>) #-}
-
-instance Applicative g => Applicative (ApT f g) where
-  pure = ApT . pure . pure
-  {-# INLINE pure #-}
-  ApT xs <*> ApT ys = ApT ((<*>) <$> xs <*> ys)
-  {-# INLINE (<*>) #-}
-
-instance Applicative g => Apply (ApF f g) where
-  (<.>) = (<*>)
-  {-# INLINE (<.>) #-}
-
-instance Applicative g => Apply (ApT f g) where
-  (<.>) = (<*>)
-  {-# INLINE (<.>) #-}
-
-instance Alternative g => Alternative (ApT f g) where
-  empty = ApT empty
-  {-# INLINE empty #-}
-  ApT g <|> ApT h = ApT (g <|> h)
-  {-# INLINE (<|>) #-}
-
--- | A version of 'lift' that can be used with no constraint for @f@.
-liftApT :: Applicative g => f a -> ApT f g a
-liftApT x = ApT (pure (Ap x (pure id)))
-
--- | Lift an action of the \"outer\" 'Functor' @g a@ to @'ApT' f g a@.
-liftApO :: Functor g => g a -> ApT f g a
-liftApO g = ApT (Pure <$> g)
-
--- | Given natural transformations @f ~> h@ and @g . h ~> h@ this gives
--- a natural transformation @ApF f g ~> h@.
-runApF :: (Applicative h, Functor g) => (forall a. f a -> h a) -> (forall a. g (h a) -> h a) -> ApF f g b -> h b
-runApF _ _ (Pure x) = pure x
-runApF f g (Ap x y) = f x <**> runApT f g y
-
--- | Given natural transformations @f ~> h@ and @g . h ~> h@ this gives
--- a natural transformation @ApT f g ~> h@.
-runApT :: (Applicative h, Functor g) => (forall a. f a -> h a) -> (forall a. g (h a) -> h a) -> ApT f g b -> h b
-runApT f g (ApT a) = g (runApF f g <$> a)
-
--- | Perform a monoidal analysis over @'ApT' f g b@ value.
---
--- Examples:
---
--- @
--- height :: ('Functor' g, 'F.Foldable' g) => 'ApT' f g a -> 'Int'
--- height = 'getSum' . runApT_ (\_ -> 'Sum' 1) 'F.maximum'
--- @
---
--- @
--- size :: ('Functor' g, 'F.Foldable' g) => 'ApT' f g a -> 'Int'
--- size = 'getSum' . runApT_ (\_ -> 'Sum' 1) 'F.fold'
--- @
-runApT_ :: (Functor g, Monoid m) => (forall a. f a -> m) -> (g m -> m) -> ApT f g b -> m
-runApT_ f g = getConst . runApT (Const . f) (Const . g . fmap getConst)
-
--- | Given a natural transformation from @f@ to @f'@ this gives a monoidal natural transformation from @ApF f g@ to @ApF f' g@.
-hoistApF :: Functor g => (forall a. f a -> f' a) -> ApF f g b -> ApF f' g b
-hoistApF _ (Pure x) = Pure x
-hoistApF f (Ap x y) = f x `Ap` hoistApT f y
-
--- | Given a natural transformation from @f@ to @f'@ this gives a monoidal natural transformation from @ApT f g@ to @ApT f' g@.
-hoistApT :: Functor g => (forall a. f a -> f' a) -> ApT f g b -> ApT f' g b
-hoistApT f (ApT g) = ApT (hoistApF f <$> g)
-
--- | Given a natural transformation from @g@ to @g'@ this gives a monoidal natural transformation from @ApF f g@ to @ApF f g'@.
-transApF :: Functor g => (forall a. g a -> g' a) -> ApF f g b -> ApF f g' b
-transApF _ (Pure x) = Pure x
-transApF f (Ap x y) = x `Ap` transApT f y
-
--- | Given a natural transformation from @g@ to @g'@ this gives a monoidal natural transformation from @ApT f g@ to @ApT f g'@.
-transApT :: Functor g => (forall a. g a -> g' a) -> ApT f g b -> ApT f g' b
-transApT f (ApT g) = ApT $ f (transApF f <$> g)
-
--- | Pull out and join @m@ layers of @'ApT' f m a@.
-joinApT :: Monad m => ApT f m a -> m (Ap f a)
-joinApT (ApT m) = m >>= joinApF
-  where
-    joinApF (Pure x) = return (pure x)
-    joinApF (Ap x y) = (liftApT x <**>) `liftM` joinApT y
-
--- | The free 'Applicative' for a 'Functor' @f@.
-type Ap f = ApT f Identity
-
--- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Ap' f@ to @g@.
---
--- prop> runAp t == retractApp . hoistApp t
-runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a
-runAp f = runApT f runIdentity
-
--- | Perform a monoidal analysis over free applicative value.
---
--- Example:
---
--- @
--- count :: 'Ap' f a -> 'Int'
--- count = 'getSum' . runAp_ (\\_ -> 'Sum' 1)
--- @
-runAp_ :: Monoid m => (forall x. f x -> m) -> Ap f a -> m
-runAp_ f = runApT_ f runIdentity
-
--- | Interprets the free applicative functor over f using the semantics for
---   `pure` and `<*>` given by the Applicative instance for f.
---
---   prop> retractApp == runAp id
-retractAp :: Applicative f => Ap f a -> f a
-retractAp = runAp id
-
--- | The free 'Alternative' for a 'Functor' @f@.
-type Alt f = ApT f []
-
--- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Alt' f@ to @g@.
-runAlt :: (Alternative g, F.Foldable t) => (forall x. f x -> g x) -> ApT f t a -> g a
-runAlt f (ApT xs) = F.foldr (\x acc -> h x <|> acc) empty xs
-  where
-    h (Pure x) = pure x
-    h (Ap x g) = f x <**> runAlt f g
-
-#if __GLASGOW_HASKELL__ < 707
-instance (Typeable1 f, Typeable1 g) => Typeable1 (ApT f g) where
-  typeOf1 t = mkTyConApp apTTyCon [typeOf1 (f t)] where
-    f :: ApT f g a -> g (f a)
-    f = undefined
-
-instance (Typeable1 f, Typeable1 g) => Typeable1 (ApF f g) where
-  typeOf1 t = mkTyConApp apFTyCon [typeOf1 (f t)] where
-    f :: ApF f g a -> g (f a)
-    f = undefined
-
-apTTyCon, apFTyCon :: TyCon
-#if __GLASGOW_HASKELL__ < 704
-apTTyCon = mkTyCon "Control.Applicative.Trans.Free.ApT"
-apFTyCon = mkTyCon "Control.Applicative.Trans.Free.ApF"
-#else
-apTTyCon = mkTyCon3 "free" "Control.Applicative.Trans.Free" "ApT"
-apFTyCon = mkTyCon3 "free" "Control.Applicative.Trans.Free" "ApF"
-#endif
-{-# NOINLINE apTTyCon #-}
-{-# NOINLINE apFTyCon #-}
-#endif
+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Applicative.Trans.Free+-- Copyright   :  (C) 2012-2013 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs, Rank2Types+--+-- 'Applicative' functor transformers for free+----------------------------------------------------------------------------+module Control.Applicative.Trans.Free+  (+  -- | Compared to the free monad transformers, they are less expressive. However, they are also more+  -- flexible to inspect and interpret, as the number of ways in which+  -- the values can be nested is more limited.+  --+  -- See <http://paolocapriotti.com/assets/applicative.pdf Free Applicative Functors>,+  -- by Paolo Capriotti and Ambrus Kaposi, for some applications.+    ApT(..)+  , ApF(..)+  , liftApT+  , liftApO+  , runApT+  , runApF+  , runApT_+  , hoistApT+  , hoistApF+  , transApT+  , transApF+  , joinApT+  -- * Free Applicative+  , Ap+  , runAp+  , runAp_+  , retractAp+  -- * Free Alternative+  , Alt+  , runAlt+  ) where++import Control.Applicative+import Control.Monad (liftM)+import Data.Functor.Apply+import Data.Functor.Identity++-- | The free 'Applicative' for a 'Functor' @f@.+data ApF f g a where+  Pure :: a -> ApF f g a+  Ap   :: f a -> ApT f g (a -> b) -> ApF f g b++-- | The free 'Applicative' transformer for a 'Functor' @f@ over+-- 'Applicative' @g@.+newtype ApT f g a = ApT { getApT :: g (ApF f g a) }++instance Functor g => Functor (ApF f g) where+  fmap f (Pure a) = Pure (f a)+  fmap f (Ap x g) = x `Ap` fmap (f .) g++instance Functor g => Functor (ApT f g) where+  fmap f (ApT g) = ApT (fmap f <$> g)++instance Applicative g => Applicative (ApF f g) where+  pure = Pure+  {-# INLINE pure #-}+  Pure f   <*> y       = fmap f y      -- fmap+  y        <*> Pure a  = fmap ($ a) y  -- interchange+  Ap a f   <*> b       = a `Ap` (flip <$> f <*> ApT (pure b))+  {-# INLINE (<*>) #-}++instance Applicative g => Applicative (ApT f g) where+  pure = ApT . pure . pure+  {-# INLINE pure #-}+  ApT xs <*> ApT ys = ApT ((<*>) <$> xs <*> ys)+  {-# INLINE (<*>) #-}++instance Applicative g => Apply (ApF f g) where+  (<.>) = (<*>)+  {-# INLINE (<.>) #-}++instance Applicative g => Apply (ApT f g) where+  (<.>) = (<*>)+  {-# INLINE (<.>) #-}++instance Alternative g => Alternative (ApT f g) where+  empty = ApT empty+  {-# INLINE empty #-}+  ApT g <|> ApT h = ApT (g <|> h)+  {-# INLINE (<|>) #-}++-- | A version of 'lift' that can be used with no constraint for @f@.+liftApT :: Applicative g => f a -> ApT f g a+liftApT x = ApT (pure (Ap x (pure id)))++-- | Lift an action of the \"outer\" 'Functor' @g a@ to @'ApT' f g a@.+liftApO :: Functor g => g a -> ApT f g a+liftApO g = ApT (Pure <$> g)++-- | Given natural transformations @f ~> h@ and @g . h ~> h@ this gives+-- a natural transformation @ApF f g ~> h@.+runApF :: (Applicative h, Functor g) => (forall a. f a -> h a) -> (forall a. g (h a) -> h a) -> ApF f g b -> h b+runApF _ _ (Pure x) = pure x+runApF f g (Ap x y) = f x <**> runApT f g y++-- | Given natural transformations @f ~> h@ and @g . h ~> h@ this gives+-- a natural transformation @ApT f g ~> h@.+runApT :: (Applicative h, Functor g) => (forall a. f a -> h a) -> (forall a. g (h a) -> h a) -> ApT f g b -> h b+runApT f g (ApT a) = g (runApF f g <$> a)++-- | Perform a monoidal analysis over @'ApT' f g b@ value.+--+-- Examples:+--+-- @+-- height :: ('Functor' g, 'Foldable' g) => 'ApT' f g a -> 'Int'+-- height = 'getSum' . runApT_ (\_ -> 'Sum' 1) 'maximum'+-- @+--+-- @+-- size :: ('Functor' g, 'Foldable' g) => 'ApT' f g a -> 'Int'+-- size = 'getSum' . runApT_ (\_ -> 'Sum' 1) 'fold'+-- @+runApT_ :: (Functor g, Monoid m) => (forall a. f a -> m) -> (g m -> m) -> ApT f g b -> m+runApT_ f g = getConst . runApT (Const . f) (Const . g . fmap getConst)++-- | Given a natural transformation from @f@ to @f'@ this gives a monoidal natural transformation from @ApF f g@ to @ApF f' g@.+hoistApF :: Functor g => (forall a. f a -> f' a) -> ApF f g b -> ApF f' g b+hoistApF _ (Pure x) = Pure x+hoistApF f (Ap x y) = f x `Ap` hoistApT f y++-- | Given a natural transformation from @f@ to @f'@ this gives a monoidal natural transformation from @ApT f g@ to @ApT f' g@.+hoistApT :: Functor g => (forall a. f a -> f' a) -> ApT f g b -> ApT f' g b+hoistApT f (ApT g) = ApT (hoistApF f <$> g)++-- | Given a natural transformation from @g@ to @g'@ this gives a monoidal natural transformation from @ApF f g@ to @ApF f g'@.+transApF :: Functor g => (forall a. g a -> g' a) -> ApF f g b -> ApF f g' b+transApF _ (Pure x) = Pure x+transApF f (Ap x y) = x `Ap` transApT f y++-- | Given a natural transformation from @g@ to @g'@ this gives a monoidal natural transformation from @ApT f g@ to @ApT f g'@.+transApT :: Functor g => (forall a. g a -> g' a) -> ApT f g b -> ApT f g' b+transApT f (ApT g) = ApT $ f (transApF f <$> g)++-- | Pull out and join @m@ layers of @'ApT' f m a@.+joinApT :: Monad m => ApT f m a -> m (Ap f a)+joinApT (ApT m) = m >>= joinApF+  where+    joinApF (Pure x) = return (pure x)+    joinApF (Ap x y) = (liftApT x <**>) `liftM` joinApT y++-- | The free 'Applicative' for a 'Functor' @f@.+type Ap f = ApT f Identity++-- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Ap' f@ to @g@.+--+-- prop> runAp t == retractApp . hoistApp t+runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a+runAp f = runApT f runIdentity++-- | Perform a monoidal analysis over free applicative value.+--+-- Example:+--+-- @+-- count :: 'Ap' f a -> 'Int'+-- count = 'getSum' . runAp_ (\\_ -> 'Sum' 1)+-- @+runAp_ :: Monoid m => (forall x. f x -> m) -> Ap f a -> m+runAp_ f = runApT_ f runIdentity++-- | Interprets the free applicative functor over f using the semantics for+--   `pure` and `<*>` given by the Applicative instance for f.+--+--   prop> retractApp == runAp id+retractAp :: Applicative f => Ap f a -> f a+retractAp = runAp id++-- | The free 'Alternative' for a 'Functor' @f@.+type Alt f = ApT f []++-- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Alt' f@ to @g@.+runAlt :: (Alternative g, Foldable t) => (forall x. f x -> g x) -> ApT f t a -> g a+runAlt f (ApT xs) = foldr (\x acc -> h x <|> acc) empty xs+  where+    h (Pure x) = pure x+    h (Ap x g) = f x <**> runAlt f g