{-# 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) ++ "]"