module Chap01 where


data SimpleVM = Coin | Choc
                 deriving (Eq, Show)

                          
data ComplexVM = In1P | In2P |Small | Large | Out1P
               deriving (Eq, Show)


type Err = String

data Proc a =  Then (a -> Proc a)
               | Stop


example01 :: Proc SimpleVM
example01 = Then (\Coin -> Stop)


example02 :: Proc SimpleVM
example02 = Then (\Coin ->
                   Then (\Choc ->
                          Then (\Coin ->
                                 Then (\Choc -> Stop))))

data CTR = CtrUp | CtrRight
         deriving (Eq, Show)

ctrProc :: Proc CTR
ctrProc = Then (\CtrRight ->
                Then (\CtrUp ->
                  Then (\CtrRight ->
                    Then (\CtrRight -> Stop))))


data Clock = Tick

clock :: Proc Clock
clock = Then (\Tick -> clock)

data ChangeVM = ChIn5P | ChOut2P | ChOut1P
              deriving (Eq, Show)

change5 = Then $ \ChIn5P ->
                  Then $ \ChOut2P ->
                          Then $ \ChOut2P ->
                                  Then $ \ChOut1P -> change5



choiceChangeVM = Then $ \ChIn5P -> (Then f)
  where f ChOut2P = Then $ \ChOut1P -> Then (\ChOut2P -> choiceChangeVM)
        f ChOut1P = Then $ \ChOut1P ->
                            Then $ \ChOut1P ->
                                    Then $ \ChOut2P -> choiceChangeVM

data ChocToffVM = CTChoc | CTToffee | CTCoin
                deriving (Eq, Show)


data CSProc a =  Todo (a -> Maybe (CSProc a))
                 | STOP

chocOrToffee = Then $ \CTCoin -> (Then f)
         where f CTChoc = chocOrToffee
               f CTToffee = chocOrToffee
                            
                         
data LemOrVM = SetO | GetO | SetL | GetL
               deriving (Eq, Show)

lemonOrOrange = Then $ \x ->
                  case x of
                   SetO -> Then $ \GetO -> lemonOrOrange
                   SetL -> Then $ \GetL -> lemonOrOrange

lOrO     = Todo $ \x ->
                   case x of
                    SetO -> Just . Todo $ \GetO -> Just lOrO
                    SetL -> Just . Todo $ \GetL -> Just lOrO
                    _    -> Nothing 

choice2 :: (Eq a, Show a) => (a, Proc a) -> (a, Proc a) -> (Proc a)
choice2 (a1,p1) (a2,p2) = Then $ \x -> if x == a1 then p1
                                      else if x == a2 then p2
                                           else error $ "expecting " ++ (show a1) ++ " or " ++ (show a2)



