Address Warnings, Add Docs to Helper Modules

Author: prikhi

Data/Array.hs

@@ -15,12 +15,14 @@ import GHC.Arr as A
 import qualified Data.List as L
 
 
+-- | Set the values of multiple indexes in bulk.
 set :: (A.Ix i) => [(i, a)] -> A.Array i a -> A.Array i a
 set is arr =
     A.accum (\_ x -> x) arr is
 {-# INLINEABLE set #-}
 
 
+-- | Set all given indexes to the passed value.
 setAll :: (A.Ix i) => a -> [i] -> A.Array i a -> A.Array i a
 setAll a is arr =
     A.accum (\_ x -> x) arr (zip is (repeat a))

Data/Map.hs

@@ -93,6 +93,8 @@ mapKeys f = \case
                 }
 
 
+-- | Fold from the right branches to left, passing both the key & value to
+-- the reducing function.
 foldrWithKeys :: (k -> v -> b -> b) -> b -> Map k v -> b
 foldrWithKeys reducer acc = \case
     Leaf ->
@@ -116,6 +118,7 @@ insert !k !v = \case
             GT -> Branch bd {bdRight = insert k v bdRight}
 
 
+-- | Insert or update a value for the key.
 upsert :: Ord a => (Maybe b -> b) -> a -> Map a b -> Map a b
 upsert maker k = \case
     Leaf ->

Day01.hs

@@ -1,39 +1,14 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns #-}
-
 module Day01 where
 
-import Control.Arrow ((&&&))
-import Control.Monad
-import Data.Array (Array)
-import Data.Bifunctor
-import Data.Char
-import Data.Either
 import Data.Function (on)
-import Data.Functor
-import Data.Map (Map)
-import Data.Maybe
-import Data.Set (Set)
 import Text.ParserCombinators.ReadP
 
 import Harness
 import ParseHelper
 
-import qualified Data.Array as A
 import qualified Data.List as L
-import qualified Data.Map as M
-import qualified Data.Set as S
-
-import Debug.Trace
 
 
--- (parseInput lineParser) OR (parseInputRaw fullInputParser)
 main :: IO ()
 main =
     getInputAndSolve (parseInputRaw elvesParser) highestCalorieElf topThreeElves

Day02.hs

@@ -1,38 +1,17 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns #-}
 
 module Day02 where
 
 import Control.Applicative ((<|>))
-import Control.Arrow ((&&&))
 import Control.Monad
-import Data.Array (Array)
-import Data.Bifunctor
-import Data.Char
-import Data.Either
-import Data.Function (on)
 import Data.Functor
-import Data.Map (Map)
-import Data.Maybe
-import Data.Set (Set)
 import Text.ParserCombinators.ReadP
 
 import Harness
 import ParseHelper
 
-import qualified Data.Array as A
-import qualified Data.List as L
-import qualified Data.Map as M
-import qualified Data.Set as S
-
-import Debug.Trace
-
 
 main :: IO ()
 main = getInputAndSolve (parseInput parseGame) idealScore targetResultScore

Day03.hs

@@ -1,36 +1,16 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns #-}
 
 module Day03 where
 
-import Control.Arrow ((&&&))
-import Control.Monad
-import Data.Array (Array)
-import Data.Bifunctor
 import Data.Char
-import Data.Either
 import Data.Function (on)
-import Data.Functor
-import Data.Map (Map)
-import Data.Maybe
-import Data.Set (Set)
 import Text.ParserCombinators.ReadP
 
 import Harness
 import ParseHelper
 
-import qualified Data.Array as A
 import qualified Data.List as L
-import qualified Data.Map as M
-import qualified Data.Set as S
-
-import Debug.Trace
 
 
 main :: IO ()

Day04.hs

@@ -1,37 +1,13 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns #-}
 
 module Day04 where
 
-import Control.Arrow ((&&&))
 import Control.Monad
-import Data.Array (Array)
-import Data.Bifunctor
-import Data.Char
-import Data.Either
-import Data.Function (on)
-import Data.Functor
-import Data.Map (Map)
-import Data.Maybe
-import Data.Set (Set)
 import Text.ParserCombinators.ReadP
 
 import Harness
 import ParseHelper
 
-import qualified Data.Array as A
-import qualified Data.List as L
-import qualified Data.Map as M
-import qualified Data.Set as S
-
-import Debug.Trace
-
 
 main :: IO ()
 main = getInputAndSolve (parseInput parseElfPair) countFullOverlaps countAnyOverlaps
@@ -44,8 +20,8 @@ countFullOverlaps = length . filter isFullOverlap
   where
     isFullOverlap :: (SectionRange, SectionRange) -> Bool
     isFullOverlap (SectionRange e1Start e1End, SectionRange e2Start e2End) =
-        (e1Start >= e2Start && e1End <= e2End)
-            || (e2Start >= e1Start && e2End <= e1End)
+        e1Start >= e2Start && e1End <= e2End
+            || e2Start >= e1Start && e2End <= e1End
 
 
 countAnyOverlaps :: [(SectionRange, SectionRange)] -> Int

Harness.hs

