From 55bc09948b5bca60054cc7d09f576adee0d3e947 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Sun, 6 Dec 2020 11:06:51 +0000
Subject: [PATCH] [hs] Make cli fancier

---
 hs/app/Main.hs          | 30 ++++++++++++++++++++++--------
 hs/src/Aoc/Day.hs       | 32 +++++++++++++++++++-------------
 hs/src/Aoc/Y2020.hs     | 18 +++++++++---------
 hs/src/Aoc/Y2020/D01.hs |  2 +-
 hs/src/Aoc/Y2020/D02.hs |  2 +-
 hs/src/Aoc/Y2020/D03.hs |  2 +-
 hs/src/Aoc/Y2020/D04.hs |  2 +-
 hs/src/Aoc/Y2020/D05.hs |  2 +-
 hs/src/Aoc/Y2020/D06.hs |  2 +-
 9 files changed, 56 insertions(+), 36 deletions(-)

diff --git a/hs/app/Main.hs b/hs/app/Main.hs
index de42bb1..4022d8b 100644
--- a/hs/app/Main.hs
+++ b/hs/app/Main.hs
@@ -4,18 +4,32 @@ import           Control.Monad
 
 import           Options.Applicative
 
-import           Aoc.Day             (Day (..))
-import qualified Aoc.Y2019           as Y2019
+import           Aoc.Day             (Day (..), Year (..))
 import qualified Aoc.Y2020           as Y2020
 
-toCommand :: Day -> Mod CommandFields (IO ())
-toCommand (DayPure name f) = command name $ info (helper <*> pure f) mempty
-toCommand (DayFile name f) = command name $ info (helper <*> p) mempty
-  where
-    p = f <$> strArgument (metavar "INPUTFILE")
+lpad :: a -> Int -> [a] -> [a]
+lpad a n as = replicate (n - length as) a ++ as
+
+yearsToParser :: [Year] -> Parser (IO ())
+yearsToParser = hsubparser . mconcat . map yearToCommand
+
+yearToCommand :: Year -> Mod CommandFields (IO ())
+yearToCommand y = command (show $ yNum y) $ flip info mempty $ daysToParser $ yDays y
+
+daysToParser :: [(Int, Day)] -> Parser (IO ())
+daysToParser = hsubparser . mconcat . map (uncurry dayToCommand)
+
+dayToCommand :: Int -> Day -> Mod CommandFields (IO ())
+dayToCommand dNum = command (lpad '0' 2 $ show dNum) . flip info mempty . dayToParser
+
+dayToParser :: Day -> Parser (IO ())
+dayToParser (DayPure f) = pure f
+dayToParser (DayFile f) = f <$> strArgument (metavar "INPUTFILE")
 
 parser :: Parser (IO ())
-parser = subparser $ mconcat $ map toCommand $ Y2019.days ++ Y2020.days
+parser = yearsToParser
+  [ Y2020.year
+  ]
 
 opts :: ParserInfo (IO ())
 opts = info (helper <*> parser) $ fullDesc <> failureCode 1
diff --git a/hs/src/Aoc/Day.hs b/hs/src/Aoc/Day.hs
index 73a949e..2adb48a 100644
--- a/hs/src/Aoc/Day.hs
+++ b/hs/src/Aoc/Day.hs
@@ -1,5 +1,6 @@
 module Aoc.Day
