Haskell doodle (F-Algebras, very short)

FAlgebra.hs

module FAlgebra where

-- https://www.schoolofhaskell.com/user/bartosz/understanding-algebras

{-
class Functor f where
  fmap :: (a -> b) -> f a -> f b
  (<$) :: a -> f b -> f a
  (<$) = fmap . const
  {-# MINIMAL fmap #-}
-}

type Algebra f a = f a -> a

data ExprF a
  = Const Integer
  | Add a a
  | Mul a a

-- fix :: a -> [a]
-- fix x = x : fix x
--
-- fix :: (a -> a) -> a
-- fix f = let x = f x in x
newtype Fix f = Fix (f (Fix f))

type Expr = Fix ExprF

expr :: Expr
expr = Fix $ (Fix $ Const 2) `Add` (Fix $ Const 3)

instance Functor ExprF where
  fmap _    (Const x)   = Const x
  fmap eval (x `Add` y) = (eval x) `Add` (eval y)
  fmap eval (x `Mul` y) = (eval x) `Mul` (eval y)

type ExprAlgebra = Algebra ExprF (Fix ExprF)

algebra :: ExprAlgebra
algebra = Fix