@@ -1,14 +1,18 @@
-{-# OPTIONS_GHC -Wall #-}
+-- | Helpers for parsing inputs & running solutions w/ timing information.
 module Harness where
 
 import Control.Exception (evaluate)
-import Data.Time (getCurrentTime, diffUTCTime)
+import Data.Time (diffUTCTime, getCurrentTime)
 
 
+-- | Read the entire input from stdin.
 getRawInput :: IO String
 getRawInput =
     getContents >>= evaluate
 
+
+-- | Parse the input, run the part 1 & 2 solvers, print the solutions with
+-- an optional label & some timing information.
 solve :: (Show b, Show c) => String -> (String -> a) -> (a -> b) -> (a -> c) -> String -> IO ()
 solve rawLabel parser p1Solver p2Solver input = do
     let label = if null rawLabel then "" else " (" <> rawLabel <> ")"
@@ -20,14 +24,18 @@ solve rawLabel parser p1Solver p2Solver input = do
     t3 <- getCurrentTime
     putStrLn $ "Part 2" <> label <> ": " <> show (p2Solver parseResult)
     t4 <- getCurrentTime
-    mapM_ putStrLn
+    mapM_
+        putStrLn
         [ "Timings:"
         , "\tParsing:\t" <> show (diffUTCTime t2 t1)
         , "\tPart 1: \t" <> show (diffUTCTime t3 t2)
         , "\tPart 2: \t" <> show (diffUTCTime t4 t3)
         , "\tTotal:  \t" <> show (diffUTCTime t4 t1)
         ]
 
+
+-- | Read & parse the input, solve both parts of the problem, & print out
+-- the solutions.
 getInputAndSolve :: (Show b, Show c) => (String -> a) -> (a -> b) -> (a -> c) -> IO ()
 getInputAndSolve parser p1Solver p2Solver =
     getRawInput >>= solve "" parser p1Solver p2Solver

ParseHelper.hs

@@ -1,3 +1,4 @@
+-- | Helper functions for parsing problem inputs.
 module ParseHelper where
 
 import Data.Char (isDigit)
@@ -9,62 +10,81 @@ import Text.ParserCombinators.ReadP
 import qualified GHC.Arr as A
 
 
+-- | Run a parser on each line of the input file.
 parseInput :: Show x => ReadP x -> String -> [x]
 parseInput parser =
     parseInputRaw $ sepBy parser newline <* end
-    where
-        end = many $ choice [void newline, eof]
+  where
+    end = many $ choice [void newline, eof]
 
+
+-- | Run a parser on the full input file.
 parseInputRaw :: Show x => ReadP x -> String -> x
 parseInputRaw parser str =
     let results = readP_to_S parser str
         successes = filter ((== "") . snd) results
         longestAttempts = sortOn (length . snd) results
-    in  case listToMaybe successes of
+     in case listToMaybe successes of
             Nothing ->
                 error $ "Parsing failure, longest attempt: " <> show (head longestAttempts)
             Just success ->
                 fst success
 
+
+-- | Parse a newline or a carriage-return & newline.
 newline :: ReadP Char
-newline = choice
-    [ char '\r' *> char '\n'
-    , char '\n'
-    ]
+newline =
+    choice
+        [ char '\r' *> char '\n'
+        , char '\n'
+        ]
+
 
+-- | Parse a positive or negative integer.
 parseInt :: ReadP Int
 parseInt = do
     sign <- option 1 (char '-' $> (-1))
     (sign *) . read <$> many1 (satisfy isDigit)
 
 
+-- | Parse a comma-separated array of ints, with optional beginning & end
+-- characters.
 parseIntArray :: Maybe Char -> Maybe Char -> ReadP [Int]
 parseIntArray maybeStart maybeEnd = do
     mapM_ char maybeStart
     ints <- sepBy parseInt (skipSpaces *> char ',' *> skipSpaces)
     mapM_ char maybeEnd
     return ints
 
+
+-- | Parse a grid of digits with no column separators & rows separated by
+-- newlines.
 parseIntGrid :: ReadP (A.Array (Int, Int) Int)
 parseIntGrid = do
     ls <- sepBy (many1 $ satisfy isDigit) newline <* newline
     let height = length ls
         width = minimum $ map length ls
-    return $ A.array ((0, 0), (height - 1, width - 1))
-        [ ((w, h), c)
-        | h <- [0 .. height - 1]
-        , w <- [0 .. width - 1]
-        , let c = read [ls !! h !! w]
-        ]
+    return $
+        A.array
+            ((0, 0), (height - 1, width - 1))
+            [ ((w, h), c)
+            | h <- [0 .. height - 1]
+            , w <- [0 .. width - 1]
+            , let c = read [ls !! h !! w]
+            ]
 
+
+-- | Parse a grid of characters.
 parseCharGrid :: (Char -> Bool) -> ReadP (A.Array (Int, Int) Char)
 parseCharGrid validChar = do
     ls <- sepBy (many1 $ satisfy validChar) newline
     let height = length ls
         width = minimum $ map length ls
-    return $ A.array ((0, 0), (width - 1, height - 1))
-        [ ((w, h), c)
-        | h <- [0 .. height - 1]
-        , w <- [0 .. width - 1]
-        , let c = ls !! h !! w
-        ]
+    return $
+        A.array
+            ((0, 0), (width - 1, height - 1))
+            [ ((w, h), c)
+            | h <- [0 .. height - 1]
+            , w <- [0 .. width - 1]
+            , let c = ls !! h !! w
+            ]

fourmolu.yaml

@@ -7,3 +7,4 @@ record-brace-space: true
 newlines-between-decls: 2
 respectful: true
 haddock-style: single-line
+haddock-style-module: multi-line