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

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)

-- | 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)

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

-- Problem: precomposing with a homomorphism isn't enough?
ernieAlgebra :: ErnieF Ernie -> Ernie
ernieAlgebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j
ernieAlgebra x                                           = embed x

-- | Dendromorphism collapsing the tree
collapseErnieSyntaxTree :: (Recursive Ernie) => Ernie -> Ernie
collapseErnieSyntaxTree = dendro (dummy :: Bert) bertAlgebra ernieAlgebra

-- | We get two dendromorphisms for the price of one!
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

-- | Catamorphism, which collapses the tree, but not very well.
collapseErnieSyntaxTree' :: (Recursive Ernie) => Ernie -> Ernie
collapseErnieSyntaxTree' = cata ernieAlgebra'

-- | Another catamorphism that is stupid and lame.
collapseBertSyntaxTree' :: (Recursive Bert) => Bert -> Bert
collapseBertSyntaxTree' = cata bertAlgebra'