Advent Of Code 2019, Day 2

Day2.hs

{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}

module Day2
  ( main
  )
where

import           Control.Monad.State            ( State
                                                , MonadState
                                                , get
                                                , gets
                                                , put
                                                , modify
                                                , evalState
                                                )
import           Data.Bifunctor                 ( first )
import           Data.List.Split                ( splitOn )
import           Data.Maybe                     ( maybe )
import           Data.Sequence                  ( Seq((:<|)) )
import qualified Data.Sequence                 as Seq
import           Data.Traversable               ( traverse )

type Intcode = Seq Int

newtype Pos = Pos Int

data Op = Add Pos Pos Pos | Mult Pos Pos Pos

newtype Machine a =
  Machine { runMachine :: State (Intcode, Pos) a }
    deriving (Functor, Applicative, Monad, MonadState (Intcode, Pos))

getValue :: Pos -> Machine Int
getValue (Pos pos) = gets ((`Seq.index` pos) . fst)

setValue :: Pos -> Int -> Machine ()
setValue (Pos pos) val = modify (first $ Seq.update pos val)

run :: [(Pos, Int)] -> Intcode -> Int
run seed intcode = evalState (runMachine (initialise >> run')) (intcode, Pos 0)
 where
  initialise = traverse (\(pos, val) -> setValue pos val) seed
  run'       = nextOp >>= maybe (getValue (Pos 0)) (\op -> execute op >> run')

nextOp :: Machine (Maybe Op)
nextOp = do
  (intcode, (Pos pc)) <- get
  put (intcode, (Pos $ pc + 4))
  pure $ decode (Seq.drop pc intcode)
 where
  decode (1 :<| p0 :<| p1 :<| p2 :<| _) = Just $ Add  (Pos p0) (Pos p1) (Pos p2)
  decode (2 :<| p0 :<| p1 :<| p2 :<| _) = Just $ Mult (Pos p0) (Pos p1) (Pos p2)
  decode _ = Nothing

execute :: Op -> Machine ()
execute (Add  p0 p1 p2) = execute' p0 p1 p2 (+)
execute (Mult p0 p1 p2) = execute' p0 p1 p2 (*)

execute' :: Pos -> Pos -> Pos -> (Int -> Int -> Int) -> Machine ()
execute' p0 p1 p2 f = do
  v0 <- getValue p0
  v1 <- getValue p1
  let v2 = f v0 v1
  setValue p2 v2

partOne :: Intcode -> Int
partOne = run seed 
  where seed = [((Pos 1), 12), ((Pos 2), 2)]

partTwo :: Intcode -> Int
partTwo intcode = head
  [ 100 * noun + verb
  | noun <- [0 .. 99]
  , verb <- [0 .. 99]
  , run [(Pos 1, noun), (Pos 2, verb)] intcode == 19690720
  ]

main :: IO ()
main = do
  intcode <- parse <$> getContents
  let p1 = partOne intcode
  print p1
  let p2 = partTwo intcode
  print p2
  where parse = Seq.fromList . fmap (read @Int) . splitOn ","