{-# 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
(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)

{- |
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 = () -> 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

{- |
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
  | [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)

-- | 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
  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