{-|
Module:         Day24
Description:    <https://adventofcode.com/2021/day/24 Day 24: Arithmetic Logic Unit>
-}
{-# LANGUAGE DeriveFunctor, FlexibleContexts, NamedFieldPuns, OverloadedStrings, TypeFamilies #-}
module Day24 (day24) where

import Control.Monad (join)
import Data.Maybe (catMaybes, listToMaybe)
import Data.String (IsString)
import Data.Text (Text)
import Data.Void (Void)
import Text.Megaparsec (MonadParsec, ParseErrorBundle, Token, Tokens, (<|>), choice, chunk, eof, parse, sepEndBy, single)
import Text.Megaparsec.Char (newline)
import Text.Megaparsec.Char.Lexer (decimal, signed)

data Register = W | X | Y | Z

data Instruction a b
  = Inp a
  | Add a (Either a b)
  | Mul a (Either a b)
  | Div a (Either a b)
  | Mod a (Either a b)
  | Eql a (Either a b)
  deriving (a -> Instruction a b -> Instruction a a
(a -> b) -> Instruction a a -> Instruction a b
(forall a b. (a -> b) -> Instruction a a -> Instruction a b)
-> (forall a b. a -> Instruction a b -> Instruction a a)
-> Functor (Instruction a)
forall a b. a -> Instruction a b -> Instruction a a
forall a b. (a -> b) -> Instruction a a -> Instruction a b
forall a a b. a -> Instruction a b -> Instruction a a
forall a a b. (a -> b) -> Instruction a a -> Instruction a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Instruction a b -> Instruction a a
$c<$ :: forall a a b. a -> Instruction a b -> Instruction a a
fmap :: (a -> b) -> Instruction a a -> Instruction a b
$cfmap :: forall a a b. (a -> b) -> Instruction a a -> Instruction a b
Functor)

data State a = State { State a -> a
w :: !a, State a -> a
x :: !a, State a -> a
y :: !a, State a -> a
z :: !a } deriving (a -> State b -> State a
(a -> b) -> State a -> State b
(forall a b. (a -> b) -> State a -> State b)
-> (forall a b. a -> State b -> State a) -> Functor State
forall a b. a -> State b -> State a
forall a b. (a -> b) -> State a -> State b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> State b -> State a
$c<$ :: forall a b. a -> State b -> State a
fmap :: (a -> b) -> State a -> State b
$cfmap :: forall a b. (a -> b) -> State a -> State b
Functor)

get :: State a -> Register -> a
get :: State a -> Register -> a
get State { a
w :: a
w :: forall a. State a -> a
w } Register
W = a
w
get State { a
x :: a
x :: forall a. State a -> a
x } Register
X = a
x
get State { a
y :: a
y :: forall a. State a -> a
y } Register
Y = a
y
get State { a
z :: a
z :: forall a. State a -> a
z } Register
Z = a
z

set :: State a -> Register -> a -> State a
set :: State a -> Register -> a -> State a
set State a
state Register
W a
w' = State a
state { w :: a
w = a
w' }
set State a
state Register
X a
x' = State a
state { x :: a
x = a
x' }
set State a
state Register
Y a
y' = State a
state { y :: a
y = a
y' }
set State a
state Register
Z a
z' = State a
state { z :: a
z = a
z' }

parser :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) => m (Instruction Register a)
parser :: m (Instruction Register a)
parser = [m (Instruction Register a)] -> m (Instruction Register a)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ Register -> Instruction Register a
forall a b. a -> Instruction a b
Inp (Register -> Instruction Register a)
-> m Register -> m (Instruction Register a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"inp " m (Tokens s) -> m Register -> m Register
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Register
reg)
  , Register -> Either Register a -> Instruction Register a
forall a b. a -> Either a b -> Instruction a b
Add (Register -> Either Register a -> Instruction Register a)
-> m Register -> m (Either Register a -> Instruction Register a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"add " m (Tokens s) -> m Register -> m Register
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Register
reg) m (Either Register a -> Instruction Register a)
-> m (Either Register a) -> m (Instruction Register a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
' ' m Char -> m (Either Register a) -> m (Either Register a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Either Register a)
value)
  , Register -> Either Register a -> Instruction Register a
forall a b. a -> Either a b -> Instruction a b
Mul (Register -> Either Register a -> Instruction Register a)
-> m Register -> m (Either Register a -> Instruction Register a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"mul " m (Tokens s) -> m Register -> m Register
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Register
reg) m (Either Register a -> Instruction Register a)
-> m (Either Register a) -> m (Instruction Register a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
' ' m Char -> m (Either Register a) -> m (Either Register a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Either Register a)
value)
  , Register -> Either Register a -> Instruction Register a
forall a b. a -> Either a b -> Instruction a b
Div (Register -> Either Register a -> Instruction Register a)
-> m Register -> m (Either Register a -> Instruction Register a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"div " m (Tokens s) -> m Register -> m Register
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Register
reg) m (Either Register a -> Instruction Register a)
-> m (Either Register a) -> m (Instruction Register a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
' ' m Char -> m (Either Register a) -> m (Either Register a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Either Register a)
value)
  , Register -> Either Register a -> Instruction Register a
forall a b. a -> Either a b -> Instruction a b
Mod (Register -> Either Register a -> Instruction Register a)
-> m Register -> m (Either Register a -> Instruction Register a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"mod " m (Tokens s) -> m Register -> m Register
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Register
reg) m (Either Register a -> Instruction Register a)
-> m (Either Register a) -> m (Instruction Register a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
' ' m Char -> m (Either Register a) -> m (Either Register a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Either Register a)
value)
  , Register -> Either Register a -> Instruction Register a
forall a b. a -> Either a b -> Instruction a b
Eql (Register -> Either Register a -> Instruction Register a)
-> m Register -> m (Either Register a -> Instruction Register a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens s
"eql " m (Tokens s) -> m Register -> m Register
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Register
reg) m (Either Register a -> Instruction Register a)
-> m (Either Register a) -> m (Instruction Register a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
' ' m Char -> m (Either Register a) -> m (Either Register a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Either Register a)
value)
  ] where
    reg :: m Register
reg = [m Register] -> m Register
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Register
W Register -> m Char -> m Register
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
'w', Register
X Register -> m Char -> m Register
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
'x', Register
Y Register -> m Char -> m Register
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
'y', Register
Z Register -> m Char -> m Register
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
'z']
    value :: m (Either Register a)
value = (Register -> Either Register a
forall a b. a -> Either a b
Left (Register -> Either Register a)
-> m Register -> m (Either Register a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Register
reg) m (Either Register a)
-> m (Either Register a) -> m (Either Register a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Either Register a
forall a b. b -> Either a b
Right (a -> Either Register a) -> m a -> m (Either Register a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m () -> m a -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)

run :: (Integral a) => [a] -> a -> [Instruction Register a] -> State a -> Maybe a
run :: [a] -> a -> [Instruction Register a] -> State a -> Maybe a
run [a]
nums a
prefix = [Instruction Register a] -> State a -> Maybe a
run' where
    run' :: [Instruction Register a] -> State a -> Maybe a
run' [] State { z :: forall a. State a -> a
z = a
0 } = a -> Maybe a
forall a. a -> Maybe a
Just a
prefix
    run' [] State a
_ = Maybe a
forall a. Maybe a
Nothing
    run' (Instruction Register a
ins:[Instruction Register a]
rest) State a
state
      | Inp Register
a <- Instruction Register a
ins
      , (a, a) -> [Instruction Register (a, a)] -> State (a, a) -> Bool
forall a.
Integral a =>
(a, a) -> [Instruction Register (a, a)] -> State (a, a) -> Bool
runRange ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [a]
nums, [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
nums) ((a -> (a, a))
-> Instruction Register a -> Instruction Register (a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a -> (a, a)) -> a -> (a, a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (,)) (Instruction Register a -> Instruction Register (a, a))
-> [Instruction Register a] -> [Instruction Register (a, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Instruction Register a
insInstruction Register a
-> [Instruction Register a] -> [Instruction Register a]
forall a. a -> [a] -> [a]
:[Instruction Register a]
rest)) (State (a, a) -> Bool) -> State (a, a) -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> a -> (a, a)) -> a -> (a, a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (,) (a -> (a, a)) -> State a -> State (a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State a
state
      = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes [[a] -> a -> [Instruction Register a] -> State a -> Maybe a
forall a.
Integral a =>
[a] -> a -> [Instruction Register a] -> State a -> Maybe a
run [a]
nums (a
10 a -> a -> a
forall a. Num a => a -> a -> a
* a
prefix a -> a -> a
forall a. Num a => a -> a -> a
+ a
i) [Instruction Register a]
rest (State a -> Maybe a) -> State a -> Maybe a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a -> State a
forall a. State a -> Register -> a -> State a
set State a
state Register
a a
i | a
i <- [a]
nums]
      | Inp Register
_ <- Instruction Register a
ins = Maybe a
forall a. Maybe a
Nothing
      | Add Register
a Either Register a
b <- Instruction Register a
ins = [Instruction Register a] -> State a -> Maybe a
run' [Instruction Register a]
rest (State a -> Maybe a) -> State a -> Maybe a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a -> State a
forall a. State a -> Register -> a -> State a
set State a
state Register
a (a -> State a) -> a -> State a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a
forall a. State a -> Register -> a
get State a
state Register
a a -> a -> a
forall a. Num a => a -> a -> a
+ (Register -> a) -> (a -> a) -> Either Register a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (State a -> Register -> a
forall a. State a -> Register -> a
get State a
state) a -> a
forall a. a -> a
id Either Register a
b
      | Mul Register
a Either Register a
b <- Instruction Register a
ins = [Instruction Register a] -> State a -> Maybe a
run' [Instruction Register a]
rest (State a -> Maybe a) -> State a -> Maybe a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a -> State a
forall a. State a -> Register -> a -> State a
set State a
state Register
a (a -> State a) -> a -> State a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a
forall a. State a -> Register -> a
get State a
state Register
a a -> a -> a
forall a. Num a => a -> a -> a
* (Register -> a) -> (a -> a) -> Either Register a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (State a -> Register -> a
forall a. State a -> Register -> a
get State a
state) a -> a
forall a. a -> a
id Either Register a
b
      | Div Register
a Either Register a
b <- Instruction Register a
ins = [Instruction Register a] -> State a -> Maybe a
run' [Instruction Register a]
rest (State a -> Maybe a) -> State a -> Maybe a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a -> State a
forall a. State a -> Register -> a -> State a
set State a
state Register
a (a -> State a) -> a -> State a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a
forall a. State a -> Register -> a
get State a
state Register
a a -> a -> a
forall a. Integral a => a -> a -> a
`div` (Register -> a) -> (a -> a) -> Either Register a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (State a -> Register -> a
forall a. State a -> Register -> a
get State a
state) a -> a
forall a. a -> a
id Either Register a
b
      | Mod Register
a Either Register a
b <- Instruction Register a
ins = [Instruction Register a] -> State a -> Maybe a
run' [Instruction Register a]
rest (State a -> Maybe a) -> State a -> Maybe a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a -> State a
forall a. State a -> Register -> a -> State a
set State a
state Register
a (a -> State a) -> a -> State a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a
forall a. State a -> Register -> a
get State a
state Register
a a -> a -> a
forall a. Integral a => a -> a -> a
`mod` (Register -> a) -> (a -> a) -> Either Register a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (State a -> Register -> a
forall a. State a -> Register -> a
get State a
state) a -> a
forall a. a -> a
id Either Register a
b
      | Eql Register
a Either Register a
b <- Instruction Register a
ins = [Instruction Register a] -> State a -> Maybe a
run' [Instruction Register a]
rest (State a -> Maybe a) -> State a -> Maybe a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a -> State a
forall a. State a -> Register -> a -> State a
set State a
state Register
a (a -> State a) -> a -> State a
forall a b. (a -> b) -> a -> b
$ State a -> Register -> a
forall a. State a -> Register -> a
get State a
state Register
a a -> a -> a
forall a p. (Eq a, Num p) => a -> a -> p
`eql` (Register -> a) -> (a -> a) -> Either Register a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (State a -> Register -> a
forall a. State a -> Register -> a
get State a
state) a -> a
forall a. a -> a
id Either Register a
b
      where a
a eql :: a -> a -> p
`eql` a
b = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then p
1 else p
0

runRange :: (Integral a) => (a, a) -> [Instruction Register (a, a)] -> State (a, a) -> Bool
runRange :: (a, a) -> [Instruction Register (a, a)] -> State (a, a) -> Bool
runRange (a, a)
r [Instruction Register (a, a)]
ins0 State (a, a)
state0 = [Instruction Register (a, a)] -> State (a, a) -> Maybe Bool
runRange' [Instruction Register (a, a)]
ins0 State (a, a)
state0 Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False where
    runRange' :: [Instruction Register (a, a)] -> State (a, a) -> Maybe Bool
runRange' [] State { z :: forall a. State a -> a
z = (a
0, a
0) } = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    runRange' [] State { z :: forall a. State a -> a
z = (a
z0, a
z1) } = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ a
z0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 Bool -> Bool -> Bool
&& a
0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
z1
    runRange' (Instruction Register (a, a)
ins:[Instruction Register (a, a)]
rest) State (a, a)
state
      | Inp Register
a <- Instruction Register (a, a)
ins = [Instruction Register (a, a)] -> State (a, a) -> Maybe Bool
runRange' [Instruction Register (a, a)]
rest (State (a, a) -> Register -> (a, a) -> State (a, a)
forall a. State a -> Register -> a -> State a
set State (a, a)
state Register
a (a, a)
r)
      | Add Register
a Either Register (a, a)
b <- Instruction Register (a, a)
ins = [Instruction Register (a, a)] -> State (a, a) -> Maybe Bool
runRange' [Instruction Register (a, a)]
rest (State (a, a) -> Maybe Bool)
-> ((a, a) -> State (a, a)) -> (a, a) -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (a, a) -> Register -> (a, a) -> State (a, a)
forall a. State a -> Register -> a -> State a
set State (a, a)
state Register
a ((a, a) -> Maybe Bool) -> Maybe (a, a) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State (a, a) -> Register -> (a, a)
forall a. State a -> Register -> a
get State (a, a)
state Register
a (a, a) -> (a, a) -> Maybe (a, a)
forall a b. (Num a, Num b) => (a, b) -> (a, b) -> Maybe (a, b)
+: (Register -> (a, a))
-> ((a, a) -> (a, a)) -> Either Register (a, a) -> (a, a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (State (a, a) -> Register -> (a, a)
forall a. State a -> Register -> a
get State (a, a)
state) (a, a) -> (a, a)
forall a. a -> a
id Either Register (a, a)
b
      | Mul Register
a Either Register (a, a)
b <- Instruction Register (a, a)
ins = [Instruction Register (a, a)] -> State (a, a) -> Maybe Bool
runRange' [Instruction Register (a, a)]
rest (State (a, a) -> Maybe Bool)
-> ((a, a) -> State (a, a)) -> (a, a) -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (a, a) -> Register -> (a, a) -> State (a, a)
forall a. State a -> Register -> a -> State a
set State (a, a)
state Register
a ((a, a) -> Maybe Bool) -> Maybe (a, a) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State (a, a) -> Register -> (a, a)
forall a. State a -> Register -> a
get State (a, a)
state Register
a (a, a) -> (a, a) -> Maybe (a, a)
forall b. (Ord b, Num b) => (b, b) -> (b, b) -> Maybe (b, b)
*: (Register -> (a, a))
-> ((a, a) -> (a, a)) -> Either Register (a, a) -> (a, a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (State (a, a) -> Register -> (a, a)
forall a. State a -> Register -> a
get State (a, a)
state) (a, a) -> (a, a)
forall a. a -> a
id Either Register (a, a)
b
      | Div Register
a Either Register (a, a)
b <- Instruction Register (a, a)
ins = [Instruction Register (a, a)] -> State (a, a) -> Maybe Bool
runRange' [Instruction Register (a, a)]
rest (State (a, a) -> Maybe Bool)
-> ((a, a) -> State (a, a)) -> (a, a) -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (a, a) -> Register -> (a, a) -> State (a, a)
forall a. State a -> Register -> a -> State a
set State (a, a)
state Register
a ((a, a) -> Maybe Bool) -> Maybe (a, a) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State (a, a) -> Register -> (a, a)
forall a. State a -> Register -> a
get State (a, a)
state Register
a (a, a) -> (a, a) -> Maybe (a, a)
forall b. Integral b => (b, b) -> (b, b) -> Maybe (b, b)
/: (Register -> (a, a))
-> ((a, a) -> (a, a)) -> Either Register (a, a) -> (a, a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (State (a, a) -> Register -> (a, a)
forall a. State a -> Register -> a
get State (a, a)
state) (a, a) -> (a, a)
forall a. a -> a
id Either Register (a, a)
b
      | Mod Register
a Either Register (a, a)
b <- Instruction Register (a, a)
ins = [Instruction Register (a, a)] -> State (a, a) -> Maybe Bool
runRange' [Instruction Register (a, a)]
rest (State (a, a) -> Maybe Bool)
-> ((a, a) -> State (a, a)) -> (a, a) -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (a, a) -> Register -> (a, a) -> State (a, a)
forall a. State a -> Register -> a -> State a
set State (a, a)
state Register
a ((a, a) -> Maybe Bool) -> Maybe (a, a) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State (a, a) -> Register -> (a, a)
forall a. State a -> Register -> a
get State (a, a)
state Register
a (a, a) -> (a, a) -> Maybe (a, a)
forall b. Integral b => (b, b) -> (b, b) -> Maybe (b, b)
%: (Register -> (a, a))
-> ((a, a) -> (a, a)) -> Either Register (a, a) -> (a, a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (State (a, a) -> Register -> (a, a)
forall a. State a -> Register -> a
get State (a, a)
state) (a, a) -> (a, a)
forall a. a -> a
id Either Register (a, a)
b
      | Eql Register
a Either Register (a, a)
b <- Instruction Register (a, a)
ins = [Instruction Register (a, a)] -> State (a, a) -> Maybe Bool
runRange' [Instruction Register (a, a)]
rest (State (a, a) -> Maybe Bool)
-> ((a, a) -> State (a, a)) -> (a, a) -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (a, a) -> Register -> (a, a) -> State (a, a)
forall a. State a -> Register -> a -> State a
set State (a, a)
state Register
a ((a, a) -> Maybe Bool) -> Maybe (a, a) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< State (a, a) -> Register -> (a, a)
forall a. State a -> Register -> a
get State (a, a)
state Register
a (a, a) -> (a, a) -> Maybe (a, a)
forall a a b.
(Num a, Num b, Ord a) =>
(a, a) -> (a, a) -> Maybe (a, b)
=: (Register -> (a, a))
-> ((a, a) -> (a, a)) -> Either Register (a, a) -> (a, a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (State (a, a) -> Register -> (a, a)
forall a. State a -> Register -> a
get State (a, a)
state) (a, a) -> (a, a)
forall a. a -> a
id Either Register (a, a)
b
    (a
a, b
b) +: :: (a, b) -> (a, b) -> Maybe (a, b)
+: (a
c, b
d) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
c, b
b b -> b -> b
forall a. Num a => a -> a -> a
+ b
d)
    (b
a, b
b) *: :: (b, b) -> (b, b) -> Maybe (b, b)
*: (b
c, b
d)
      | b
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
0 Bool -> Bool -> Bool
&& b
c b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
0 = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
a b -> b -> b
forall a. Num a => a -> a -> a
* b
c, b
b b -> b -> b
forall a. Num a => a -> a -> a
* b
d)
      | b
b b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 Bool -> Bool -> Bool
&& b
d b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
b b -> b -> b
forall a. Num a => a -> a -> a
* b
d, b
a b -> b -> b
forall a. Num a => a -> a -> a
* b
c)
      | b
a b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
0 Bool -> Bool -> Bool
&& b
d b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
a b -> b -> b
forall a. Num a => a -> a -> a
* b
d, b
b b -> b -> b
forall a. Num a => a -> a -> a
* b
c)
      | b
b b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 Bool -> Bool -> Bool
&& b
c b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
0 = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
b b -> b -> b
forall a. Num a => a -> a -> a
* b
c, b
a b -> b -> b
forall a. Num a => a -> a -> a
* b
d)
      | [b]
xs <- [b
0, b
a b -> b -> b
forall a. Num a => a -> a -> a
* b
c, b
a b -> b -> b
forall a. Num a => a -> a -> a
* b
d, b
b b -> b -> b
forall a. Num a => a -> a -> a
* b
c, b
b b -> b -> b
forall a. Num a => a -> a -> a
* b
d] = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just ([b] -> b
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [b]
xs, [b] -> b
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [b]
xs)
    (b
a, b
b) /: :: (b, b) -> (b, b) -> Maybe (b, b)
/: (b
c, b
d)
      | b
c b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0 = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
a b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
d, b
b b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
c)
      | b
