module Grammar where

lparen :: ShowS
lparen = showChar '('

rparen :: ShowS
rparen = showChar ')'

showsp :: ShowS
showsp = showChar ' '

showln :: ShowS
showln = showChar '\n'

compose :: [ (a -> a) ] -> (a -> a)
compose = foldl (.) id

showseq :: Show a => [a] -> ShowS
showseq = foldl (\f x -> f . shows x) id

showvar :: Variable -> ShowS
showvar v = lparen . showString "VAR " . shows v . rparen . showsp

showints :: [Int] -> ShowS
showints = compose . map (\i -> shows i . showsp)


--------------------------------------------------------------------------------
-- Grammar
--------------------------------------------------------------------------------

type Character = [Rule]

type Rule = ([StateNumber], Stmt)

data Stmt = IF [Alt] Stmt
          | DECISION NewState Utterance
          | CASE Variable [Arm] Stmt
  deriving (Eq,Ord)

type Arm = (ValueSet, Stmt)
type Alt = (Condition, Stmt)

data Condition = EQUALS Variable Int
               | AND [Condition]
               | OR [Condition]
	       | NOT Condition
  deriving (Eq,Ord)

type Variable = String

type StateNumber = Int

data NewState = STATE Int
              | WILDCARD [Int]
  deriving (Eq,Ord)

type Utterance = String

type ValueSet = [Int]

--------------------------------------------------------------------------------
-- Output Functions
--------------------------------------------------------------------------------

instance Show Character where
  showsPrec _ rs = lparen . showln . showrules rs . rparen . showln
    where showrules = compose . map (\(sns,s) -> lparen . showints sns . showln . shows s . rparen . showln)

instance Show Stmt where
  showsPrec _ (IF ((c,s):css) d) = lparen . showString "IF " . shows c . shows s . lparen . showELSEIF css . rparen . showln . shows d . rparen . showln
    where showELSEIF = compose . map (\(c,s) -> lparen . showString "ELSEIF " . shows c . shows s . rparen)
  showsPrec _ (DECISION d u) = lparen . showString "DECISION " . shows d . shows u . rparen . showln
  showsPrec _ (CASE v arms s) = lparen . showString "CASE " . showvar v . lparen . showseq arms . rparen . shows s . rparen . showln
  showsPrec _ (IF [] d) = error "empty IF"  -- shows d

instance Show Arm where
  showsPrec _ (vs,s) = lparen . showString "ARM " . shows vs . showln . shows s . rparen

instance Show Condition where
  showsPrec _ (EQUALS v i) = lparen . showString "EQUALS " . showvar v . shows i . rparen . showln
  showsPrec _ (AND cs) = lparen . showString "AND " . showseq cs . rparen . showln
  showsPrec _ (OR cs) = lparen . showString "OR " . showseq cs . rparen . showln
  showsPrec _ (NOT c) = error "condition NOT"

instance Show NewState where
  showsPrec _ (STATE i) = shows i . showsp
  showsPrec _ (WILDCARD _) = showChar '_' . showsp
  --  showsPrec _ (WILDCARD x) = showChar '_' . shows x . showChar '_' . showsp

instance Show ValueSet where
  showsPrec _ vs = lparen . showints vs . rparen