import Data.List
import Data.Either

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 = if elem being coast
	then Right (delete being coast)
	else Left $ show being ++ " is not here"

-- if Goat ate Cabbage or Wolf ate Goat - game is over
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 >>= \rcoast -> Right (being:lc, rcoast)
	Nothing -> eaten rc >> Right river
shipping river@(lc, rc) boat Rightward = case boat of
	Just being -> takeit being lc >>= eaten >>= \lcoast -> Right (lcoast, 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

gretings :: IO ()
gretings = print "* Welcome to the WGC! *"

prompt :: IO ()
prompt = print "[0 - empty, 1 - Wolf, 2 - Goat, 3 - Gabbage]"

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

-- after each 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 -> Either String River
check river@(_, rc) = if null rc then Left "* Congratulations! You win! *" else Right river

main = gretings >> prompt >> loop start
	where loop (r,d) = case check r of
		Left err -> print err
		Right _ -> display (r,d) >> input >>= turn (r,d) >>= \st -> loop st