{-# LANGUAGE KindSignatures, TypeFamilies, DeriveFunctor, DeriveTraversable,
DeriveFoldable, TypeOperators #-}
module Main where
import Data.Combinators.TH
--import Cp -- Program Calculus Combinators library
--import Data.Functor.Foldable -- Recursion schemes library
--import Data.Functor.Foldable.TH -- Recursion schemes makeBaseFunctor
import Data.List (foldl')
import Data.Functor.Compose
makeCombinator ''Compose
newtype Fix f = Fix { unFix :: f (Fix f) }
data Tree a = Leaf String | Node [a] deriving (Functor)
type Hash = Int
type PartiallySubstantiatedMerkleTree = Fix (((,) Hash) `Compose` Maybe `Compose` Tree)
makeCombinator ''Fix
{-
makeCombinator ''ListF
l :: [a] -> Integer
l = cata (listf zero (succ . p2))
data BTree a = Empty | Node(a, (BTree a, BTree a)) deriving Show
makeBaseFunctor ''BTree
makeCombinator ''BTree
makeCombinator ''BTreeF
countBTree :: BTree a -> Integer
countBTree = cata (btreef (const 0) (succ . uncurry (+) . p2))
data Expr a
= Lit a
| Add (Expr a) (Expr a)
| Expr a :* [Expr a]
deriving (Show)
makeBaseFunctor ''Expr
makeCombinator ''Expr
makeCombinator ''ExprF
eval :: Expr Integer -> Integer
eval = cata (exprf id add (uncurry $ foldl' (*)))
expr1 :: Expr Integer
expr1 = Add (Lit 2) (Mul (Lit 3) [Lit 4])
data A a = C { v :: a, w :: a } | D { x :: a, z :: a }
makeCombinator ''A
data ExprInfix a
= ExprInfix a :** [ExprInfix a]
| AddI (ExprInfix a) (ExprInfix a)
| LitI a
deriving (Show)
makeCombinator ''ExprInfix
{- GADTs are not currently supported!
data B = forall a. Eq a => B [a]
makeCombinator ''B
-}
-}
main :: IO ()
main = undefined