Skip to content

Commit 95fea10

Browse files
prikhiprikhi
committed
Address Warnings, Add Docs to Helper Modules
1 parent 18bfd33 commit 95fea10

File tree

9 files changed

+58
-114
lines changed

9 files changed

+58
-114
lines changed

‎Data/Array.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,12 +15,14 @@ import GHC.Arr as A
1515
import qualified Data.List as L
1616

1717

18+
-- | Set the values of multiple indexes in bulk.
1819
set :: (A.Ix i) => [(i, a)] -> A.Array i a -> A.Array i a
1920
set is arr =
2021
A.accum (\_ x -> x) arr is
2122
{-# INLINEABLE set #-}
2223

2324

25+
-- | Set all given indexes to the passed value.
2426
setAll :: (A.Ix i) => a -> [i] -> A.Array i a -> A.Array i a
2527
setAll a is arr =
2628
A.accum (\_ x -> x) arr (zip is (repeat a))

‎Data/Map.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -93,6 +93,8 @@ mapKeys f = \case
9393
}
9494

9595

96+
-- | Fold from the right branches to left, passing both the key & value to
97+
-- the reducing function.
9698
foldrWithKeys :: (k -> v -> b -> b) -> b -> Map k v -> b
9799
foldrWithKeys reducer acc = \case
98100
Leaf ->
@@ -116,6 +118,7 @@ insert !k !v = \case
116118
GT -> Branch bd {bdRight = insert k v bdRight}
117119

118120

121+
-- | Insert or update a value for the key.
119122
upsert :: Ord a => (Maybe b -> b) -> a -> Map a b -> Map a b
120123
upsert maker k = \case
121124
Leaf ->

‎Day01.hs‎

