// Mart Lubbers s4109503
// Charlie Gerhardus s3050009

module skeleton9
//One does not go over 80chars.
//the true lambda character is the .

from iTasks import always, hasValue, :: TaskValue(..), :: Task, :: Stability,
	:: TaskCont(..), :: Action, updateInformation, viewInformation, class
	descr, instance descr String, :: UpdateOption, :: ViewOption(..), -||-,
	-||, ||-, startEngine, class Publishable, >>*, class TFunctor,
	instance TFunctor Task, class TApplicative, instance TApplicative Task,
	instance Publishable Task, Void
import Data.Tuple, StdClass, StdList, iTasks._Framework.Generic, Text.JSON,
	Data.Functor, Control.Applicative, Control.Monad, Data.Map, StdMisc
import qualified iTasks
import qualified Text
from Text import class Text, instance Text String
from StdFunc import o
import qualified Data.List as List

:: BM a b = {t :: a -> b, f :: b -> a}
bm :: BM a a
bm = {f=id, t=id}
:: Op = Pl | Mi | Ti
:: Set :== Expr [Int]
:: Element :== Expr Int
:: Expr a
	= New (BM a [Int])
	| Insert (BM a [Int]) Element Set
	| Delete (BM a [Int]) Element Set
	| Variable (BM a a) Ident
	| Union (BM a [Int]) Set Set
	| Difference (BM a [Int]) Set Set
	| Intersection (BM a [Int]) Set Set
	| Integer (BM a Int) Int
	| Size (BM a Int) Set
	| Oper (BM a Int) Element Op Element
	| Assign (BM a a) Ident (Expr a)
new :== New bm
insert = Insert bm
delete = Delete bm
variable = Variable bm
union = Union bm
difference = Difference bm
intersection = Intersection bm
integer :== Integer bm
size = Size bm
oper = Oper bm
instance + Element where (+) x y = Oper bm x Pl y
instance - Element where (-) x y = Oper bm x Mi y
instance * Element where (*) x y = Oper bm x Ti y
(=.) infix 4
(=.) x y = Assign bm x y

print :: a -> String | show a
print x = 'Text'.concat (show x [])

class show a :: a [String] -> [String]
instance show Op where
	show o l = case o of Pl = ["+":l]; Mi = ["-":l]; Ti = ["*":l];
instance show Int where show i l = [toString i:l]
instance show [Int] where show i l = [toString i:l]
instance show (Expr a) | show a where
	show (New _) l = ["{}":l]
	show (Insert _ e s) l = ["{":show e ["}|":show s l]]
	show (Delete _ e s) l = ["{":show e ["}\\":show s l]]
	show (Variable _ s) l = [s:l]
	show (Union _ s1 s2) l = show s1 ["|":show s2 l]
	show (Difference _ s1 s2) l = show s1 ["\\":show s2 l]
	show (Intersection _ s1 s2) l = show s1 ["&":show s2 l]
	show (Integer _ i) l = show i l
	show (Size _ s) l = ["|":show s ["|":l]]
	show (Oper _ e1 op e2) l = show e1 (show op (show e2 l))
	show (Assign _ s e) l = [s:["=":show e l]]

// === State
:: Ident :== String
:: State :== Map Ident Dynamic
:: Sem a = Sem (State -> (MaybeEx a, State))
:: MaybeEx a = Result a | Exception String

// === state handling

instance Functor Sem where
	fmap :: (a -> b) (Sem a) -> Sem b
	fmap f (Sem sF) = Sem (appFst (fmap f) o sF)

instance Functor MaybeEx where
	fmap :: (a -> b) (MaybeEx a) -> MaybeEx b
	fmap f (Result a) = Result (f a)
	fmap _ (Exception e) = Exception e

instance Applicative Sem where
	pure :: a -> Sem a
	pure a = Sem \st.(pure a, st)

	(<*>) infixl 4 :: (Sem (a -> b)) (Sem a) -> Sem b
	(<*>) (Sem sFA) (Sem sFB) = Sem newSF
	where
		newSF st
			# (ra, st) = sFA st
			# (rb, st) = sFB st
			= (ra <*> rb, st)

instance Applicative MaybeEx where
	pure :: a -> MaybeEx a
	pure a = Result a

	(<*>) infixl 4 :: (MaybeEx (a -> b)) (MaybeEx a) -> MaybeEx b
	(<*>) (Result f) (Result x) = Result (f x)
	(<*>) (Exception e) _ = Exception e
	(<*>) _ (Exception e) = Exception e

instance Monad Sem where
	bind :: (Sem a) (a -> Sem b) -> Sem b
	bind (Sem sFA) f = Sem sF
	where
		sF st
			# (mbA, st) = sFA st
			= case mbA of
				Result a
					# (Sem sFB) = f a
					= sFB st
				Exception e = (Exception e, st)

fail :: String -> Sem a
fail msg = Sem \st.(Exception msg, st)

store :: Ident a -> Sem a | TC a
store i v = Sem \st.(Result v, put i (dynamic v) st)

read :: Ident -> Sem a | TC a
read i = Sem \st.case get i st of
	Just (a :: a^) = (Result a, st)
	Just d = (Exception ('Text'.concat ["expected ", toString expType, " got ",
		toString (typeCodeOfDynamic d)]), st)
	Nothing = (Exception "No variable with that name", st)
where
	expType = typeCodeOfDynamic (dynamic undef :: a^)

// === semantics
eval :: (Expr a) -> Sem a | TC a
eval (New {f}) = return (f [])
eval (Variable {f} i) = read i
eval (Assign {f} v e) = eval e >>= \a.store v a
eval (Insert {f} e s) = eval e >>= \a.eval s 
	>>= \x.return (f ('List'.union [a] x))
eval (Delete {f} e s) = eval e >>= \a.eval s
	>>= \x.return (f ('List'.delete a x))
eval (Union {f} s1 s2) = eval s1 >>= \x.eval s2
	>>= \y.return (f ('List'.union x y))
eval (Difference {f} s1 s2) = eval s1 >>= \x.eval s2
	>>= \y.return (f ('List'.difference x y))
eval (Intersection {f} s1 s2) = eval s1 >>= \x.eval s2 
	>>= \y.return (f ('List'.intersect x y))
eval (Integer {f} i) = return (f i)
eval (Size {f} s) = eval s >>= \x.return (f (length x))
eval (Oper {f} e1 o e2) = eval e1 >>= \a.eval e2 >>= \b.return (f (case o of
	Pl = a+b
	Mi = a-b
	Ti = a*b))

evalExpr :: (Expr a) State -> (MaybeEx a, State) | TC a
evalExpr expr st = let (Sem func) = eval expr in func st

Start :: (MaybeEx Int, State)
Start = evalExpr (size (variable "x")) state
	where
		(_, state) = evalExpr ("x" =. (insert (integer 42) new)) newMap