-- |
-- Module      : Advent.OCR
-- Copyright   : (c) Justin Le 2020
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Library to parse "ASCII Art" letters from <https://adventofcode.com
-- Advent of Code> puzzles.  Compatible with all puzzles from 2015 to 2019.
--
module Advent.OCR (
  -- * Parse
    parseLetters
  , parseLettersWith
  , parseLettersEither
  , unsafeParseLetters
  , parseAsciiMap
  , asciiMapToLetters
  -- * Letter Map
  , LetterMap
  , defaultLetterMap
  -- ** Custom Letter Map
  , parseLetters'
  , parseLettersWith'
  , parseLettersEither'
  , unsafeParseLetters'
  , asciiMapToLetters'
  ) where

import           Advent.OCR.Internal
import           Data.Bifunctor
import           Data.Maybe
import           Data.Set            (Set)
import qualified Data.Set            as S

-- | A version of 'parseLettersWith'' accepting a custom 'LetterMap'
-- letterform database.
parseLettersWith'
    :: LetterMap        -- ^ database of letterforms
    -> (a -> Int)       -- ^ get X
    -> (a -> Int)       -- ^ get Y
    -> Set a
    -> Maybe String
parseLettersWith' :: forall a.
LetterMap -> (a -> Int) -> (a -> Int) -> Set a -> Maybe String
parseLettersWith' LetterMap
lm a -> Int
f a -> Int
g = LetterMap -> Set Point -> Maybe String
parseLettersV2 LetterMap
lm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\a
x -> forall a. a -> a -> V2 a
V2 (a -> Int
f a
x) (a -> Int
g a
x))

-- | A version of 'parseLetters' that takes a set of any type of value, as
-- long as you provide functions to access the X and Y coordinates.
parseLettersWith
    :: (a -> Int)       -- ^ get X
    -> (a -> Int)       -- ^ get Y
    -> Set a
    -> Maybe String
parseLettersWith :: forall a. (a -> Int) -> (a -> Int) -> Set a -> Maybe String
parseLettersWith = forall a.
LetterMap -> (a -> Int) -> (a -> Int) -> Set a -> Maybe String
parseLettersWith' LetterMap
defaultLetterMap

-- | A version of 'parseLetters'' accepting a custom 'LetterMap' letterform
-- database.
parseLetters'
    :: LetterMap            -- ^ database of letterforms
    -> Set (Int, Int)       -- ^ set of points
    -> Maybe String         -- ^ result, with unknown letters replaced with "?"
parseLetters' :: LetterMap -> Set (Int, Int) -> Maybe String
parseLetters' LetterMap
lm = LetterMap -> Set Point -> Maybe String
parseLettersV2 LetterMap
lm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Set a -> Set b
S.mapMonotonic (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> V2 a
V2)

-- | The go-to default: given a set of point coordinates, parse it into
-- the string it represents.  Should be compatible with any Advent of Code
-- challenge from 2015 to 2019.
--
-- @
-- 'parseLetters' 'defaultLetterMap' myPoints
--
-- -- or, using Data.Default
-- 'parseLetters' 'Data.Default.Class.def' myPoints
-- @
--
-- A 'Nothing' means that there were no recognized letters found.  A 'Just'
-- means that least 50% of letter forms are recognized.  Unrecognized
-- characters will be replaced with "?"; for more information, use
-- 'parseLettersEither'.
--
-- This function is robust to changes in orientation or flipping, but will
-- be fastest if the coordinates are oriented with (0,0) on the upper left
-- corner.  However, because of this, it might return the wrong answer if
-- your coordinates are /not/ oriented this way and your result is
-- symmetrical: it'll always prioritize the interpretaion against (0,0)
-- upper-left orientation first.
parseLetters
    :: Set (Int, Int)       -- ^ set of points
    -> Maybe String         -- ^ result, with unknown letters replaced with "?"
parseLetters :: Set (Int, Int) -> Maybe String
parseLetters = LetterMap -> Set (Int, Int) -> Maybe String
parseLetters' LetterMap
defaultLetterMap

