- 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
-*/
+eval (Lock _ _) s=:{locked=(Just c)}
+ = Error ("Cannot lock new container, craner contains " +++ c)
+eval (Unlock _ _) s=:{locked=(Just c)}
+ | s.craneOnQuay = pure {s & onQuay = [c:s.onQuay], locked = Nothing}
+ = pure {s & onShip = [c:s.onShip], locked = Nothing}
+eval (Unlock b1 b2) s=:{locked=Nothing}
+ = Error "Cannot unlock container, crane contains nothing"
+eval (Wait _) s = Ok s
+eval (a :. b) s = eval a s >>= eval b
+eval (WhileContainerBelow _ action) s
+ | s.craneOnQuay && not (isEmpty s.onQuay) || not s.craneOnQuay && not (isEmpty s.onShip)
+ = eval (action :. whileContainerBelow action) s
+ = pure s
+
+opt :: (Action a b) -> Action a b
+opt (WhileContainerBelow b a) = WhileContainerBelow b (opt a)
+opt (Wait bm :. b) = opt (bm.f2 b)
+opt (a :. Wait bm) = opt (bm.t2 a)
+opt (a :. b) = opt a :. opt b
+opt x = x
+
+Start = opt (moveToShip :. wait :. moveDown)
+//print :: (Action i f) [String] -> [String]
+//print (MoveToShip _ _) s = ["Move to ship":s]
+//print (MoveToQuay _ _) s = ["Move to quay":s]
+//print (MoveUp _ _) s = ["Move up":s]
+//print (MoveDown _ _) s = ["Move down":s]
+//print (Lock _ _) s = ["Lock":s]
+//print (Unlock _ _) s = ["Unlock":s]
+//print (Wait _) s = ["Wait":s]
+//print (a :. b) s = print a ["\n":print b s]
+//print (WhileContainerBelow _ a) s
+// = ["While container below (":indent ["\n":print a [")":s]]]
+//where
+// indent s = map (\s->if (s.[0] == '\n') (s +++ "\t") s)
+//
+
+print :: (Action i f) String [String] -> [String]
+print (MoveToShip _ _) i s = [i,"Move to ship":s]
+print (MoveToQuay _ _) i s = [i,"Move to quay":s]
+print (MoveUp _ _) i s = [i,"Move up":s]
+print (MoveDown _ _) i s = [i,"Move down":s]
+print (Lock _ _) i s = [i,"Lock":s]
+print (Unlock _ _) i s = [i,"Unlock":s]
+print (Wait _) i s = [i,"Wait":s]
+print (a :. b) i s = print a i ["\n":print b i s]
+print (WhileContainerBelow _ a) i s
+ = [i,"While container below (\n":print a ("\t"+++i) ["\n",i,")":s]]
+
+Start = print loadShip "" []
+
+p1 = moveToShip :. moveDown
+
+//p2 = moveToShip :. wait :. lock // the required type error