[hs] Solve 2020_18

This commit is contained in:
Joscha 2020-12-18 16:14:56 +00:00
parent ba07bdfadb
commit 1f30a7495b
3 changed files with 60 additions and 0 deletions

View file

@ -6,6 +6,7 @@ dependencies:
- containers - containers
- megaparsec - megaparsec
- optparse-applicative - optparse-applicative
- parser-combinators
- text - text
- transformers - transformers

View file

@ -19,6 +19,7 @@ import qualified Aoc.Y2020.D13 as D13
import qualified Aoc.Y2020.D14 as D14 import qualified Aoc.Y2020.D14 as D14
import qualified Aoc.Y2020.D15 as D15 import qualified Aoc.Y2020.D15 as D15
import qualified Aoc.Y2020.D16 as D16 import qualified Aoc.Y2020.D16 as D16
import qualified Aoc.Y2020.D18 as D18
year :: Year year :: Year
year = Year 2020 year = Year 2020
@ -38,4 +39,5 @@ year = Year 2020
, (14, D14.day) , (14, D14.day)
, (15, D15.day) , (15, D15.day)
, (16, D16.day) , (16, D16.day)
, (18, D18.day)
] ]

57
hs/src/Aoc/Y2020/D18.hs Normal file
View file

@ -0,0 +1,57 @@
{-# LANGUAGE OverloadedStrings #-}
module Aoc.Y2020.D18
( day
) where
import Control.Monad
import Data.Char
import Control.Monad.Combinators.Expr
import qualified Data.Text as T
import qualified Text.Megaparsec.Char.Lexer as L
import Aoc.Day
import Aoc.Parse
data Expr
= Lit Int
| Add Expr Expr
| Mul Expr Expr
deriving (Show)
eval :: Expr -> Int
eval (Lit l) = l
eval (Add a b) = eval a + eval b
eval (Mul a b) = eval a * eval b
lexeme :: Parser a -> Parser a
lexeme = L.lexeme (void $ lineWhile isSpace)
symbol :: T.Text -> Parser T.Text
symbol = L.symbol (void $ lineWhile isSpace)
parser :: [[Operator Parser Expr]] -> Parser [Expr]
parser table = manyLines expr
where
parens = between (symbol "(") (symbol ")")
term = (Lit <$> lexeme L.decimal) <|> parens expr
expr = makeExprParser term table
table1 :: [[Operator Parser Expr]]
table1 = [[InfixL (Add <$ symbol "+"), InfixL (Mul <$ symbol "*")]]
table2 :: [[Operator Parser Expr]]
table2 = [[InfixL (Add <$ symbol "+")], [InfixL (Mul <$ symbol "*")]]
solver :: FilePath -> T.Text -> IO ()
solver path text = do
putStrLn ">> Part 1"
parseAndSolve path text (parser table1) $ print . sum . map eval
putStrLn ""
putStrLn ">> Part 2"
parseAndSolve path text (parser table2) $ print . sum . map eval
day :: Day
day = dayText solver