complete day 5HEADmaster

2 files changed, 53 insertions, 16 deletions

diff --git a/day05/app/Main.hs b/day05/app/Main.hs
index b56e45b..f22ed5a 100644
--- a/day05/app/Main.hs
+++ b/day05/app/Main.hs
@@ -145,6 +145,8 @@ module Main (main) where
 
 import Data.ByteString.Lazy (ByteString)
 import Data.Char (digitToInt)
+import Data.List (filter)
+import Data.Sequence (fromList, index, splitAt, update, (><))
 import Options.Applicative (Parser, ParserInfo, argument, execParser, fullDesc, help, helper, info, metavar, str)
 import Relude hiding (ByteString, elem, empty, filter, fromList, length, null, optional, readFile, splitAt)
 import Text.Parsec (ParseError, parse, (<?>))
@@ -157,7 +159,7 @@ type Opts :: Type
 newtype Opts = Opts {_filename :: Text} deriving stock (Show)
 
 type Supplies :: Type
-newtype Supplies = Supplies {_i :: [[Char]]} deriving stock (Show)
+newtype Supplies = Supplies {_i :: Seq (Seq Char)} deriving stock (Show)
 
 type Order :: Type
 data Order = Order {_amount :: Int, _from :: Int, _to :: Int} deriving stock (Show)
@@ -166,7 +168,7 @@ parseInput :: FilePath -> ByteString -> Either ParseError (Supplies, [Order])
 parseInput = parse $ (,) <$> (supplies <* eol) <*> orders
   where
     supplies :: GenParser t st Supplies
-    supplies = Supplies <$> many1 (lineBlock <* eol) <* axis
+    supplies = (Supplies . fromList . map (fromList . filter (/= ' '))) . transpose <$> many1 (lineBlock <* eol) <* axis
 
     lineBlock :: GenParser t st [Char]
     lineBlock = block `sepBy1` space
@@ -207,11 +209,38 @@ parseInput = parse $ (,) <$> (supplies <* eol) <*> orders
             <?> "end of line"
         )
 
-runPart1 :: (Supplies, [Order]) -> (Supplies, [Order])
-runPart1 x = x
+move :: Int -> Int -> Int -> Supplies -> Supplies
+move f t n s = Supplies $ update tp1 (fst moveElements >< toStack) (update fp1 (snd moveElements) (_i s))
+  where
+    moveElements :: (Seq Char, Seq Char)
+    moveElements = splitAt n fromStack
+
+    fromStack :: Seq Char
+    fromStack = index (_i s) fp1
+
+    toStack :: Seq Char
+    toStack = index (_i s) tp1
+
+    tp1 :: Int
+    tp1 = t - 1
+
+    fp1 :: Int
+    fp1 = f - 1
 
-runPart2 :: (Supplies, [Order]) -> Int
-runPart2 = undefined
+runPart1 :: (Supplies, [Order]) -> [Char]
+runPart1 (sup, ors) = toList $ fmap (`index` 0) (_i run)
+  where
+    run :: Supplies
+    run = foldl' (\s o -> loop (_amount o) (move (_from o) (_to o) 1) s) sup ors
+
+    loop :: Int -> (Supplies -> Supplies) -> Supplies -> Supplies
+    loop n f s = foldl' (\s' _ -> f s') s [1 .. n]
+
+runPart2 :: (Supplies, [Order]) -> [Char]
+runPart2 (sup, ors) = toList $ fmap (`index` 0) (_i run)
+  where
+    run :: Supplies
+    run = foldl' (\s o -> move (_from o) (_to o) (_amount o) s) sup ors
 
 main :: IO ()
 main = do
diff --git a/day07/app/Main.hs b/day07/app/Main.hs
index 413fcca..223f7f7 100644
--- a/day07/app/Main.hs
+++ b/day07/app/Main.hs
@@ -121,6 +121,9 @@ Find the smallest directory that, if deleted, would free up enough space on the
 run the update.  What is the total size of that directory?
 -}
 {-# LANGUAGE DerivingStrategies #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use 'foldl'' from Relude" #-}
 
 module Main (main) where
 
@@ -154,12 +157,19 @@ data SystemEntry a = File a | Directory Text [SystemEntry a] deriving stock (Sho
 root :: SystemEntry FileData
 root = Directory "/" []
 
-foldrEntry :: Monoid b => (a -> b -> b) -> b -> SystemEntry a -> b
-foldrEntry f b (File fd) = f fd b
-foldrEntry f b (Directory _ xs) = mconcat $ fmap (foldrEntry f b) xs
+foldrFile :: Monoid b => (a -> b -> b) -> b -> SystemEntry a -> b
+foldrFile f b (File fd) = f fd b
+foldrFile f b (Directory _ xs) = mconcat $ fmap (foldrFile f b) xs
+
+foldrDirectory :: Monoid b => (a -> b -> b) -> b -> SystemEntry a -> [b]
+foldrDirectory _ _ (File _) = []
+foldrDirectory f b (Directory n xs) = b' : concatMap (foldrDirectory f mempty) xs
+  where
+    b' = foldrFile f b (Directory n xs)
 
+-- | Foldable over Files
 instance Foldable SystemEntry where
-  foldMap fam = foldrEntry (mappend . fam) mempty
+  foldMap fam = foldrFile (mappend . fam) mempty
 
 parseInput :: FilePath -> ByteString -> Either ParseError [Queries]
 parseInput = parse $ queries <* (eol <|> eof)
@@ -208,13 +218,8 @@ run (Directory n ses) (ChangeDir d : qs) = run (Directory n (ses' : ses)) qs'
 run (Directory n ses) (List fd : qs) = run (Directory n (fmap File fd ++ ses)) qs
 run _ _ = error "invalid operation"
 
-getSize :: SystemEntry FileData -> Int
-getSize = getSum . foldr ((<>) . Sum . _size) (Sum 0)
-
 getDirSizes :: SystemEntry FileData -> [Int]
-getDirSizes (File _) = []
-getDirSizes (Directory n ses) =
-  getSize (Directory n ses) : foldl (\a d -> a ++ getDirSizes d) [] ses
+getDirSizes = map getSum . foldrDirectory ((<>) . Sum. _size) (Sum 0)
 
 runPart1 :: [Queries] -> Int
 runPart1 = sum . filter (<= minSize) . getDirSizes . fst . run root . drop 1
@@ -228,6 +233,9 @@ runPart2 qs = minimum $ filter (>= requiredSpace - unusedSpace) $ getDirSizes sy
     systemEntry :: SystemEntry FileData
     systemEntry = fst $ run root $ drop 1 qs
 
+    getSize :: SystemEntry FileData -> Int
+    getSize = getSum . foldr ((<>) . Sum . _size) (Sum 0)
+
     unusedSpace :: Int
     unusedSpace = totalSpace - getSize systemEntry