{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : AOC.Challenge.Day18
-- License     : BSD3
--
-- Stability   : experimental
-- Portability : non-portable
--
-- Day 18.  See "AOC.Solver" for the types used in this module!

module AOC.Challenge.Day18 (
    day18a
  , day18b
  ) where

import           AOC.Solver           ((:~>)(..))
import           Control.Monad        (MonadPlus)
import           Data.Char            (digitToInt)
import           Data.Void            (Void)
import qualified Text.Megaparsec      as P
import qualified Text.Megaparsec.Char as P

type Parser = P.Parsec Void String

-- | A right-associative syntax
data Syntax f a = Syntax
    { forall (f :: * -> *) a. Syntax f a -> [f (a -> a -> a)]
sBinOps :: [f (a -> a -> a)]  -- ^ Operations at each level; highest precedence is last.
    , forall (f :: * -> *) a. Syntax f a -> f a
sPrim   :: f a                -- ^ How to parse a primitive
    , forall (f :: * -> *) a. Syntax f a -> f a -> f a
sPar    :: f a -> f a         -- ^ parentheses
    }

exprSyntax1 :: Syntax Parser Int
exprSyntax1 :: Syntax Parser Int
exprSyntax1 = Syntax :: forall (f :: * -> *) a.
[f (a -> a -> a)] -> f a -> (f a -> f a) -> Syntax f a
Syntax
    { sBinOps :: [Parser (Int -> Int -> Int)]
sBinOps = [ [Parser (Int -> Int -> Int)] -> Parser (Int -> Int -> Int)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice [ Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) (Int -> Int -> Int) -> Parser [Char] -> Parser (Int -> Int -> Int)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser [Char]
" * ", Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> Parser [Char] -> Parser (Int -> Int -> Int)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser [Char]
" + " ] ]  -- all same level
    , sPrim :: Parser Int
sPrim   = Char -> Int
digitToInt (Char -> Int) -> Parser Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.digitChar
    , sPar :: Parser Int -> Parser Int
sPar    = Parser [Char] -> Parser [Char] -> Parser Int -> Parser Int
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between Parser [Char]
"(" Parser [Char]
")"
    }

exprSyntax2 :: Syntax Parser Int
exprSyntax2 :: Syntax Parser Int
exprSyntax2 = Syntax :: forall (f :: * -> *) a.
[f (a -> a -> a)] -> f a -> (f a -> f a) -> Syntax f a
Syntax
    { sBinOps :: [Parser (Int -> Int -> Int)]
sBinOps = [ Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) (Int -> Int -> Int) -> Parser [Char] -> Parser (Int -> Int -> Int)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser [Char]
" * "    -- + higher than *
                , Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> Parser [Char] -> Parser (Int -> Int -> Int)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser [Char]
" + "
                ]
    , sPrim :: Parser Int
sPrim   = Char -> Int
digitToInt (Char -> Int) -> Parser Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.digitChar
    , sPar :: Parser Int -> Parser Int
sPar    = Parser [Char] -> Parser [Char] -> Parser Int -> Parser Int
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between Parser [Char]
"(" Parser [Char]
")"
    }

parseSyntax :: forall f a. MonadPlus f => Syntax f a -> f a
parseSyntax :: forall (f :: * -> *) a. MonadPlus f => Syntax f a -> f a
parseSyntax Syntax{f a
[f (a -> a -> a)]
f a -> f a
sPar :: f a -> f a
sPrim :: f a
sBinOps :: [f (a -> a -> a)]
sPar :: forall (f :: * -> *) a. Syntax f a -> f a -> f a
sPrim :: forall (f :: * -> *) a. Syntax f a -> f a
sBinOps :: forall (f :: * -> *) a. Syntax f a -> [f (a -> a -> a)]
..} = f a
parseTopLevel
  where
    parseTopLevel :: f a
    parseTopLevel :: f a
parseTopLevel = [f (a -> a -> a)] -> f a
parseLevels [f (a -> a -> a)]
sBinOps
    parseLevels :: [f (a -> a -> a)] -> f a
    parseLevels :: [f (a -> a -> a)] -> f a
parseLevels = \case
      []   -> f a
sPrim f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> f a -> f a
sPar f a
parseTopLevel
      f (a -> a -> a)
o:[f (a -> a -> a)]
os ->
        let parseDown :: f a
parseDown = [f (a -> a -> a)] -> f a
parseLevels [f (a -> a -> a)]
os
            parseThisLevelWith :: a -> f a
parseThisLevelWith a
x = (f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) (f a -> f a) -> f a -> f a
forall a b. (a -> b) -> a -> b
$ do
              a -> a -> a
f <- f (a -> a -> a)
o
              a
y <- f a
parseDown
              a -> f a
parseThisLevelWith (a -> a -> a
f a
x a
y)
        in  f a
parseDown f a -> (a -> f a) -> f a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> f a
parseThisLevelWith

day18 :: (Num a, Show a) => Syntax Parser a -> String :~> a
day18 :: forall a. (Num a, Show a) => Syntax Parser a -> [Char] :~> a
day18 Syntax Parser a
s = MkSol :: forall a b.
([Char] -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> [Char]) -> a :~> b
MkSol
    { sParse :: [Char] -> Maybe [Char]
sParse = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just
    , sShow :: a -> [Char]
sShow  = a -> [Char]
forall a. Show a => a -> [Char]
show
    , sSolve :: (?dyno::DynoMap) => [Char] -> Maybe a
sSolve = Parsec Void [Char] a -> [Char] -> Maybe a
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
P.parseMaybe (Parsec Void [Char] a -> [Char] -> Maybe a)
-> Parsec Void [Char] a -> [Char] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> Parser [a] -> Parsec Void [Char] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Syntax Parser a -> Parsec Void [Char] a
forall (f :: * -> *) a. MonadPlus f => Syntax f a -> f a
parseSyntax Syntax Parser a
s Parsec Void [Char] a -> Parser Char -> Parser [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`P.sepBy` Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.newline)
    }
{-# INLINE day18 #-}

day18a :: String :~> Int
day18a :: [Char] :~> Int
day18a = Syntax Parser Int -> [Char] :~> Int
forall a. (Num a, Show a) => Syntax Parser a -> [Char] :~> a
day18 Syntax Parser Int
exprSyntax1

day18b :: String :~> Int
day18b :: [Char] :~> Int
day18b = Syntax Parser Int -> [Char] :~> Int
forall a. (Num a, Show a) => Syntax Parser a -> [Char] :~> a
day18 Syntax Parser Int
exprSyntax2