{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

{- |
Description: Supporting definitions for crossword puzzles
Copyright: Copyright (C) 2021 Yoo Chung
License: GPL-3.0-or-later
Maintainer: dev@chungyc.org

Supporting definitions for crossword puzzles.
In particular, this supports "Problems.P99".
-}
module Problems.Crosswords (Crossword (..), printCrossword, parseCrossword, readCrossword) where

import           Data.List (intersperse)
import           System.IO

{- |
A crossword puzzle.

A list of words to fill the puzzle with is given along the grid to fill.
The crossword puzzle grid is represented with a list of sublists.
Each sublist denotes a row, and each value in the sublists denotes a spot.
For each value in a spot:

* 'True' denotes a blank spot that needs a character to be filled in.
* 'False' denotes a spot that cannot be filled in.
*  A character value denotes a spot pre-filled with the character.
-}
data Crossword = Crossword
  { Crossword -> [String]
word :: [String]              -- ^ List of words to fill crossword puzzle with
  , Crossword -> [[Either Bool Char]]
grid :: [[Either Bool Char]]  -- ^ Grid for the crossword puzzle
  }
  deriving (Crossword -> Crossword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Crossword -> Crossword -> Bool
$c/= :: Crossword -> Crossword -> Bool
== :: Crossword -> Crossword -> Bool
$c== :: Crossword -> Crossword -> Bool
Eq, Int -> Crossword -> ShowS
[Crossword] -> ShowS
Crossword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Crossword] -> ShowS
$cshowList :: [Crossword] -> ShowS
show :: Crossword -> String
$cshow :: Crossword -> String
showsPrec :: Int -> Crossword -> ShowS
$cshowsPrec :: Int -> Crossword -> ShowS
Show)

{- |
Print out a solution to a crossword puzzle.

>>> :{
printCrossword $ Just [ [ Nothing,  Nothing,  Just 'P', Nothing,  Nothing  ]
                      , [ Nothing,  Nothing,  Just 'O', Nothing,  Nothing  ]
                      , [ Just 'A', Just 'L', Just 'P', Just 'H', Just 'A' ]
                      , [ Nothing,  Nothing,  Just 'P', Nothing,  Just 'R' ]
                      , [ Nothing,  Nothing,  Just 'Y', Nothing,  Just 'E' ]
                      , [ Nothing,  Nothing,  Nothing,  Nothing,  Just 'S' ]
                      ]
:}
■ ■ P ■ ■
■ ■ O ■ ■
A L P H A
■ ■ P ■ R
■ ■ Y ■ E
■ ■ ■ ■ S
-}
printCrossword :: Maybe [[Maybe Char]] -> IO ()
printCrossword :: Maybe [[Maybe Char]] -> IO ()
printCrossword Maybe [[Maybe Char]]
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
printCrossword (Just [[Maybe Char]]
solution) = 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 forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Char
' ' forall a b. (a -> b) -> a -> b
$ 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

{- |
Parses a crossword puzzle specification in a particular syntax.

It first lists the words in an arbitrary order, one word per line.
Then, after an empty line, the crossword grid is defined.
In this grid specification, a blank spot is represented by a dot (@.@).
Spots can also contain predefined character values.

=== __Notes__

This parses the crossword specifications provided by problem 99 in the original list.
-}
parseCrossword :: String -> Maybe Crossword
parseCrossword :: String -> Maybe Crossword
parseCrossword String
spec
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
gridLines' = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just 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') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> [Either Bool Char]
parseLine [String]
ls
  where parseLine :: String -> [Either Bool Char]
parseLine = forall a b. (a -> b) -> [a] -> [b]
map Char -> Either Bool Char
parseSpot
        parseSpot :: Char -> Either Bool Char
parseSpot Char
' ' = forall a b. a -> Either a b
Left Bool
False
        parseSpot Char
'.' = forall a b. a -> Either a b
Left Bool
True
        parseSpot Char
c   = 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 = forall a b. (a -> b) -> [a] -> [b]
map forall {b}. [Either Bool b] -> [Either Bool b]
pad [[Either Bool Char]]
rs
  where n :: Int
n = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Either Bool b]
r) (forall a b. a -> Either a b
Left Bool
False)

-- | Reads a crossword puzzle from a file, whose syntax is as specified by 'parseCrossword'.
--
-- === __Notes__
--
-- This parses the crossword specifications provided by problem 99 in the original list.
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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Maybe Crossword
parseCrossword String
spec