+module expr
+
+import StdEnv
+
+import Control.Applicative
+import Control.Monad
+import Data.Error
+import Data.Func
+import Data.Functor
+import Text.Parsers.Simple.Core
+import Text.Parsers.Simple.Chars
+
+class expr e where
+ lit :: a -> e a | toString a
+ (+.) infixl 6 :: (e a) (e a) -> e a | + a
+class div e where
+ (/.) infixl 7 :: (e a) (e a) -> e a | /, ==, zero a
+class eq e where
+ (==.) infix 4 :: (e a) (e a) -> e Bool | == a
+
+:: Print a = P String
+runPrint :: (Print a) -> String
+runPrint (P a) = a
+instance expr Print where
+ lit a = P (toString a)
+ (+.) (P a) (P b) = P (a +++ "+" +++ b)
+instance div Print where
+ (/.) (P a) (P b) = P (a +++ "/" +++ b)
+instance eq Print where
+ (==.) (P a) (P b) = P (a +++ "==" +++ b)
+
+:: Eval a = E a
+runEval :: (Eval a) -> a
+runEval (E a) = a
+instance expr Eval where
+ lit a = E a
+ (+.) (E a) (E b) = E (a + b)
+instance div Eval where
+ (/.) (E a) (E b)
+ | b == zero = E zero
+ = E (a / b)
+instance eq Eval where
+ (==.) (E a) (E b) = E (a == b)
+
+:: EvalM a :== MaybeError String a
+runEvalM :: (EvalM a) -> MaybeError String a
+runEvalM a = a
+instance expr (MaybeError String) where
+ lit a = pure a
+ (+.) l r = (+) <$> l <*> r
+instance div (MaybeError String) where
+ (/.) l r = (/) <$> l <*> (r >>= \v->if (v == zero) (Error "div0") (pure v))
+instance eq (MaybeError String) where
+ (==.) l r = (==) <$> l <*> r
+
+pToken c = pSatisfy ((==)c)
+class parseExpr a :: Parser Char a
+instance parseExpr a:: parseExpr
+parseExpr :: Parser Char (v a) | expr, div v & parsable, ==, +, /, zero, toString a
+parseExpr = foldr ($) parseBasic
+ [ flip pChainl1 (pToken '+' $> (+.))
+ , flip pChainl1 (pToken '/' $> (/.))
+ ]
+where
+ parseBasic = lit <$> parsable
+
+class parsable a :: Parser Char a
+instance parsable Int where parsable = foldl (\a b->10*a+digitToInt b) 0 <$> some pDigit
+
+Start :: Either [Error] (Print Int)
+Start = parse parseExpr ['42+42']
+/*Start = (runPrint e, runEval e, runEvalM e, parse )
+where
+ e :: v Bool | expr, div, eq v
+ e = lit 39 +. lit 3 /. lit 0 ==. lit 4
+*/