example24.hs

-- Puzzle explained at https://github.com/dag/all-about-monads/blob/master/examples/example24.hs

-- Print each possible solution, one per line
main :: IO ()
main = mapM_ putStrLn solution

data Sex = Male | Female deriving (Show, Eq)

-- | Boolean implication
(==>) :: Bool -> Bool -> Bool
x ==> y = not x || y
infixr 3 ==>

-- | Given one sex compute the other.
other_sex :: Sex -> Sex
other_sex Male   = Female
other_sex Female = Male

-- | List of possible solutions to the problem
solution :: [String]
solution =
  [ "Child: "      ++ show child_is ++
    ", Parent 1: " ++ show parent1 ++
    ", Parent 2: " ++ show parent2

  | let sexes = [Male, Female]
  , parent1    <- sexes
  , child_is   <- sexes
  , child_said <- sexes

  , let parent2 = other_sex parent1
  , let child_lied = child_is /= child_said

  , let parent1_statement  = child_said == Male
  , let parent2_statement1 = child_is   == Female
  , let parent2_statement2 = child_lied

  , child_is == Male   ==> not child_lied
  , parent1  == Male   ==> parent1_statement
  , parent2  == Female ==> parent2_statement1 /= parent2_statement2
  , parent2  == Male   ==> parent2_statement1 && parent2_statement2
  ]