{-# 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 = (([Either (Set Point) Char] -> String)
-> Maybe [Either (Set Point) Char] -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Either (Set Point) Char] -> String)
 -> Maybe [Either (Set Point) Char] -> Maybe String)
-> ((Either (Set Point) Char -> Char)
    -> [Either (Set Point) Char] -> String)
-> (Either (Set Point) Char -> Char)
-> Maybe [Either (Set Point) Char]
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Set Point) Char -> Char)
-> [Either (Set Point) Char] -> String
forall a b. (a -> b) -> [a] -> [b]
map) ((Set Point -> Char)
-> (Char -> Char) -> Either (Set Point) Char -> Char
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Char -> Set Point -> Char
forall a b. a -> b -> a
const Char
'?') Char -> Char
forall a. a -> a
id)
                  (Maybe [Either (Set Point) Char] -> Maybe String)
-> (Set Point -> Maybe [Either (Set Point) Char])
-> Set Point
-> Maybe String
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 = [[Either (Set Point) Char]] -> Maybe [Either (Set Point) Char]
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 <- [Point -> Point
forall a. a -> a
id, Point -> Point
forall a. Num a => V2 a -> V2 a
reflX]
      , Point -> Point
rots <- [Point -> Point
forall a. a -> a
id, Point -> Point
forall a. Num a => V2 a -> V2 a
perp, Point -> Point
forall a. Num a => a -> a
negate, Point -> Point
forall a. Num a => a -> a
negate (Point -> Point) -> (Point -> Point) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point
forall a. Num a => V2 a -> V2 a
perp]
      , let ls :: Set Point
ls = (Point -> Point) -> Set Point -> Set Point
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (Point -> Point
rots (Point -> Point) -> (Point -> Point) -> Point -> Point
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 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
n :: Double
      , Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
percGood Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.5
      ]
    tryMe :: Set Point -> ((Sum Double, Sum Double), [Either (Set Point) Char])
tryMe = (Set Point -> ((Sum Double, Sum Double), Either (Set Point) Char))
-> [Set Point]
-> ((Sum Double, Sum Double), [Either (Set Point) Char])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\Set Point
c -> ((Sum Double, Sum Double), Either (Set Point) Char)
-> (Char -> ((Sum Double, Sum Double), Either (Set Point) Char))
-> Maybe Char
-> ((Sum Double, Sum Double), Either (Set Point) Char)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Double -> Sum Double
forall a. a -> Sum a
Sum Double
1, Double -> Sum Double
forall a. a -> Sum a
Sum Double
0), Set Point -> Either (Set Point) Char
forall a b. a -> Either a b
Left Set Point
c) (((Double -> Sum Double
forall a. a -> Sum a
Sum Double
1, Double -> Sum Double
forall a. a -> Sum a
Sum Double
1),) (Either (Set Point) Char
 -> ((Sum Double, Sum Double), Either (Set Point) Char))
-> (Char -> Either (Set Point) Char)
-> Char
-> ((Sum Double, Sum Double), Either (Set Point) Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Either (Set Point) Char
forall a b. b -> Either a b
Right) (Maybe Char -> ((Sum Double, Sum Double), Either (Set Point) Char))
-> (LetterMap -> Maybe Char)
-> LetterMap
-> ((Sum Double, Sum Double), Either (Set Point) Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Point -> LetterMap -> Maybe Char
lookupLetterMap Set Point
c (LetterMap -> ((Sum Double, Sum Double), Either (Set Point) Char))
-> LetterMap -> ((Sum Double, Sum Double), Either (Set Point) Char)
forall a b. (a -> b) -> a -> b
$ LetterMap
lm)
          ([Set Point]
 -> ((Sum Double, Sum Double), [Either (Set Point) Char]))
-> (Set Point -> [Set Point])
-> Set Point
-> ((Sum Double, Sum Double), [Either (Set Point) Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V2 Double -> Double) -> Set Point -> [Set Point]
forall a. Ord a => (V2 Double -> a) -> Set Point -> [Set Point]
contiguousShapesBy V2 Double -> Double
forall a. V2 a -> a
v2x
    perp :: V2 a -> V2 a
perp (V2 a
x a
y) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a -> a
forall a. Num a => a -> a
negate a
y) a
x
    reflX :: V2 a -> V2 a
reflX (V2 a
x a
y) = a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (a -> a
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
                    )