{-# LANGUAGE ImportQualifiedPost, DeriveFunctor, OverloadedStrings #-}
{-|
Module      : Main
Description : Day 7 solution
Copyright   : (c) Eric Mertens, 2015
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2015/day/7>

>>> :{
mapM_
  (\(k,v) -> putStrLn (k ++ ": " ++ show v))
  (Map.assocs (tieCircuit (parse [
    "123 -> x",
    "456 -> y",
    "x AND y -> d",
    "x OR y -> e",
    "x LSHIFT 2 -> f",
    "y RSHIFT 2 -> g",
    "NOT x -> h",
    "NOT y -> i"])))
:}
d: 72
e: 507
f: 492
g: 114
h: 65412
i: 65079
x: 123
y: 456

-}
module Main where

import Advent (getInputLines)
import Advent.ReadS (P(..), runP, (<++))
import Control.Applicative ((<|>))
import Data.Bits (Bits(shiftL, complement, (.&.), (.|.), shiftR))
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Word (Word16)

data Gate a = Gate1 Op1 a | Gate2 a Op2 a deriving (forall a b. (a -> b) -> Gate a -> Gate b)
-> (forall a b. a -> Gate b -> Gate a) -> Functor Gate
forall a b. a -> Gate b -> Gate a
forall a b. (a -> b) -> Gate a -> Gate b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Gate a -> Gate b
fmap :: forall a b. (a -> b) -> Gate a -> Gate b
$c<$ :: forall a b. a -> Gate b -> Gate a
<$ :: forall a b. a -> Gate b -> Gate a
Functor
data Op1 = Not | Id
data Op2 = And | Or | LShift | RShift

-- |
-- >>> :main
-- 16076
-- 2797
main :: IO ()
IO ()
main =
 do Map String (Gate (Either Word16 String))
circuit1 <- [String] -> Map String (Gate (Either Word16 String))
parse ([String] -> Map String (Gate (Either Word16 String)))
-> IO [String] -> IO (Map String (Gate (Either Word16 String)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> IO [String]
getInputLines Int
2015 Int
7
    let answer1 :: Word16
answer1 = Map String (Gate (Either Word16 String)) -> Word16
findAnswer Map String (Gate (Either Word16 String))
circuit1
    Word16 -> IO ()
forall a. Show a => a -> IO ()
print Word16
answer1

    let circuit2 :: Map String (Gate (Either Word16 String))
circuit2 = String
-> Gate (Either Word16 String)
-> Map String (Gate (Either Word16 String))
-> Map String (Gate (Either Word16 String))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
"b" (Op1 -> Either Word16 String -> Gate (Either Word16 String)
forall a. Op1 -> a -> Gate a
Gate1 Op1
Id (Word16 -> Either Word16 String
forall a b. a -> Either a b
Left Word16
answer1)) Map String (Gate (Either Word16 String))
circuit1
    Word16 -> IO ()
forall a. Show a => a -> IO ()
print (Map String (Gate (Either Word16 String)) -> Word16
findAnswer Map String (Gate (Either Word16 String))
circuit2)

-- | Build a circuit and compute output 'a'
findAnswer :: Map String (Gate (Either Word16 String)) -> Word16
findAnswer :: Map String (Gate (Either Word16 String)) -> Word16
findAnswer Map String (Gate (Either Word16 String))
circuit = Map String (Gate (Either Word16 String)) -> Map String Word16
tieCircuit Map String (Gate (Either Word16 String))
circuit Map String Word16 -> String -> Word16
forall k a. Ord k => Map k a -> k -> a
Map.! String
"a"

tieCircuit :: Map String (Gate (Either Word16 String)) -> Map String Word16
tieCircuit :: Map String (Gate (Either Word16 String)) -> Map String Word16
tieCircuit Map String (Gate (Either Word16 String))
m = Map String Word16
m'
  where
  m' :: Map String Word16
m' = (Gate (Either Word16 String) -> Word16)
-> Map String (Gate (Either Word16 String)) -> Map String Word16
forall a b. (a -> b) -> Map String a -> Map String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Gate Word16 -> Word16
evalGate (Gate Word16 -> Word16)
-> (Gate (Either Word16 String) -> Gate Word16)
-> Gate (Either Word16 String)
-> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Word16 String -> Word16)
-> Gate (Either Word16 String) -> Gate Word16
forall a b. (a -> b) -> Gate a -> Gate b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Word16 String -> Word16
evalKey) Map String (Gate (Either Word16 String))
m

  evalKey :: Either Word16 String -> Word16
evalKey (Left Word16
lit) = Word16
lit
  evalKey (Right String
var) = Map String Word16
m' Map String Word16 -> String -> Word16
forall k a. Ord k => Map k a -> k -> a
Map.! String
var

evalGate :: Gate Word16 -> Word16
evalGate :: Gate Word16 -> Word16
evalGate (Gate1   Op1
Id     Word16
x) = Word16
x
evalGate (Gate1   Op1
Not    Word16
x) = Word16 -> Word16
forall a. Bits a => a -> a
complement Word16
x
evalGate (Gate2 Word16
x Op2
And    Word16
y) = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
y
evalGate (Gate2 Word16
x Op2
Or     Word16
y) = Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
y
evalGate (Gate2 Word16
x Op2
RShift Word16
y) = Word16
x Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y
evalGate (Gate2 Word16
x Op2
LShift Word16
y) = Word16
x Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y

-- * Parsing

parse :: [String] -> Map String (Gate (Either Word16 String))
parse :: [String] -> Map String (Gate (Either Word16 String))
parse = [(String, Gate (Either Word16 String))]
-> Map String (Gate (Either Word16 String))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Gate (Either Word16 String))]
 -> Map String (Gate (Either Word16 String)))
