-- |
-- Module      : AOC.Solver
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Types to drive the challenge runner and help speed up/clean up
-- solutions.
--

module AOC.Solver (
    (:~>)(..)
  , withSolver, withSolver'
  , SomeSolution(.., MkSomeSol)
  , SolutionError(..)
  , runSolution
  , runSomeSolution
  , ssIsNF
  -- * 'DynoMap'
  , runSolutionWith
  , runSomeSolutionWith
  , dyno
  , dyno_
  ) where

import           AOC.Util
import           AOC.Util.DynoMap
import           Control.DeepSeq
import           Data.Dynamic
import           Data.Map             (Map)
import           GHC.Generics         (Generic)

-- | Abstracting over the type of a challenge solver to help with cleaner
-- solutions.
--
-- A @a ':~>' b@ encapsulates something that solves a challenge with input
-- type @a@ into a response of type @b@.
--
-- Consists of a parser, a shower, and a solver.  The solver solves
-- a general @a -> 'Maybe' b@ function, and the parser and shower are used
-- to handle the boilerplate of parsing and printing the solution.
data a :~> b = MkSol
    { forall a b. (a :~> b) -> String -> Maybe a
sParse :: String -> Maybe a    -- ^ parse input into an @a@
    , forall a b. (a :~> b) -> (?dyno::DynoMap) => a -> Maybe b
sSolve :: (?dyno :: DynoMap)
             => a      -> Maybe b    -- ^ solve an @a@ input to a @b@ solution
    , forall a b. (a :~> b) -> b -> String
sShow  :: b      -> String     -- ^ print out the @b@ solution in a pretty way
    }

-- | Wrap an @a ':~>' b@ and hide the type variables so we can put
-- different solutions in a container.
data SomeSolution where
    MkSomeSolWH :: a :~> b -> SomeSolution
    MkSomeSolNF :: (NFData a, NFData b) => a :~> b -> SomeSolution

-- | Check if a 'SomeSolution' is equipped with an 'NFData' instance on the
-- types
ssIsNF :: SomeSolution -> Bool
ssIsNF :: SomeSolution -> Bool
ssIsNF = \case
    MkSomeSolWH a :~> b
_ -> Bool
False
    MkSomeSolNF a :~> b
_ -> Bool
True

data SomeSolHelp where
    SSH :: a :~> b -> SomeSolHelp

toHelp :: SomeSolution -> SomeSolHelp
toHelp :: SomeSolution -> SomeSolHelp
toHelp (MkSomeSolWH a :~> b
x) = (a :~> b) -> SomeSolHelp
forall a b. (a :~> b) -> SomeSolHelp
SSH a :~> b
x
toHelp (MkSomeSolNF a :~> b
x) = (a :~> b) -> SomeSolHelp
forall a b. (a :~> b) -> SomeSolHelp
SSH a :~> b
x

