{-# Language QuasiQuotes, TemplateHaskell #-}
{-|
Module      : Main
Description : Day 2 solution
Copyright   : (c) Eric Mertens, 2021
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2021/day/2>

Implement a simple submarine piloting/aiming command interpreter.

-}
module Main (main) where

import Advent (format, stageTH)
import Data.Foldable (foldMap')

-- | Three possible commands a submarine can receive.
data C = Cforward | Cdown | Cup

stageTH

-- | >>> :main
-- 1636725
-- 1872757425
main :: IO ()
IO ()
main =
 do [(C, Int)]
inp <- [format|2021 2 (@C %u%n)*|]
    case ((C, Int) -> S) -> [(C, Int)] -> S
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (C, Int) -> S
toS [(C, Int)]
inp of
      S Int
dx Int
dy1 Int
dy2 ->
       do Int -> IO ()
forall a. Show a => a -> IO ()
print (Int
dxInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
dy1)
          Int -> IO ()
forall a. Show a => a -> IO ()
print (Int
dxInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
dy2)

-- | Computes the individual effect of a single instruction on a submarine.
toS :: (C, Int) -> S
toS :: (C, Int) -> S
toS (C
c,Int
n) =
  case C
c of
    C
Cup      -> Int -> Int -> Int -> S
S Int
0 (-Int
n) Int
0
    C
Cdown    -> Int -> Int -> Int -> S
S Int
0 Int
n    Int
0
    C
Cforward -> Int -> Int -> Int -> S
S Int
n Int
0    Int
0

-- | Tracks the current state of the submarine's x displacement
-- as well as the displacement for parts 1 and 2
data S = S !Int !Int !Int -- dx dy1 dy2
  deriving Int -> S -> ShowS
[S] -> ShowS
S -> String
(Int -> S -> ShowS) -> (S -> String) -> ([S] -> ShowS) -> Show S
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> S -> ShowS
showsPrec :: Int -> S -> ShowS
$cshow :: S -> String
show :: S -> String
$cshowList :: [S] -> ShowS
showList :: [S] -> ShowS
Show

-- | A submarine that hasn't moved and is at the origin.
instance Monoid S where mempty :: S
mempty = Int -> Int -> Int -> S
S Int
0 Int
0 Int
0

-- | Composes two submarine movements from left to right.
instance Semigroup S where S Int
x1 Int
y1 Int
z1 <> :: S -> S -> S
<> S Int
x2 Int
y2 Int
z2 = Int -> Int -> Int -> S
S (Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
x2) (Int
y1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y2) (Int
z1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
z2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y1Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x2)