From 23636d3fc0dc00fc5ca0f73362f1539e32658923 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Thu, 3 Dec 2020 11:49:24 +0000
Subject: [PATCH] [hs] Solve 2020_03

---
 hs/src/Aoc/Day.hs       |  6 ++++++
 hs/src/Aoc/Parse.hs     | 11 +++++------
 hs/src/Aoc/Y2020.hs     |  2 ++
 hs/src/Aoc/Y2020/D03.hs | 43 +++++++++++++++++++++++++++++++++++++++++
 4 files changed, 56 insertions(+), 6 deletions(-)
 create mode 100644 hs/src/Aoc/Y2020/D03.hs

diff --git a/hs/src/Aoc/Day.hs b/hs/src/Aoc/Day.hs
index 83fe1b6..73a949e 100644
--- a/hs/src/Aoc/Day.hs
+++ b/hs/src/Aoc/Day.hs
@@ -1,5 +1,6 @@
 module Aoc.Day
   ( Day(..)
+  , runDay
   , dayPure
   , dayFile
   , dayString
@@ -19,6 +20,11 @@ data Day
   = DayPure String (IO ())
   | DayFile String (FilePath -> IO ())
 
+-- | Helper function for trying out days in ghci.
+runDay :: Day -> FilePath -> IO ()
+runDay (DayPure _ f) _ = f
+runDay (DayFile _ f) p = f p
+
 dayPure :: String -> IO () -> Day
 dayPure = DayPure
 
diff --git a/hs/src/Aoc/Parse.hs b/hs/src/Aoc/Parse.hs
index ab3e01d..7af5eb7 100644
--- a/hs/src/Aoc/Parse.hs
+++ b/hs/src/Aoc/Parse.hs
@@ -4,12 +4,11 @@ module Aoc.Parse
   , module Text.Megaparsec.Char.Lexer
   , Parser
   , manyLines
-  , word
   , untilEol
+  , lineChar
   ) where
 
 import           Data.Void
-import           Data.Char
 
 import qualified Data.Text                  as T
 import           Text.Megaparsec
@@ -21,10 +20,10 @@ import           Text.Megaparsec.Char.Lexer (binary, decimal, float,
 type Parser = Parsec Void T.Text
 
 manyLines :: Parser a -> Parser [a]
-manyLines p = sepEndBy (try p) newline
-
-word :: Parser T.Text
-word = takeWhileP Nothing (not . isSeparator)
+manyLines p = endBy (try p) newline
 
 untilEol :: Parser T.Text
 untilEol = takeWhileP Nothing (/= '\n')
+
+lineChar :: Parser Char
+lineChar = satisfy (/= '\n')
diff --git a/hs/src/Aoc/Y2020.hs b/hs/src/Aoc/Y2020.hs
index b4eb5b6..42c0ef3 100644
--- a/hs/src/Aoc/Y2020.hs
+++ b/hs/src/Aoc/Y2020.hs
@@ -5,9 +5,11 @@ module Aoc.Y2020
 import           Aoc.Day
 import qualified Aoc.Y2020.D01 as D01
 import qualified Aoc.Y2020.D02 as D02
+import qualified Aoc.Y2020.D03 as D03
 
 days :: [Day]
 days =
   [ D01.day
   , D02.day
+  , D03.day
   ]
diff --git a/hs/src/Aoc/Y2020/D03.hs b/hs/src/Aoc/Y2020/D03.hs
new file mode 100644
index 0000000..8b45dbb
--- /dev/null
+++ b/hs/src/Aoc/Y2020/D03.hs
@@ -0,0 +1,43 @@
+module Aoc.Y2020.D03
+  ( day
+  ) where
+
+import           Data.List
+
+import           Aoc.Day
+import           Aoc.Parse
+
+parser :: Parser [[Bool]]
+parser = manyLines $ many $ do
+  c <- lineChar
+  pure $ c == '#'
+
+slope :: Int -> Int -> [Maybe Int]
+slope dx dy = intercalate (replicate (dy - 1) Nothing) [[Just x] | x <- [0,dx..]]
+
+onSlope :: [[Bool]] -> [Maybe Int] -> Int
+onSlope trees s = length $ filter id $ [row !! x | (row, Just x) <- zip trees s]
+
+solver :: [[Bool]] -> IO ()
+solver trees = do
+  let infTrees = map cycle trees
+
+  putStrLn ">> Part 1"
+  let treesHit = length $ filter id $ zipWith (!!) infTrees [0,3..]
+  putStrLn $ "Trees hit for slope 3-1: " ++ show treesHit
+
+  putStrLn ">> Part 2"
+  let oneOne = onSlope infTrees $ slope 1 1
+      threeOne = onSlope infTrees $ slope 3 1
+      fiveOne = onSlope infTrees $ slope 5 1
+      sevenOne = onSlope infTrees $ slope 7 1
+      oneTwo = onSlope infTrees $ slope 1 2
+  putStrLn $ "right 1, down 1: " ++ show oneOne
+  putStrLn $ "right 3, down 1: " ++ show threeOne
+  putStrLn $ "right 5, down 1: " ++ show fiveOne
+  putStrLn $ "right 7, down 1: " ++ show sevenOne
+  putStrLn $ "right 1, down 2: " ++ show oneTwo
+  putStrLn $ "Product: " ++ show (oneOne * threeOne * fiveOne * sevenOne * oneTwo)
+
+day :: Day
+day = dayParse "2020_03" parser solver