Puzzle.hs

module Puzzle where

import Data.List


data Girl   = Ellie | Emily | Jessica    deriving (Bounded, Enum, Eq, Show)
data Animal = Elephant | Zebra | Giraffe deriving (Bounded, Enum, Eq, Show)
data Lolly  = Grunge | Plooper | Zinger  deriving (Bounded, Enum, Eq, Show)
data Adult = Aunt | Grandma | Mum        deriving (Bounded, Enum, Eq, Show)

type Row = (Girl, Animal, Lolly, Adult)
type Table = [Row]
type Rule = Row -> Bool

rules :: [Rule]
rules = [ \(g, a, l, w) -> g /= Ellie || w == Grandma && l /= Zinger
        , \(g, a, l, w) -> w /= Mum || a == Elephant
        , \(g, a, l, w) -> a /= Giraffe || l /= Plooper
        , \(g, a, l, w) -> w /= Aunt || l == Grunge && g /= Jessica
        ]

solution :: Table
solution = head $ filter rowsMatchRules allCombinations

allCombinations :: [Table]
allCombinations = [ table
                  | as <- permsOfEnum
                  , ls <- permsOfEnum
                  , ws <- permsOfEnum
                  , let table = zip4 [minBound .. maxBound] as ls ws
                  ] 

permsOfEnum :: (Bounded a, Enum a) => [[a]]
permsOfEnum = permutations [minBound .. maxBound]

rowsMatchRules :: Table -> Bool
rowsMatchRules combinations = all matchesRules combinations

matchesRules :: Row -> Bool
matchesRules combination = all (\r -> r combination) rules

{- 
alternative: specify rules in the list comprehension:

[ table
| ...
let table = ...
, any (\(g, a, l, w) -> g == Ellie && w == Grandma) table
, all (...)
...
]
this can then be generalised to a generic solver
-}

{-
ExistentialQuantification:
data Rule = forall a b . (Eq a, Eq b) => Is (Row -> a, a) (Row b -> b)

when forall is "inside", it's an existential, if "outside", universal
-}