{-# LANGUAGE RankNTypes #-}
import qualified Prelude
import Prelude (Show(..), Functor(..), ($), (++), Monoid(..))
------------------
data Bool
= False
| True
newtype BoolF = BoolF { bool :: forall a. a -> a -> a }
true, false :: BoolF
true = BoolF $ \x _ -> x
false = BoolF $ \_ x -> x
or, and :: BoolF -> BoolF -> BoolF
p `or` q = BoolF $ \x y -> bool p x (bool q x y)
p `and` q = BoolF $ \x y -> bool p (bool q x y) y
instance Show BoolF where
show p = bool p "True" "False"
------------------
data List a
= Nil
| Cons a (List a)
newtype ListF a = ListF { list :: forall b. b -> (a -> ListF a -> b) -> b }
nil :: ListF a
nil = ListF $ \x _ -> x
cons :: a -> ListF a -> ListF a
cons x xs = ListF $ \_ f -> f x xs
foldl :: (a -> b -> b) -> b -> ListF a -> b
foldl f o xs = list xs o (\x xs -> x `f` foldl f o xs)
intercalate :: a -> ListF a -> ListF a
intercalate w xs = list xs nil (\x xs -> cons x (foldl (\x' xs' -> cons w (cons x' xs')) nil xs))
instance Monoid (ListF a) where
mempty = nil
mappend xs ys = list xs ys (\x xs -> cons x (mappend xs ys))
instance Functor ListF where
fmap f xs = list xs nil (\x xs -> cons (f x) (fmap f xs))
instance Show a => Show (ListF a) where
show xs = "[" ++ foldl (++) "" (intercalate "," $ fmap show xs) ++ "]"