Wolf, Goat and Cabbage

wgc.hs

import Control.Lens
import Data.List
import Data.Either
import Control.Error.Util

data Being = Wolf | Goat | Cabbage deriving (Eq, Show)
data Direction = Leftward | Rightward
type Boat = Maybe Being
type Coast = [Being]
type River = (Coast, Coast)
type Gamestate = (River, Direction)

instance Show Direction where
	show Rightward = ".......(boat)"
	show Leftward = "(boat)......."

-- initial state
start :: Gamestate
start = (([], [Wolf, Goat, Cabbage]), Rightward)

-- take a being on the boat
takeit :: Being -> Coast -> Either String Coast
takeit being coast = note (show being ++ " is not here") $ find (== being) coast <&> (`delete` coast)

-- if Goat ate Cabbage or Wolf ate Goat - try again
eaten :: Coast -> Either String Coast
eaten coast
	| elem Goat coast && elem Cabbage coast = Left "* Goat ate cabbage! Try again! *"
	| elem Goat coast && elem Wolf coast = Left "* Wolf ate goat! Try again! *"
	| otherwise = Right coast

-- moving between coasts on the river
shipping :: River -> Boat -> Direction -> Either String River
shipping river@(lc, rc) boat Leftward = case boat of
	Just being -> takeit being rc >>= eaten >>= \rc' -> Right (being:lc, rc')
	Nothing -> eaten rc >> Right river
shipping river@(lc, rc) boat Rightward = case boat of
	Just being -> takeit being lc >>= eaten >>= \lc' -> Right (lc', being:rc)
	Nothing -> eaten lc >> Right river

-- interpretation of user's input
input :: IO Boat
input = getLine >>= \choice -> case choice of
	"0" -> return Nothing
	"1" -> return $ Just Wolf
	"2" -> return $ Just Goat
	"3" -> return $ Just Cabbage
	_ -> print "Wrong, try again" >> input

display :: Gamestate -> IO ()
display ((lc, rc), dir) = print $ "River: " ++ show lc ++ " " ++ show dir ++ " " ++ show rc

invert :: Direction -> Direction
invert Leftward = Rightward
invert Rightward = Leftward

-- after each successful turn we got new state of river and last direction
turn :: Gamestate -> Boat -> IO Gamestate
turn (river, dir) boat = case shipping river boat (invert dir) of
	Left err -> print err >> return (river, dir)
	Right newriver -> return (newriver, invert dir)

-- if right coast is empty - victory
check :: River -> Bool
check (_, rc) = null rc

greetings = print "* Welcome to the WGC! *"
prompt = print "[0 - empty, 1 - Wolf, 2 - Goat, 3 - Gabbage]"
congratulate = print "* Congratulations! You win! *"

main = greetings >> prompt >> loop start
	where loop (r,d) = if check r then congratulate
		else display (r,d) >> input >>= turn (r,d) >>= \st -> loop st