Advent of code #2 Haskell solution

Question

I've tried to solve AoC day 2 challenge in Haskell (here - don't worry, it's not a competition so sharing a solution here is OK).

The goal is to implement a very simple VM with opcodes 1 (add), 2 (mult) and 99 (exit).

I feel like my solution is incredibly verbose. That maybe be because I rely heavily on the state monad (my background is imperative programming, so there's that). Is there anything I could improve without rewriting the whole solution?

Here's my code, thanks for all suggestions:

import Data.Sequence
import Control.Monad.State
import Data.List.Split

data Machine = Machine {
    mState :: Seq Int,
    mPos :: Int,
    isDone :: Bool
}

opReadHead :: State Machine Int
opReadHead = do
    machine <- get
    return $ index (mState machine) (mPos machine)

opReadAt :: Int -> State Machine Int
opReadAt target = do
    machine <- get
    return $ index (mState machine) target

opForward :: State Machine ()
opForward = do
    machine <- get
    put $ machine { mPos = mPos machine + 1 }

opWrite :: Int -> Int -> State Machine ()
opWrite target what = do
    machine <- get
    put $ machine { mState = update target what (mState machine) }

opReadNext :: State Machine Int
opReadNext = do
    a <- opReadHead
    opForward
    return a

opAdd :: State Machine ()
opAdd = do
    aPtr <- opReadNext
    a <- opReadAt aPtr
    bPtr <- opReadNext
    b <- opReadAt bPtr
    target <- opReadNext
    opWrite target (a + b)

opMult :: State Machine ()
opMult = do
    aPtr <- opReadNext
    a <- opReadAt aPtr
    bPtr <- opReadNext
    b <- opReadAt bPtr
    target <- opReadNext
    opWrite target (a * b)

opExit :: State Machine ()
opExit = do
    current <- get
    put $ current { isDone = True }

isMachineDone :: State Machine Bool
isMachineDone = do
    get >>= (return . isDone)

opcode :: Int -> State Machine ()
opcode 1 = opAdd
opcode 2 = opMult
opcode 99 = opExit

opExecuteNext :: State Machine ()
opExecuteNext = do
    opValue <- opReadNext
    opcode opValue

runCode :: State Machine ()
runCode = do
    done <- isMachineDone
    if done
    then return ()
    else opExecuteNext >> runCode 

evalWith :: Machine -> Int -> Int -> Int
evalWith machine noun verb = do
    fst $ runState (do
        opWrite 1 noun
        opWrite 2 verb
        runCode
        opReadAt 0
        ) machine

main :: IO()
main = do
    fileData <- readFile "input"
    let memory = map read $ splitOn "," fileData
    let machine = Machine {
        mState = fromList memory,
        mPos = 0,
        isDone = False
    }
    let outputs = [(evalWith machine x y, (x, y)) | x <- [0..99], y <- [0..99]]
    print $ snd $ head $ Prelude.filter ((== 19690720) . fst) outputs
```

Answer 1

Use Control.Lens for code this stateful. (Control.Lens.TH must be used to define Machine.) May as well leave out type signatures this homogenous. Control.Monad.Loops often helps against explicit monadic recursion.

opReadAt target = uses mState $ (`index` target)
opReadNext = mPos <<+= 1 >>= opReadAt
opWrite target what = mState %= update target what

opBin op = do
    a <- opReadNext >>= opReadAt
    b <- opReadNext >>= opReadAt
    target <- opReadNext
    opWrite target $ op a b 

opcode 1 = opBin (+)
opcode 2 = opBin (*)
opcode 99 = isDone .= True

runCode = (opReadNext >>= opCode) `untilM_` use isDone

evalWith :: Int -> Int -> Machine -> Int
evalWith noun verb = evalState $ do
    opWrite 1 noun
    opWrite 2 verb
    runCode
    opReadAt 0

Answer 2

Thanks for this, I used your example to finish mine that also uses State:

import System.IO
import Data.Sequence
import Control.Monad.State
import qualified Data.Text as T
import Data.Maybe

convertToInteger :: String -> Int
convertToInteger s = read s :: Int

type CompState = (Int, Seq Int)
type CompValue = Int

data Instruction = Add | Mult | Stop deriving (Show)

instruction :: State CompState Instruction
instruction = state $ \(pointer, mem) ->
    (case (Data.Sequence.lookup pointer mem) of
        Just 1 -> Add
        Just 2 -> Mult
        Just 99 -> Stop
        _ -> Stop
    , (pointer, mem))

calcul :: (Int -> Int -> Int) -> State CompState ()
calcul operator = state $ \(pointer, mem) ->
    let addr1 = Data.Sequence.lookup (pointer+1) mem
        addr2 = Data.Sequence.lookup (pointer+2) mem
        op1 = join $ Data.Sequence.lookup <$> addr1 <*> pure mem
        op2 = join $ Data.Sequence.lookup <$> addr2 <*> pure mem
        destAddr = Data.Sequence.lookup (pointer+3) mem 
        val = (operator <$> op1 <*> op2)
        newMem = Data.Sequence.update <$> destAddr <*> val <*> pure mem in
    ((), (pointer+4, fromJust newMem))

computeStep :: State CompState ()
computeStep = do
    inst <- instruction

    _ <- case inst of
        Add -> calcul (+) >> computeStep
        Mult -> calcul (*) >> computeStep
        Stop -> return ()

    return ()

a = [1,0,0,0,99]
b = [2,3,0,3,99]
c = [2,4,4,5,99,0]   
d = [1,1,1,4,99,5,6,0,99]

main :: IO()
main = do
    handle <- openFile "2-input.txt" ReadMode
    contents <- hGetContents handle

    let inputData = fromList . map convertToInteger . map T.unpack $ T.splitOn (T.pack ",") (T.pack contents)
    let updatedInputData = update 2 2 (update 1 12 inputData)

    print $ snd $ snd $ runState computeStep (0, updatedInputData)

Is it shorter or does it only look like it?