From 53aacea98717ebccce2464349640af5c98e8be31 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Sun, 6 Dec 2020 12:06:31 +0000
Subject: [PATCH] [hs] Migrate 2019_04

---
 hs/src/Aoc/Parse.hs                 | 15 +++++++++++++++
 hs/src/Aoc/Y2019.hs                 |  2 ++
 hs/src/Aoc/Y2019/{A04.hs => D04.hs} | 29 +++++++++++++++++++----------
 3 files changed, 36 insertions(+), 10 deletions(-)
 rename hs/src/Aoc/Y2019/{A04.hs => D04.hs} (61%)

diff --git a/hs/src/Aoc/Parse.hs b/hs/src/Aoc/Parse.hs
index 3261298..f139066 100644
--- a/hs/src/Aoc/Parse.hs
+++ b/hs/src/Aoc/Parse.hs
@@ -8,6 +8,7 @@ module Aoc.Parse
   , untilSpace
   , untilEol
   , lineChar
+  , digit
   ) where
 
 import           Data.Char
@@ -39,3 +40,17 @@ untilEol = takeWhileP (Just "non-newline character") (/= '\n')
 
 lineChar :: Parser Char
 lineChar = label "non-newline character" $ satisfy (/= '\n')
+
+digit :: Num a => Parser a
+digit = foldr1 (<|>)
+  [ 0 <$ char '0'
+  , 1 <$ char '1'
+  , 2 <$ char '2'
+  , 3 <$ char '3'
+  , 4 <$ char '4'
+  , 5 <$ char '5'
+  , 6 <$ char '6'
+  , 7 <$ char '7'
+  , 8 <$ char '8'
+  , 9 <$ char '9'
+  ]
diff --git a/hs/src/Aoc/Y2019.hs b/hs/src/Aoc/Y2019.hs
index 6fb5cff..8eac36c 100644
--- a/hs/src/Aoc/Y2019.hs
+++ b/hs/src/Aoc/Y2019.hs
@@ -6,10 +6,12 @@ import           Aoc.Day
 import qualified Aoc.Y2019.D01 as D01
 import qualified Aoc.Y2019.D02 as D02
 import qualified Aoc.Y2019.D03 as D03
+import qualified Aoc.Y2019.D04 as D04
 
 year :: Year
 year = Year 2019
   [ ( 1, D01.day)
   , ( 2, D02.day)
   , ( 3, D03.day)
+  , ( 4, D04.day)
   ]
diff --git a/hs/src/Aoc/Y2019/A04.hs b/hs/src/Aoc/Y2019/D04.hs
similarity index 61%
rename from hs/src/Aoc/Y2019/A04.hs
rename to hs/src/Aoc/Y2019/D04.hs
index af88c35..c362e0d 100644
--- a/hs/src/Aoc/Y2019/A04.hs
+++ b/hs/src/Aoc/Y2019/D04.hs
@@ -1,7 +1,10 @@
-module Aoc.Y2019.A04
-  ( solve201904
+module Aoc.Y2019.D04
+  ( day
   ) where
 
+import           Aoc.Day
+import           Aoc.Parse
+
 type Passwd = (Int, Int, Int, Int, Int, Int)
 
 passwds :: [Passwd]
@@ -17,9 +20,6 @@ passwds = do
 getRange :: Passwd -> Passwd -> [Passwd]
 getRange lowerBound upperBound = takeWhile (<=upperBound) $ dropWhile (<lowerBound) passwds
 
-passwdsInRange :: [Passwd]
-passwdsInRange = getRange (1,3,6,8,1,8) (6,8,5,9,7,9)
-
 seqDigits :: Passwd -> Bool
 seqDigits (a, b, c, d, e, f) = or $ zipWith (==) [a,b,c,d,e] [b,c,d,e,f]
 
@@ -30,10 +30,19 @@ sepSeqDigits (a, b, c, d, e, f) =
       rightEdge = zipWith (/=) [b,c,d,e,f] [c,d,e,f,0]
   in  or $ zipWith3 (\x y z -> x && y && z) leftEdge pair rightEdge
 
-solve201904 :: FilePath -> IO ()
-solve201904 _ = do
-  putStrLn ">> Part 1"
-  print $ length $ filter seqDigits passwdsInRange
+parser :: Parser (Passwd, Passwd)
+parser = (,) <$> (pPasswd <* char '-') <*> (pPasswd <* newline)
+  where
+    pPasswd = (,,,,,) <$> digit <*> digit <*> digit <*> digit <*> digit <*> digit
 
+solver :: (Passwd, Passwd) -> IO ()
+solver (low, high) = do
+  putStrLn ">> Part 1"
+  print $ length $ filter seqDigits $ getRange low high
+
+  putStrLn ""
   putStrLn ">> Part 2"
-  print $ length $ filter sepSeqDigits passwdsInRange
+  print $ length $ filter sepSeqDigits $ getRange low high
+
+day :: Day
+day = dayParse parser solver