From 38201248c4731aec888fcd761b62b401651e71fa Mon Sep 17 00:00:00 2001
From: Amneesh Singh <natto@weirdnatto.in>
Date: Mon, 5 Dec 2022 23:39:03 +0530
Subject: [PATCH] day4,5: update - use parser combinators

not the cleanest, im still learning parsing in hs

Signed-off-by: Amneesh Singh <natto@weirdnatto.in>
---
 Lib.hs  | 17 -----------------
 day4.hs | 45 +++++++++++++++++++++++++--------------------
 day5.hs | 37 ++++++++++++++++++++++---------------
 3 files changed, 47 insertions(+), 52 deletions(-)
 delete mode 100644 Lib.hs

diff --git a/Lib.hs b/Lib.hs
deleted file mode 100644
index 7f87baa..0000000
--- a/Lib.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module Lib (chunks, split) where
-
-chunks :: Int -> [a] -> [[a]]
-chunks n xs
-  | null xs = []
-  | otherwise = head : chunks n tail
-  where (head, tail) = splitAt n xs
-
-split :: Eq a => a -> [a] -> [[a]]
-split del =
-  foldr
-    ( \c (x : xs) ->
-        if c == del
-          then [] : x : xs
-          else (c : x) : xs
-    )
-    [[]]
diff --git a/day4.hs b/day4.hs
index ec76916..343beb6 100644
--- a/day4.hs
+++ b/day4.hs
@@ -1,29 +1,34 @@
-import Lib (split)
+import Data.Char (isDigit)
+import Text.ParserCombinators.ReadP
+  ( ReadP,
+    char,
+    many1,
+    readP_to_S,
+    satisfy,
+  )
 
 main :: IO ()
 main = do
-  input <- readFile "day4.in"
+  input <- map (fst . last . readP_to_S parse) . lines <$> readFile "day4.in"
   putStr "Q1: "
   print $ q1 input
   putStr "Q2: "
   print $ q2 input
 
-q1 :: String -> Int
-q1 =
-  length
-    . filter
-      ( \x ->
-          let [[a, b], [c, d]] = map (map (read :: String -> Int) . split '-') $ split ',' x
-           in a >= c && b <= d || c >= a && d <= b
-      )
-    . lines
+parse :: ReadP ((Int, Int), (Int, Int))
+parse = do
+  a <- readInt
+  char '-'
+  b <- readInt
+  char ','
+  c <- readInt
+  char '-'
+  d <- readInt
+  return ((a, b), (c, d))
+  where
+    readInt :: ReadP Int
+    readInt = read <$> many1 (satisfy isDigit)
 
-q2 :: String -> Int
-q2 =
-  length
-    . filter
-      ( \x ->
-          let [[a, b], [c, d]] = map (map (read :: String -> Int) . split '-') $ split ',' x
-           in b >= c && a <= d || d >= a && c <= b
-      )
-    . lines
+q1, q2 :: [((Int, Int), (Int, Int))] -> Int
+q1 = length . filter (\((a, b), (c, d)) -> a >= c && b <= d || c >= a && d <= b)
+q2 = length . filter (\((a, b), (c, d)) -> b >= c && a <= d)
diff --git a/day5.hs b/day5.hs
index b8379a9..e1b935a 100644
--- a/day5.hs
+++ b/day5.hs
@@ -1,20 +1,22 @@
-import Lib (split)
+import Data.Char (isDigit)
+import Data.List (transpose)
+import Data.Maybe (catMaybes)
+import Text.ParserCombinators.ReadP
 
 main :: IO ()
 main = do
-  input <- readFile "day5.in"
-  let [crates, cmds] = split "" $ lines input
-  let cratesList = init $ parseCrates $ init crates
-  let cmdsList = parseCmds cmds
+  input <- lines <$> readFile "day5.in"
+  let (crates, cmds) = break null input
+  let cratesList = map catMaybes $ transpose $ map (fst . last . readP_to_S parseCrates) $ init crates
+  let cmdsList = map ((\(n, a, b) -> (n, a - 1, b - 1)) . fst . last . readP_to_S parseCmd) $ tail cmds
+  print cratesList
   putStr "Q1: "
   print $ q1 cratesList cmdsList
   putStr "Q2: "
   print $ q2 cratesList cmdsList
 
-q1 :: [[Char]] -> [(Int, Int, Int)] -> [Char]
+q1, q2 :: [[Char]] -> [(Int, Int, Int)] -> [Char]
 q1 crates cmds = map head $ foldl (\x xs -> moveCrates x xs True) crates cmds
-
-q2 :: [[Char]] -> [(Int, Int, Int)] -> [Char]
 q2 crates cmds = map head $ foldl (\x xs -> moveCrates x xs False) crates cmds
 
 -- Computers are fast, really, not optimising right now
@@ -26,12 +28,17 @@ moveCrates crates (n, a, b) rev =
     replace :: Int -> [a] -> a -> [a]
     replace i xs x = take i xs ++ [x] ++ drop (i + 1) xs
 
-parseCrates :: [[Char]] -> [[Char]]
-parseCrates ([] : _) = [[]]
-parseCrates crates = parseCrate crates : parseCrates (map (drop 4) crates)
+parseCrates :: ReadP [Maybe Char]
+parseCrates = sepBy parseRow (char ' ')
   where
-    parseCrate :: [[Char]] -> [Char]
-    parseCrate = foldr (\(_ : x : _ : _) xs -> if x /= ' ' then x : xs else xs) []
+    parseRow :: ReadP (Maybe Char)
+    parseRow = (Just <$> (char '[' *> get <* char ']')) +++ (Nothing <$ string "   ")
 
-parseCmds :: [[Char]] -> [(Int, Int, Int)]
-parseCmds = foldr (\x xs -> let y = split ' ' x in (read $ y !! 1, read (y !! 3) - 1, read (y !! 5) - 1) : xs) []
+parseCmd :: ReadP (Int, Int, Int)
+parseCmd =
+  (,,) <$> (string "move " *> getInt)
+    <*> (string " from " *> getInt)
+    <*> (string " to " *> getInt)
+  where
+    getInt :: ReadP Int
+    getInt = read <$> many1 (satisfy isDigit)