
I'm sorry, the formatting got mangled in my last message, because I was using MarkdownHere. I'll try again without converting it to HTML. I'm a fan of `regex-applicative`. It's a combinator library modelled on the parsec family but because it parses only regular languages rather than context-free ones, it's a bit simpler to use and is a better match for some tasks. It uses `OverloadedStrings` to make it easier to include literal string matches and provides a non-greedy repeating combinator called `few` that avoids having to specify exclusive matches. I think it solves this problem quite nicely: ```haskell {-# LANGUAGE OverloadedStrings #-} import Text.Regex.Applicative -- This is just <*> with right associativity (<&>) :: Applicative f => f (a -> b) -> f a -> f b (<&>) = (<*>) infixr 3 <&> type Item = (String, String) item :: String -> RE Char ([Item] -> [Item]) item key = (:) . (,) key <$> few anySym -- ${year}/${month}/${day} ${hour}:${minute} User ${username} runs command ${command}. pattern :: RE Char [Item] pattern = item "year" <* "/" <&> item "month" <* "/" <&> item "day" <* " " <&> item "hour" <* ":" <&> item "minute" <* " User " <&> item "username" <* " runs command " <&> item "command" <* "." <&> pure [] input :: String input = "2019/04/17 17:27 User magicloud runs command ls." output :: Maybe [Item] output = match pattern input -- Just [("year","2019"),("month","04"),("day","17"),("hour","17"),("minute","27"),("username","magicloud"),("command","ls")] ``` (Also available as a [gist](https://gist.github.com/neilmayhew/e4fc90b7eaeb7bbcfeb6d6938544ecc9).) Obviously the combinator version is less compact and therefore could be considered less readable, but the implementation details could probably be tweaked a bit. It would also be relatively easy to write a quasi-quoter that turns the original input syntax (with `${variable}`) into the equivalent I've shown here.