d b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0 = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
a b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
c, b
b b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
d)
      | Bool
otherwise = Maybe (b, b)
forall a. Maybe a
Nothing
    (a
a, a
b) %: :: (a, a) -> (a, a) -> Maybe (a, a)
%: (a
c, a
d)
      | a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 Bool -> Bool -> Bool
&& a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just ((a, a) -> Maybe (a, a)) -> (a, a) -> Maybe (a, a)
forall a b. (a -> b) -> a -> b
$ if a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
c Bool -> Bool -> Bool
&& a
a a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
c
        then (a
a a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
c, a
b a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
c)
        else (a
0, a
c a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
      | Bool
otherwise = Maybe (a, a)
forall a. Maybe a
Nothing
    (a
a, a
b) =: :: (a, a) -> (a, a) -> Maybe (a, b)
=: (a
c, a
d)
      | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
1, b
1)
      | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
d Bool -> Bool -> Bool
&& a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
d = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
0, b
1)
      | Bool
otherwise = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
0, b
0)

day24 :: Text -> Either (ParseErrorBundle Text Void) (Maybe (Integer, Integer))
day24 :: Text
-> Either (ParseErrorBundle Text Void) (Maybe (Integer, Integer))
day24 Text
input = do
    [Instruction Register Integer]
ins <- Parsec Void Text [Instruction Register Integer]
-> String
-> Text
-> Either
     (ParseErrorBundle Text Void) [Instruction Register Integer]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void Text Identity (Instruction Register Integer)
