Refactor

Author: joelhed

advent-of-code-y2022.cabal

@@ -31,6 +31,8 @@ library
       Day4
       Day5
       Day6
+      Day7
+      Days
       Lib
       Utils
   other-modules:

app/Main.hs

@@ -2,9 +2,8 @@
 module Main (main) where
 
 import System.Environment
-import System.IO (openFile, hGetContents, IOMode (..))
+import System.IO (openFile, hGetContents', IOMode (..))
 import Data.List (isInfixOf)
-import Data.Maybe (fromJust)
 
 import qualified Data.ByteString.Lazy.Char8 as L8
 import qualified Data.ByteString.Char8 as C8
@@ -13,45 +12,23 @@ import Network.HTTP.Client.TLS
 import Network.HTTP.Simple
 
 import Lib
-import Day1
-import Day2
-import Day3
-import Day4
-import Day5
-import Day6
+import Utils (maybeAt)
+import Days
 
-days :: [Day]
-days = [ day1
-       , day2
-       , day3
-       , day4
-       , day5
-       , day6
-       ]
-
-getDayFromDaySpec :: DaySpec -> Day
-getDayFromDaySpec = (days !!) . (subtract 1)
-
-getPartFromDayPartSpec :: DayPartSpec -> Maybe Part
-getPartFromDayPartSpec spec =
-    (getPartFromPartSpec $ partSpec spec) day
-    where day = getDayFromDaySpec $ daySpec spec
-
-parseDayPartSpec :: [String] -> DayPartSpec
-parseDayPartSpec args = case args of
-    []                 -> let daySp = (length days)
-                          in DayPartSpec daySp $ getLatestPartSpec $ getDayFromDaySpec daySp
-    [dayStr]           -> let daySp = (read dayStr)
-                          in DayPartSpec daySp $ getLatestPartSpec $ getDayFromDaySpec daySp
-    (dayStr:partStr:_) -> let daySp = (read dayStr)
-                          in DayPartSpec daySp $ getPartSpecByNum  $ read partStr
+parseDayPartSpec :: [String] -> Maybe DayPartSpec
+parseDayPartSpec args =
+    DayPartSpec daySpec' <$> partSpec'
+    where daySpec'  = maybe (length days) read
+                    . maybeAt 0 $ args
+          partSpec' = maybe (getLatestPartSpec <$> getDayFromDaySpec daySpec') (getPartSpecByNum . read)
+                    . maybeAt 1 $ args
 
 getSessionId :: IO String
 getSessionId = do
     handle <- openFile "session_id" ReadMode
-    hGetContents handle
+    hGetContents' handle
 
-downloadInput :: DaySpec -> IO (Maybe String)
+downloadInput :: DaySpec -> IO String
 downloadInput day = do
     manager <- newManager tlsManagerSettings
     sessionId <- getSessionId
@@ -62,23 +39,30 @@ downloadInput day = do
     response <- httpLBS request'
     let body = L8.unpack $ responseBody response
     if isInfixOf "Please log in" body then
-        error "session id not supplied"
+        fail "session id not supplied"
+    else if isInfixOf "Please don't repeatedly request this endpoint before it unlocks!" body then
+        fail "input for day not yet released"
     else
-        return $ Just body
+        return body
 
 main :: IO ()
 main = do
     args <- getArgs
-    (dayPartSpec, input) <-
-        if args /= [] && head args == "--download" then do
-            let dayPartSpec = parseDayPartSpec $ tail args
-            maybeInput <- downloadInput $ daySpec dayPartSpec
-            case maybeInput of
-                (Just input) -> return (dayPartSpec, input)
-                Nothing      -> error $ "no input to download for day " ++ (show $ daySpec dayPartSpec)
-        else do
-            let dayPartSpec = parseDayPartSpec args
-            input <- getContents
-            return (dayPartSpec, input)
-    let part = fromJust $ getPartFromDayPartSpec $ dayPartSpec
-    putStrLn $ part input
+    let (args', shouldDownload) = if args /= [] && head args == "--download"
+                                  then (tail args, True)
+                                  else (args, False)
+
+    dayPartSpec <- case parseDayPartSpec args' of
+        Just x  -> return x
+        Nothing -> fail "no such day and/or part exists"
+
+    part <- case getPartFromDayPartSpec dayPartSpec of
+        Just x  -> return x
+        Nothing -> fail "no such part exists"
+
+    input <-
+        if shouldDownload
+        then downloadInput $ daySpec dayPartSpec
+        else getContents
+
+    putStrLn . part $ input

src/Day7.hs

@@ -0,0 +1,8 @@
+module Day7 (day7) where
+
+import Lib
+
+day7 :: Day
+day7 = Day { part1 = id
+           , part2 = Nothing
+           }

src/Days.hs

@@ -0,0 +1,35 @@
+module Days ( days
+            , getDayFromDaySpec
+            , getPartFromDayPartSpec
+            ) where
+
+import Control.Monad (join)
+
+import Lib
+import Utils (maybeAt)
+
+import Day1
+import Day2
+import Day3
+import Day4
+import Day5
+import Day6
+import Day7
+
+days :: [Day]
+days = [ day1
+       , day2
+       , day3
+       , day4
+       , day5
+       , day6
+       , day7
+       ]
+
+getDayFromDaySpec :: DaySpec -> Maybe Day
+getDayFromDaySpec = (flip maybeAt) days . subtract 1
+
+getPartFromDayPartSpec :: DayPartSpec -> Maybe Part
+getPartFromDayPartSpec (DayPartSpec daySpec' partSpec') =
+    join $ getPartFromPartSpec partSpec' <$> getDayFromDaySpec daySpec'
+

src/Lib.hs

@@ -31,7 +31,7 @@ getLatestPartSpec day =
         (Just _) -> Part2
         Nothing  -> Part1
 
-getPartSpecByNum :: Int -> PartSpec
-getPartSpecByNum 1 = Part1
-getPartSpecByNum 2 = Part2
-getPartSpecByNum _ = error "too many parts for me!"
+getPartSpecByNum :: Int -> Maybe PartSpec
+getPartSpecByNum 1 = Just Part1
+getPartSpecByNum 2 = Just Part2
+getPartSpecByNum _ = Nothing

src/Utils.hs

@@ -1,4 +1,13 @@
-module Utils (pair, splitOn) where
+module Utils ( pair
+             , splitOn
+             , maybeAt
+             ) where
+
+-- (!!) but returns Maybe
+maybeAt :: Int -> [a] -> Maybe a
+maybeAt idx xs = case drop idx xs of
+    []    -> Nothing
+    (x:_) -> (Just x)
 
 -- Split a list at the appearance of a given item. This removes said item.
 splitOn :: (Eq a) => a -> [a] -> [[a]]