module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (foldM, forM_)
import Data.List ((\\))


data House = House   
    { color :: Color      
    , man   :: Man
    , pet   :: Pet
    , drink :: Drink
    , smoke :: Smoke
    }
    deriving (Eq, Show)

data Color = Red | Green | Blue | Yellow | White
    deriving (Eq, Show, Enum, Bounded)

data Man = Eng | Swe | Dan | Nor | Ger
    deriving (Eq, Show, Enum, Bounded)

data Pet = Dog | Birds | Cats | Horse | Zebra
    deriving (Eq, Show, Enum, Bounded)

data Drink = Coffee | Tea | Milk | Beer | Water
    deriving (Eq, Show, Enum, Bounded)

data Smoke = PallMall | Dunhill | Blend | BlueMaster | Prince
    deriving (Eq, Show, Enum, Bounded)

type Solution = [House]

main :: IO ()
main = do
  forM_ solutions $ \sol -> mapM_ print sol
                            >> putStrLn "
  putStrLn "No More Solutions"


solutions :: [Solution]
solutions = filter finalCheck . map reverse $ foldM next [] [1..5]
    where
      
      next :: Solution -> Int -> [Solution]
      next sol pos = [h:sol | h <- newHouses sol, consistent h pos]


newHouses :: Solution -> Solution
newHouses sol =    
    House <$> new color <*> new man <*> new pet <*> new drink <*> new smoke
    where
      new trait = [minBound ..] \\ map trait sol  


consistent :: House -> Int -> Bool
consistent house pos = and                  
    [ man   `is` Eng     <=>   color `is` Red              
    , man   `is` Swe     <=>   pet   `is` Dog              
    , man   `is` Dan     <=>   drink `is` Tea              
    , color `is` Green   <=>   drink `is` Coffee           
    , pet   `is` Birds   <=>   smoke `is` PallMall         
    , color `is` Yellow  <=>   smoke `is` Dunhill          
    , const (pos == 3)   <=>   drink `is` Milk             
    , const (pos == 1)   <=>   man   `is` Nor              
    , drink `is` Beer    <=>   smoke `is` BlueMaster       
    , man   `is` Ger     <=>   smoke `is` Prince           
    ]
    where
      infix 4 <=>
      p <=> q  =  p house == q house   


is :: Eq a => (House -> a) -> a -> House -> Bool
(trait `is` value) house  =  trait house == value


finalCheck :: [House] -> Bool
finalCheck solution = and                    
    [ (color `is` Green)   `leftOf` (color `is` White)  
    , (smoke `is` Blend  ) `nextTo` (pet   `is` Cats )  
    , (smoke `is` Dunhill) `nextTo` (pet   `is` Horse)  
    , (color `is` Blue   ) `nextTo` (man   `is` Nor  )  
    , (smoke `is` Blend  ) `nextTo` (drink `is` Water)  
    ]
    where
      nextTo :: (House -> Bool) -> (House -> Bool) -> Bool
      nextTo p q = leftOf p q || leftOf q p
      leftOf p q 
          | (_:h:_) <- dropWhile (not . p) solution = q h
          | otherwise                               = False