{-  Probably the most significat feature of functional
    programming languages is their datatypes.  Lists are 
    all very fine but we must get past them ... :-)
    
     So now we dip into data types ..

     The simplest datatype is Bool

      data Bool = True | False

     But what next ... here we dip into non-empty list:
     they are  nearly lsits but not quite!!
-}


--
--  Without success/fail nothing happens!
--
data SF a = SS a
          | FF
   deriving (Show, Eq)

--  Non-empty lists  ... they are almost list but not quite

data NList a = Single a
             | Many a (NList a)


instance Show a => Show (NList a) where
           show xs = "[["++(showrest xs) where
                 showrest (Single a) = (show a)++"]]"
                 showrest (Many a ys) = (show a)++","++(showrest ys)

instance Eq a => Eq (NList a) where
            (Single a) == (Single b) = a==b
            (Many a as) == (Many b bs) = (a==b) && (as == bs)

-- Non empty lists are nearly lists
--     in fact non-empty lists wrapped in the "success or fail"
--     datatype are isomorphic to lists!!
--     Here are the translations in each direction ...
nl2l:: SF (NList a) -> [a]
nl2l FF = []
nl2l (SS xs) = nl2l_helper xs where
      nl2l_helper (Single x) = [x]
      nl2l_helper (Many x xs) = x:(nl2l_helper xs)

l2nl:: [a] -> (SF (NList a))
l2nl [] = FF
l2nl (x:xs) = SS (l2nl_helper x xs) where
       l2nl_helper x [] = Single x
       l2nl_helper x (y:ys) = Many x (l2nl_helper y ys)

--  Here is the "fold" for non-empty lists

foldNList:: (a -> b -> b) -> (a -> b) -> (NList a) -> b
foldNList f g (Single x) = g x
foldNList f g (Many x xs) = f x (foldNList f g xs)

--  Now we can sum non-empty lists easily

sumNList:: (NList Integer) -> Integer
sumNList = foldNList (+) id

-- We can append non-empty lists
appNList:: (NList a) -> (NList a) -> (NList a)
appNList as bs = foldNList Many (\a -> Many a bs)  as

{- For testing!!

test_appNList as bs =
  case (l2nl as,l2nl bs) of
     (SS xs,SS ys) -> SS (appNList xs ys)
     _  -> FF

test_appNList "abcd" "efgh"
-}

-- We can flatten non-empty lists
flattenNList:: (NList (NList a)) -> NList a
flattenNList = foldNList appNList id

--
-- one thing we can do for non-empty lists which we
-- cannot REALLY do for lists is to take the head!
--

headNList:: (NList a) -> a
headNList (Single a) = a
headNList (Many a _) = a



----------------------------------------------------
--
--  Lets talk natural numbers: this is a really
--        foundational datatype -- the "unary numbers".
--        It is not very practical ... but conceptually
--        crucial!
--
-----------------------------------------------------

data Nat = Succ Nat | Zero
   deriving (Eq)

instance Show Nat where
       show Zero = "z"
       show (Succ n) = "s"++(show n)
--
--  First up what is a fold for Nat?
--
foldNat:: (a -> a) -> a -> Nat -> a
foldNat f a0 Zero = a0
foldNat f a0 (Succ n) = f (foldNat f a0 n)

--  Note this is a "for loop"  n |-> f^n(a0) ... done in
--  unary!

-- Transalating from integers and back

nat2int:: Nat -> Integer
nat2int = foldNat (\n -> n+1) 0

int2nat::Integer -> (SF Nat)
int2nat n | n < 0 = FF
          | otherwise = SS (int2nat' n) where
    int2nat' 0 = Zero
    int2nat' n = Succ (int2nat' (n-1))

-- Adding and multiplying in unary

addNat:: Nat -> Nat -> Nat
addNat n m = foldNat Succ m n

multNat:: Nat -> Nat -> Nat
multNat n = foldNat (addNat n) Zero

-- the predecessor function and monus

mypred:: Nat -> Nat
mypred Zero = Zero
mypred (Succ m) = m

monus:: Nat -> Nat -> Nat
monus n = foldNat mypred n

-----------------------------------------------------
--
--  Lets talk binary numbers (this is essentially what
--  is implemented in hardware: so these numbers are
--  seriously built-in!!
--
-----------------------------------------------------

data BNat = B0 BNat | B1 BNat | BZ
   deriving (Eq)

instance Show BNat where
    show m = "{"++(show' m)++"}" where
        show' BZ = ""
        show' (B0 m) = "0"++(show' m)
        show' (B1 m) = "1"++(show' m)
--
-- Again lets get the fold sorted:
--
foldBNat:: (a -> a) -> (a -> a) -> a -> BNat -> a
foldBNat f0 f1 a BZ = a
foldBNat f0 f1 a (B0 n) = f0 (foldBNat f0 f1 a n)
foldBNat f0 f1 a (B1 n) = f1 (foldBNat f0 f1 a n)

--
-- Translating to and from Integers:
--

bnat2int:: BNat -> Integer
bnat2int = fst . (foldBNat (\(n,b) -> (n,2*b)) (\(n,b) -> (n+b,2*b)) (2,0))

int2BNat:: Integer -> (SF BNat)
int2BNat n | n<0 = FF
           | otherwise = SS (int2BNat' n BZ) where           
   int2BNat' n | n==0 = id
               | (n `mod` 2) == 1 = (\x -> (int2BNat' (n `div` 2)) (B1 x))
               | (n `mod` 2) == 0 = (\x -> (int2BNat' (n `div` 2)) (B0 x))
               | otherwise = id

--
--  Can you  write addition and multiplication?
--