{-|
Module:         Day2
Description:    <https://adventofcode.com/2021/day/2 Day 2: Dive!>
-}
{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
module Day2 (day2a, day2b) where

import Common (readEntire)
import Control.Arrow (first)
import Data.List (foldl')
import Data.Text (Text)
import qualified Data.Text as T (lines, stripPrefix)
import qualified Data.Text.Read as T (decimal)
import Data.Text.Read (Reader)

data Move a = Horizontal a | Vertical a

move :: (Integral a) => Reader (Move a)
move :: Reader (Move a)
move (Text -> Text -> Maybe Text
T.stripPrefix Text
"forward " -> Just Text
f) = (a -> Move a) -> (a, Text) -> (Move a, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> Move a
forall a. a -> Move a
Horizontal ((a, Text) -> (Move a, Text))
-> Either String (a, Text) -> Either String (Move a, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader a
forall a. Integral a => Reader a
T.decimal Text
f
move (Text -> Text -> Maybe Text
T.stripPrefix Text
"down " -> Just Text
d) = (a -> Move a) -> (a, Text) -> (Move a, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> Move a
forall a. a -> Move a
Vertical ((a, Text) -> (Move a, Text))
-> Either String (a, Text) -> Either String (Move a, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader a
forall a. Integral a => Reader a
T.decimal Text
d
move (Text -> Text -> Maybe Text
T.stripPrefix Text
"up " -> Just Text
u) = (a -> Move a) -> (a, Text) -> (Move a, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a -> Move a
forall a. a -> Move a
Vertical (a -> Move a) -> (a -> a) -> a -> Move a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
negate) ((a, Text) -> (Move a, Text))
-> Either String (a, Text) -> Either String (Move a, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader a
forall a. Integral a => Reader a
T.decimal Text
u
move Text
_ = String -> Either String (Move a, Text)
forall a b. a -> Either a b
Left String
"no parse"

day2a :: Text -> Either String Int
day2a :: Text -> Either String Int
day2a Text
input = do
    [Move Int]
moves <- (Text -> Either String (Move Int))
-> [Text] -> Either String [Move Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Reader (Move Int) -> Text -> Either String (Move Int)
forall a. Reader a -> Text -> Either String a
readEntire Reader (Move Int)
forall a. Integral a => Reader (Move a)
move) ([Text] -> Either String [Move Int])
-> [Text] -> Either String [Move Int]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
input
    let x :: Int
x = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int
d | Horizontal Int
d <- [Move Int]
moves]
        y :: Int
y = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int
d | Vertical Int
d <- [Move Int]
moves]
    Int -> Either String Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either String Int) -> Int -> Either String Int
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y

day2b :: Text -> Either String Int
day2b :: Text -> Either String Int
day2b Text
input = do
    [Move Int]
moves <- (Text -> Either String (Move Int))
-> [Text] -> Either String [Move Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Reader (Move Int) -> Text -> Either String (Move Int)
forall a. Reader a -> Text -> Either String a
readEntire Reader (Move Int)
forall a. Integral a => Reader (Move a)
move) ([Text] -> Either String [Move Int])
-> [Text] -> Either String [Move Int]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
input
    let (Int
x, Int
y, Int
_) = ((Int, Int, Int) -> Move Int -> (Int, Int, Int))
-> (Int, Int, Int) -> [Move Int] -> (Int, Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int, Int) -> Move Int -> (Int, Int, Int)
forall a. Num a => (a, a, a) -> Move a -> (a, a, a)
step (Int
0, Int
0, Int
0) [Move Int]
moves
        step :: (a, a, a) -> Move a -> (a, a, a)
step (a
x0, a
y0, a
z) (Horizontal a
d) = (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
d, a
y0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
d a -> a -> a
forall a. Num a => a -> a -> a
* a
z, a
z)
        step (a
x0, a
y0, a
z) (Vertical a
d) = (a
x0, a
y0, a
z a -> a -> a
forall a. Num a => a -> a -> a
+ a
d)
    Int -> Either String Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either String Int) -> Int -> Either String Int
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y