-- | A version of 'parseLettersEither'' accepting a custom 'LetterMap'
-- letterform database.
parseLettersEither'
    :: LetterMap            -- ^ database of letterforms
    -> Set (Int, Int)
    -> Maybe [Either (Set (Int, Int)) Char]
parseLettersEither' :: LetterMap -> Set (Int, Int) -> Maybe [Either (Set (Int, Int)) Char]
parseLettersEither' LetterMap
lm = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Set a -> Set b
S.mapMonotonic) (\(V2 Int
x Int
y) -> (Int
x, Int
y))
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. LetterMap -> Set Point -> Maybe [Either (Set Point) Char]
parseLettersEitherV2 LetterMap
lm
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Set a -> Set b
S.mapMonotonic (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> V2 a
V2)

-- | A version of 'parseLetters' returning a list of characters that were
-- either recognized or unrecognized; in the case of unrecognized
-- characters, returns the set of their coordinates but shifted to (0, 0)
-- as its upper left corner.
parseLettersEither
    :: Set (Int, Int)
    -> Maybe [Either (Set (Int, Int)) Char]
parseLettersEither :: Set (Int, Int) -> Maybe [Either (Set (Int, Int)) Char]
parseLettersEither = LetterMap -> Set (Int, Int) -> Maybe [Either (Set (Int, Int)) Char]
parseLettersEither' LetterMap
defaultLetterMap

-- | A version of 'unsafeParseLetters'' accepting a custom 'LetterMap'
-- letterform database.
unsafeParseLetters'
    :: LetterMap
    -> Set (Int, Int)
    -> String
unsafeParseLetters' :: LetterMap -> Set (Int, Int) -> String
unsafeParseLetters' LetterMap
lm =
      forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Advent.OCR.unsafeParseLetters': Unable to parse letters")
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. LetterMap -> Set (Int, Int) -> Maybe String
parseLetters' LetterMap
lm

-- | A version of 'parseLetters' that will be undefined ('error') when no
-- parse is found.
unsafeParseLetters
    :: Set (Int, Int)
    -> String
unsafeParseLetters :: Set (Int, Int) -> String
unsafeParseLetters =
      forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Advent.OCR.unsafeParseLetters: Unable to parse letters")
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Int, Int) -> Maybe String
parseLetters

-- | Parse raw ASCII art into a set of points, usable with
-- 'parseLetters'.
parseAsciiMap
    :: Set Char             -- ^ characters to use as "on"/included
    -> String               -- ^ raw ASCII art
    -> Set (Int, Int)
parseAsciiMap :: Set Char -> String -> Set (Int, Int)
parseAsciiMap Set Char
c = forall a b. (a -> b) -> Set a -> Set b
S.mapMonotonic (\(V2 Int
x Int
y) -> (Int
x, Int
y)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Char -> String -> Set Point
parseAsciiMapV2 Set Char
c

-- | A version of 'asciiMapToLetters'' accepting a custom 'LetterMap'
-- letterform database.
asciiMapToLetters'
    :: Set Char             -- ^ characters to use as "on"/included in ASCII art
    -> LetterMap            -- ^ database of letterforms
    -> String               -- ^ raw ASCII art
    -> Maybe String
asciiMapToLetters' :: Set Char -> LetterMap -> String -> Maybe String
asciiMapToLetters' Set Char
c LetterMap
lm = LetterMap -> Set Point -> Maybe String
parseLettersV2 LetterMap
lm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Char -> String -> Set Point
parseAsciiMapV2 Set Char
c

-- | Convenient all-in-one utility function combining 'parseAsciiMap' and
-- 'parseLetters', to directly parse ASCII art into its letters.
asciiMapToLetters
    :: Set Char             -- ^ characters to use as "on"/included in ASCII art
    -> String               -- ^ raw ASCII art
    -> Maybe String
asciiMapToLetters :: Set Char -> String -> Maybe String
asciiMapToLetters Set Char
c = Set Char -> LetterMap -> String -> Maybe String
asciiMapToLetters' Set Char
c LetterMap
defaultLetterMap