# 2015

## 1 Kinds

Maybe: S -> S  
A: S  
B: S  
C: S -> S  
D: k -> (k -> S) -> S  
E: ((S -> S) -> S) -> S  
D Maybe A: *incorrect*  
D A Maybe: S  
D Maybe: ((S -> S) -> S) -> S (if polymorphic kinds are allowed; otherwise incorrect)  
D A: (S -> S) -> S

:: T m = T (m Int)

## 2 Generic Programming

```clean
// a
generic gToNothing a :: a -> a
gToNothing{|Maybe|} _ _ = Nothing
gToNothing{|UNIT|} _ = UNIT
gToNothing{|EITHER|} fl fr (LEFT x)  = LEFT  (fl x)
gToNothing{|EITHER|} fl fr (RIGHT x) = RIGHT (fr x)
gToNothing{|PAIR|} fx fy (PAIR x y)  = PAIR (fx x) (fy y)
gToNothing{|OBJECT|} fx (OBJECT x) = OBJECT (fx x)
gToNothing{|CONS|} fx (CONS x) = CONS (fx x)

// b
gToNothing{|Int|} i = i
gToNothing{|Bool|} b = b
derive gToNothing (,), []

Start = gToNothing{|*|} (Just 1, [Nothing, Just True])

// c
:: Rose a = RoseLeaf | RoseTwig a [Rose a]

prop_gToNothing_once_is_enough :: (Rose (Maybe Int)) -> Property
prop_gToNothing_once_is_enough r = n r === twice n r
where n = gToNothing{|*|}

// d
:: NothingCount a = NC Int

generic gMaxNothingCount a :: NothingCount a
gMaxNothingCount{|Int|} = NC 0
gMaxNothingCount{|Maybe|} (NC x) = NC (max 1 x)
gMaxNothingCount{|UNIT|} = NC 0
gMaxNothingCount{|EITHER|} (NC x) (NC y) = NC (max x y)
gMaxNothingCount{|PAIR|} (NC x) (NC y) = NC (x + y)
gMaxNothingCount{|OBJECT|} (NC c) = NC c
gMaxNothingCount{|CONS|} (NC c) = NC c
```

## 3 Deep Embedding

```clean
// a
:: MoException e r = Exception e | Result r

instance Functor (MoException e)
where
	fmap f (Exception e) = Exception e
	fmap f (Result r)    = Result (f r)

instance Applicative (MoException e)
where
	pure x = Result x
	(<*>) (Exception e) _ = Exception e
	(<*>) _ (Exception e) = Exception e
	(<*>) (Result f) (Result r) = Result (f r)

instance Monad (MoException e)
where
	bind (Exception e) _ = Exception e
	bind (Result r) f = f r

unlockedInUpPos :: MoException CraneException a
unlockedInUpPos = Exception UnlockedInUpPos

movedInDownPos :: MoException CraneException a
movedInDownPos = Exception MovedInDownPos

// b
:: VPosition = Up | Down
:: HPosition = Ship | Quay

:: Position =
	{ v :: VPosition
	, h :: HPosition
	}

:: State =
	{ quay  :: [String]
	, ship  :: [String]
	, crane :: Maybe String
	, pos   :: Position
	}

// c
// The advantage of using monads is two-fold:
// - We can hide all error handling using combinators
// - We get a lot for free using combinators (forever, ...)

eval :: CAction State -> MoException CraneException State
eval MoveLeft  {pos={h=Quay,v=Down}} = movedInDownPos
eval MoveLeft  s                     = pure {s & pos.h=Ship}
eval MoveRight {pos={h=Ship,v=Down}} = movedInDownPos
eval MoveRight s                     = pure {s & pos.h=Quay}
eval MoveUp    s = pure {s & pos.v=Up}
eval MoveDown  s = pure {s & pos.v=Down}
eval Lock      s
| s.crane =: (Just _) = pure s
| s.pos.v =: Up       = pure s
| s.pos.h =: Ship     = pure case s.ship of
	[]     -> s
	[c:cs] -> {s & crane=Just c, ship=cs}
| s.pos.h =: Quay     = pure case s.quay of
	[]     -> s
	[c:cs] -> {s & crane=Just c, quay=cs}
eval Unlock {pos={v=Up},crane=Just _} = unlockedInUpPos
eval Unlock s=:{crane=Just c} = pure case s.pos.h of
	Ship -> {s & crane=Nothing, ship=[c:s.ship]}
	Quay -> {s & crane=Nothing, quay=[c:s.quay]}
eval Unlock s = pure s
eval (a :. b) s = eval a s >>= eval b
eval w=:(WhileContainerBelow a) s
| isContainerBelow s = eval (a :. w) s
| otherwise          = pure s
where
	isContainerBelow :: State -> Bool
	isContainerBelow {pos={h=Quay},quay=[_:_]} = True
	isContainerBelow {pos={h=Ship},ship=[_:_]} = True
	isContainerBelow _                         = False
```

