From 1f30a7495bc8d44cb27809dd94a3c2511d8d5224 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Fri, 18 Dec 2020 16:14:56 +0000
Subject: [PATCH] [hs] Solve 2020_18

---
 hs/package.yaml         |  1 +
 hs/src/Aoc/Y2020.hs     |  2 ++
 hs/src/Aoc/Y2020/D18.hs | 57 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 60 insertions(+)
 create mode 100644 hs/src/Aoc/Y2020/D18.hs

diff --git a/hs/package.yaml b/hs/package.yaml
index 6f35e39..54f60fe 100644
--- a/hs/package.yaml
+++ b/hs/package.yaml
@@ -6,6 +6,7 @@ dependencies:
 - containers
 - megaparsec
 - optparse-applicative
+- parser-combinators
 - text
 - transformers
 
diff --git a/hs/src/Aoc/Y2020.hs b/hs/src/Aoc/Y2020.hs
index 2e29ab8..e9936f5 100644
--- a/hs/src/Aoc/Y2020.hs
+++ b/hs/src/Aoc/Y2020.hs
@@ -19,6 +19,7 @@ import qualified Aoc.Y2020.D13 as D13
 import qualified Aoc.Y2020.D14 as D14
 import qualified Aoc.Y2020.D15 as D15
 import qualified Aoc.Y2020.D16 as D16
+import qualified Aoc.Y2020.D18 as D18
 
 year :: Year
 year = Year 2020
@@ -38,4 +39,5 @@ year = Year 2020
   , (14, D14.day)
   , (15, D15.day)
   , (16, D16.day)
+  , (18, D18.day)
   ]
diff --git a/hs/src/Aoc/Y2020/D18.hs b/hs/src/Aoc/Y2020/D18.hs
new file mode 100644
index 0000000..b3e6a2b
--- /dev/null
+++ b/hs/src/Aoc/Y2020/D18.hs
@@ -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