forall e s (m :: * -> *) a.
(MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) =>
m (Instruction Register a)
parser ParsecT Void Text Identity (Instruction Register Integer)
-> ParsecT Void Text Identity Char
-> Parsec Void Text [Instruction Register Integer]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline Parsec Void Text [Instruction Register Integer]
-> ParsecT Void Text Identity ()
-> Parsec Void Text [Instruction Register Integer]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" Text
input
    Maybe (Integer, Integer)
-> Either (ParseErrorBundle Text Void) (Maybe (Integer, Integer))
forall a b. b -> Either a b
Right (Maybe (Integer, Integer)
 -> Either (ParseErrorBundle Text Void) (Maybe (Integer, Integer)))
-> Maybe (Integer, Integer)
-> Either (ParseErrorBundle Text Void) (Maybe (Integer, Integer))
forall a b. (a -> b) -> a -> b
$ (,) (Integer -> Integer -> (Integer, Integer))
-> Maybe Integer -> Maybe (Integer -> (Integer, Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer]
-> Integer
-> [Instruction Register Integer]
-> State Integer
-> Maybe Integer
forall a.
Integral a =>
[a] -> a -> [Instruction Register a] -> State a -> Maybe a
run [Integer
9, Integer
8..Integer
1] Integer
0 [Instruction Register Integer]
ins (Integer -> Integer -> Integer -> Integer -> State Integer
forall a. a -> a -> a -> a -> State a
State Integer
0 Integer
0 Integer
0 Integer
0) Maybe (Integer -> (Integer, Integer))
-> Maybe Integer -> Maybe (Integer, Integer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Integer]
-> Integer
-> [Instruction Register Integer]
-> State Integer
-> Maybe Integer
forall a.
Integral a =>
[a] -> a -> [Instruction Register a] -> State a -> Maybe a
run [Integer
1..Integer
9] Integer
0 [Instruction Register Integer]
ins (Integer -> Integer -> Integer -> Integer -> State Integer
forall a. a -> a -> a -> a -> State a
State Integer
0 Integer
0 Integer
0 Integer
0)