[hs] Solve 2020_03

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
 

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')

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
   ]

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