module Data.Foldable.Functor.Examples ( Bert (..)
, Ernie (..)
, BertF (..)
, ErnieF (..)
, collapseErnieSyntaxTree
, collapseErnieSyntaxTree'
, collapseBertSyntaxTree
, collapseBertSyntaxTree'
) where
import Data.Foldable.Functor.Extensions (Dummy (dummy), SubHom (homo),
dendro)
import Data.Functor.Foldable (Recursive, cata, embed)
import Data.Functor.Foldable.TH (makeBaseFunctor)
data Bert = Bert Ernie
| Num Integer
| String String
| Add Bert Bert
deriving (Show, Eq)
data Ernie = Ernie Bert
| Multiply Ernie Ernie
| List [Ernie]
deriving (Show, Eq)
makeBaseFunctor ''Bert
makeBaseFunctor ''Ernie
instance Dummy Bert where
dummy = Num 3
instance Dummy Ernie where
dummy = Ernie dummy
instance SubHom ErnieF BertF Ernie Bert where
homo ea alberta (BertF e) = Bert $ dendro (dummy :: Bert) alberta ea e
homo _ f b = f b
instance SubHom BertF ErnieF Bert Ernie where
homo alberta ea (ErnieF b) = Ernie $ dendro (dummy :: Ernie) ea alberta b
homo _ f e = f e
bertAlgebra :: BertF Bert -> Bert
bertAlgebra (AddF (Num i) (Num j)) = Num $ i + j
bertAlgebra x = embed x
ernieAlgebra :: ErnieF Ernie -> Ernie
ernieAlgebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j
ernieAlgebra x = embed x
collapseErnieSyntaxTree :: (Recursive Ernie) => Ernie -> Ernie
collapseErnieSyntaxTree = dendro (dummy :: Bert) bertAlgebra ernieAlgebra
collapseBertSyntaxTree :: (Recursive Bert) => Bert -> Bert
collapseBertSyntaxTree = dendro (dummy :: Ernie) ernieAlgebra bertAlgebra
bertAlgebra' :: BertF Bert -> Bert
bertAlgebra' (BertF e) = Bert $ collapseErnieSyntaxTree' e
bertAlgebra' (AddF (Num i) (Num j)) = Num $ i + j
bertAlgebra' x = embed x
ernieAlgebra' :: ErnieF Ernie -> Ernie
ernieAlgebra' (ErnieF e) = Ernie $ collapseBertSyntaxTree' e
ernieAlgebra' (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j
ernieAlgebra' x = embed x
collapseErnieSyntaxTree' :: (Recursive Ernie) => Ernie -> Ernie
collapseErnieSyntaxTree' = cata ernieAlgebra'
collapseBertSyntaxTree' :: (Recursive Bert) => Bert -> Bert
collapseBertSyntaxTree' = cata bertAlgebra'