-> ([String] -> [(String, Gate (Either Word16 String))])
-> [String]
-> Map String (Gate (Either Word16 String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (String, Gate (Either Word16 String)))
-> [String] -> [(String, Gate (Either Word16 String))]
forall a b. (a -> b) -> [a] -> [b]
map (P (String, Gate (Either Word16 String))
-> String -> (String, Gate (Either Word16 String))
forall a. P a -> String -> a
runP P (String, Gate (Either Word16 String))
pCmd)

pCmd :: P (String, Gate (Either Word16 String))
pCmd :: P (String, Gate (Either Word16 String))
pCmd = (String
 -> Gate (Either Word16 String)
 -> (String, Gate (Either Word16 String)))
-> Gate (Either Word16 String)
-> String
-> (String, Gate (Either Word16 String))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (Gate (Either Word16 String)
 -> String -> (String, Gate (Either Word16 String)))
-> P (Gate (Either Word16 String))
-> P (String -> (String, Gate (Either Word16 String)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Gate (Either Word16 String))
pGate P (String -> (String, Gate (Either Word16 String)))
-> P String -> P (String -> (String, Gate (Either Word16 String)))
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P String
"->" P (String -> (String, Gate (Either Word16 String)))
-> P String -> P (String, Gate (Either Word16 String))
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadS String -> P String
forall a. ReadS a -> P a
P ReadS String
lex

pGate :: P (Gate (Either Word16 String))
pGate :: P (Gate (Either Word16 String))
pGate =
  Op1 -> Either Word16 String -> Gate (Either Word16 String)
forall a. Op1 -> a -> Gate a
Gate1 (Op1 -> Either Word16 String -> Gate (Either Word16 String))
-> P Op1 -> P (Either Word16 String -> Gate (Either Word16 String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>          P Op1
pOp1 P (Either Word16 String -> Gate (Either Word16 String))
-> P (Either Word16 String) -> P (Gate (Either Word16 String))
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Either Word16 String)
pArg P (Gate (Either Word16 String))
-> P (Gate (Either Word16 String))
-> P (Gate (Either Word16 String))
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Either Word16 String
-> Op2 -> Either Word16 String -> Gate (Either Word16 String)
forall a. a -> Op2 -> a -> Gate a
Gate2 (Either Word16 String
 -> Op2 -> Either Word16 String -> Gate (Either Word16 String))
-> P (Either Word16 String)
-> P (Op2 -> Either Word16 String -> Gate (Either Word16 String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Either Word16 String)
pArg P (Op2 -> Either Word16 String -> Gate (Either Word16 String))
-> P Op2 -> P (Either Word16 String -> Gate (Either Word16 String))
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Op2
pOp2 P (Either Word16 String -> Gate (Either Word16 String))
-> P (Either Word16 String) -> P (Gate (Either Word16 String))
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P (Either Word16 String)
pArg

pOp1 :: P Op1
pOp1 :: P Op1
pOp1 = Op1 -> P Op1
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op1
Id P Op1 -> P Op1 -> P Op1
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Op1
Not Op1 -> P String -> P Op1
forall a b. a -> P b -> P a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P String
"NOT"

pOp2 :: P Op2
pOp2 :: P Op2
pOp2 = Op2
And Op2 -> P String -> P Op2
forall a b. a -> P b -> P a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P String
"AND" P Op2 -> P Op2 -> P Op2
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Op2
Or Op2 -> P String -> P Op2
forall a b. a -> P b -> P a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P String
"OR" P Op2 -> P Op2 -> P Op2
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Op2
LShift Op2 -> P String -> P Op2
forall a b. a -> P b -> P a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P String
"LSHIFT" P Op2 -> P Op2 -> P Op2
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Op2
RShift Op2 -> P String -> P Op2
forall a b. a -> P b -> P a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P String
"RSHIFT"

pArg :: P (Either Word16 String)
pArg :: P (Either Word16 String)
pArg = Word16 -> Either Word16 String
forall a b. a -> Either a b
Left (Word16 -> Either Word16 String)
-> P Word16 -> P (Either Word16 String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadS Word16 -> P Word16
forall a. ReadS a -> P a
P ReadS Word16
forall a. Read a => ReadS a
reads P (Either Word16 String)
-> P (Either Word16 String) -> P (Either Word16 String)
forall a. P a -> P a -> P a
<++ String -> Either Word16 String
forall a b. b -> Either a b
Right (String -> Either Word16 String)
-> P String -> P (Either Word16 String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadS String -> P String
forall a. ReadS a -> P a
P ReadS String
lex