module Haskell.Env.Cmd where

import Haskell.AST
import Haskell.Rewrite
import Pretty
import Util


data Action = Action RewCmd Name
  deriving (Show)

data RewCmd = CRewrite Name
            | CBeta
            | CEta
            | CCase
            | CCaseForce
            | CEtaCase
            | CCaseCase
            | CRepeat RewCmd
  deriving (Show)

instance Pretty Action where
    pretty (Action cmd target) = Node ("action " ++ target) [pretty cmd]

instance Pretty RewCmd where
    pretty (CRewrite name) = Leaf ("rew " ++ name)
    pretty CBeta = Leaf "beta"
    pretty CEta = Leaf "eta"
    pretty CCase = Leaf "case"
    pretty CCaseForce = Leaf "case!"
    pretty CEtaCase = Leaf "etacase"
    pretty CCaseCase = Leaf "casecase"
    pretty (CRepeat cmd) = Node "repeat" [pretty cmd]


exprTransformer :: RewCmd -> Maybe (Expr -> Expr)
exprTransformer = fmap (normalise .) . exprTransformer'

exprTransformer' :: RewCmd -> Maybe (Expr -> Expr)
exprTransformer' (CRewrite _) = Nothing
exprTransformer' CBeta        = Just betared
exprTransformer' CEta         = Just etared
exprTransformer' CCase        = Just (casered False)
exprTransformer' CCaseForce   = Just (casered True)
exprTransformer' CEtaCase     = Just etacase
exprTransformer' CCaseCase    = Just casecase
exprTransformer' (CRepeat (CRepeat cmd)) = exprTransformer' (CRepeat cmd)
exprTransformer' (CRepeat cmd) = fixpoint <$> exprTransformer' cmd