Trying to improve my command parsing

I’m writing a program where user types in commands. There are 2 parts to a command, a verb and a noun. Some commands has only a verb, like “quit”. Other commands require both a verb and a noun, like “add { firstName: “Alice”, age: 30 }”. For now I think nouns can just be JSON strings.

However, for simple rules like those, the code I write somewhat concerns me. For the full context, I’m using SDL2 bindings, and listsafe package.

  -- Events and stuff

  let eventPayloads = SDL.eventPayload <$> events
  
  let shouldQuit        = any ( == SDL.QuitEvent ) eventPayloads
      shouldSubmitCmd   = any ( isKeyHit SDL.KeycodeReturn ) eventPayloads

  -- Actual parsing is below

  let cmdTokens = words cmdInput
      maybeVerb = Safe.head cmdTokens
      maybeNoun :: Maybe String = ( Safe.!! ) cmdTokens 1

  if shouldSubmitCmd then do
    case maybeVerb of
      Nothing ->
        putStrLn "Error: Empty command."  -- TODO: Print to GUI.

      Just verb ->
        case verb of
          "add" ->
            case maybeNoun of
              Nothing ->
                putStrLn "Error: Adding what?"

              Just noun ->
                putStrLn $ "Adding " ++ noun

          "quit" ->
            putStrLn "Quitting"

          _ ->
            putStrLn "Error: Unknown command."

It looks like a lot of branching to me. I’m not sure if this number of branching is normal. And if I need to handle the case of too many arguments, I’ll need to branch out and indent further.

One thing that came to my mind is parsers. I haven’t looked into it, but from my limited experience with URL parsers in Elm, I imagine I can set up parsers that turn strings into a sum type. For example in Elm, I’ll have:

type Route
  = Blog Int
  | NotFound

I can chain a string parser for “blog”, and an int parser, and map it to the type constructor Blog Int. If parser fails that, then it’s mapped to NotFound.

Assuming Haskell parsers are like that, I’m worried that if I use parsers, I’ll lose the ability to give user detailed feedback for different invalid commands. Because if the parser fails to parse a string into any type constructor, then it’ll fall back to an error type constructor. But there are more than one forms of invalid commands. So I can’t give specific feedback based on only one type of error. Or should I set up more error type constructors? Then I’m not sure if the resulted code will be much better than the current one.

I’d like some assistance before going too far. Is my understanding of parsers correct? Maybe there’s some clever usage of monads I haven’t seen?

1 Like

I believe there is indeed a clever usage of monads you can use to ease this problem. You’d want to make your monad Either instead of Maybe, and use note to assign the error messages. For example:

  data Command = Add String | Quit

  parseCmd :: String -> Either String Command
  parseCmd cmdInput = do
    verb <- maybeVerb & note "Error: Empty command"
    case verb of
      "add" -> do
        noun <- maybeNoun & note "Error: Adding what?"
        pure $ Add noun
      "quit" -> 
        pure Quit
      _ ->
        Left "Error: Unknown command."

  where
    maybeVerb = Safe.head cmdTokens
    maybeNoun :: Maybe String = ( Safe.!! ) cmdTokens 1
    cmdTokens = words cmdInput

I’d strongly recommend separating parsing the command from doing the command, as I have in the example above (which only parses, doesn’t do anything).
Is that the sort of fix you’re looking for?

2 Likes

Yes! That’s the idiomatic code I was seeking. I knew this is a situation where monad has its advantage. Not sure if the code can be any more cleaner.

Thanks for the help. I’m going to try to parse the noun as JSON string next.

1 Like

I think it’s worth also mentioning that you can match multiple patterns in a case statement. That might be really useful if you wanted to do something like error if someone provided a noun when they shouldn’t:

  data Command = Add String | Quit

  parseCmd :: String -> Either String Command
  parseCmd cmdInput = do
    verb <- maybeVerb & note "Error: Empty command"
    case verb, maybeNoun of
      "add", Just noun -> Right $ Add noun
      "add", Nothing -> Left "Error: Adding what?"
      "quit", Nothing -> Right Quit
      "quit", Just noun -> Left ("Error: Unrecognized argument '" <> noun <> "'.  Perhaps you just meant 'quit'?")
      _, _ -> Left "Error: Unknown command."

  where
    maybeVerb = Safe.head cmdTokens
    maybeNoun :: Maybe String = ( Safe.!! ) cmdTokens 1
    cmdTokens = words cmdInput
2 Likes

You will have to add some parentheses:

    case (verb, maybeNoun) of
      ("add", Just noun) -> Right $ Add noun
      ("add", Nothing) -> Left "Error: Adding what?"
      ("quit", Nothing) -> Right Quit
      ("quit", Just noun) -> Left ("Error: Unrecognized argument '" <> noun <> "'.  Perhaps you just meant 'quit'?")
      (_, _) -> Left "Error: Unknown command."
3 Likes

Oh good catch! Sorry!

1 Like

Good to know, thanks!