Examples.hs

{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveFoldable        #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DeriveTraversable     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}

-- | This module contains an example used by the test suite.
module Data.Functor.Foldable.Examples ( -- * Data Types
                                        Bert (..)
                                      , Ernie (..)
                                      , BertF (..)
                                      , ErnieF (..)
                                      -- * Catamorphisms
                                      , collapseErnieSyntaxTree
                                      , collapseErnieSyntaxTree'
                                      , collapseBertSyntaxTree
                                      , collapseBertSyntaxTree'
                                      ) where

import           Control.DeepSeq                     (NFData)
import           Data.Functor.Foldable
import           Data.Functor.Foldable.Extensions
import           Data.Functor.Foldable.Extensions.TH
import           Data.Functor.Foldable.TH
import           GHC.Generics                        (Generic)

-- | We call our co-dependent data types 'Ernie' and 'Bert'. They represent mutually recursive
data Bert = Bert Ernie
          | Num Integer
          | String String
          | Add Bert Bert
           deriving (Show, Eq, Generic, NFData)

data Ernie = Ernie Bert
           | Multiply Ernie Ernie
           | List [Ernie]
           deriving (Show, Eq, Generic, NFData)

makeBaseFunctor ''Ernie
makeBaseFunctor ''Bert

instance Dummy Bert where
    dummy = Num 3

instance Dummy Ernie where
    dummy = Ernie dummy

entanglePair ''Ernie ''Bert
entanglePair ''Bert ''Ernie

-- | BertF-algebra
bertAlgebra :: BertF Bert -> Bert
bertAlgebra (AddF (Num i) (Num j)) = Num $ i + j
bertAlgebra x                      = embed x

-- | ErnieF-algebra
ernieAlgebra :: ErnieF Ernie -> Ernie
ernieAlgebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j
ernieAlgebra x                                           = embed x

-- | Dendromorphism collapsing the tree. Note that we can use the same
-- F-algebras here as we would in a normal catamorphism.
collapseErnieSyntaxTree :: (Recursive Ernie) => Ernie -> Ernie
collapseErnieSyntaxTree = dendro (dummy :: Bert) bertAlgebra ernieAlgebra

-- | We can generate two functions by swapping the F-algebras and the dummy
-- type.
collapseBertSyntaxTree :: (Recursive Bert) => Bert -> Bert
collapseBertSyntaxTree = dendro (dummy :: Ernie) ernieAlgebra bertAlgebra

-- | Catamorphism, which collapses the tree the usual way.
collapseErnieSyntaxTree' :: (Recursive Ernie) => Ernie -> Ernie
collapseErnieSyntaxTree' = cata algebra
    where algebra (ErnieF e)                                  = Ernie $ collapseBertSyntaxTree' e
          algebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j
          algebra x                                           = embed x

collapseBertSyntaxTree' :: (Recursive Bert) => Bert -> Bert
collapseBertSyntaxTree' = cata algebra
    where algebra (BertF e)              = Bert $ collapseErnieSyntaxTree' e
          algebra (AddF (Num i) (Num j)) = Num $ i + j
          algebra x                      = embed x