module a9

/*
  Advanced Progrmming 2018, Assignment 8
  Pieter Koopman, pieter@cs.ru.nl
*/
import StdEnv


import Control.Applicative
import Control.Monad => qualified join
import Control.Monad.State
import Control.Monad.Trans
import Data.Func
import Data.Functor
import Data.Either
import Data.Maybe
import Data.List

import Text

import qualified Data.List as List
import qualified Data.Map as Map

:: Set   :== Sem [Int]
:: Elem  :== Sem Int
:: Ident :== String

// === State
:: Val :== Either Int [Int]
:: SemState :== 'Map'.Map String Val

:: Sem a =
	{ evaluator :: StateT SemState (Either String) a
	, printer   :: [String] -> [String]
	}

fail :: String -> StateT SemState (Either String) a
fail s = liftT (Left s)

//Sets
integer :: Int -> Elem
integer i = {evaluator=pure i,printer = \c->[toString i:c]}

set :: [Int] -> Set
set i =
	{ evaluator = pure (removeDup i)
	, printer   = \c->["[":intersperse "," (map toString i)] ++ ["]":c]
	}

size :: Set -> Elem
size s =
	{ evaluator = length <$> s.evaluator
	, printer   = \c->["size(":s.printer [")"]]
	}

class variable a :: String -> a
instance variable Set
where
	variable i =
		{ evaluator
			= gets ('Map'.get i) >>= \v->case v of
				Nothing = fail ("No set with identifier " +++ i)
				Just (Left v) = fail (i +++ " is an element")
				Just (Right v) = pure v
		, printer = \c->[i:c]
		}
instance variable Elem
where
	variable i =
		{ evaluator
			= gets ('Map'.get i) >>= \v->case v of
				Nothing = fail ("No element with identifier " +++ i)
				Just (Right v) = fail (i +++ " is a set")
				Just (Left v) = pure v
		, printer = \c->[i:c]
		}
class (+.) infixl 6 a b ~c :: a b -> c
instance +. Elem Elem Elem
where
	+. a b =
		{ evaluator = (+) <$> a.evaluator <*> b.evaluator
		, printer   = \c->a.printer ["+":b.printer c]
		}
instance +. Elem Set Set
where
	+. a b =
		{ evaluator = 'List'.union <$> pure <$> a.evaluator <*> b.evaluator
		, printer   = \c->a.printer ["+":b.printer c]
		}
instance +. Set Elem Set
where
	+. a b =
		{ evaluator = 'List'.union <$> a.evaluator <*> (pure <$> b.evaluator)
		, printer   = \c->a.printer ["+":b.printer c]
		}
instance +. Set Set Set
where
	+. a b =
		{ evaluator = 'List'.union <$> a.evaluator <*> b.evaluator
		, printer   = \c->a.printer ["+":b.printer c]
		}
class (-.) infixl 6 a b ~c :: a b -> c
instance -. Elem Elem Elem
where
	 -. a b =
		{ evaluator = (-) <$> a.evaluator <*> b.evaluator
		, printer   = \c->a.printer ["-":b.printer c]
		}
instance -. Set Elem Set
where
	 -. a b =
		{ evaluator = 'List'.difference <$> a.evaluator <*> (pure <$> b.evaluator)
		, printer   = \c->a.printer ["-":b.printer c]
		}
instance -. Set Set Set
where
	 -. a b =
		{ evaluator = 'List'.difference <$> a.evaluator <*> b.evaluator
		, printer   = \c->a.printer ["-":b.printer c]
		}
class (*.) infixl 6 a b ~c :: a b -> c
instance *. Elem Elem Elem
where
	 *. a b =
		{ evaluator = (*) <$> a.evaluator <*> b.evaluator
		, printer   = \c->a.printer ["*":b.printer c]
		}
instance *. Elem Set Set
where
	 *. a b =
		{ evaluator = a.evaluator >>= \x->map ((*)x) <$> b.evaluator
		, printer   = \c->a.printer ["*":b.printer c]
		}
