{-|
Module:         Day10
Description:    <https://adventofcode.com/2021/day/10 Day 10: Syntax Scoring>
-}
module Day10 (day10a, day10b) where

import Control.Monad ((<=<), foldM)
import Data.Either (lefts)
import Data.List (sort)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T (lines, unpack)

day10a :: Text -> Int
day10a :: Text -> Int
day10a Text
input = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [Either Int [Char]] -> [Int]
forall a b. [Either a b] -> [a]
lefts ([Either Int [Char]] -> [Int]) -> [Either Int [Char]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Char] -> Either Int [Char]
forall a. Num a => [Char] -> Either a [Char]
points ([Char] -> Either Int [Char])
-> (Text -> [Char]) -> Text -> Either Int [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> Either Int [Char]) -> [Text] -> [Either Int [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.lines Text
input where
    points :: [Char] -> Either a [Char]
points (Char
'(':[Char]
xs) = [Char] -> Either a [Char]
points [Char]
xs Either a [Char] -> ([Char] -> Either a [Char]) -> Either a [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> [Char] -> Either a [Char]
score Char
')'
    points (Char
'[':[Char]
xs) = [Char] -> Either a [Char]
points [Char]
xs Either a [Char] -> ([Char] -> Either a [Char]) -> Either a [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> [Char] -> Either a [Char]
score Char
']'
    points (Char
'{':[Char]
xs) = [Char] -> Either a [Char]
points [Char]
xs Either a [Char] -> ([Char] -> Either a [Char]) -> Either a [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> [Char] -> Either a [Char]
score Char
'}'
    points (Char
'<':[Char]
xs) = [Char] -> Either a [Char]
points [Char]
xs Either a [Char] -> ([Char] -> Either a [Char]) -> Either a [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> [Char] -> Either a [Char]
score Char
'>'
    points [Char]
xs = [Char] -> Either a [Char]
forall a b. b -> Either a b
Right [Char]
xs
    score :: Char -> [Char] -> Either a [Char]
score Char
c (Char
x:[Char]
xs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x = [Char] -> Either a [Char]
points [Char]
xs
    score Char
_ (Char
')':[Char]
_) = a -> Either a [Char]
forall a b. a -> Either a b
Left a
3
    score Char
_ (Char
']':[Char]
_) = a -> Either a [Char]
forall a b. a -> Either a b
Left a
57
    score Char
_ (Char
'}':[Char]
_) = a -> Either a [Char]
forall a b. a -> Either a b
Left a
1197
    score Char
_ (Char
'>':[Char]
_) = a -> Either a [Char]
forall a b. a -> Either a b
Left a
25137
    score Char
_ [Char]
xs = [Char] -> Either a [Char]
points [Char]
xs

day10b :: Text -> Maybe Int
day10b :: Text -> Maybe Int
day10b Text
input = [Int] -> Maybe Int
forall a. Ord a => [a] -> Maybe a
median ([Int] -> Maybe Int) -> [Int] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe Int) -> [[Char]] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Int -> Char -> Maybe Int) -> Int -> [Char] -> Maybe Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Int -> Char -> Maybe Int
forall a. Num a => a -> Char -> Maybe a
score Int
0 ([Char] -> Maybe Int)
-> ([Char] -> Maybe [Char]) -> [Char] -> Maybe Int
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Char] -> [Char] -> Maybe [Char]
points [Char]
"") ([[Char]] -> [Int]) -> [[Char]] -> [Int]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> [Text] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.lines Text
input where
    points :: [Char] -> [Char] -> Maybe [Char]
points [Char]
cs (Char
'(':[Char]
xs) = [Char] -> [Char] -> Maybe [Char]
points (Char
')'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs) [Char]
xs
    points [Char]
cs (Char
'[':[Char]
xs) = [Char] -> [Char] -> Maybe [Char]
points (Char
']'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs) [Char]
xs
    points [Char]
cs (Char
'{':[Char]
xs) = [Char] -> [Char] -> Maybe [Char]
points (Char
'}'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs) [Char]
xs
    points [Char]
cs (Char
'<':[Char]
xs) = [Char] -> [Char] -> Maybe [Char]
points (Char
'>'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs) [Char]
xs
    points (Char
c:[Char]
cs) (Char
x:[Char]
xs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x = [Char] -> [Char] -> Maybe [Char]
points [Char]
cs [Char]
xs
    points [Char]
cs [] = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
cs
    points [Char]
_ [Char]
_ = Maybe [Char]
forall a. Maybe a
Nothing
    score :: a -> Char -> Maybe a
score a
x Char
')' = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
5 a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
    score a
x Char
']' = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
5 a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
2
    score a
x Char
'}' = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
5 a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
3
    score a
x Char
'>' = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
5 a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
4
    score a
_ Char
_ = Maybe a
forall a. Maybe a
Nothing
    median :: [a] -> Maybe a
median [] = Maybe a
forall a. Maybe a
Nothing
    median [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
xs [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)