{-# OPTIONS_GHC -XTypeOperators #-}

module Expr where

import ParseDecorate
import ParseHelper
import Data.Char


data Expr
  = Num Integer
  | Add [Expr]
  | Sub Expr Expr
  | Mul [Expr]
  | Div Expr Expr
  deriving (Eq, Show)

type ExprAlg a = ( Integer -> a
                 , a -> a -> a
                 , a -> a -> a
                 )

foldExpr :: ExprAlg a -> Expr -> a
foldExpr (f1, f2, f3) = f where
  f (Num x1)    = f1 x1
  f (Sub x1 x2) = f2 (f x1) (f x2)
  f (Div x1 x2) = f3 (f x1) (f x2)

eval = foldExpr (id, (-), div)


pExpr = pSub

pSub :: Parser Char Expr
pSub = label "pSub" $ (foldl1 Sub) <$> pChain pDiv (symbol '-')

-- pAdd :: Parser Char Expr
-- pAdd = label "pSub" $ Add <$> pChain pDiv (symbol '+')

pDiv :: Parser Char Expr
pDiv = label "pDiv" $ (foldl1 Div) <$> pChain pAtom (symbol '/')

pAtom :: Parser Char Expr
pAtom = label "pAtom" $ pNum <|> parenthesised pSub

pNum :: Parser Char Expr
pNum = unit $ label "pNum" $ Num . read <$> many (oneOf "1234567890")

oneOf :: Eq s => [s] -> Parser s s
oneOf = foldl1 (<|>) . map symbol

pChain :: Parser s a -> Parser s b -> Parser s [a]
pChain unit sep = label "chain" $ (:) <$> unit <*> many (flip const <$> sep <*> unit)

{-
pChainL :: Parser s a -> Parser s (a -> a -> a) -> Parser s a
pChainL unit op = unit <*> many (op <*> unit)
-}