-- | Handy pattern to work with both 'MkSomeSolWH' and 'MkSomeSolNF'.  As
-- a constructor, just uses 'MkSomeSolWH', so might not be desirable.
pattern MkSomeSol :: () => forall a b. () => a :~> b -> SomeSolution
pattern $bMkSomeSol :: forall a b. (a :~> b) -> SomeSolution
$mMkSomeSol :: forall {r}.
SomeSolution
-> (forall {a} {b}. (a :~> b) -> r) -> (Void# -> r) -> r
MkSomeSol s <- (toHelp->SSH s)
  where
    MkSomeSol a :~> b
x = (a :~> b) -> SomeSolution
forall a b. (a :~> b) -> SomeSolution
MkSomeSolWH a :~> b
x
{-# COMPLETE MkSomeSol #-}

-- | Errors that might happen when running a ':~>' on some input.
data SolutionError = SEParse
                   | SESolve
  deriving (Int -> SolutionError -> ShowS
[SolutionError] -> ShowS
SolutionError -> String
(Int -> SolutionError -> ShowS)
-> (SolutionError -> String)
-> ([SolutionError] -> ShowS)
-> Show SolutionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SolutionError] -> ShowS
$cshowList :: [SolutionError] -> ShowS
show :: SolutionError -> String
$cshow :: SolutionError -> String
showsPrec :: Int -> SolutionError -> ShowS
$cshowsPrec :: Int -> SolutionError -> ShowS
Show, SolutionError -> SolutionError -> Bool
(SolutionError -> SolutionError -> Bool)
-> (SolutionError -> SolutionError -> Bool) -> Eq SolutionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolutionError -> SolutionError -> Bool
$c/= :: SolutionError -> SolutionError -> Bool
== :: SolutionError -> SolutionError -> Bool
$c== :: SolutionError -> SolutionError -> Bool
Eq, Eq SolutionError
Eq SolutionError
-> (SolutionError -> SolutionError -> Ordering)
-> (SolutionError -> SolutionError -> Bool)
-> (SolutionError -> SolutionError -> Bool)
-> (SolutionError -> SolutionError -> Bool)
-> (SolutionError -> SolutionError -> Bool)
-> (SolutionError -> SolutionError -> SolutionError)
-> (SolutionError -> SolutionError -> SolutionError)
-> Ord SolutionError
SolutionError -> SolutionError -> Bool
SolutionError -> SolutionError -> Ordering
SolutionError -> SolutionError -> SolutionError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SolutionError -> SolutionError -> SolutionError
$cmin :: SolutionError -> SolutionError -> SolutionError
max :: SolutionError -> SolutionError -> SolutionError
$cmax :: SolutionError -> SolutionError -> SolutionError
>= :: SolutionError -> SolutionError -> Bool
$c>= :: SolutionError -> SolutionError -> Bool
> :: SolutionError -> SolutionError -> Bool
$c> :: SolutionError -> SolutionError -> Bool
<= :: SolutionError -> SolutionError -> Bool
$c<= :: SolutionError -> SolutionError -> Bool
< :: SolutionError -> SolutionError -> Bool
$c< :: SolutionError -> SolutionError -> Bool
compare :: SolutionError -> SolutionError -> Ordering
$ccompare :: SolutionError -> SolutionError -> Ordering
Ord, (forall x. SolutionError -> Rep SolutionError x)
-> (forall x. Rep SolutionError x -> SolutionError)
-> Generic SolutionError
forall x. Rep SolutionError x -> SolutionError
forall x. SolutionError -> Rep SolutionError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SolutionError x -> SolutionError
$cfrom :: forall x. SolutionError -> Rep SolutionError x
Generic)

instance NFData SolutionError

-- | Construct a ':~>' from just a normal @String -> String@ solver.
-- Does no parsing or special printing treatment.
withSolver' :: (String -> String) -> String :~> String
withSolver' :: ShowS -> String :~> String
withSolver' ShowS
f = (String -> Maybe String) -> String :~> String
withSolver (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
f)

-- | Construct a ':~>' from a @String -> 'Maybe' String@ solver, which
-- might fail.  Does no parsing or special printing treatment.
withSolver :: (String -> Maybe String) -> String :~> String
withSolver :: (String -> Maybe String) -> String :~> String
withSolver String -> Maybe String
f = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
    { sParse :: String -> Maybe String
sParse = String -> Maybe String
forall a. a -> Maybe a
Just
    , sShow :: ShowS
sShow  = ShowS
forall a. a -> a
id
    , sSolve :: (?dyno::DynoMap) => String -> Maybe String
sSolve = (?dyno::DynoMap) => String -> Maybe String
String -> Maybe String
f
    }

-- | Run a ':~>' on some input.
runSolution :: a :~> b -> String -> Either SolutionError String
runSolution :: forall a b. (a :~> b) -> String -> Either SolutionError String
runSolution = Map String Dynamic
-> (a :~> b) -> String -> Either SolutionError String
forall a b.
Map String Dynamic
-> (a :~> b) -> String -> Either SolutionError String
runSolutionWith Map String Dynamic
forall a. Monoid a => a
mempty

-- | Run a ':~>' on some input, with a map of dynamic values for testing
runSolutionWith
    :: Map String Dynamic       -- ^ map of dynamic values for testing with 'lookupDyno'.
    -> a :~> b
    -> String
    -> Either SolutionError String
runSolutionWith :: forall a b.
Map String Dynamic
-> (a :~> b) -> String -> Either SolutionError String
runSolutionWith Map String Dynamic
dm MkSol{b -> String
(?dyno::DynoMap) => a -> Maybe b
String -> Maybe a
sShow :: b -> String
sSolve :: (?dyno::DynoMap) => a -> Maybe b
sParse :: String -> Maybe a
sShow :: forall a b. (a :~> b) -> b -> String
sSolve :: forall a b. (a :~> b) -> (?dyno::DynoMap) => a -> Maybe b
sParse :: forall a b. (a :~> b) -> String -> Maybe a
..} (ShowS
stripNewline->String
s) = do
    a
x <- SolutionError -> Maybe a -> Either SolutionError a
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither SolutionError
SEParse (Maybe a -> Either SolutionError a)
-> (String -> Maybe a) -> String -> Either SolutionError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
sParse (String -> Either SolutionError a)
-> String -> Either SolutionError a
forall a b. (a -> b) -> a -> b
$ String
s
    b
y <- SolutionError -> Maybe b -> Either SolutionError b
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
maybeToEither SolutionError
SESolve (Maybe b -> Either SolutionError b)
-> (a -> Maybe b) -> a -> Either SolutionError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
(?dyno::DynoMap) => a -> Maybe b
sSolve (a -> Either SolutionError b) -> a -> Either SolutionError b
forall a b. (a -> b) -> a -> b
$ a
x
    pure $ b -> String
sShow b
y
  where
    ?dyno = Map String Dynamic -> DynoMap
Dyno Map String Dynamic
dm

-- | Run a 'SomeSolution' on some input.
runSomeSolution
    :: SomeSolution
    -> String
    -> Either SolutionError String
runSomeSolution :: SomeSolution -> String -> Either SolutionError String
runSomeSolution = Map String Dynamic
-> SomeSolution -> String -> Either SolutionError String
runSomeSolutionWith Map String Dynamic
forall a. Monoid a => a
mempty

-- | Run a 'SomeSolution' on some input, with a map of dynamic values for
-- testing
runSomeSolutionWith
    :: Map String Dynamic       -- ^ map of dynamic values for testing with 'lookupDyno'.
    -> SomeSolution
    -> String
    -> Either SolutionError String
runSomeSolutionWith :: Map String Dynamic
-> SomeSolution -> String -> Either SolutionError String
runSomeSolutionWith Map String Dynamic
dm (MkSomeSol a :~> b
c) = Map String Dynamic
-> (a :~> b) -> String -> Either SolutionError String
forall a b.
Map String Dynamic
-> (a :~> b) -> String -> Either SolutionError String
runSolutionWith Map String Dynamic
dm a :~> b
c

-- | From a @?dyno@ Implicit Params, look up a value at a given key.  Meant
-- to be used with TypeApplications:
--
-- > 'dyno' @"hello"
--
-- This can be used within the body of 'sSolve', since it will always be
-- called with the implicit parameter.
--
-- When called on actual puzzle input, result will always be 'Nothing'.
-- But, for some test inputs, there might be supplied values.
--
-- This is useful for when some problems have parameters that are
-- different with test inputs than for actual inputs.
dyno
    :: forall a. (Typeable a, ?dyno :: DynoMap)
    => String
    -> Maybe a
dyno :: forall a. (Typeable a, ?dyno::DynoMap) => String -> Maybe a
dyno = (String -> DynoMap -> Maybe a
forall a. Typeable a => String -> DynoMap -> Maybe a
`lookupDyno` ?dyno::DynoMap
DynoMap
?dyno)

-- | A version of 'dyno' taking a default value in case the key is not
-- in the map.  When called on actual puzzle input, this is always 'id'.
-- However, for some test inputs, there might be supplied values.
--
-- Meant to be used with TypeApplications:
--
-- > 'dyno_' @"hello" 7
--
-- This is useful for when some problems have parameters that are
-- different with test inputs than for actual inputs.
dyno_
    :: forall a. (Typeable a, ?dyno :: DynoMap)
    => String
    -> a            -- ^ default
    -> a
dyno_ :: forall a. (Typeable a, ?dyno::DynoMap) => String -> a -> a
dyno_ String
str a
def = String -> a -> DynoMap -> a
forall a. Typeable a => String -> a -> DynoMap -> a
lookupDynoWith String
str a
def ?dyno::DynoMap
DynoMap
?dyno