module skeleton8

import StdList, StdInt, Data.Tuple, StdClass, iTasks._Framework.Generic, Text.JSON, Data.Functor, Control.Applicative, Control.Monad, Data.Void
import qualified iTasks
import qualified Text
from Text import class Text, instance Text String
from StdFunc import o
from StdTuple import fst
import qualified Data.Map as DM
import Data.Either
import qualified Data.List as List

:: Element :== Stmt Int
:: Set :== Stmt [Int]
:: Val = I Int | S [Int] | B Bool
:: State :== Map String Val
:: Sem a = Sem (State -> (Either String a, State)) 
:: Stmt a = {v :: Sem a, p :: [String]}

:: THEN = THEN
:: ELSE = ELSE
:: DO = DO

instance Functor Sem where
	fmap :: (a -> b) (Sem a) -> Sem b
	fmap f (Sem s) = Sem \st.let (a, st`) = s st in (fmap f a, st`)

instance Applicative Sem where
	pure :: a -> Sem a
	pure s = Sem \st.(pure s, st)
	(<*>) infixl 4  :: (Sem (a -> b)) (Sem a) -> Sem b
	(<*>) a f = ap a f

instance Monad Sem where
	bind :: (Sem a) (a -> Sem b) -> Sem b
	bind (Sem s) f = Sem \st.case s st of
		(Right v, st`) = let (Sem r) = f v in r st`
		(Left e, st`) = (Left e, st`)

fail :: String -> Sem a
fail s = Sem \st.(Left s,st)

instance + Element where 
	(+) s1 s2 = {v=(+) <$> s1.v <*> s2.v, p=s1.p ++ ["+"] ++ s2.p}
instance - Element where
	(-) s1 s2 = {v=(-) <$> s1.v <*> s2.v, p=s1.p ++ ["-"] ++ s2.p}
instance * Element where
	(*) s1 s2 = {v=(*) <$> s1.v <*> s2.v, p=s1.p ++ ["*"] ++ s2.p}

integer :: Int -> Element
integer i = {v=return i, p=[toString i]}

size :: Set -> Element
size s = {v=length <$> s.v, p=["|":s.p++["|"]]}

new :: Set
new = {v=return [], p=["∅"]}

insert :: Element Set -> Set
insert e s = union {v=((\x.[x]) <$> e.v), p=["{":e.p++["}"]]} s

delete :: Element Set -> Set
delete e s = difference {v=((\x.[x]) <$> e.v), p=["{":e.p++["}"]]} s

union :: Set Set -> Set
union s1 s2 = {v='List'.union <$> s1.v <*> s2.v, p=s1.p++["∪":s2.p]}

difference :: Set Set -> Set
difference s1 s2 = {v='List'.difference <$> s1.v <*> s2.v, p=s1.p++["\\":s2.p]}

intersection :: Set Set -> Set
intersection s1 s2 = {v='List'.intersect <$> s1.v <*> s2.v, p=s1.p++["∩":s2.p]}

class variable a :: String -> a

instance variable Element where
	variable k = {v=Sem \st.case 'DM'.get k st of
		(Just (I v)) = (Right v, st)
		(Just _) = (Left "Wrong type, expected Int", st)
		_ = (Left ("Variable '"+++ k +++ "' not found"), st), p=[k]}

instance variable Set where
	variable k = {v=Sem \st.case 'DM'.get k st of
		(Just (S v)) = ((Right v), st)
		(Just _) = (Left "Wrong type, expected Set", st)
		_ = (Left ("Variable '" +++ k +++ "' not found"), st), p=[k]}
class (=.) infix 2 a :: String a -> a

instance =. Element where
	(=.) k v = {v=Sem \st.let (Sem v`) = v.v in case v` st of
		(Right v`, st) = (Right v`, 'DM'.put k (I v`) st)
		(Left e, st) = (Left e, st), p=[k:[":=":v.p]]}

instance =. Set where
	(=.) k v = {v=Sem \st.let (Sem v`) = v.v in case v` st of
		(Right v`, st) = (Right v`, 'DM'.put k (S v`) st)
		(Left e, st) = (Left e, st), p=[k:[":=":v.p]]}

(:.) infixl 1 :: (Stmt a) (Stmt b) -> (Stmt b)
(:.) s1 s2 = {v=s1.v >>| s2.v, p=s1.p ++ [";\n":s2.p]}

(==.) infix 4 :: (Stmt a) (Stmt a) -> (Stmt Bool) | == a
(==.) s1 s2 = {v=(==) <$> s1.v <*> s2.v, p=s1.p++["==":s2.p]}

(<.) infix 4 :: (Stmt a) (Stmt a) -> (Stmt Bool) | < a
(<.) s1 s2 = {v=(<) <$> s1.v <*> s2.v, p=s1.p++["<":s2.p]}

IF :: (Stmt Bool) THEN (Stmt a) ELSE (Stmt a) -> Stmt a
IF c _ t _ e = {v=c.v >>= \c`.if c` t.v e.v,
		p=["IF ":c.p]++[" THEN\n":t.p]++ ["\nELSE\n":e.p] ++ ["\nFI"]}

WHILE :: (Stmt Bool) DO (Stmt a) -> Stmt Int
WHILE c _ b = {v=while c.v b.v, p=["WHILE ":c.p]++[" DO\n":b.p]++["\nOD"]}
	where
		while c b = c >>= \c`.if c` (((+) 1) <$> (b >>| while c b)) (return 0)

eval e = let (Sem ev) = e.v in let (_, st) = ev 'DM'.newMap in 'DM'.toList st
print e = 'Text'.concat e.p

Start = print expr10
//Start = eval expr10

expr1 :: Element
expr1 = integer 2

expr2 :: Element
expr2 = expr1 + expr1

expr3 :: Element
expr3 = expr1 + expr1 * integer 3

expr4 :: Set
expr4 = union new (insert expr1 (insert expr3 new))

expr5 :: Set
expr5 =
    x =. expr4 :.
    variable x

expr6 :: Element
expr6 =
    x =. insert (integer 11) new :.
    x =. size (variable x) :.
    variable x

expr7 :: Set
expr7 =
    x =. insert (integer 11) new :.
    y =. variable x

expr8 :: Set
expr8 =
    x =. insert (integer 11) new :.
    x =. insert (size (variable x)) (variable x) :.
    variable x

expr9 :: Set
expr9 =
    x =. insert (integer 0) new :.
    IF (size (variable x) ==. integer 0) THEN
        (x =. insert (integer 0) (variable x))
    ELSE
        (x =. delete (integer 0) (variable x)) :.
    variable x

expr10 :: Set
expr10 =
	z =. integer 7 :.
	x =. new :.
	x =. insert (variable z) (variable x) :.
	y =. union (variable x) (variable x) :.
	WHILE (size (variable x) <. integer 5) DO
		(x =. insert (size (variable x)) (variable x)) :.
	z =. difference (variable x) (intersection (variable x) (insert (variable z) new))

x = "x"
y = "y"
z = "z"