Logic Puzzle (ID: O382PX)

Main.hs

import Data.List
import Data.Maybe

main :: IO ()
main = do
  putStrLn $ show $ head solves

solves :: [[[Int]]]
solves = [state |
          state <- initStates 3 5,
          let [wakeUpCalls, disasters, softDrinks] = state,
          (wakeUpCalls !! 4) == 0, -- 5.
          (stateFromPerson (disasters !! 4) softDrinks) == 3, -- 8.
          ((disasters !! 2) == 2) || ((disasters !! 3) == 2), -- 9.
          (disasters !! 3) /= 2, -- 1.
          (disasters !! 0) /= 0, -- 10.
          -- 4
          let clue4Person1 = (disasters !! 2),
          let clue4Person2 = 1,
          let clue4Person3 = (wakeUpCalls !! 0),
          let clue4Person4 = (softDrinks !! 0),
          let clue4Person5 = (disasters !! 1),
          clue4Person1 /= clue4Person2,
          clue4Person1 /= clue4Person3,
          clue4Person1 /= clue4Person4,
          clue4Person1 /= clue4Person5,
          clue4Person2 /= clue4Person3,
          clue4Person2 /= clue4Person4,
          clue4Person2 /= clue4Person5,
          clue4Person3 /= clue4Person4,
          clue4Person3 /= clue4Person5,
          clue4Person4 /= clue4Person5,
          (stateFromPerson (wakeUpCalls !! 1) softDrinks) /= 3, -- 2.
          (stateFromPerson (disasters !! 1) wakeUpCalls) < (stateFromPerson (disasters !! 2) wakeUpCalls), -- 3.
          (stateFromPerson (disasters !! 1) wakeUpCalls) > (stateFromPerson (softDrinks !! 2) wakeUpCalls), -- 6.
          (stateFromPerson (softDrinks !! 4) wakeUpCalls) > (stateFromPerson 4 wakeUpCalls), -- 11.
          let (time1, time2) = (stateFromPerson (softDrinks !! 4) wakeUpCalls,
                                stateFromPerson (disasters !! 4) wakeUpCalls),
          (time1, time2) == (1, 2) || (time1, time2) == (2, 1), -- 7.
          True] -- for auto-indent
  where
    stateFromPerson person state = fromJust $ elemIndex person state

initStates :: Int -> Int -> [[[Int]]]
initStates nState nPeople = foldl comb [[]] $
                            replicate nState $
                            permutations [0..(nPeople - 1)]
  where
    comb a b = do
      a' <- a
      b' <- b
      return $ a' ++ [b']