-  ( Day(..)
+  ( Year(..)
+  , Day(..)
   , runDay
   , dayPure
   , dayFile
@@ -16,29 +17,34 @@ import           Text.Megaparsec
 
 import           Aoc.Parse
 
+data Year = Year
+  { yNum  :: Int
+  , yDays :: [(Int, Day)]
+  }
+
 data Day
-  = DayPure String (IO ())
-  | DayFile String (FilePath -> IO ())
+  = DayPure (IO ())
+  | DayFile (FilePath -> IO ())
 
 -- | Helper function for trying out days in ghci.
 runDay :: Day -> FilePath -> IO ()
-runDay (DayPure _ f) _ = f
-runDay (DayFile _ f) p = f p
+runDay (DayPure f) _ = f
+runDay (DayFile f) p = f p
 
-dayPure :: String -> IO () -> Day
+dayPure :: IO () -> Day
 dayPure = DayPure
 
-dayFile :: String -> (FilePath -> IO ()) -> Day
+dayFile :: (FilePath -> IO ()) -> Day
 dayFile = DayFile
 
-dayString :: String -> (String -> IO ()) -> Day
-dayString name f = dayFile name $ f <=< readFile
+dayString :: (String -> IO ()) -> Day
+dayString f = dayFile $ f <=< readFile
 
-dayText :: String -> (T.Text -> IO ()) -> Day
-dayText name f = dayFile name $ f <=< T.readFile
+dayText :: (T.Text -> IO ()) -> Day
+dayText f = dayFile $ f <=< T.readFile
 
-dayParse :: String -> Parser a -> (a -> IO ()) -> Day
-dayParse name p f = dayFile name $ \path -> do
+dayParse :: Parser a -> (a -> IO ()) -> Day
+dayParse p f = dayFile $ \path -> do
   text <- T.readFile path
   case parse (p <* eof) path text of
     Right a -> f a
diff --git a/hs/src/Aoc/Y2020.hs b/hs/src/Aoc/Y2020.hs
index 60fa930..1524ee9 100644
--- a/hs/src/Aoc/Y2020.hs
+++ b/hs/src/Aoc/Y2020.hs
@@ -1,5 +1,5 @@
 module Aoc.Y2020
-  ( days
+  ( year
   ) where
 
 import           Aoc.Day
@@ -10,12 +10,12 @@ import qualified Aoc.Y2020.D04 as D04
 import qualified Aoc.Y2020.D05 as D05
 import qualified Aoc.Y2020.D06 as D06
 
-days :: [Day]
-days =
-  [ D01.day
-  , D02.day
-  , D03.day
-  , D04.day
-  , D05.day
-  , D06.day
+year :: Year
+year = Year 2020
+  [ ( 1, D01.day)
+  , ( 2, D02.day)
+  , ( 3, D03.day)
+  , ( 4, D04.day)
+  , ( 5, D05.day)
+  , ( 6, D06.day)
   ]
diff --git a/hs/src/Aoc/Y2020/D01.hs b/hs/src/Aoc/Y2020/D01.hs
index 1beaa2b..4bfda2f 100644
--- a/hs/src/Aoc/Y2020/D01.hs
+++ b/hs/src/Aoc/Y2020/D01.hs
@@ -37,4 +37,4 @@ solver values = do
   putStrLn $ show y1 ++ " * " ++ show y2 ++ " * " ++ show y3 ++ " = " ++ show (y1 * y2 * y3)
 
 day :: Day
-day = dayParse "2020_01" parser solver
+day = dayParse parser solver
diff --git a/hs/src/Aoc/Y2020/D02.hs b/hs/src/Aoc/Y2020/D02.hs
index 101efc8..88fdb7d 100644
--- a/hs/src/Aoc/Y2020/D02.hs
+++ b/hs/src/Aoc/Y2020/D02.hs
@@ -42,4 +42,4 @@ solver ls = do
   print $ length $ filter validPositions ls
 
 day :: Day
-day = dayParse "2020_02" parser solver
+day = dayParse parser solver
diff --git a/hs/src/Aoc/Y2020/D03.hs b/hs/src/Aoc/Y2020/D03.hs
index 1289881..d71b3ea 100644
--- a/hs/src/Aoc/Y2020/D03.hs
+++ b/hs/src/Aoc/Y2020/D03.hs
@@ -44,4 +44,4 @@ solver trees = do
   putStrLn $ "Product: " ++ show (oneOne * threeOne * fiveOne * sevenOne * oneTwo)
 
 day :: Day
-day = dayParse "2020_03" parser solver
+day = dayParse parser solver
diff --git a/hs/src/Aoc/Y2020/D04.hs b/hs/src/Aoc/Y2020/D04.hs
index c468bf3..d512fea 100644
--- a/hs/src/Aoc/Y2020/D04.hs
+++ b/hs/src/Aoc/Y2020/D04.hs
@@ -157,4 +157,4 @@ solver passports = do
   print $ length $ filter hasValidKeys passports
 
 day :: Day
-day = dayParse "2020_04" parser solver
+day = dayParse parser solver
diff --git a/hs/src/Aoc/Y2020/D05.hs b/hs/src/Aoc/Y2020/D05.hs
index e3924c2..a12a63c 100644
--- a/hs/src/Aoc/Y2020/D05.hs
+++ b/hs/src/Aoc/Y2020/D05.hs
@@ -40,4 +40,4 @@ solver ps = do
   print $ mySeats $ Set.fromList ps
 
 day :: Day
-day = dayParse "2020_05" parser solver
+day = dayParse parser solver
diff --git a/hs/src/Aoc/Y2020/D06.hs b/hs/src/Aoc/Y2020/D06.hs
index 73dad68..5c5bb61 100644
--- a/hs/src/Aoc/Y2020/D06.hs
+++ b/hs/src/Aoc/Y2020/D06.hs
@@ -22,4 +22,4 @@ solver groups = do
   print $ sum $ map (Set.size . foldr1 Set.intersection . map Set.fromList) groups
 
 day :: Day
-day = dayParse "2020_06" parser solver
+day = dayParse parser solver