content: Introduction
  ============
  
  - *Recursion Schemes* are essentially programming patterns
  - By structuring our programs in a well-defined way we can:
      - communicate and reason about our programs
      - reuse both code and ideas
      - use a catalogue of theorems to optimise or prove properties
      - identify and exploit opportunities for parallelism
  
  - In this literal Haskell talk, inspired by\
  *Origami progamming* [1], we'll attempt\
  to understand the theory via some\
  practical examples
  
  \vspace{0.75in}
  \begin{picture}(0,0)(0,0)
  \put(200,10){\includegraphics[height=1.25in]{images/origami.jpg}}
  \end{picture}
  
  
  Overview
  ========
  
  \begin{columns}
  \column{0.55\textwidth}
  \begin{itemize}
  \item Foldable \& Traversable
  \item Catamorphisms
  \item Fixed points of Functors
  \item Composing \& Combining Algebras
  \item Working with fixed data-types
  \item Anamorphisms \& Corecursion
  \item Hylomorphisms
  \item Paramorphisms
  \end{itemize}
  \column{0.45\textwidth}
  \begin{itemize}
  \item Compositional data-types
  \item Monadic variants
  \item Apomorphisms
  \item Memoization
  \item Zygomorphisms
  \item Histomorphisms
  \item Futumorphisms
  \item Conclusion
  \end{itemize}
  \end{columns}
  
  
  Language Pragmas
  ================
  
  > {-# LANGUAGE DeriveFunctor          #-}
  > {-# LANGUAGE DeriveFoldable         #-}
  > {-# LANGUAGE DeriveTraversable      #-}
  > {-# LANGUAGE FlexibleContexts       #-}
  > {-# LANGUAGE FlexibleInstances      #-}
  > {-# LANGUAGE StandaloneDeriving     #-}
  > {-# LANGUAGE UndecidableInstances   #-}
  > {-# LANGUAGE ScopedTypeVariables    #-}
  > {-# LANGUAGE ViewPatterns           #-}
  > {-# LANGUAGE TypeOperators          #-}
  > {-# LANGUAGE TupleSections          #-}
  > {-# LANGUAGE RankNTypes             #-}
  > {-# LANGUAGE MultiParamTypeClasses  #-}
  > {-# LANGUAGE FunctionalDependencies #-}
  
  Imports
  =======
  
  Haskell platform
  ----------------
  
  > import Prelude hiding
  >   (mapM, sequence, replicate, lookup, foldr, length)
  > import Control.Applicative
  >   (pure, many, empty, (<$>),(<*>),(<*),(*>),(<|>),(<$))
  > import Control.Arrow ((&&&),(***),(|||), first, second)
  > import Control.Monad hiding (mapM, sequence)
  > import Control.Monad.Reader hiding (mapM, sequence)
  > import Control.Monad.ST
  > import Data.Foldable (Foldable)
  > import qualified Data.Foldable as F
  
  ----
  
  > import Data.List (break)
  > import Data.Map (Map)
  > import qualified Data.Map as M
  > import Data.Set (Set)
  > import qualified Data.Set as S
  > import Data.Maybe
  > import Data.Monoid
  > import Data.Traversable
  > import Numeric
  >
  
  ----
  
  Third-party Hackage packages
  ----------------------------
  
  > import Data.Bool.Extras (bool)
  > import Data.Hashable
  > import Data.HashTable.Class (HashTable)
  > import qualified Data.HashTable.ST.Cuckoo as C
  > import qualified Data.HashTable.Class as H
  > import Text.ParserCombinators.Parsec
  >     hiding (space, many, (<|>))
  > import Text.PrettyPrint.Leijen
  >     (Doc, Pretty, (<+>), text, space, pretty)
  > import qualified Text.PrettyPrint.Leijen as PP
  
  
  Useful functions
  ================
  
  - fan-out or _fork_ \footnote{defined more generally in Control.Arrow}
  
  ~~~{.haskell}
  (&&&) :: (b -> c) -> (b -> c') -> b -> (c, c')
  (f &&& g) x = (f x, g x)
  ~~~
  
  - fan-in \footnotemark[\value{footnote}]
  
  ~~~{.haskell}
  (|||) ::: (b -> d) -> (c -> d) -> Either b c -> d
  (|||) = either
  ~~~
  
  ----
  
  - function product \footnotemark[\value{footnote}]
  
  ~~~{.haskell}
  (***) :: (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
  (f *** g) (x, y) = (f x, g y)
  ~~~
  
  - generalised unzip for functors
  
  > funzip :: Functor f => f (a, b) -> (f a, f b)
  > funzip = fmap fst &&& fmap snd
  
  
  Foldable
  ========
  
  The Foldable class gives you the ability to process the elements of a structure one-at-a-time, discarding the shape.
  
  - Intuitively: list-like fold methods
  - Derivable using the `DeriveFoldable` language pragma
  
  ~~~{.haskell}
  class Foldable t where
      foldMap :: Monoid m => (a -> m) -> t a -> m
      fold :: Monoid m => t m -> m
      foldr :: (a -> b -> b) -> b -> t a -> b
      foldl :: (a -> b -> a) -> a -> t b -> a
      foldr1 :: (a -> a -> a) -> t a -> a
      foldl1 :: (a -> a -> a) -> t a -> a
  ~~~
  
  ----
  
  ~~~{.haskell}
  data Tree a = Empty | Leaf a | Node (Tree a) (Tree a)
  
  instance Foldable Tree
    foldMap f Empty      = mempty
    foldMap f (Leaf x)   = f x
    foldMap f (Node l r) = foldMap f l <> foldMap f r
  
  count :: Foldable t => t a -> Int
  count = getSum . foldMap (const $ Sum 1)
  ~~~
  
  
  Traversable
  ===========
  
  Traversable gives you the ability to traverse a structure from left-to-right, performing an effectful action on each element and preserving the shape.
  
  - Intuitively: fmap with effects
  - Derivable using the `DeriveTraversable` language pragma
  - See _Applicative Programming with Effects_, by McBride and Paterson [2]
  
  ~~~{.haskell}
  class (Functor t, Foldable t) => Traversable t where
    traverse :: Applicative f =>
                (a -> f b) -> t a -> f (t b)
    sequenceA :: Applicative f => t (f a) -> f (t a)
    mapM :: Monad m => (a -> m b) -> t a -> m (t b)
    sequence :: Monad m => t (m a) -> m (t a)
  ~~~
  
  ----
  
  ~~~{.haskell}
  instance Traversable Tree where
    traverse f Empty = pure Empty
    traverse f (Leaf x) = Leaf <$> f x
    traverse f (Node k r) =
      Node <$> traverse f l <*> traverse f r
  ~~~
  
  Note:
  
  - `mapM` and `sequence` generalize Prelude functions of the same names
  - sequence can also be thought of as a generalised matrix transpose!
  
  ~~~{.haskell}
  sequence :: Monad m => t (m a) -> m (t a)
  sequence = mapM id
  ~~~
  
  ~~~
  sequence [putStrLn "a", putStrLn "b"] :: IO [()]
  ~~~
  
  ----
  
  What if we need to access the structure?
  ----------------------------------------
  
  We need to work with a domain of (`f a`) instead of `a`
  
  
  Catamorphisms
  =============
  
  A *catamorphism* (cata meaning “downwards”) is a generalisation of the concept of a fold.
  
  - models the fundamental pattern of (internal) *iteration*
  - for a list, it describes bracketing from the right
  - for a tree, it describes a bottom-up traversal, i.e. children first
  
  `foldr` from the Haskell Prelude is a specialised catamorphism:
  
  ~~~{.haskell}
  foldr :: (a -> b -> b) -> z -> [a] -> [b]
  foldr f z []     = z
  foldr f z (x:xs) = f x (foldr f z xs)
  ~~~
  
  ---
  
  - We can express the parameters used above in terms of a single
  _F-algebra_ `f b -> b` over a functor `f` and carrier `b`
  
  ~~~{.haskell}
  foldr :: (Maybe (a, b) -> b) -> [a] -> b
  foldr alg []     = alg $ Nothing
  foldr alg (x:xs) = alg $ Just (x, foldr alg xs)
  ~~~
  
  ----
  
  - We could also factor out the `List a` to `Maybe (a, [a])` isomorphism
  
  > foldr :: (Maybe (a, b) -> b) -> [a] -> b
  > foldr alg = alg . fmap (id *** foldr alg) . unList
  >   where
  >     unList []     = Nothing
  >     unList (x:xs) = Just (x, xs)
  
  > length :: [a] -> Int
  > length = foldr alg where
  >   alg :: Maybe (a, Int) -> Int
  >   alg Nothing        = 0
  >   alg (Just (_, xs)) = xs + 1
  
  ~~~
   > length "foobar"
   6
  ~~~
  
  ----
  
  This definition of `foldr` can literally be read from the commutative diagram below.\footnote{The nodes represent types (objects) and the edges functions (morphisms).}
  
  \vspace{0.2in}
  \centerline{\resizebox{4in}{!}{%
  \begin{tikzpicture}[auto, font=\small\sffamily]
    \node (ffixf) at (0,2.75) {\bf\it Maybe (a, [a])};
    \node (fixf) at (0,0) {\bf\it [a]};
    \node (fa) at (4.5,2.75) {\bf\it Maybe (a, b)};
    \node (a) at (4.5,0) {\bf\it b};
    \draw[->] (ffixf) to node {\tiny fmap (id *** foldr alg)} (fa);
    \draw[->] (fixf) to node {\tiny unList} (ffixf);
    \draw[->] (fixf) to node [swap] {\tiny foldr alg} (a);
    \draw[->] (fa) to node {\tiny alg} (a);
  \end{tikzpicture}
  }}
  
  ----
  
  - To demonstrate the expressiveness of foldr, we can even write a left fold using an algebra with a higher-order carrier
  
  > foldl :: forall a b. (b -> a -> b) -> [a] -> b -> b
  > foldl f = foldr alg where
  >   alg :: Maybe (a, b -> b) -> (b -> b)
  >   alg Nothing       = id
  >   alg (Just (x,xs)) = \r -> xs (f r x)
  
  
  Fixed points of Functors
  ========================
  
  An idea from category theory which gives:
  
  - data-type generic functions
  - compositional data
  
  Fixed points are represented by the type:
  
  > -- | the least fixpoint of functor f
  > newtype Fix f = Fix { unFix :: f (Fix f) }
  
  A functor `f` is a data-type of kind `* -> *` together
  with an `fmap` function.
  
  \centerline{$Fix \: f \cong f (f (f (f (f ... $ etc}
  
  \begin{picture}(0,0)(0,0)
  \put(210,110){\includegraphics[height=1in]{images/nuts-and-bolts.jpg}}
  \end{picture}
  
  ----
  
  Data-type generic programming
  -----------------------------
  
  - allows as to parametrise functions on the structure, or _shape_, of a data-type
  - useful for large complex data-types, where boilerplate traversal code often dominates, especially when updating a small subset of constructors
  - for recursion schemes, we can\
   capture the pattern as a \
   standalone combinator
  
  \begin{picture}(0,0)(0,0)
  \put(200,-35){\includegraphics[height=1.2in]{images/shapes.jpg}}
  \end{picture}
  
  ----
  
  Limitations
  -----------
  
  - The set of data-types that can be represented\
  by means of Fix is limited to _regular_ data-types\footnote{
  A data-type is regular if it does not contain function spaces
  and if the type constructor arguments are the same on both sides
  of the definition.}
  
  - Nested data-types and mutually recursive\
  data-types require higher-order approaches\footnote{More
  specifically, we need to fix higher-order functors.}
  
  
  \begin{picture}(0,0)(0,0)
  \put(235,-60){\includegraphics[height=0.66in]{images/warning.jpg}}
  \end{picture}
  
  ----
  
  - In order to work with lists using a data-type generic `cata` combinator, we need a new “unfixed” type representation
  
  > data ListF a r = C a r | N
  
  - `ListF a r` is not an ordinary functor, but we can define a polymorphic functor instance for `ListF a`
  
  > instance Functor (ListF a) where
  >   fmap f N        = N
  >   fmap f (C x xs) = C x (f xs)
  
  - we might also want a pattern functor for natural numbers!
  
  > data NatF r = Succ r | Zero deriving Functor
  
  ----
  
  Catamorphisms - revisited
  -------------------------
  
  - we would like to write foldr once for all data-types
  
  - category theory shows us how to define it data-type generically for a functor fixed-point
  
  ~~~{.haskell}
  cata :: Functor f => (f a -> a) -> Fix f -> a
  cata alg = alg . fmap (cata alg) . unFix
  ~~~
  
  ----
  
  Catamorphism
  ------------
  
  \vspace{0.2in}
  \centerline{\resizebox{3in}{!}{%
  \begin{tikzpicture}[node distance=2.75cm, auto, font=\small\sffamily]
    \node (ffixf) {\bf\it f (Fix f)};
    \node (fixf) [below of=ffixf] {\bf\it Fix f};
    \node (fa) [right of=ffixf] {\bf\it f a};
    \node (a) [right of=fixf] {\bf\it a};
    \draw[->] (ffixf) to node {\tiny fmap (cata alg)} (fa);
    \draw[->] (ffixf) to node [swap] {\tiny Fix} (fixf);
    \draw[->] (fixf) to node [swap] {\tiny cata alg} (a);
    \draw[->] (fa) to node {\tiny alg} (a);
  \end{tikzpicture}
  }}
  
  ----
  
  The catamorphism-fusion law
  ----------------------------
  
  The *catamorphism-fusion law* [3], arguably the most important law, can be used to transform the composition of a function with a catamorphism into single catamorphism, eliminating intermediate data structures.
  
  $$h \: . \: f = g\: . \: fmap \: h \implies h \: . \: cata \: f = cata \: g$$
  
  where
  
  ~~~{.haskell}
  f :: f a -> a
  g :: f b -> b
  h :: a -> b
  ~~~
  
  \begin{picture}(0,0)(0,0)
  \put(225,0){\includegraphics[height=1in]{images/fusion.png}}
  \end{picture}
  
  ----
  
  Example: a simple expression language
  -------------------------------------
  
  > data ExprF r = Const Int
  >              | Var   Id
  >              | Add   r r
  >              | Mul   r r
  >              | IfNeg r r r
  >                deriving ( Show, Eq, Ord, Functor
  >                         , Foldable, Traversable )
  
  > type Id = String
  
  > type Expr = Fix ExprF
  
  
  The *pattern functor* `ExprF` represents the structure of type `Expr`
  
  The isomorphism between a data-type and its pattern functor
  type is witnessed by the functions `Fix` and `unFix`
  
  ----
  
  We can also conveniently derive instances for fixed functors, although
  this does require the controversial `UndecidableInstances` extension,
  amongst others.
  
  > deriving instance Show (f (Fix f)) => Show (Fix f)
  > deriving instance Eq (f (Fix f))   => Eq (Fix f)
  > deriving instance Ord (f (Fix f))  => Ord (Fix f)
  
  ----
  
  Example: evaluator with global environment
  ------------------------------------------
  
  > type Env = Map Id Int
  
  > eval :: Env -> Expr -> Maybe Int
  > eval env = cata (evalAlg env)
  
  > evalAlg :: Env -> ExprF (Maybe Int) -> Maybe Int
  > evalAlg env = alg where
  >   alg (Const c)     = pure c
  >   alg (Var i)       = M.lookup i env
  >   alg (Add x y)     = (+)  <$> x <*> y
  >   alg (Mul x y)     = (*)  <$> x <*> y
  >   alg (IfNeg t x y) = t >>= bool x y . (<0)
  
  ----
  
  An example expression
  ---------------------
  
  > e1 = Fix (Mul
  >            (Fix (IfNeg
  >                   (Fix (Mul (Fix (Const 1))
  >                             (Fix (Var "a"))))
  >                   (Fix (Add (Fix (Var "b"))
  >                             (Fix (Const 0))))
  >                   (Fix (Add (Fix (Var "b"))
  >                             (Fix (Const 2))))))
  >                 (Fix (Const 3)))
  
  NB. the `Fix` boilerplate could be removed by defining "smart" constructors.
  
  ----
  
  An example expression
  ---------------------
  
  \vspace{0.2in}
  \centerline{\hbox{%
  \begin{tikzpicture}[]
  \Tree [.Mul [.IfNeg [.Mul [.Const 1 ] [.Var a ] ] [.Add [.Var b ] [.Const 0 ] ] [.Add [.Var b ] [.Const 2 ] ] ] [.Const 3 ] ]
  \end{tikzpicture}
  }}
  
  ----
  
  > testEnv :: Env
  > testEnv = M.fromList [("a",1),("b",3)]
  
  ~~~
   > eval testEnv e1
   Just 9
  ~~~
  
  ----
  
  Example: a pretty printer
  -------------------------
  
  > ppr :: Expr -> Doc
  > ppr = cata pprAlg
  >
  > pprAlg :: ExprF Doc -> Doc
  > pprAlg (Const c)     = text $ show c
  > pprAlg (Var  i)      = text i
  > pprAlg (Add x y)     = PP.parens $ x <+> text "+" <+> y
  > pprAlg (Mul x y)     = PP.parens $ x <+> text "*" <+> y
  > pprAlg (IfNeg t x y) = PP.parens $ text "ifNeg"   <+> t
  >                         <+> text "then" <+> x
  >                         <+> text "else" <+> y
  
  ~~~
   > ppr e1
   ((ifNeg (1 * a) then (b + 0) else (b + 2)) * 3)
  ~~~
  
  ----
  
  Example: collecting free variables
  ----------------------------------
  
  > freeVars :: Expr -> Set Id
  > freeVars = cata alg where
  >     alg :: ExprF (Set Id) -> Set Id
  >     alg (Var i) = S.singleton i
  >     alg e = F.fold e
  
  ~~~
   > freeVars e1
   fromList ["a","b"]
  ~~~
  
  ----
  
  Example: substituting variables
  -------------------------------
  
  > substitute :: Map Id Expr -> Expr -> Expr
  > substitute env = cata alg where
  >   alg :: ExprF Expr -> Expr
  >   alg e@(Var i) = fromMaybe (Fix e) $ M.lookup i env
  >   alg e = Fix e
  
  ~~~
   > let sub = M.fromList [("b",Fix $ Var "a")]
   > freeVars $ substitute sub e1
   fromList ["a"]
  ~~~
  
  
  Composing Algebras
  ==================
  
  - It is **not** true in general that catamorphisms compose
  - However, there is a very useful special case!
  
  Example: an optimisation pipeline
  ---------------------------------
  
  > optAdd :: ExprF Expr -> Expr
  > optAdd (Add (Fix (Const 0)) e) = e
  > optAdd (Add e (Fix (Const 0))) = e
  > optAdd e = Fix e
  >
  > optMul :: ExprF Expr -> Expr
  > optMul (Mul (Fix (Const 1)) e) = e
  > optMul (Mul e (Fix (Const 1))) = e
  > optMul e = Fix e
  
  ----
  
  The following composition works, but involves two complete traversals:
  
  > optimiseSlow :: Expr -> Expr
  > optimiseSlow = cata optAdd . cata optMul
  
  We need an algebra composition operator that gives us *short-cut fusion*:
  
  ~~~{.haskell}
  cata f . cata g = cata (f `comp` g)
  ~~~
  
  For the special case:
  
  ~~~{.haskell}
  f :: f a -> a;  g :: g (Fix f) -> Fix f
  ~~~~
  
  for arbitrary functors `f` and `g`, this is simply: \
  `comp x y = x . unFix . y`
  
  ----
  
  We can now derive a more efficient optimise pipeline:\footnote{In practice, such a pipeline is likely to be iterated until an equality fixpoint is reached, hence efficiency is important.}
  
  > optimiseFast :: Expr -> Expr
  > optimiseFast = cata (optMul . unFix . optAdd)
  
  We have just applied the *catamorphism compose law* [3], usually stated in the form:
  
  ~~~{.haskell}
  f :: f a -> a
  h :: g a -> f a
  
  cata f . cata (Fix . h) = cata (f . h)
  ~~~
  
  
  Combining Algebras
  ==================
  
  - Algebras over the same functor but different carrier types can be combined as products, such that two or more catamorphisms are performed as one
  
  Given the following two algebras,
  
  ~~~{.haskell}
  f :: f a -> a;  g :: f b -> b
  ~~~
  
  we want an algebra of type `f (a, b) -> (a, b)`
  
  - We can use the *banana-split theorem* [3]:
  
  ~~~{.haskell}
  cata f &&& cata g =
      cata ( f . fmap fst &&&
             g . fmap snd )
  ~~~
  
  \begin{picture}(0,0)(0,0)
  \put(225,20){\includegraphics[height=0.8in]{images/banana-split.png}}
  \end{picture}
  
  ----
  
  - rewrite the product using `funzip`
  
  > algProd :: Functor f =>
  >            (f a -> a) -> (f b -> b) ->
  >            f (a, b) -> (a, b)
  > algProd f g = (f *** g) . funzip
  
  
  - we can also combine two algebras over different functors but the same carrier type into a coproduct
  
  > algCoprod :: (f a -> a) -> (g a -> a) ->
  >              Either (f a) (g a) -> a
  > algCoprod = (|||)
  
  
  Working with fixed data-types
  =============================
  
  We can use type classes and functional dependencies to transparently apply the isomorphism between the unfixed representation and the original fixed type, e.g. `[a]` for lists.
  
  > class Functor f => Fixpoint f t | t -> f where
  >   inF  :: f t -> t
  >   outF :: t -> f t
  
  > cata :: Fixpoint f t => (f a -> a) -> t -> a
  > cata alg = alg . fmap (cata alg) . outF
  
  ----
  
  Some example `Fixpoint` instances
  ---------------------------------
  
  > instance Functor f => Fixpoint f (Fix f) where
  >   inF  = Fix
  >   outF = unFix
  
  > instance Fixpoint (ListF a) [a] where
  >   inF N        = []
  >   inF (C x xs) = x : xs
  >   outF []      = N
  >   outF (x:xs)  = C x xs
  
  > instance Fixpoint NatF Integer where
  >   inF Zero           = 0
  >   inF (Succ n)       = n + 1
  >   outF n | n > 0     = Succ (n - 1)
  >          | otherwise = Zero
  
  
  Anamorphisms
  ============
  
  An *anamorphism* (ana meaning “upwards”) is a generalisation of the concept of an unfold.
  
  - The corecursive dual of catamorphisms
  - produces streams and other regular structures from a seed
  - `ana` for lists is unfoldr, view patterns help see the duality
  
  ~~~{.haskell}
  foldr :: (Maybe (a, b) -> b) -> [a] -> b
  foldr f []       = f $ Nothing
  foldr f (x : xs) = f $ Just (x, foldr f xs)
  ~~~
  
  > unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
  > unfoldr f (f -> Nothing)                   = []
  > unfoldr f (f -> Just (x, unfoldr f -> xs)) = x : xs
  
  ----
  
  Example: replicate the supplied seed by a given number
  ------------------------------------------------------
  
  > replicate :: Int -> a -> [a]
  > replicate n x = unfoldr c n where
  >   c 0 = Nothing
  >   c n = Just (x, n-1)
  
  ~~~
   > replicate 4 '*'
   "****"
  ~~~
  
  ----
  
  Example: split a list using a predicate
  ---------------------------------------
  
  > linesBy :: (t -> Bool) -> [t] -> [[t]]
  > linesBy p = unfoldr c where
  >     c []     = Nothing
  >     c xs     = Just $ second (drop 1) $ break p xs
  
  ~~~
   > linesBy (==',') "foo,bar,baz"
   ["foo","bar","baz"]
  ~~~
  
  ----
  
  Example: merging lists
  ----------------------
  
  Given two sorted lists, `mergeLists` merges them into one sorted list.
  
  > mergeLists :: forall a. Ord a => [a] -> [a] -> [a]
  > mergeLists = curry $ unfoldr c where
  >   c :: ([a], [a]) -> Maybe (a, ([a], [a]))
  >   c ([], [])   = Nothing
  >   c ([], y:ys) = Just (y, ([], ys))
  >   c (x:xs, []) = Just (x, (xs, []))
  >   c (x:xs, y:ys) | x <= y = Just (x, (xs, y:ys))
  >                  | x > y  = Just (y, (x:xs, ys))
  
  ~~~
   > mergeLists [1,4] [2,3,5]
   [1,2,3,4,5]
  ~~~
  
  ----
  
  Corecursion
  -----------
  
  An anamorphism is an example of *corecursion*, the dual of recursion. Corecursion produces (potentially infinite) codata, whereas ordinary recursion consumes (necessarily finite) data.
  
  - Using `cata` or `ana` only, our program is guaranteed to terminate
  - However, not every program can be written in terms of just `cata` or `ana`
  
  ----
  
  There is no enforced distinction between data and codata in Haskell, so we can make use of `Fix` again\footnote{In total functional languages like Agda and Coq, we would be required to make this distinction.}
  
  > -- | anamorphism
  > ana :: Functor f => (a -> f a) -> a -> Fix f
  > ana coalg = Fix . fmap (ana coalg) . coalg
  
  However, it it often useful to try to enforce this distinction, especially when working with streams.
  
  > -- | The greatest fixpoint of functor f
  > newtype Cofix f = Cofix { unCofix :: f (Cofix f) }
  
  > -- | an alternative anamorphism typed for codata
  > ana' :: Functor f => (a -> f a) -> a -> Cofix f
  > ana' coalg = Cofix . fmap (ana' coalg) . coalg
  
  ----
  
  Anamorphism
  -----------
  
  \vspace{0.2in}
  \centerline{\resizebox{3in}{!}{%
  \begin{tikzpicture}[node distance=2.75cm, auto, font=\small\sffamily]
    \node (ffixf) {\bf\it f (Cofix f)};
    \node (fixf) [below of=ffixf] {\bf\it Cofix f};
    \node (fa) [right of=ffixf] {\bf\it f a};
    \node (a) [right of=fixf] {\bf\it a};
    \draw[->] (fa) to node [swap] {\tiny fmap (ana coalg)} (ffixf);
    \draw[->] (fixf) to node {\tiny unFix} (ffixf);
    \draw[->] (a) to node [swap] {\tiny ana coalg} (fixf);
    \draw[->] (a) to node [swap] {\tiny coalg} (fa);
  \end{tikzpicture}
  }}
  
  ----
  
  Example: coinductive streams
  ----------------------------
  
  > data StreamF a r = S a r deriving Show
  > type Stream a = Cofix (StreamF a)
  
  > instance Functor (StreamF a) where
  >   fmap f (S x xs) = S x (f xs)
  
  stream constructor:
  
  > consS x xs = Cofix (S x xs)
  
  stream deconstructors:
  
  > headS (unCofix -> (S x _ )) = x
  > tailS (unCofix -> (S _ xs)) = xs
  
  ----
  
  - the function `iterateS` generates an infinite stream using the supplied iterator and seed
  
  > iterateS :: (a -> a) -> a -> Stream a
  > iterateS f = ana' c where
  >   c x = S x (f x)
  
  > s1 = iterateS (+1) 1
  
  ~~~
   > takeS 6 $ s1
   [1,2,3,4,5,6]
  ~~~
  
  
  Hylomorphism
  ============
  
  A *hylomorphism* is the composition of a catamorphism and an anamorphism.
  
  - models *general recursion* (!)
  - allows us to substitute any recursive control structure with a data structure
  - a representation which easily allows us to exploit parallelism
  
  > hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
  > hylo g h = cata g . ana h
  
  NB. hylomorphisms are **Turing complete**, so we have lost any termination guarantees.
  
  ----
  
  To see the explicit recursion, `cata` and `ana` can be fused together via substitution and the fmap-fusion Functor law:
  
  ~~~{.haskell}
  fmap p . fmap q = fmap (p . q)
  ~~~
  
  Giving:
  
  ~~~{.haskell}
  hylo f g = f . fmap (hylo f g) . g
  ~~~
  
  NB. this transformation is the basis for *deforestation*, eliminating intermediate data structures.
  
  - `cata` and `ana` could be defined simply as:
  
  ~~~{.haskell}
  cata f = hylo f unFix
  ana  g = hylo Fix g
  ~~~~
  
  ----
  
  Example: Merge sort
  -------------------
  
  We use a tree data-type to capture the divide-and-conquer pattern of recursion.
  
  > data LTreeF a r = Leaf a | Bin r r
  
  > merge :: Ord a => LTreeF a [a] -> [a]
  > merge (Leaf x) = [x]
  > merge (Bin xs ys) = mergeLists xs ys
  >
  > unflatten [x] = Leaf x
  > unflatten (half -> (xs, ys)) = Bin xs ys
  >
  
  > half xs = splitAt (length xs `div` 2) xs
  >
  
  ----
  
  - Finally, we can implement merge-sort as a hylomorphism
  
  > msort :: Ord a => [a] -> [a]
  > msort = hylo merge unflatten
  
  ~~~
   > msort [7,6,3,1,5,4,2]
   [1,2,3,4,5,6,7]
  ~~~
  
  \begin{picture}(0,0)(0,0)
  \put(165,-50){\resizebox{2in}{!}{%
  \begin{tikzpicture}[]
  \Tree [.Bin [.Bin [.Leaf 7 ] [.Bin [.Leaf 6 ] [.Leaf 3 ] ] ] [.Bin [.Bin [.Leaf 1 ] [.Leaf 5 ] ] [.Bin [.Leaf 4 ] [.Leaf 2 ] ] ] ]
  \end{tikzpicture}}}
  \end{picture}
  
  
  Paramorphisms
  =============
  
  A *paramorphism* (para meaning “beside”) is an extension of the concept of a catamorphism.
  
  - models *primitive recursion* over an inductive type
  - a convenient way of getting access to the original input structures
  - very useful in practice!
  
  For a pattern functor, a paramorphism is:
  
  ~~~{.haskell}
  para :: Fixpoint f t => (f (a, t) -> a ) -> t -> a
  para alg = fst . cata (alg &&& Fix . fmap snd)
  ~~~~
  
  ----
  
  For better efficiency, we can modify the original cata definition:
  
  > para :: Fixpoint f t => (f (a, t) -> a) -> t -> a
  > para alg = alg . fmap (para alg &&& id) . outF
  
  ----
  
  Example: computing the factorial
  --------------------------------
  
  - This is the classic example of primitive recursion
  - The usual Haskell example `fact n = foldr (*) [1..n]` is actually an unfold followed by a fold
  
  > fact :: Integer -> Integer
  > fact = para alg where
  >   alg Zero          = 1
  >   alg (Succ (f, n)) = f * (n + 1)
  
  $$
  \begin{array}{rcl}
  0! & = & 1 \\
  (n+1)! & = & n! * (n+1) \\
  \end{array}
  $$
  
  ~~~
   > fact 10
   3628800
  ~~~
  
  ----
  
  Example: sliding window
  -----------------------
  
  > sliding :: Int -> [a] -> [[a]]
  > sliding n = para alg where
  >   alg N             = []
  >   alg (C x (r, xs)) = take n (x:xs) : r
  
  NB. the lookahead via the input argument is left-to-right, whereas the input list is processed from the right.
  
  ~~~
   > sliding 3 [1..5]
   [[1,2,3],[2,3,4],[3,4,5],[4,5],[5]]
  ~~~
  
  ----
  
  Example: collecting all catamorphism sub-results
  ------------------------------------------------
  
  > cataTrace :: forall f a.
  >   (Functor f, Ord (f (Fix f)), Foldable f) =>
  >   (f a -> a) -> Fix f -> Map (Fix f) a
  > cataTrace alg = para phi where
  >   phi :: f (Map (Fix f) a, Fix f) -> Map (Fix f) a
  >   phi (funzip -> (fm, ft)) = M.insert k v m'
  >    where
  >      k  = Fix ft
  >      v  = alg $ fmap (m' M.!) ft
  >      m' = F.fold fm
  >
  
  ~~~
   > let m = cataTrace (evalAlg testEnv) $ optimiseFast e1
   > map (first ppr) $ M.toList m
   [(2,Just 2),(3,Just 3),(a,Just 1),(b,Just 3),
    ((b + 2),Just 5), ...
  ~~~
  
  
  Compositional Data-types
  ========================
  
  - “Unfixed” types can be composed in a modular fashion
  - explored in the seminar paper *Data types \a`a la carte* [4]
  
  > -- | The coproduct of pattern functors f and g
  > data (f :+: g) r = Inl (f r) | Inr (g r)
  
  > -- | The product of pattern functors f and g
  > data (f :*: g) r = (f r) :*: (g r)
  
  > -- | The free monad pattern functor
  > data FreeF f a r = FreeF (f r) | Pure a
  
  > -- | The cofree comonad pattern functor
  > data CofreeF f a r = CofreeF (f r) a
  
  \begin{picture}(0,0)(0,0)
  \put(240,10){\includegraphics[height=1in]{images/jigsaw.jpg}}
  \end{picture}
  
  ----
  
  Example: Templating
  -------------------
  
  - type-safe templating requires a syntax tree with holes
  - ideally we would parse a string template into such a tree, then fill the holes
  
  We use a *free monad* structure `Ctx f a` to represent a node with
  either a term of type `f` or a hole of type `a`.
  
  > -- | A Context is a term (f r) which can contain holes a
  > data CtxF f a r = Term (f r) | Hole a
  >                   deriving (Show, Functor)
  
  > -- | Context fixed-point type. A free monad.
  > type Ctx f a = Fix (CtxF f a)
  
  
  \begin{picture}(0,0)(0,0)
  \put(250,-15){\includegraphics[height=0.8in]{images/cookie-cutter.jpg}}
  \end{picture}
  
  ----
  
  Fill all the holes of type `a` in the template `Ctx f a` using the supplied function of type `a -> Fix f`
  
  > fillHoles :: forall f a. Functor f =>
  >              (a -> Fix f) -> Ctx f a -> Fix f
  > fillHoles g = cata alg where
  >   alg :: CtxF f a (Fix f) -> Fix f
  >   alg (Term t) = Fix t
  >   alg (Hole a) = g a
  
  ----
  
  We will add template variables to JSON by composing data types and parsers.
  
  - we need an “unfixed” JSON datatype and parser (see appendix)
  
  ~~~{.haskell}
  pJSValueF :: CharParser () r ->
               CharParser () (JSValueF r)
  ~~~
  
  > pJSValue :: CharParser () JSValue
  > pJSValue = fix $ \p -> Fix <$> pJSValueF p
  
  - compose a new `JSTemplate` type
  
  > type Name = String
  > type JSTemplate = Ctx JSValueF Name
  
  ----
  
  - define a parser for our variable syntax: `${name}`
  
  > pVar :: CharParser () Name
  > pVar = char '$' *> between (char '{') (char '}')
  >                      (many alphaNum)
  
  - compose the variable parser with the unfixed JSON parser
  
  > pJSTemplate :: CharParser () (Ctx JSValueF Name)
  > pJSTemplate = fix $ \p ->
  >   Fix <$> (Term <$> pJSValueF p <|> Hole <$> pVar)
  
  ----
  
  > temp1 = parse' pJSTemplate "[{\"foo\":${a}}]"
  
  ~~~
   > temp1
   Fix {unFix = Term (
     JSArray [Fix {unFix = Term (
       JSObject [("foo",Fix {unFix = Hole "a"})])}])})
  ~~~
  
  > vlookup :: Ord a => Map a JSValue -> a -> JSValue
  > vlookup env = fromMaybe (Fix JSNull) . (`M.lookup` env)
  
  ~~~
   > let env = M.fromList [("a", Fix $ JSNumber 42)]
   > fillHoles (vlookup env) temp1
   Fix {unFix =
     JSArray [Fix {unFix =
       JSObject [("foo",Fix {unFix = JSNumber 42.0})]}]}
  ~~~
  
  ----
  
  Example: Annotating
  -------------------
  
  - useful for storing intermediate values
  - inspired by ideas from *attribute grammars*
  
  We use a *cofree comonad* structure `Ann f a` to annotate our nodes of
  type `f` with attributes of type `a`.
  
  > -- | Annotate (f r) with attribute a
  > newtype AnnF f a r = AnnF (f r, a) deriving Functor
  
  > -- | Annotated fixed-point type. A cofree comonad.
  > type Ann f a = Fix (AnnF f a)
  
  > -- | Attribute of the root node
  > attr :: Ann f a -> a
  > attr (unFix -> AnnF (_, a)) = a
  
  \begin{picture}(0,0)(0,0)
  \put(225,10){\includegraphics[height=1in]{images/post-it-note.jpg}}
  \end{picture}
  
  ----
  
  > -- | strip attribute from root
  > strip :: Ann f a -> f (Ann f a)
  > strip (unFix -> AnnF (x, _)) = x
  
  > -- | strip all attributes
  > stripAll :: Functor f => Ann f a -> Fix f
  > stripAll = cata alg where
  >   alg (AnnF (x, _)) = Fix x
  
  > -- | annotation constructor
  > ann :: (f (Ann f a), a) -> Ann f a
  > ann = Fix . AnnF
  
  > -- | annotation deconstructor
  > unAnn :: Ann f a -> (f (Ann f a), a)
  > unAnn (unFix -> AnnF a) = a
  
  ----
  
  *Synthesized* attributes are created in a bottom-up traversal using a catamorphism.
  
  > synthesize :: forall f a. Functor f =>
  >               (f a -> a) -> Fix f -> Ann f a
  > synthesize f = cata alg where
  >   alg :: f (Ann f a) -> Ann f a
  >   alg = ann . (id &&& f . fmap attr)
  
  For example, annotating each node with the sizes of all subtrees:
  
  > sizes :: (Functor f, Foldable f) => Fix f -> Ann f Int
  > sizes = synthesize $ (+1) . F.sum
  
  ----
  
  A pretty-printing catamorphism over such an annotated tree:
  
  > pprAnn :: Pretty a => Ann ExprF a -> Doc
  > pprAnn = cata alg where
  >   alg (AnnF (d, a)) = pprAlg d <+>
  >                       text "@" <+> pretty a
  
  ~~~
   > pprAnn $ sizes e1
   ((ifNeg (1 @ 1 * a @ 1) @ 3
      then (b @ 1 + 0 @ 1) @ 3
      else (b @ 1 + 2 @ 1) @ 3) @ 10
        * 3 @ 1) @ 12
  ~~~
  
  ----
  
  annotated with sizes
  --------------------
  
  \vspace{0.2in}
  \centerline{\resizebox{4.5in}{!}{%
  \begin{tikzpicture}[]
  \Tree [.@ [.Mul [.@ [.IfNeg [.@ [.Mul [.@ [.Const 1 ] 1 ] [.@ [.Var a ] 1 ] ] 3 ] [.@ [.Add [.@ [.Var b ] 1 ] [.@ [.Const 0 ] 1 ] ] 3 ] [.@ [.Add [.@ [.Var b ] 1 ] [.@ [.Const 2 ] 1 ] ] 3 ] ] 10 ] [.@ [.Const 3 ] 1 ] ] 12 ]
  \end{tikzpicture}
  }}
  
  ----
  
  *Inherited* attributes are created in a top-down manner from an initial value.
  
  - we can still use a cata/paramorphism by using a higher-order carrier
  - the bottom-up traversal happens top-down when the built function is run
  
  > inherit :: forall f a. Functor f =>
  >             (Fix f -> a -> a) -> a -> Fix f -> Ann f a
  > inherit f root n = para alg n root where
  >   alg :: f (a -> Ann f a, Fix f) -> (a -> Ann f a)
  >   alg (funzip -> (ff, n)) p = ann (n', a)
  >     where
  >       a  = f (Fix n) p
  >       n' = fmap ($ a) ff
  
  ----
  
  For example, the `depths` function computes the depth of all subtrees:
  
  > depths :: Functor f => Fix f -> Ann f Int
  > depths = inherit (const (+1)) 0
  
  ~~~
   > pprAnn $ depths e1
   ((ifNeg (1 @ 4 * a @ 4) @ 3
      then (b @ 4 + 0 @ 4) @ 3
      else (b @ 4 + 2 @ 4) @ 3) @ 2
        * 3 @ 2) @ 1
  ~~~
  
  Note that we could combine the `synthesize` and `inherit` algebras and do both in one traversal.
  
  ----
  
  annotated with depths
  ---------------------
  
  \vspace{0.2in}
  \centerline{\resizebox{4.5in}{!}{%
  \begin{tikzpicture}[]
  \Tree [.@ [.Mul [.@ [.IfNeg [.@ [.Mul [.@ [.Const 1 ] 4 ] [.@ [.Var a ] 4 ] ] 3 ] [.@ [.Add [.@ [.Var b ] 4 ] [.@ [.Const 0 ] 4 ] ] 3 ] [.@ [.Add [.@ [.Var b ] 4 ] [.@ [.Const 2 ] 4 ] ] 3 ] ] 2 ] [.@ [.Const 3 ] 2 ] ] 1 ]
  \end{tikzpicture}
  }}
  
  
  Monadic variants
  ================
  
  A monadic carrier type `m a` gives an algebra `f (m a) -> m a`
  
  This is inconvenient, as we would have to explicitly sequence the embedded monadic values of the argument.
  
  We can define a variant combinator `cataM` that allows us to use an algebra with a monadic codomain only `f a -> m a`
  
  - sequencing is done automatically by using `mapM` instead of `fmap`
  - composition with the algebra must now happen in the Kleisli category
  
  > cataM :: (Monad m, Traversable f) =>
  >          (f a -> m a) -> Fix f -> m a
  > cataM algM = algM <=< (mapM (cataM algM) . unFix)
  
  ----
  
  Example: eval revisited
  -----------------------
  
  - `cataM` simplifies working with a monadic algebra carrier types\footnote{compare and contrast the `IfNeg` clause between eval and eval'}
  - monad transformers can offer much additional functionality, such as error handling
  
  > eval' :: Env -> Expr -> Maybe Int
  > eval' env = (`runReaderT` env) . cataM algM where
  >     algM :: ExprF Int -> ReaderT Env Maybe Int
  >     algM (Const c)     = return c
  >     algM (Var i)       = ask >>= lift . M.lookup i
  >     algM (Add x y)     = return $ x + y
  >     algM (Mul x y)     = return $ x * y
  >     algM (IfNeg t x y) = return $ bool x y (t<0)
  >
  
  NB. ReaderT would be especially useful for local environments.
  
  
  Memoization
  ===========
  
  - memoization, or caching, lets us trade space for time where necessary
  - since we restrict recursion to a library of standard combinators, we can define memoizing variants that can easily be swapped in
  
  
  - the simplest (pure) memoize function requires some kind of `Enumerable` context
  
  ~~~{.haskell}
  memoize :: Enumerable k => (k -> v) -> k -> v
  ~~~
  
  ----
  
  - a monadic codomain allows us to use e.g. an underlying State or ST monad
  
  > memoize :: Memo k v m => (k -> m v) -> k -> m v
  > memoize f x = lookup x >>= (`maybe` return)
  >   (f x >>= \r -> insert x r >> return r)
  
  > memoFix :: Memo k v m =>
  >            ((k -> m v) -> k -> m v) -> k -> m v
  > memoFix f = let mf = memoize (f mf) in mf
  
  ----
  
  - runs the memoized computation using a HashTable (see appendix for `Memo` instance)
  
  > runMemo ::
  >   (forall s. ReaderT (C.HashTable s k v) (ST s) a) -> a
  > runMemo m = runST $ H.new >>= runReaderT m
  
  - a (transparent) memoizing catamorphism
  
  > memoCata :: (Eq (f (Fix f)), Traversable f,
  >             Hashable (Fix f)) =>
  >             (f a -> a) -> Fix f -> a
  > memoCata f x = runMemo $
  >   memoFix (\rec -> fmap f . mapM rec . unFix) x
  
  **WARNING** this could result in a slowdown unless your algebra is significantly more expensive than a hash computation!
  
  
  Apomorphism
  ===========
  
  An *apomorphism* (apo meaning “apart”) is the categorical dual of a paramorphism and an extension of the concept of anamorphism (coinduction) [6].
  
  - models *primitive corecursion* over a coinductive type
  - allows us to short-circuit the traversal and immediately deliver a result
  
  > apo :: Fixpoint f t => (a -> f (Either a t)) -> a -> t
  > apo coa = inF . fmap (apo coa ||| id) . coa
  
  - can also be expressed in terms of an anamorphism
  
  ~~~{.haskell}
  apo :: Fixpoint f t => (a -> f (Either a t)) -> a -> t
  apo coa = ana (coa ||| fmap Right . outF) . Left
  ~~~
  
  ----
  
  The function `insertElem` uses an apomorphism to generate a new insertion step
  when `x>y`, but short-circuits to the final result when `x<=y`
  
  > insertElem :: forall a. Ord a => ListF a [a] -> [a]
  > insertElem = apo c where
  >   c :: ListF a [a] ->
  >        ListF a (Either (ListF a [a]) [a])
  >   c N        = N
  >   c (C x []) = C x (Left N)
  >   c (C x (y:xs))
  >     | x <= y = C x (Right (y:xs))
  >     | x > y  = C y (Left (C x xs))
  
  ----
  
  To implement insertion sort, we simply insert every element of the supplied list into a new list, using `cata`.
  
  > insertionSort :: Ord a => [a] -> [a]
  > insertionSort = cata insertElem
  
  
  Zygomorphism
  ============
  
  - asymmetric form of mutual iteration, where both a data consumer and an auxiliary function are defined
  - a generalisation of paramorphisms
  
  
  > algZygo :: Functor f =>
  >     (f  b     -> b) ->
  >     (f (a, b) -> a) ->
  >     f (a, b) -> (a, b)
  > algZygo f g = g &&& f . fmap snd
  
  > zygo :: Functor f =>
  >         (f b -> b) -> (f (a, b) -> a) -> Fix f -> a
  > zygo f g = fst . cata (algZygo f g)
  
  
  ----
  
  Example: using evaluation to find discontinuities
  -------------------------------------------------
  
  The aim is to count the number of live conditionals causing discontinuities due to an arbitrary supplied environment, in a single traversal.
  
  `discontAlg` takes as one of its embedded arguments, the result of evaluating the current term using the environment.
  
  > discontAlg :: ExprF (Sum Int, Maybe Int) -> Sum Int
  > discontAlg (IfNeg (t, tv) (x, xv) (y, yv))
  >   | isJust xv, isJust yv, xv == yv =  t <> x <> y
  >   | otherwise = maybe (Sum 1 <> t <> x <> y)
  >                       (bool (t <> y) (t <> x) . (<0)) tv
  > discontAlg e = F.fold . fmap fst $ e
  
  Note that we have to check for redundant live conditionals for which both branches evaluate to the same value.
  
  ----
  
  > -- | number of live conditionals
  > disconts :: Env -> Expr -> Int
  > disconts env = getSum . zygo (evalAlg env) discontAlg
  
  - expression `e2` is a function of variables `a` and `b`
  
  > e2 = Fix (IfNeg (Fix (Var "b")) e1 (Fix (Const 4)))
  
  ~~~
   >  freeVars e2
   fromList ["a","b"]
  ~~~
  
  ----
  
  - by supplying `disconts` with a value for `b`, we can look for discontinuities with respect to a new function over just `a`
  
  ~~~
   > ppr . optimiseFast $ e2
   (ifNeg b
     then
       ((ifNeg a then b else (b + 2)) * 3)
     else
       4)
  
   > disconts (M.fromList [("b",-1)]) e2
   1
  ~~~
  
  
  Histomorphism
  =============
  
  - introduced by Uustalu & Venu in 1999 [7]
  - models *course-of-value recursion* which allows us to use arbitrary previously computed values
  - useful for applying dynamic programming techniques to recursive structures
  
  A histomorphism moves bottom-up annotating the tree with results and finally collapses the tree producing the end result.
  
  > -- | Histomorphism
  > histo :: Fixpoint f t => (f (Ann f a) -> a) -> t -> a
  > histo alg = attr . cata (ann . (id &&& alg))
  
  ----
  
  Example: computing Fibonacci numbers
  ------------------------------------
  
  > fib :: Integer -> Integer
  > fib = histo f where
  >   f :: NatF (Ann NatF Integer) -> Integer
  >   f Zero                                        = 0
  >   f (Succ (unAnn -> (Zero,_)))                  = 1
  >   f (Succ (unAnn -> (Succ (unAnn -> (_,n)),m))) = m + n
  
  $$
  \begin{array}{rcl}
  F_0 & = & 0 \\
  F_1 & = & 1 \\
  F_n & = & F_{n-1} + F_{n-2} \\
  \end{array}
  $$
  
  ~~~
   > fib 100
   354224848179261915075
  ~~~
  
  ----
  
  Example: filtering by position
  ------------------------------
  
  The function `evens` takes every second element from the given list.
  
  > evens :: [a] -> [a]
  > evens = histo alg where
  >   alg N                      = []
  >   alg (C _ (strip -> N    )) = []
  >   alg (C _ (strip -> C x y)) = x : attr y
  
  ~~~
   > evens [1..6]
  [2,4,6]
  ~~~
  
  
  Futumorphism
  ============
  
  - introduced by Uustalu & Venu in 1999 [7]
  - the corecursive dual of the histomorphism
  - models *course-of-value* coiteration
  - allows us to produce one or more levels
  
  > futu :: Functor f => (a -> f (Ctx f a)) -> a -> Cofix f
  > futu coa = ana' ((coa ||| id) . unCtx) . hole
  
  > -- | deconstruct values of type Ctx f a
  > unCtx :: Ctx f a -> Either a (f (Ctx f a))
  > unCtx c = case unFix c of
  >   Hole x -> Left x
  >   Term t -> Right t
  
  > term = Fix . Term
  > hole = Fix . Hole
  
  ----
  
  Example: stream processing
  --------------------------
  
  The function `exch` pairwise exchanges the elements of any given stream.
  
  > exch :: Stream a -> Stream a
  > exch = futu coa where
  >   coa xs = S (headS $ tailS xs)
  >              (term $ S (headS xs)
  >                        (hole $ tailS $ tailS xs))
  >
  
  ~~~
   > takeS 10 $ exch s1
   [2,1,4,3,6,5,8,7,10,9]
  ~~~
  
   (1,(2,(3,(4,(5, ...
   (2,(1,(3,(4,(5, ...
   (2,(1,(4,(3,(5, ...
   etc
  
  
  Conclusion
  ==========
  
  - catamorphisms, anamorphisms and hylomorphisms (folds, unfolds, and refolds) are fundamental and together capture all recursive computation
  - other more exotic recursion schemes are based on the above and just offer more structure
  - applying these patterns will help us build more reliable, efficient and parallel programs
  - seek to avoid direct explicit recursion wherever possible
  
  ----
  
  Recursion   Corecursion   General
  ----------  ------------  ---------
  cata        ana           hylo
  para        apo
  histo       futu
  zygo
  
  Table: schemes we discussed in this talk
  
  
  References
  ==========
  
  [1] J. Gibbons, “Origami programming.”, The Fun of Programming, Palgrave, 2003.
  
  [2] C. McBride & R. Paterson, “Applicative programming with effects”, Journal of Functional Programming, vol. 18, no. 01, pp. 1-13, 2008.
  
  [3] E. Meijer, “Functional Programming with Bananas , Lenses , Envelopes and Barbed Wire”, 1991.
  
  [4] W. Swierstra, “Data types à la carte”, Journal of Functional Programming, vol. 18, no. 04, pp. 423–436, Mar. 2008.
  
  ----
  
  [5] L. Augusteijn, “Sorting morphisms” pp. 1–23. 3rd International Summer School on Advanced Functional Programming, volume 1608 of LNCS, 1998.
  
  [6] V. Vene, “Functional Programming with Apomorphisms (Corecursion)” pp. 147–161, 1998.
  
  [7] T. Uustalu & V. Venu, “Primitive (Co)Recursion and Course-of-Value (Co)Iteration, Categorically” Informatica, Vol. 10, No. 1, 5–26, 1999.
  
  
  Appendix
  ========
  
  memo monad class and HashTable instance
  ----------------------------------------
  
  > class Monad m => Memo k v m | m -> k, m -> v where
  >   lookup  :: k -> m (Maybe v)
  >   insert  :: k -> v -> m ()
  
  > -- | HashTable-based Memo monad
  > instance (Eq k, Hashable k, HashTable h) =>
  >          Memo k v (ReaderT (h s k v) (ST s)) where
  >   lookup k   = ask >>= \h -> lift $ H.lookup h k
  >   insert k v = ask >>= \h -> lift $ H.insert h k v
  
  ----
  
  Expr Hashable instance
  ----------------------
  
  > instance Hashable Expr where
  >   hashWithSalt s = F.foldl hashWithSalt s . unFix
  
  > instance Hashable r => Hashable (ExprF r) where
  >   hashWithSalt s (Const c)
  >     = 1 `hashWithSalt` s `hashWithSalt` c
  >   hashWithSalt s (Var id)
  >     = 2 `hashWithSalt` s `hashWithSalt` id
  >   hashWithSalt s (Add x y)
  >     = 3 `hashWithSalt` s `hashWithSalt` (x, y)
  >   hashWithSalt s (Mul x y)
  >     = 4 `hashWithSalt` s `hashWithSalt` (x, y)
  >   hashWithSalt s (IfNeg t x y)
  >     = 5 `hashWithSalt` s `hashWithSalt` (t, x, y)
  
  ----
  
  stream utilities
  ----------------
  
  > takeS :: Int -> Stream a -> [a]
  > takeS 0 _                   = []
  > takeS n (unCofix -> S x xs) = x : takeS (n-1) xs
  
  ----
  
  unfixed JSON data-type
  ----------------------
  
  > data JSValueF r
  >     = JSNull
  >     | JSBool     Bool
  >     | JSNumber   Double
  >     | JSString   String
  >     | JSArray    [r]
  >     | JSObject   [(String, r)]
  >     deriving (Show, Eq, Ord, Functor, Foldable)
  >
  > type JSValue = Fix JSValueF
  
  ----
  
  simple unfixed JSON parser
  --------------------------
  
  - Modified from code published in _Real World Haskell_
  
  > parse' :: CharParser () a -> String -> a
  > parse' p = either (error . show) id . parse p "(unknown)"
  
  > pJSValueF :: CharParser () r ->
  >              CharParser () (JSValueF r)
  > pJSValueF r = spaces *> pValue r
  
  > pSeries :: Char -> CharParser () r ->
  >            Char -> CharParser () [r]
  > pSeries left parser right =
  >     between (char left <* spaces) (char right) $
  >             (parser <* spaces) `sepBy`
  >                 (char ',' <* spaces)
  
  ----
  
  > pArray :: CharParser () r -> CharParser () [r]
  > pArray r = pSeries '[' r ']'
  
  > pObject :: CharParser () r -> CharParser () [(String, r)]
  > pObject r = pSeries '{' pField '}'
  >     where pField = (,) <$>
  >             (pString <* char ':' <* spaces) <*> r
  
  > pBool :: CharParser () Bool
  > pBool = True <$ string "true"
  >      <|> False <$ string "false"
  
  ----
  
  > pValue :: CharParser () r -> CharParser () (JSValueF r)
  > pValue r = value <* spaces
  >   where value = choice [ JSString <$> pString
  >                        , JSNumber <$> pNumber
  >                        , JSObject <$> pObject r
  >                        , JSArray <$> pArray r
  >                        , JSBool <$> pBool
  >                        , JSNull <$ string "null"
  >                        ]
  >                 <?> "JSON value"
  
  ----
  
  > pNumber :: CharParser () Double
  > pNumber = do s <- getInput
  >              case readSigned readFloat s of
  >                [(n, s')] -> n <$ setInput s'
  >                _         -> empty
  
  > pString :: CharParser () String
  > pString = between (char '\"') (char '\"') (many jchar)
  >     where jchar = char '\\' *> pEscape
  >               <|> satisfy (`notElem` "\"\\")
  
  > pEscape = choice (zipWith decode
  >                   "bnfrt\\\"/" "\b\n\f\r\t\\\"/")
  >     where decode c r = r <$ char c
  
  ----
  
  LTreeF functor instance
  -----------------------
  
  > instance Functor (LTreeF a) where
  >   fmap f (Leaf a)    = Leaf a
  >   fmap f (Bin r1 r2) = Bin (f r1) (f r2)
  >
  
  tikz-qtree printer for leaf trees
  ---------------------------------
  
  > pQtLTree :: Pretty a => Fix (LTreeF a) -> Doc
  > pQtLTree = (text "\\Tree" <+>) . cata alg where
  >   alg (Leaf a)  = node ".Leaf"$ pretty a
  >   alg (Bin l r) = node ".Bin" $ l <+> r
  
  ----
  
  a tikz-qtree printer
  --------------------
  
  > pQt :: Expr -> Doc
  > pQt = (text "\\Tree" <+>) . cata pQtAlg
  
  > pQtAlg :: ExprF Doc -> Doc
  > pQtAlg (Const c)     = node ".Const" $ text $ show c
  > pQtAlg (Var id)      = node ".Var"   $ text id
  > pQtAlg (Add x y)     = node ".Add"   $ x <+> y
  > pQtAlg (Mul x y)     = node ".Mul"   $ x <+> y
  > pQtAlg (IfNeg t x y) = node ".IfNeg" $ t <+> x <+> y
  >
  > node s d = PP.brackets $ text s <+> d PP.<> space
  
  ----
  
  tikz-qtree printer for annotated trees
  ---------------------------------------
  
  > pQtAnn :: Pretty a => Ann ExprF a -> Doc
  > pQtAnn = (text "\\Tree" <+>) . cata alg where
  >   alg (AnnF (d, a)) = node ".@" $ pQtAlg d <+> pretty a
  