59 lines
1.5 KiB
Haskell
59 lines
1.5 KiB
Haskell
module Puzzles.Day5 (puzzle) where
|
|
|
|
import Control.Monad
|
|
import Data.List
|
|
import Data.Ord
|
|
import Data.Text.Lazy qualified as TL
|
|
import Puzzle
|
|
import Text.Megaparsec hiding (some)
|
|
import Text.Megaparsec.Char
|
|
import Text.Megaparsec.Char.Lexer qualified as Lex
|
|
|
|
puzzle :: Puzzle
|
|
puzzle =
|
|
Puzzle
|
|
{ number = 5
|
|
, parser = do
|
|
ranges <- flip sepEndBy newline $ Range <$> Lex.decimal <* single '-' <*> Lex.decimal
|
|
void newline
|
|
vals <- sepEndBy Lex.decimal newline
|
|
pure (ranges, vals)
|
|
, parts =
|
|
[ \(ranges, vals) ->
|
|
TL.show
|
|
. length
|
|
. filter (flip any ranges . isInRange)
|
|
$ vals
|
|
, TL.show
|
|
. sum
|
|
. map rangeLength
|
|
. foldr addInterval []
|
|
. sortOn (Down . (.lower))
|
|
. fst
|
|
]
|
|
, extraTests = mempty
|
|
}
|
|
|
|
data Range = Range
|
|
{ lower :: Int
|
|
, upper :: Int
|
|
}
|
|
deriving (Eq, Ord, Show)
|
|
|
|
rangeLength :: Range -> Int
|
|
rangeLength r = r.upper - r.lower + 1
|
|
|
|
isInRange :: Int -> Range -> Bool
|
|
isInRange n r = n >= r.lower && n <= r.upper
|
|
|
|
extend :: Int -> Range -> Range
|
|
extend upper r = r{upper = max r.upper upper}
|
|
|
|
addInterval :: Range -> [Range] -> [Range]
|
|
addInterval new = \case
|
|
[] -> [new]
|
|
(r : rs) ->
|
|
if isInRange new.lower r
|
|
then extend new.upper r : rs
|
|
else new : r : rs
|