import Data.List
import Data.List.Split (chunksOf)
import Data.Char

data Suit = Club | Heart | Diamond | Spade           deriving (Show, Read, Eq)
data Sex  = Out | In                                 deriving (Show, Read, Eq)
data Side = Side { suit :: Suit , sex :: Sex}        deriving (Show, Read)
instance Eq Side where x == y = (suit x == suit y) && (sex x /= sex y)
data Piece = Piece { north :: Side , east  :: Side
                   , south :: Side , west  :: Side } deriving (Show, Read, Eq)

parsePiece [n,e,s,w] = Piece { north = parseSide n, east = parseSide e
                             , south = parseSide s, west = parseSide w }
  where parseSide c = Side { suit = parseSuit c, sex =  parseSex c }
        parseSuit c | toLower c == 'c' = Club
                    | toLower c == 'd' = Diamond
                    | toLower c == 's' = Spade
                    | otherwise        = Heart
        parseSex  c = if isLower c then In else Out

explore :: ([Piece], [Piece]) -> [([Piece], [Piece])]
explore (list, pool) = concatMap pluck [0..(length pool - 1)]
  where pluck i = [ (list ++ [c], excise i pool)
                  | c <- take 4 $ iterate rotate (pool!!i)
                  ]
        excise i xs = take i xs ++ drop (i+1) xs
        rotate piece = Piece { north = east piece, east = south piece
                             , south = west piece, west = north piece }

validate :: Int -> [Piece] -> Bool --validates position n, indexed at zero
validate n xs = (not hasAbove || matchAbove) && (not hasLeft || matchLeft)
  where hasLeft    = n `mod` 3 /= 0
        hasAbove   = n >= 3
        matchLeft  = west  (xs!!n) == east  (xs!!(n-1))
        matchAbove = north (xs!!n) == south (xs!!(n-3))

step 0 xs = explore ([], xs)
step n xs = filter (\(xs,_) -> validate n xs) $ concatMap explore $ step (pred n) xs

renderGrid :: [Piece] -> [String]
renderGrid = intercalate ["----|-----|----"] . map renderRow . chunksOf 3
 where renderRow xs = [ intercalate " | " $ map (\x -> renderSq x!!n) xs | n <- [0..2] ]
       renderSq p = [ "."          ++ [unParse $ north p] ++ "."
                    , [unParse $ west p] ++ " "           ++ [unParse $ east p]
                    , "."          ++ [unParse $ south p] ++ "."
                    ]
       unParse s
         | suit s == Club    = f 'c'
         | suit s == Spade   = f 's'
         | suit s == Diamond = f 'd'
         | otherwise         = f 'h'
         where f = if sex s == Out then toUpper else id

main = do
  let allPieces = map parsePiece $ [ "HDdh", "CHsh", "DCcd", "SDsh", "SDhd", "SShc", "CHdc", "HDcc", "HSsc" ]
  let sol = fst $ head $ step 8 allPieces
  mapM_ putStrLn $ renderGrid sol