{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
module Problems.Crosswords (Crossword (..), printCrossword, parseCrossword, readCrossword) where
import Data.List (intersperse)
import System.IO
data Crossword = Crossword
{ Crossword -> [String]
word :: [String]
, Crossword -> [[Either Bool Char]]
grid :: [[Either Bool Char]]
}
deriving (Crossword -> Crossword -> Bool
(Crossword -> Crossword -> Bool)
-> (Crossword -> Crossword -> Bool) -> Eq Crossword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Crossword -> Crossword -> Bool
== :: Crossword -> Crossword -> Bool
$c/= :: Crossword -> Crossword -> Bool
/= :: Crossword -> Crossword -> Bool
Eq, Int -> Crossword -> ShowS
[Crossword] -> ShowS
Crossword -> String
(Int -> Crossword -> ShowS)
-> (Crossword -> String)
-> ([Crossword] -> ShowS)
-> Show Crossword
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Crossword -> ShowS
showsPrec :: Int -> Crossword -> ShowS
$cshow :: Crossword -> String
show :: Crossword -> String
$cshowList :: [Crossword] -> ShowS
showList :: [Crossword] -> ShowS
Show)
printCrossword :: Maybe [[Maybe Char]] -> IO ()
printCrossword :: Maybe [[Maybe Char]] -> IO ()
printCrossword Maybe [[Maybe Char]]
Nothing = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printCrossword (Just [[Maybe Char]]
solution) = ([Maybe Char] -> IO ()) -> [[Maybe Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Maybe Char] -> IO ()
printRow [[Maybe Char]]
solution
where printRow :: [Maybe Char] -> IO ()
printRow [Maybe Char]
cs = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Char -> ShowS
forall a. a -> [a] -> [a]
intersperse Char
' ' ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Maybe Char -> Char) -> [Maybe Char] -> String
forall a b. (a -> b) -> [a] -> [b]
map Maybe Char -> Char
fromSpot [Maybe Char]
cs
fromSpot :: Maybe Char -> Char
fromSpot Maybe Char
Nothing = Char
'■'
fromSpot (Just Char
c) = Char
c
parseCrossword :: String -> Maybe Crossword
parseCrossword :: String -> Maybe Crossword
parseCrossword String
spec
| [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
gridLines' = Maybe Crossword
forall a. Maybe a
Nothing
| Bool
otherwise = Crossword -> Maybe Crossword
forall a. a -> Maybe a
Just (Crossword -> Maybe Crossword) -> Crossword -> Maybe Crossword
forall a b. (a -> b) -> a -> b
$ Crossword { word :: [String]
word = [String]
wordLines, grid :: [[Either Bool Char]]
grid = [String] -> [[Either Bool Char]]
parseGrid [String]
gridLines }
where ([String]
wordLines, [String]
gridLines') = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String
"" ==) ([String] -> ([String], [String]))
-> [String] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
spec
String
_ : [String]
gridLines = [String]
gridLines'
parseGrid :: [String] -> [[Either Bool Char]]
parseGrid :: [String] -> [[Either Bool Char]]
parseGrid [String]
ls = [[Either Bool Char]] -> [[Either Bool Char]]
padRows ([[Either Bool Char]] -> [[Either Bool Char]])
-> [[Either Bool Char]] -> [[Either Bool Char]]
forall a b. (a -> b) -> a -> b
$ (String -> [Either Bool Char]) -> [String] -> [[Either Bool Char]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [Either Bool Char]
parseLine [String]
ls
where parseLine :: String -> [Either Bool Char]
parseLine = (Char -> Either Bool Char) -> String -> [Either Bool Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Either Bool Char
parseSpot
parseSpot :: Char -> Either Bool Char
parseSpot Char
' ' = Bool -> Either Bool Char
forall a b. a -> Either a b
Left Bool
False
parseSpot Char
'.' = Bool -> Either Bool Char
forall a b. a -> Either a b
Left Bool
True
parseSpot Char
c = Char -> Either Bool Char
forall a b. b -> Either a b
Right Char
c
padRows :: [[Either Bool Char]] -> [[Either Bool Char]]
padRows :: [[Either Bool Char]] -> [[Either Bool Char]]
padRows [[Either Bool Char]]
rs = ([Either Bool Char] -> [Either Bool Char])
-> [[Either Bool Char]] -> [[Either Bool Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Either Bool Char] -> [Either Bool Char]
forall {b}. [Either Bool b] -> [Either Bool b]
pad [[Either Bool Char]]
rs
where n :: Int
n = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Either Bool Char] -> Int) -> [[Either Bool Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Either Bool Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Either Bool Char]]
rs
pad :: [Either Bool b] -> [Either Bool b]
pad [Either Bool b]
r = [Either Bool b]
r [Either Bool b] -> [Either Bool b] -> [Either Bool b]
forall a. [a] -> [a] -> [a]
++ Int -> Either Bool b -> [Either Bool b]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Either Bool b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Either Bool b]
r) (Bool -> Either Bool b
forall a b. a -> Either a b
Left Bool
False)
readCrossword :: FilePath -> IO (Maybe Crossword)
readCrossword :: String -> IO (Maybe Crossword)
readCrossword String
path = do
Handle
h <- String -> IOMode -> IO Handle
openFile String
path IOMode
ReadMode
String
spec <- Handle -> IO String
hGetContents Handle
h
Maybe Crossword -> IO (Maybe Crossword)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Crossword -> IO (Maybe Crossword))
-> Maybe Crossword -> IO (Maybe Crossword)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Crossword
parseCrossword String
spec