Today’s Advent of Code puzzle, “Distress Signal”, is one of those classic define-a-bespoke-ordering-on-a-data-structure problems.

We’ll tackle it by writing as little code as possble, which translates to a largeish import list. Reproduced right from the start, as this is literate Haskell.

import           Control.Applicative ((<|>),liftA2)
import           Data.Aeson          (FromJSON,eitherDecodeStrict',parseJSON,withArray,withScientific)
import           Data.List           (findIndices,sort)
import           Data.Foldable       (toList)
import           Data.Functor        ((<&>))
import           Data.Scientific     (floatingOrInteger)
import qualified Data.ByteString.Char8 as BS

A packet is either an integer or a list of recursive packets.¹

data Packet = I Int | L [Packet]

A packet as given in the puzzle input happens to be valid JSON, so let’s parse it from there and spare futile head-scratching.

instance FromJSON Packet where
  parseJSON = liftA2 (<|>) parseInt parseList
    where
      parseInt = withScientific "integer" $
        floatingOrInteger                           >>>
        either (const (fail "Not an integer")) pure >>>
        fmap I
      parseList = withArray "list" $
        toList             >>>
        traverse parseJSON >>>
        fmap L

To parse globally, I’ll assume the input is well-formed and ignore the explicit pairings by skipping blank lines and deferring the re-pairing to part 1 which is the only one to make use of it.

main :: IO ()
main = do
  Right packets <-
    BS.getContents <&>
    BS.lines               >>>
    filter (not . BS.null) >>>
    traverse eitherDecodeStrict'
  print (part1 packets)
  print (part2 packets)

Now the puzzle revolves entirely around being able to sort packets.

Comparing two integer values is straightforward, I’ll delegate it to the underlying Ints:

comparePackets :: Packet -> Packet -> Ordering
comparePackets (I a)  (I b)  = compare a  b

Comparing two list values follows the same lexicographical ordering rules as standard Haskell lists, provided their elements have a proper ordering. Which is not the case for us here yet, as there’s no Ord instance on Packets. But assuming we could define one, we could delegate all the same:

comparePackets (L as) (L bs) = compare as bs

Last, comparing an integer to a list works as if promoting the integer to a single-element list.

comparePackets a@I{} l = comparePackets (L [a]) l
comparePackets l b@I{} = comparePackets l (L [b])

So we need to define an Ord instance on Packets. How would we do that? Well, all we need to do is call our comparePackets function!

instance Eq Packet where (==) = ((== EQ) .) . comparePackets
instance Ord Packet where compare = comparePackets

It’s worth pondering why we needed both an Ord instance and an external comparison function. The reason is that sneaky Eq instance above. It’s needed to declare an Ord instance. And though what I’ll be doing probably doesn’t need to call it, I don’t want to be liable for breakage when that changes later on.²

In part 1, we’re only looking to identify the correctly ordered pairs.

part1,part2 :: [Packet] -> Int
part1 = sum . map succ . findIndices (uncurry (<)) . pairs

In part 2, we’re looking for the sorted positions of two special markers called “dividers”.

part2 = let dividers = [L[L[I 2]],L[L[I 6]]] in
  product . map succ . findIndices (`elem` dividers) . sort . (dividers ++)

And that’s all there is to it!

Well, except for a little bit of boring support code.³

pairs :: [a] -> [(a,a)]
pairs (a:b:xs) = (a,b) : pairs xs
pairs [] = []
(>>>) :: (a -> b) -> (b -> c) -> a -> c
(>>>) = flip (.)
infixr 2 >>>

This concludes today’s solution. See you tomorrow!