{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections   #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module      : Advent.OCR.Internal
-- Copyright   : (c) Justin Le 2020
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Internal utility functions for "Advent.OCR".


module Advent.OCR.Internal (
  -- * Parse
    V2(..)
  , Point
  , parseLettersV2
  , parseLettersEitherV2
  , parseAsciiMapV2
  -- * Letter Map
  , LetterMap(..)
  , lookupLetterMap
  , defaultLetterMap
  , rawLetterforms1
  , rawLetterforms2
  , parseLetterMap
  -- * Utility
  , contiguousShapes
  , contiguousShapesBy
  ) where

import           Advent.OCR.LetterMap
import           Data.Default.Class
import           Data.Maybe
import           Data.Monoid
import           Data.Set                   (Set)
import           Language.Haskell.TH.Lift
import qualified Data.Set                   as S

-- | A version of 'Advent.OCR.parseLetters' taking 'Point'.  Used
-- internally.
parseLettersV2
    :: LetterMap
    -> Set Point
    -> Maybe String
parseLettersV2 :: LetterMap -> Set Point -> Maybe String
parseLettersV2 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 a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Char
'?') forall a. a -> a
id)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. LetterMap -> Set Point -> Maybe [Either (Set Point) Char]
parseLettersEitherV2 LetterMap
lm

-- | A version of 'Advent.OCR.parseLettersEither' taking (and returning)
-- 'Point'. Used internally.
parseLettersEitherV2
    :: LetterMap
    -> Set Point
    -> Maybe [Either (Set Point) Char]
parseLettersEitherV2 :: LetterMap -> Set Point -> Maybe [Either (Set Point) Char]
parseLettersEitherV2 LetterMap
lm Set Point
letters = forall a. [a] -> Maybe a
listToMaybe [[Either (Set Point) Char]]
attempts
  where
    attempts :: [[Either (Set Point) Char]]
attempts =
      [ [Either (Set Point) Char]
res
      | Point -> Point
refl <- [forall a. a -> a
id, forall {a}. Num a => V2 a -> V2 a
reflX]
      , Point -> Point
rots <- [forall a. a -> a
id, forall {a}. Num a => V2 a -> V2 a
perp, forall a. Num a => a -> a
negate, forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Num a => V2 a -> V2 a
perp]
      , let ls :: Set Point
ls = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (Point -> Point
rots forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point
refl) Set Point
letters
            ((Sum Double
n, Sum Double
goodCount), [Either (Set Point) Char]
res) = Set Point -> ((Sum Double, Sum Double), [Either (Set Point) Char])
tryMe Set Point
ls
            percGood :: Double
percGood = Double
goodCount forall a. Fractional a => a -> a -> a
/ Double
n :: Double
      , Double
n forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
percGood forall a. Ord a => a -> a -> Bool
>= Double
0.5
      ]
    tryMe :: Set Point -> ((Sum Double, Sum Double), [Either (Set Point) Char])
tryMe = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Set Point
c -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((forall a. a -> Sum a
Sum Double
1, forall a. a -> Sum a
Sum Double
0), forall a b. a -> Either a b
Left Set Point
c) (((forall a. a -> Sum a
Sum Double
1, forall a. a -> Sum a
Sum Double
1),) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Point -> LetterMap -> Maybe Char
lookupLetterMap Set Point
c forall a b. (a -> b) -> a -> b
$ LetterMap
lm)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => (V2 Double -> a) -> Set Point -> [Set Point]
contiguousShapesBy forall a. V2 a -> a
v2x
    perp :: V2 a -> V2 a
perp (V2 a
x a
y) = forall a. a -> a -> V2 a
V2 (forall a. Num a => a -> a
negate a
y) a
x
    reflX :: V2 a -> V2 a
reflX (V2 a
x a
y) = forall a. a -> a -> V2 a
V2 (forall a. Num a => a -> a
negate a
x) a
y

-- | Default is compatible with all challenges in Advent of Code 2015 to
-- 2019.
instance Default LetterMap where
    def :: LetterMap
def = LetterMap
defaultLetterMap

-- | The default lettermap compatible all challenges in Advent of Code 2015
-- - 2019.
defaultLetterMap :: LetterMap
defaultLetterMap :: LetterMap
defaultLetterMap = $( lift $ uncurry parseLetterMap rawLetterforms1
                          <> uncurry parseLetterMap rawLetterforms2
                    )