{-# LANGUAGE OverloadedStrings #-}
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
data Syntax f a = Syntax
{ forall (f :: * -> *) a. Syntax f a -> [f (a -> a -> a)]
sBinOps :: [f (a -> a -> a)]
, forall (f :: * -> *) a. Syntax f a -> f a
sPrim :: f a
, forall (f :: * -> *) a. Syntax f a -> f a -> f a
sPar :: f a -> f a
}
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]
" + " ] ]
, 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]
" * "
, 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