Lines changed: 0 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -1,39 +1,14 @@
1-
{-# LANGUAGE BangPatterns #-}
2-
{-# LANGUAGE LambdaCase #-}
3-
{-# LANGUAGE MultiWayIf #-}
4-
{-# LANGUAGE NamedFieldPuns #-}
5-
{-# LANGUAGE RecordWildCards #-}
6-
{-# LANGUAGE TupleSections #-}
7-
{-# LANGUAGE TypeApplications #-}
8-
{-# LANGUAGE ViewPatterns #-}
9-
101
module Day01 where
112

12-
import Control.Arrow ((&&&))
13-
import Control.Monad
14-
import Data.Array (Array)
15-
import Data.Bifunctor
16-
import Data.Char
17-
import Data.Either
183
import Data.Function (on)
19-
import Data.Functor
20-
import Data.Map (Map)
21-
import Data.Maybe
22-
import Data.Set (Set)
234
import Text.ParserCombinators.ReadP
245

256
import Harness
267
import ParseHelper
278

28-
import qualified Data.Array as A
299
import qualified Data.List as L
30-
import qualified Data.Map as M
31-
import qualified Data.Set as S
32-
33-
import Debug.Trace
3410

3511

36-
-- (parseInput lineParser) OR (parseInputRaw fullInputParser)
3712
main :: IO ()
3813
main =
3914
getInputAndSolve (parseInputRaw elvesParser) highestCalorieElf topThreeElves

‎Day02.hs‎

Lines changed: 0 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,38 +1,17 @@
1-
{-# LANGUAGE BangPatterns #-}
21
{-# LANGUAGE LambdaCase #-}
3-
{-# LANGUAGE MultiWayIf #-}
42
{-# LANGUAGE NamedFieldPuns #-}
53
{-# LANGUAGE RecordWildCards #-}
6-
{-# LANGUAGE TupleSections #-}
7-
{-# LANGUAGE TypeApplications #-}
8-
{-# LANGUAGE ViewPatterns #-}
94

105
module Day02 where
116

127
import Control.Applicative ((<|>))
13-
import Control.Arrow ((&&&))
148
import Control.Monad
15-
import Data.Array (Array)
16-
import Data.Bifunctor
17-
import Data.Char
18-
import Data.Either
19-
import Data.Function (on)
209
import Data.Functor
21-
import Data.Map (Map)
22-
import Data.Maybe
23-
import Data.Set (Set)
2410
import Text.ParserCombinators.ReadP
2511

2612
import Harness
2713
import ParseHelper
2814

29-
import qualified Data.Array as A
30-
import qualified Data.List as L
31-
import qualified Data.Map as M
32-
import qualified Data.Set as S
33-
34-
import Debug.Trace
35-
3615

3716
main :: IO ()
3817
main = getInputAndSolve (parseInput parseGame) idealScore targetResultScore

‎Day03.hs‎

Lines changed: 0 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1,36 +1,16 @@
1-
{-# LANGUAGE BangPatterns #-}
21
{-# LANGUAGE LambdaCase #-}
3-
{-# LANGUAGE MultiWayIf #-}
4-
{-# LANGUAGE NamedFieldPuns #-}
5-
{-# LANGUAGE RecordWildCards #-}
6-
{-# LANGUAGE TupleSections #-}
72
{-# LANGUAGE TypeApplications #-}
8-
{-# LANGUAGE ViewPatterns #-}
93

104
module Day03 where
115

12-
import Control.Arrow ((&&&))
13-
import Control.Monad
14-
import Data.Array (Array)
15-
import Data.Bifunctor
166
import Data.Char
17-
import Data.Either
187
import Data.Function (on)
19-
import Data.Functor
20-
import Data.Map (Map)
21-
import Data.Maybe
22-
import Data.Set (Set)
238
import Text.ParserCombinators.ReadP
249

2510
import Harness
2611
import ParseHelper
2712

28-
import qualified Data.Array as A
2913
import qualified Data.List as L
30-
import qualified Data.Map as M
31-
import qualified Data.Set as S
32-
33-
import Debug.Trace
3414

3515

3616
main :: IO ()

‎Day04.hs‎

Lines changed: 2 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -1,37 +1,13 @@
1-
{-# LANGUAGE BangPatterns #-}
2-
{-# LANGUAGE LambdaCase #-}
3-
{-# LANGUAGE MultiWayIf #-}
4-
{-# LANGUAGE NamedFieldPuns #-}
51
{-# LANGUAGE RecordWildCards #-}
6-
{-# LANGUAGE TupleSections #-}
7-
{-# LANGUAGE TypeApplications #-}
8-
{-# LANGUAGE ViewPatterns #-}
92

103
module Day04 where
114

12-
import Control.Arrow ((&&&))
135
import Control.Monad
14-
import Data.Array (Array)
15-
import Data.Bifunctor
16-
import Data.Char
17-
import Data.Either
18-
import Data.Function (on)
19-
import Data.Functor
20-
import Data.Map (Map)
21-
import Data.Maybe
22-
import Data.Set (Set)
236
import Text.ParserCombinators.ReadP
247

258
import Harness
269
import ParseHelper
2710

28-
import qualified Data.Array as A
29-
import qualified Data.List as L
30-
import qualified Data.Map as M
31-
import qualified Data.Set as S
32-
33-
import Debug.Trace
34-
3511

3612
main :: IO ()
3713
main = getInputAndSolve (parseInput parseElfPair) countFullOverlaps countAnyOverlaps
@@ -44,8 +20,8 @@ countFullOverlaps = length . filter isFullOverlap
4420
where
4521
isFullOverlap :: (SectionRange, SectionRange) -> Bool
4622
isFullOverlap (SectionRange e1Start e1End, SectionRange e2Start e2End) =
47-
(e1Start >= e2Start && e1End <= e2End)
48-
|| (e2Start >= e1Start && e2End <= e1End)
23+
e1Start >= e2Start && e1End <= e2End
24+
|| e2Start >= e1Start && e2End <= e1End
4925

5026

5127
countAnyOverlaps :: [(SectionRange, SectionRange)] -> Int

‎Harness.hs‎

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,18 @@
1-
{-# OPTIONS_GHC -Wall #-}
1+
-- | Helpers for parsing inputs & running solutions w/ timing information.
22
module Harness where
33

44
import Control.Exception (evaluate)
5-
import Data.Time (getCurrentTime, diffUTCTime)
5+
import Data.Time (diffUTCTime, getCurrentTime)
66

77

8+
-- | Read the entire input from stdin.
89
getRawInput :: IO String
910
getRawInput =
1011
getContents >>= evaluate
1112

13+
14+
-- | Parse the input, run the part 1 & 2 solvers, print the solutions with
15+
-- an optional label & some timing information.
1216
solve :: (Show b, Show c) => String -> (String -> a) -> (a -> b) -> (a -> c) -> String -> IO ()
1317
solve rawLabel parser p1Solver p2Solver input = do
1418
let label = if null rawLabel then "" else " (" <> rawLabel <> ")"
@@ -20,14 +24,18 @@ solve rawLabel parser p1Solver p2Solver input = do
2024
t3 <- getCurrentTime
2125
putStrLn $ "Part 2" <> label <> ": " <> show (p2Solver parseResult)
2226
t4 <- getCurrentTime
23-
mapM_ putStrLn
27+
mapM_
28+
putStrLn
2429
[ "Timings:"
2530
, "\tParsing:\t" <> show (diffUTCTime t2 t1)
2631
, "\tPart 1: \t" <> show (diffUTCTime t3 t2)
2732
, "\tPart 2: \t" <> show (diffUTCTime t4 t3)
2833
, "\tTotal: \t" <> show (diffUTCTime t4 t1)
2934
]
3035

36+
37+
-- | Read & parse the input, solve both parts of the problem, & print out
38+
-- the solutions.
3139
getInputAndSolve :: (Show b, Show c) => (String -> a) -> (a -> b) -> (a -> c) -> IO ()
3240
getInputAndSolve parser p1Solver p2Solver =
3341
getRawInput >>= solve "" parser p1Solver p2Solver

‎ParseHelper.hs‎

Lines changed: 39 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
-- | Helper functions for parsing problem inputs.
12
module ParseHelper where
23

34
import Data.Char (isDigit)
@@ -9,62 +10,81 @@ import Text.ParserCombinators.ReadP
910
import qualified GHC.Arr as A
1011

1112

13+
-- | Run a parser on each line of the input file.
1214
parseInput :: Show x => ReadP x -> String -> [x]
1315
parseInput parser =
1416
parseInputRaw $ sepBy parser newline <* end
15-
where
16-
end = many $ choice [void newline, eof]
17+
where
18+
end = many $ choice [void newline, eof]
1719

20+
21+
-- | Run a parser on the full input file.
1822
parseInputRaw :: Show x => ReadP x -> String -> x
1923
parseInputRaw parser str =
2024
let results = readP_to_S parser str
2125
successes = filter ((== "") . snd) results
2226
longestAttempts = sortOn (length . snd) results
23-
in case listToMaybe successes of
27+
in case listToMaybe successes of
2428
Nothing ->
2529
error $ "Parsing failure, longest attempt: " <> show (head longestAttempts)
2630
Just success ->
2731
fst success
2832

33+
34+
-- | Parse a newline or a carriage-return & newline.
2935
newline :: ReadP Char
30-
newline = choice
31-
[ char '\r' *> char '\n'
32-
, char '\n'
33-
]
36+
newline =
37+
choice
38+
[ char '\r' *> char '\n'
39+
, char '\n'
40+
]
41+
3442

43+
-- | Parse a positive or negative integer.
3544
parseInt :: ReadP Int
3645
parseInt = do
3746
sign <- option 1 (char '-' $> (-1))
3847
(sign *) . read <$> many1 (satisfy isDigit)
3948

4049

50+
-- | Parse a comma-separated array of ints, with optional beginning & end
51+
-- characters.
4152
parseIntArray :: Maybe Char -> Maybe Char -> ReadP [Int]
4253
parseIntArray maybeStart maybeEnd = do
4354
mapM_ char maybeStart
4455
ints <- sepBy parseInt (skipSpaces *> char ',' *> skipSpaces)
4556
mapM_ char maybeEnd
4657
return ints
4758

59+
60+
-- | Parse a grid of digits with no column separators & rows separated by
61+
-- newlines.
4862
parseIntGrid :: ReadP (A.Array (Int, Int) Int)
4963
parseIntGrid = do
5064
ls <- sepBy (many1 $ satisfy isDigit) newline <* newline
5165
let height = length ls
5266
width = minimum $ map length ls
53-
return $ A.array ((0, 0), (height - 1, width - 1))
54-
[ ((w, h), c)
55-
| h <- [0 .. height - 1]
56-
, w <- [0 .. width - 1]
57-
, let c = read [ls !! h !! w]
58-
]
67+
return $
68+
A.array
69+
((0, 0), (height - 1, width - 1))
70+
[ ((w, h), c)
71+
| h <- [0 .. height - 1]
72+
, w <- [0 .. width - 1]
73+
, let c = read [ls !! h !! w]
74+
]
5975

76+
77+
-- | Parse a grid of characters.
6078
parseCharGrid :: (Char -> Bool) -> ReadP (A.Array (Int, Int) Char)
6179
parseCharGrid validChar = do
6280
ls <- sepBy (many1 $ satisfy validChar) newline
6381
let height = length ls
6482
width = minimum $ map length ls
65-
return $ A.array ((0, 0), (width - 1, height - 1))
66-
[ ((w, h), c)
67-
| h <- [0 .. height - 1]
68-
, w <- [0 .. width - 1]
69-
, let c = ls !! h !! w
70-
]
83+
return $
84+
A.array
85+
((0, 0), (width - 1, height - 1))
86+
[ ((w, h), c)
87+
| h <- [0 .. height - 1]
88+
, w <- [0 .. width - 1]
89+
, let c = ls !! h !! w
90+
]

‎fourmolu.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,3 +7,4 @@ record-brace-space: true
77
newlines-between-decls: 2
88
respectful: true
99
haddock-style: single-line
10+
haddock-style-module: multi-line

0 commit comments

Comments
 (0)