module a10

import StdEnv

import Data.Functor
import Control.Applicative
import Control.Monad
import Data.Maybe
import Data.Error

:: BM a b = {t :: a->b, f :: b->a, t2 :: A.c t:(t c a)->t c b, f2 :: A.c t:(t b c)->t a c}
bm = {t = id, f = id, t2 = id, f2 = id}

:: Action b a
	= MoveToShip (BM b High) (BM a High)
	| MoveToQuay (BM b High) (BM a High)
	| MoveUp (BM b Low) (BM a High)
	| MoveDown (BM b High) (BM a Low)
	| Lock (BM b Low) (BM a Low)
	| Unlock (BM b Low) (BM a Low)
	| Wait (BM b a)
	| E.i: (:.) infixl 1 (Action b i) (Action i a)
	| WhileContainerBelow (BM b a) (Action a a)
:: High = High
:: Low = Low

moveToShip = MoveToShip bm bm
moveToQuay = MoveToQuay bm bm
moveUp     = MoveUp     bm bm
moveDown   = MoveDown   bm bm
lock       = Lock       bm bm
unlock     = Unlock     bm bm
wait       = Wait       bm
whileContainerBelow = WhileContainerBelow bm

:: State =
	{ onShip      :: [String]
	, onQuay      :: [String]
	, craneUp     :: Bool
	, craneOnQuay :: Bool
	, locked      :: Maybe String
	}

state0 =
	{ onShip = []
	, onQuay = ["apples","beer","camera's"]
	, craneUp = True
	, craneOnQuay = True
	, locked = Nothing
	}

// ================
:: Sem a = Sem ((MaybeErrorString State) -> MaybeErrorString State)


eval :: (Action i f) State -> MaybeErrorString State
eval (MoveToShip b1 b2) s = pure {s & craneOnQuay = False}
eval (MoveToQuay b1 b2) s = pure {s & craneOnQuay = True}
eval (MoveUp b1 b2)     s = pure {s & craneUp = True}
eval (MoveDown b1 b2)   s = pure {s & craneUp = False}
eval (Lock b1 b2) s=:{locked=Nothing}
	| s.craneOnQuay =  
	                =
eval (Lock b1 b2) s=:{locked=Nothing} = Error ("Cannot lock new container, craner contains " + container)
eval (Lock b1 b2) s=:{locked=(Just _)} = Error ("Cannot lock new container, craner contains " + container)
	Nothing
		| s.craneOnQuay
		= case s.onQuay of
			[c:r] = pure {s & onQuay = r, locked = Just c}
			[]    = Error "Cannot lock container on empty quay"
		= case s.onShip of
			[c:r] = pure {s & onShip = r, locked = Just c}
			[]    = Error "Cannot lock container on empty ship"
	Just container
		= Error ("Cannot lock new container, craner contains " + container)
eval (Unlock b1 b2)     s =case s.locked of
	Just container | s.craneOnQuay
		 = Result {s & onQuay = [container:s.onQuay], locked = Nothing}
			 = Result {s & onShip = [container:s.onShip], locked = Nothing}
			Nothing = Error "Cannot unlock container, craner contains nothing"
		Wait bm = Result s
		a :. b  = eval b (eval a r)
		WhileContainerBelow bm action
			| s.craneOnQuay && not (isEmpty s.onQuay) ||
			  not s.craneOnQuay && not (isEmpty s.onShip)
			= eval (action :. WhileContainerBelow bm action) r
			= r
*/

Start = 42