-- ---------------------------------------------------------------
--  Solves a typical puzzle where 3 cannibals and 3 missionaries
--  want to cross a river using a small canoe.
--
--    - If there are more cannibals than missionaries in either
--        bank of the river. Cannibals will eat the missionaries.
--        You lost.
--    - The canoe can be used by one or two persons.
--
--  by Fernando J. Pereda <ferdy@gentoo.org>
-- ---------------------------------------------------------------

module Main
    where

-- {{{ Type Definitions
type ProbSt = (SideSt,SideSt,CanoePos)

type SideSt = (Int,Int)

data CanoePos = Start
              | End
              deriving (Eq)

data Trip = C
          | M
          | CC
          | MM
          | CM
          deriving (Eq)

trips :: [Trip]
trips = [C,M,CC,MM,CM]
-- }}}

-- {{{ Type instances
instance Show CanoePos where
    show Start = "| \\__/ ~~~~~~~ |"
    show End   = "| ~~~~~~~ \\__/ |"

instance Show Trip where
    show C  = "     | ~~~ \\_C/ ~~~ |"
    show M  = "     | ~~~ \\_M/ ~~~ |"
    show CC = "     | ~~~ \\CC/ ~~~ |"
    show MM = "     | ~~~ \\MM/ ~~~ |"
    show CM = "     | ~~~ \\CM/ ~~~ |"
-- }}}

-- {{{ Check States
-- |Checks whether a state is valid or not
validateState :: ProbSt -> Bool
validateState ((lc,lm),(rc,rm),_) | lc > lm && lm > 0 = False
                                  | rc > rm && rm > 0 = False
                                  | otherwise         = True

-- |Have we solved the problem?
problemSolved :: ProbSt -> Bool
problemSolved ((0,0),(3,3),End) = True
problemSolved _                 = False

-- |Check if we can make a trip
checkTrip :: ProbSt -> Trip -> Bool
checkTrip ((lc,lm),(rc,rm),pos) trp = case trp of
                                       C  -> nc >= 1
                                       M  -> nm >= 1
                                       CM -> nc >= 1 && nm >= 1
                                       CC -> nc >= 2
                                       MM -> nm >= 2
                                      where
                                       nc = if pos == Start then lc else rc
                                       nm = if pos == Start then lm else rm
-- }}}

-- {{{ Misc. Functions over types
-- |Gets the possible next states given a problem state
nextStates :: ProbSt -> [ProbSt]
nextStates prob = map (makeTrip prob) [ tr | tr <- trips
                                      , checkTrip prob tr
                                      , validateState $ makeTrip prob tr ]

-- |User-friendly printing
printState :: ProbSt -> String
printState (a,b,c) = show a ++ show c ++ show b
-- }}}

-- {{{ Modify State
-- |Makes a trip. Maybe a new problem state. DOES NOT CHECK for trip validity
makeTrip :: ProbSt -> Trip -> ProbSt
makeTrip ((lc,lm),(rc,rm),Start) C  = ((lc-1,lm),(rc+1,rm),End)
makeTrip ((lc,lm),(rc,rm),Start) M  = ((lc,lm-1),(rc,rm+1),End)
makeTrip ((lc,lm),(rc,rm),Start) CM = ((lc-1,lm-1),(rc+1,rm+1),End)
makeTrip ((lc,lm),(rc,rm),Start) CC = ((lc-2,lm),(rc+2,rm),End)
makeTrip ((lc,lm),(rc,rm),Start) MM = ((lc,lm-2),(rc,rm+2),End)
makeTrip ((lc,lm),(rc,rm),End)   C  = ((lc+1,lm),(rc-1,rm),Start)
makeTrip ((lc,lm),(rc,rm),End)   M  = ((lc,lm+1),(rc,rm-1),Start)
makeTrip ((lc,lm),(rc,rm),End)   CM = ((lc+1,lm+1),(rc-1,rm-1),Start)
makeTrip ((lc,lm),(rc,rm),End)   CC = ((lc+2,lm),(rc-2,rm),Start)
makeTrip ((lc,lm),(rc,rm),End)   MM = ((lc,lm+2),(rc,rm-2),Start)
--- }}}

-- {{{ Problem solving functions
-- |Gets possible next moves. Checks for loops.
solveStep :: ProbSt -> [ProbSt] -> [[ProbSt]]
solveStep prob probs = if problemSolved prob
                       then [prob:probs]
                       else concat [ solveStep p' (prob:probs) | p' <- nextStates prob
                                                               , p' `notElem` probs ]

-- |Solves the problem, returns a list of needed movements, given an initial state
solveProblem :: [[ProbSt]]
solveProblem = solveStep ((3,3),(0,0),Start) []
-- }}}

-- {{{ Main function
main :: IO ()
main = do
        -- Solve the problem and print an user-friendly title
        res <- return solveProblem
        len <- return $ length res
        tit <- return $ "Found "++(show len)++" different solutions:"
        putStrLn tit
        putStrLn $ replicate (length tit) '-'

        -- Now proccess the list of solutions
        sequence $ map ( putStr
                       . (\x -> "\nPossible solution: "++show (length x)++" steps:\n\n"++unlines x)
                       . map printState
                       . reverse
                       ) solveProblem
        return ()
-- }}}