AoC 2021/02

01.hs

module Main (main) where

import Data.ByteString.Char8 qualified as B
import Y2021.D02.Movement

main :: IO ()
main = do
    ds <- B.getContents >>= parseAllIO . B.lines
    let Pos (Depth d, Horizontal h) = travel ds
    print $ d * h

travel :: Foldable t => t Direction -> Pos
travel = foldMap $ \case
    Up      d -> pos (negate d) 0
    Down    d -> pos d          0
    Forward h -> pos 0          h

02.hs

module Main (main) where

import Data.ByteString.Char8 qualified as B
import Control.Monad.Trans.Accum
import Data.Monoid (Ap(..))
import Y2021.D02.Movement

main :: IO ()
main = do
    ds <- B.getContents >>= parseAllIO . B.lines
    let Pos (Depth d, Horizontal h) = evalAccum (getAp (travel ds)) mempty
    print $ d * h

type Aim = Depth

travel :: Foldable t => t Direction -> Ap (Accum Aim) Pos
travel = foldMap $ Ap . \case
    Down    d -> mempty <$ add d
    Up      d -> mempty <$ add (negate d)
    Forward h -> looks $ \a -> pos (a * fromIntegral h) h

Movement.hs

{-# Language OverloadedStrings #-}

module Y2021.D02.Movement where

import Data.Attoparsec.ByteString.Char8
import Data.ByteString (ByteString)
import Data.Bifunctor.Biap
import Data.Monoid (Sum(..))
import UnliftIO.Exception

newtype Depth = Depth Int
    deriving stock (Show, Eq, Ord, Bounded)
    deriving newtype (Enum, Num, Real, Integral)
    deriving (Semigroup, Monoid) via Sum Int
newtype Horizontal = Horizontal Int
    deriving stock (Show, Eq, Ord, Bounded)
    deriving newtype (Enum, Num, Real, Integral)
    deriving (Semigroup, Monoid) via Sum Int
newtype Pos = Pos (Depth, Horizontal)
    deriving stock (Show, Eq, Ord, Bounded)
    deriving newtype (Semigroup, Monoid)
    deriving Num via Biap (,) Depth Horizontal

class Parsable t where
    parser :: Parser t

parseAllIO :: Parsable t => [ByteString] -> IO [t]
parseAllIO = either throwString pure . traverse (parseOnly parser)

data Direction = Up Depth | Down Depth | Forward Horizontal
    deriving stock (Show, Eq, Ord)

instance Parsable Direction where
    parser = choice
        [ "up "      *> (Up      <$> decimal)
        , "down "    *> (Down    <$> decimal)
        , "forward " *> (Forward <$> decimal) ]

pos :: Depth -> Horizontal -> Pos
pos d h = Pos (d,h)