## 4 Task-Oriented Programming

```clean
// a
enterAndSimulate :: Task State
enterAndSimulate = enterInformation "Initial state" [] >>= apply
where
	apply :: State -> Task State
	apply st = (enterInformation "Action" [] -|| viewInformation "State" [] st) >>*
		[ OnAction ActionContinue (hasValue (\a -> eval` a st))
		, OnAction ActionQuit     (always st)
		]

	eval` :: CAction State -> Task State
	eval` a st = case eval a st of
		Result st -> return st
		Exception e -> throw e

// b
simulate :: CAction State -> Task ((CAction, State), MoException CraneException State)
simulate a st = withShared (a,st) \shr ->
	updateSharedInformation "Setup" [] shr -&&-
	viewSharedInformation "Result" [ViewWith (uncurry eval)] shr
```

## 5 Shallow Embedding

```clean
// a
moveLeft :: State -> MoException CraneException State
moveLeft {pos={h=Quay,v=Down}} = movedInDownPos
moveLeft s                     = pure {s & pos.h=Ship}

moveRight :: State -> MoException CraneException State
moveRight {pos={h=Ship,v=Down}} = movedInDownPos
moveRight s                     = pure {s & pos.h=Quay}

moveUp :: State -> MoException CraneException State
moveUp s = pure {s & pos.v=Up}

moveDown :: State -> MoException CraneException State
moveDown s = pure {s & pos.v=Down}

lock :: State -> MoException CraneException State
lock s
| s.crane =: (Just _) = pure s
| s.pos.v =: Up       = pure s
| s.pos.h =: Ship     = pure case s.ship of
	[]     -> s
	[c:cs] -> {s & crane=Just c, ship=cs}
| s.pos.h =: Quay     = pure case s.quay of
	[]     -> s
	[c:cs] -> {s & crane=Just c, quay=cs}

unlock :: State -> MoException CraneException State
unlock {pos={v=Up},crane=Just _} = unlockedInUpPos
unlock s=:{crane=Just c} = pure case s.pos.h of
	Ship -> {s & crane=Nothing, ship=[c:s.ship]}
	Quay -> {s & crane=Nothing, quay=[c:s.quay]}
unlock s = pure s

(:.) infixl 1 ::
	(State -> MoException CraneException State)
	(State -> MoException CraneException State)
	State -> MoException CraneException State
(:.) a b s = a s >>= b

whileContainerBelow :: (State -> MoException CraneException State)
	State -> MoException CraneException State
whileContainerBelow a s
| isContainerBelow s = a s >>= whileContainerBelow a
| otherwise          = pure s
where
	isContainerBelow :: State -> Bool
	isContainerBelow {pos={h=Quay},quay=[_:_]} = True
	isContainerBelow {pos={h=Ship},ship=[_:_]} = True
	isContainerBelow _                         = False

// b
:: Up = Up_
:: Down = Down_

:: State updown = // ... (updown is always Up or Down)

moveLeft :: (State Up) -> MoException CraneException (State Up)
moveRight :: (State Up) -> MoException CraneException (State Up)

moveUp :: (State Down) -> MoException CraneException (State Up)
moveDown :: (State Up) -> MoException CraneException (State Down)

lock :: (State Down) -> MoException CraneException (State Down)
unlock :: (State Down) -> MoException CraneException (State Down)

(:.) infixl 1 ::
	((State a) -> MoException CraneException (State b))
	((State b) -> MoException CraneException (State c))
	(State a) -> MoException CraneException (State c)

whileContainerBelow :: ((State a) -> MoException CraneException (State a))
	(State a) -> MoException CraneException (State a)
where
	isContainerBelow :: (State a) -> Bool
```

c. We would have to include whether an action moves up or down in the `CAction`
   type, i.e. `:: CAction updown = // ...`. But then `MoveUp` can only be a
   constructor of the type `:: CAction Up`, not of `:: CAction Down`, and there
   is no way to indicate this in the type definition.
   With GADTs we can indicate it in the type definition, assuming that the
   bimap argument of the constructor is always `bimapId :: Bimap a a`.

d. Shallow embedding is faster and more space-efficient, because we do not
   interpret data structures but execute code directly. In shallow embedding it
   is also easier to add a language construct, although it is more difficult to
   add a view.