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

• Alper: I'm very curious how you could improve it using a Lens but the documentation for that is very useless for somebody new. Could you given an example of how it would work?

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?

• Gurkenglas: instruction should be written in terms of gets. calcul in terms of modify. Instruction is superfluous. So's the Just 99 case. Don't use Maybe if you're merely gonna fromJust. snd $ runState -> evalState.
• Alper: Thanks for your additions which are barely understandable since I could only just get this State thing to work (almost no documentation) and have after this experience moved on from Haskell.