Simple DFA using the State Monad

Question

I've been getting to grips with some Monads in Haskell recently, and to get some practice I plucked a Mealy Machine out of thin air and decided to implement it using the State Monad (it's a simple machine and a simple implementation, don't worry).

• The input is a string of characters from +, -, n, e.
  • +, "plus". Output a 1,
  • -, "minus". Output a -1.
  • n, "toggle negated". Until "toggled off", flip the sign of the output from + or -.
  • e, "toggle enabled". Until "toggled back on", output 0 from + or -.
• The output is just a sequence of the same length as the input, containing 1, 0, and -1s as outputted by the DFA. In the code below, the output is actually the sum of this sequence, acting as a quick checksum. All states are accepting states.

For example, an input of +-n+-e+e+ would result in [1, -1, 0, -1, 1, 0, 0, 0, -1].

To unambiguously define the behaviour, here's a pretty messy state transition diagram:

^{If "posate" (as the opposite of negate) isn't a word already, it is now! The transitions are labelled with the "english name", the symbol used to represent this transition, and the "output" from the machine. All states are accepting states, I left out the conventional double rings.}

---

At last, the code:

import Control.Monad.Trans.State.Lazy
import Control.Monad (foldM)

data Input = Plus | Minus | ToggleNegate | ToggleEnabled
type Emission = Integer
type Accum = [Emission]
type Output = [Emission]
type Negated = Bool
type Enabled = Bool

toInput :: Char -> Input
toInput '+' = Plus
toInput '-' = Minus
toInput 'n' = ToggleNegate
toInput 'e' = ToggleEnabled
toInput  _  = error "Invalid input representation"

-- Determine new state of state machine along with transition emission
step :: (Negated, Enabled, Input) -> (Negated, Enabled, Emission)
step (n, e, ToggleNegate)  = (not n, e, 0)
step (n, e, ToggleEnabled) = (n, not e, 0)
step (n, False, i)         = (n, False, 0)
step (n, e, Plus)          = (n, e, if n then -1 else  1)
step (n, e, Minus)         = (n, e, if n then  1 else -1)

-- Helper function for "evaluate"'s foldM
mapEmissions :: Accum -> Input -> State (Negated, Enabled) Output
mapEmissions accum input = do
    (negated, enabled) <- get
    let (negated', enabled', emission) = step (negated, enabled, input)
    put (negated', enabled')
    return (accum ++ [emission])

-- Process an input string and return the result
-- (False, True) is the start state: (not negated, enabled)
evaluate :: [Input] -> Output
evaluate inputs = evalState (foldM mapEmissions [] inputs) (False, True)


-- Convenience function for output formatting
shouldEqual :: String -> Integer -> IO ()
shouldEqual input expected = do
    let actual = (sum . evaluate . map toInput) input
    putStrLn $ "Expected " ++ show expected ++ ", got " ++ show actual ++ ": " ++ input

main :: IO ()
main = do
    "+-n--n" `shouldEqual` 2
    "+e----e++" `shouldEqual` 3
    "-n++e++e--+-n++" `shouldEqual` 1

Code online here.

---

I'm happy to hear any and all critiques and advice, but in particular:

• Am I using the State monad idiomatically? Can I write any bits of code more elegantly?
• Is this an appropriate use for this monad? This isn't a particularly complex task, but I feel like it makes passing around the DFA's state simpler.

Thanks for taking the time to read, and Happy New Year!

Answer 1

Use traverse instead of foldM + accumulate

In a fold, you usually use a function that reduces (or folds) your input into a single result. You, on the other hand, use fold mapEmissions to create a list from an input list. Both lists will have the same number of elements. That's not a fold. That's a map.

So first of all, let's use traverse instead of foldM:

evaluate :: [Input] -> Output
evaluate inputs = evalState (traverse emit inputs) (False, True)

Next, let's figure out how emit should look like:

emit :: Input -> State (Negated, Enabled) Emission
emit input = do
    (negated, enabled) <- get
    let (negated', enabled', emission) = step (negated, enabled, input)
    put (negated', enabled')
    return emission

Almost the same as mapEmission, and we can use emit to implement mapEmission:

mapEmission accum input = (accum ++) <$> emit input

Therefore, we should really replace the foldM by traverse.

Consider already existing interfaces

step can be rewritten with another interface that fits the state interface:

type MMState = (Negated, Enabled) --  Mealy Machine State

step :: Input -> MMState -> (MMState, Emission)
step ToggleNegate  (n, e)     = ((not n, e    ), 0)
step ToggleEnabled (n, e)     = ((    n, not e), 0)
step _             (n, False) = ((n,     False), 0)
step Plus          (n, e)     = ((n,     e    ), if n then -1 else  1)
step Minus         (n, e)     = ((n,     e    ), if n then  1 else -1)

This makes emit even easier:

emit :: Input -> State MMState Emission
emit input = state (step input)

Note that MMState makes it easier to change the other types, as there is less repetition.

It's completely up to you to write step like this, though.

Encapsulate possible errors in the type (if possible)

In toInput consider Maybe Input or Either String Input instead of error:

toInput :: Char -> Either String Input
toInput '+' = pure Plus
toInput '-' = pure Minus
toInput 'n' = pure ToggleNegate
toInput 'e' = pure ToggleEnabled
toInput  c  = Left $ "Unrecognised character: " ++ [c]

Use Int instead of Integer if the values are small

Instead of Integer we should use Int as Emission. Integer can be arbitrarily large, but your output values are either -1, 0 or 1. Int is much more suitable for that.

Other comments

Other than that, well done. You followed good practice by including type signatures, and your code is easy to read and to follow. The only real hurdle was foldM instead of traverse.

However, your single instruction type is called Input, whereas your complete output type is called Output. That naming is somewhat unbalanced.

---

Overall, we end up with:

import Control.Monad.Trans.State.Lazy

data Input = Plus | Minus | ToggleNegate | ToggleEnabled
type Emission = Int
type Output = [Emission]
type Negated = Bool
type Enabled = Bool
type MMState = (Negated, Enabled) --  Mealy Machine State

toInput :: Char -> Either String Input
toInput '+' = pure Plus
toInput '-' = pure Minus
toInput 'n' = pure ToggleNegate
toInput 'e' = pure ToggleEnabled
toInput  c  = Left $ "Unrecognised character: " ++ [c]

step :: Input -> MMState -> (MMState, Emission)
step ToggleNegate  (n, e)     = ((not n, e),     0)
step ToggleEnabled (n, e)     = ((    n, not e), 0)
step _             (n, False) = ((n,     False), 0)
step Plus          (n, e)     = ((n,     e),     if n then -1 else  1)
step Minus         (n, e)     = ((n,     e),     if n then  1 else -1)

emit :: Input -> State MMState Emission
emit input = state (step input)

evaluate :: [Input] -> Output
evaluate inputs = evalState (traverse emit inputs) (False, True)

By the way, we can now use emit on any traversable, so we could relax evaluate's type to

evaluate :: Traversable t => t Input -> t Emission
evaluate inputs = evalState (traverse emit inputs) (False, True)

But that's up to you.

Answer 2

Looks pretty good to me.

The only thing I'd be wary of is the return (accum ++ [emission]) which means building the ouput will have complexity O(n²) where n is the size of the output. To remedy that, you could store the output in reversed order i.e. have return (emission : accum) instead and call reverse in evaluate.

You could also decide to structure this outputting mechanism as a Writer in which case you probably want to use the Endo [a] monoid aka Difference Lists for the same efficiency reasons.