instance *. Set Set Set
where
	 *. a b =
		{ evaluator = 'List'.intersect <$> a.evaluator <*> b.evaluator
		, printer   = \c->a.printer ["*":b.printer c]
		}

class (=.) infixl 2 a :: Ident a -> a
instance =. Set
where
	 =. n s =
		{ evaluator = s.evaluator >>= \v->modify ('Map'.put n (Right v)) *> pure v
		, printer   = \c->[n,"=":s.printer c]
		}
instance =. Elem
where
	 =. n s =
		{ evaluator = s.evaluator >>= \v->modify ('Map'.put n (Left v)) *> pure v
		, printer   = \c->[n,"=":s.printer c]
		}

//Logicals
:: Logical :== Sem Bool
true :: Logical
true = {evaluator = pure True, printer = \c->["True":c]}

false :: Logical
false = {evaluator = pure False, printer = \c->["False":c]}

In :: Elem Set -> Logical
In e s =
	{ evaluator = elem <$> e.evaluator <*> s.evaluator
	, printer   = \c->e.printer ["In":s.printer c]
	}

class (==.) infix 4 a :: a a -> Logical
instance ==. Elem
where
	 ==. a b =
		{evaluator = (==) <$> a.evaluator <*> b.evaluator
		,printer   = \c->a.printer ["==":b.printer c]
		}
instance ==. Set
where
	 ==. a b =
		{evaluator = (==) <$> a.evaluator <*> b.evaluator
		,printer   = \c->a.printer ["==":b.printer c]
		}

class (<=.) infixl 6 a b :: a b -> Logical
instance <=. Elem Elem
where
	 <=. a b =
		{evaluator = (<=) <$> a.evaluator <*> b.evaluator
		,printer   = \c->a.printer ["<=":b.printer c]
		}
instance <=. Set Set
where
	 <=. a b =
		{evaluator = ((<=) `on` length) <$> a.evaluator <*> b.evaluator
		,printer   = \c->a.printer ["<=":b.printer c]
		}

Not :: Logical -> Logical
Not a = {evaluator = not <$> a.evaluator, printer = \c->["not":a.printer c]}

(||.) infixr 2 :: Logical Logical -> Logical
(||.) a b =
		{evaluator = (||) <$> a.evaluator <*> b.evaluator
		,printer   = \c->a.printer ["||":b.printer c]
		}

(&&.) infixr 2 :: Logical Logical -> Logical
(&&.) a b =
		{evaluator = (&&) <$> a.evaluator <*> b.evaluator
		,printer   = \c->a.printer ["&&":b.printer c]
		}

//Stmts
:: Stmt :== Sem ()
expression :: Set -> Stmt
expression e = {evaluator = e.evaluator *> pure (), printer = e.printer}

logical :: Logical -> Stmt
logical e = {evaluator = e.evaluator *> pure (), printer = e.printer}

For :: String Set Stmt -> Stmt
For ident bag body =
	{ evaluator = bag.evaluator >>= \v->
		foldr proc (pure ()) [ident =. integer e\\e<-v]
	, printer   = \c->["For",ident,"=":bag.printer ["In":body.printer c]]
	}
where
	proc :: (Sem Int) (StateT SemState (Either String) ()) -> StateT SemState (Either String) ()
	proc e m = e.evaluator *> body.evaluator *> m

If :: Logical Stmt Stmt -> Stmt
If l s1 s2 =
	{ evaluator = l.evaluator >>= \b->if b s1.evaluator s2.evaluator
	, printer   = \c->["If":l.printer ["then":s1.printer ["else":s2.printer c]]]
	}

evalSem :: (Sem a) -> (SemState -> Either String a)
evalSem s = evalStateT s.evaluator

printSem :: (Sem a) -> ([String] -> [String])
printSem s = s.printer

Start =
	( evalSem (integer 42 +. integer 42 +. set [] +. integer 4 +. set [42]) 'Map'.newMap
	, join " " $ printSem (integer 42 +. integer 42 +. set [] +. integer 4 +. set [42]) []
	)