How to parse a series of lines (with only a few interesting ones) with Parsec in Haskell

Viewed 510

I have some input data of the form below (this is just a small sample).

ID_SID_0_LANG=eng
ID_VIDEO_FORMAT=H264
ID_VIDEO_HEIGHT=574
ID_START_TIME=0.00
ID_SUBTITLE_ID=0
ID_VIDEO_ID=0
ID_VIDEO_FPS=25.000
ID_VIDEO_WIDTH=700

I'm trying to see if I can parse this with Parsec. For the sake of our example, I want to pull out two values, the width and the height. I am trying to see if this can be done with Parsec.

  • The lines may come in any order
  • If either the width or the height are missing, I'd like a ParseError
  • If either the width or the height occur more than once, I'd like a ParseError
  • The other lines are mixed and varied per input, I can assume nothing beyond their basic format.

I'd like to use Parsec because I'm going to have to parse the values (which, in general, may be of different types - enumerations for codecs, elapsed types, strings, etc.). And I'd like my returned data structure to contain Naturals rather than, say, Maybe Natural, to simplify later code.

My problem is how to "parse" the leading ID_ lines that aren't interesting to me, but pick up only those that are. So I want to parse "any number of uninteresting ID_ lines; a height (or width); any number of uninteresting ID_ lines; a width (or height if width already found); any number of uninteresting ID_ lines). And I'd like to do this without repeating the notion of what constitutes an "interesting" key, because repetition is a primary cause of subtle error when being later maintained.

My best effort so far is to parse lines producing a list of Data Structure Modifiers for the interesting lines, each with a Key, and separately checking for presence of the required lines and lack of duplication of the unique lines; but that's not satisfying because I'm repeating the "interesting" keys.

Can this be elegantly done with Parsec?

Thanks,

3 Answers

Given that you want an "elegant" Parsec solution, I think you're looking for a variant of a permutation parser.

For background reading, see the documentation for Text.Parsec.Perm and its more modern incarnation in module Control.Applicative.Permutation of the parser-combinators library. In addition, this Functional Pearl paper Parsing Permutation Phrases describes the approach and is great fun to read.

There are two special aspects to your problem: First, I'm not aware of an existing permutation parser that allows for "unmatched" content before, between and after matched portions in a clean manner, and hacks like building the skip logic into the component parsers or deriving an extra parser to identify skippable lines for use in intercalateEffect from Control.Applicative.Permutation seem ugly. Second, the special structure of your input -- the fact that the lines can be recognized by the identifier rather than only general component parsers -- means that we can write a more efficient solution than a usual permutation parser, one that looks up identifiers in a map instead of trying a list of parsers in sequence.

Below is a possible solution. On the one hand, it's using a sledgehammer to kill a fly. In your simple situation, writing an ad hoc parser to read in the identifiers and their RHSs, check for required identifiers and duplicates, and then invoke identifier-specific parsers for the RHSs, seems more straightforward. On the other hand, maybe there are more complicated scenarios where the solution below would be justified, and I think it's conceivable it might be useful to others.

Anyway, here's the idea. First, some preliminaries:

{-# OPTIONS_GHC -Wall #-}
module ParseLines where
import Control.Applicative
import Control.Monad
import Data.List (intercalate)
import Text.Parsec (unexpected, eof, parseTest)
import Text.Parsec.Char (char, letter, alphaNum, noneOf, newline, digit)
import Text.Parsec.String (Parser)
import qualified Data.Map.Lazy as Map
import qualified Data.Set as Set

Let's say we have a data type representing the final result of the parse:

data Video = Video
  { width :: Int
  , height :: Int
  } deriving (Show)

We're going to construct a Permutation a parser. The type a is what we're going to eventually return (and in this case, it's always Video). This Permutation will actually be a Map from "known" identifiers like ID_VIDEO_WIDTH to a special kind of parser that will parse the right-hand side for the given identifier (e.g., an integer like 700) and then return -- not the parsed integer -- but a continuation Permutation a that parses the remaining data to construct a Video, with the parsed integer (e.g., 700) "baked in" to the continuation. The continuation will have a map that recognizes the "remaining" values, and we'll also keep track of known identifiers we've already read to flag duplicates.

We'll use the following type:

type Identifier = String
data Permutation a = Permutation
  -- "seen" identifiers for flagging duplicates
  (Set.Set Identifier)
  (Either
    -- if there are more values to read, map identifier to a parser
    -- that parses RHS and returns continuation for parsing the rest
    (Map.Map Identifier (Parser (Permutation a)))
    -- or we're ready for an eof and can return the final value
    a)

"Running" such a parser involves converting it to a plain Parser, and this is where we implement the logic for identifying recognized lines, flagging duplicates, and skipping unrecognized identifiers. First, here's a parser for identifiers. If you wanted to be more lenient, you could use many1 (noneOf "\n=") or something.

ident :: Parser String
ident = (:) <$> letter' <*> many alphaNum'
  where letter' = letter <|> underscore
        alphaNum' = alphaNum <|> underscore
        underscore = char '_'

and here's a parser for skipping the rest of a line when we see an unrecognized identifier:

skipLine :: Parser ()
skipLine = void $ many (noneOf "\n") >> newline

Finally, here's how we run the Permutation parser:

runPermutation :: Permutation a -> Parser a
runPermutation p@(Permutation seen e)
  = -- if end of file, return the final answer (or error)
    eof *>
    case e of
      Left m -> fail $
        "eof before " ++ intercalate ", " (Map.keys m)
      Right a -> return a
  <|>
    -- otherwise, parse the identifier
    do k <- ident <* char '='
       -- is it one we're waiting for?
       case either (Map.lookup k) (const Nothing) e of
         -- no, it's not, so check for duplicates and skip
         Nothing -> if Set.member k seen
           then unexpected ("duplicate " ++ k)
           else skipLine *> runPermutation p
         -- yes, it is
         Just prhs -> do
           -- parse the RHS to get a continuation Permutation
           -- and run it to parse rest of parameters
           (prhs <* newline) >>= runPermutation

To see how this is supposed to work, here's how we would directly construct a Permutation to parse a Video. It's long, but not that complicated:

perm2 :: Permutation Video
perm2 = Permutation
  -- nothing's been seen yet
  Set.empty
  -- parse width or height
  $ Left (Map.fromList
   [ ("ID_VIDEO_WIDTH", do
         -- parse the width
         w <- int
         -- return a continuation permutation
         return $ Permutation
           -- we've seen width
           (Set.fromList ["ID_VIDEO_WIDTH"])
           -- parse height
           $ Left (Map.fromList
            [ ("ID_VIDEO_HEIGHT", do
                  -- parse the height
                  h <- int
                  -- return a continuation permutation
                  return $ Permutation
                    -- we've seen them all
                    (Set.fromList ["ID_VIDEO_WIDTH", "ID_VIDEO_HEIGHT"])
                    -- have all parameters, so eof returns the video
                    $ Right (Video w h))
            ]))
   -- similarly for other permutation:
   , ("ID_VIDEO_HEIGHT", do
         h <- int
         return $ Permutation
           (Set.fromList ["ID_VIDEO_HEIGHT"])
           $ Left (Map.fromList
            [ ("ID_VIDEO_WIDTH", do
                  w <- int
                  return $ Permutation
                    (Set.fromList ["ID_VIDEO_WIDTH", "ID_VIDEO_HEIGHT"])
                    $ Right (Video w h))
            ]))
   ])

int :: Parser Int
int = read <$> some digit

You can test it like so:

testdata1 :: String
testdata1 = unlines
  [ "ID_SID_0_LANG=eng"
  , "ID_VIDEO_FORMAT=H264"
  , "ID_VIDEO_HEIGHT=574"
  , "ID_START_TIME=0.00"
  , "ID_SUBTITLE_ID=0"
  , "ID_VIDEO_ID=0"
  , "ID_VIDEO_FPS=25.000"
  , "ID_VIDEO_WIDTH=700"
  ]

test1 :: IO ()
test1 = parseTest (runPermutation perm2) testdata1

You should be able to verify that it provides appropriate errors for missing keys, duplicate entries for known keys, and accepts keys in any order.

Finally, we obviously don't want to construct permutation parsers like perm2 manually, so we take a page from the Text.Parsec.Perm module and introduce the following syntax:

video :: Parser Video
video = runPermutation (Video <$$> ("ID_VIDEO_WIDTH", int) <||> ("ID_VIDEO_HEIGHT", int))

and define operators to construct the necessary Permutation objects. These definitions are a little tricky, but they follow pretty directly from the definition of Permutation.

(<$$>) :: (a -> b) -> (Identifier, Parser a) -> Permutation b
f <$$> xq = Permutation Set.empty (Right f) <||> xq
infixl 2 <$$>

(<||>) :: Permutation (a -> b) -> (Identifier, Parser a) -> Permutation b
p@(Permutation seen e) <||> (x, q)
  = Permutation seen (Left (Map.insert x q' m'))
  where
    q' = (\a -> addQ x a p) <$> q
    m' = case e of Right _ -> Map.empty
                   Left m -> Map.map (fmap (<||> (x, q))) m
infixl 1 <||>

addQ :: Identifier -> a -> Permutation (a -> b) -> Permutation b
addQ x a (Permutation seen e)
  = Permutation (Set.insert x seen) $ case e of
      Right f -> Right (f a)
      Left m -> Left (Map.map (fmap (addQ x a)) m)

and the final test:

test :: IO ()
test = parseTest video testdata1

giving:

> test
Video {width = 700, height = 574}
>

Here's the final code, slightly rearranged:

{-# OPTIONS_GHC -Wall #-}
module ParseLines where

import Control.Applicative
import Control.Monad
import Data.List (intercalate)
import Text.Parsec (unexpected, eof, parseTest)
import Text.Parsec.Char (char, letter, alphaNum, noneOf, newline, digit)
import Text.Parsec.String (Parser)
import qualified Data.Map.Lazy as Map
import qualified Data.Set as Set

-- * Permutation parser for identifier settings

-- | General permutation parser for a type @a@.
data Permutation a = Permutation
  -- | "Seen" identifiers for flagging duplicates
  (Set.Set Identifier)
  -- | Either map of continuation parsers for more identifiers or a
  -- final value once we see eof.
  (Either (Map.Map Identifier (Parser (Permutation a))) a)

-- | Create a one-identifier 'Permutation' from a 'Parser'.
(<$$>) :: (a -> b) -> (Identifier, Parser a) -> Permutation b
f <$$> xq = Permutation Set.empty (Right f) <||> xq
infixl 2 <$$>

-- | Add a 'Parser' to a 'Permutation'.
(<||>) :: Permutation (a -> b) -> (Identifier, Parser a) -> Permutation b
p@(Permutation seen e) <||> (x, q)
  = Permutation seen (Left (Map.insert x q' m'))
  where
    q' = (\a -> addQ x a p) <$> q
    m' = case e of Right _ -> Map.empty
                   Left m -> Map.map (fmap (<||> (x, q))) m
infixl 1 <||>

-- | Helper to add a parsed component to a 'Permutation'.
addQ :: Identifier -> a -> Permutation (a -> b) -> Permutation b
addQ x a (Permutation seen e)
  = Permutation (Set.insert x seen) $ case e of
      Right f -> Right (f a)
      Left m -> Left (Map.map (fmap (addQ x a)) m)

-- | Convert a 'Permutation' to a 'Parser' that detects duplicates
-- and skips unknown identifiers.
runPermutation :: Permutation a -> Parser a
runPermutation p@(Permutation seen e)
  = -- if end of file, return the final answer (or error)
    eof *>
    case e of
      Left m -> fail $
        "eof before " ++ intercalate ", " (Map.keys m)
      Right a -> return a
  <|>
    -- otherwise, parse the identifier
    do k <- ident <* char '='
       -- is it one we're waiting for?
       case either (Map.lookup k) (const Nothing) e of
         -- no, it's not, so check for duplicates and skip
         Nothing -> if Set.member k seen
           then unexpected ("duplicate " ++ k)
           else skipLine *> runPermutation p
         -- yes, it is
         Just prhs -> do
           -- parse the RHS to get a continuation Permutation
           -- and run it to parse rest of parameters
           (prhs <* newline) >>= runPermutation

-- | Left-hand side of a setting.
type Identifier = String

-- | Parse an 'Identifier'.
ident :: Parser Identifier
ident = (:) <$> letter' <*> many alphaNum'
  where letter' = letter <|> underscore
        alphaNum' = alphaNum <|> underscore
        underscore = char '_'

-- | Skip (rest of) a line.
skipLine :: Parser ()
skipLine = void $ many (noneOf "\n") >> newline

-- * Parsing video information

-- | Our video data.
data Video = Video
  { width :: Int
  , height :: Int
  } deriving (Show)

-- | Parsing integers (RHS of width and height settings)
int :: Parser Int
int = read <$> some digit

-- | Some test data
testdata1 :: String
testdata1 = unlines
  [ "ID_SID_0_LANG=eng"
  , "ID_VIDEO_FORMAT=H264"
  , "ID_VIDEO_HEIGHT=574"
  , "ID_START_TIME=0.00"
  , "ID_SUBTITLE_ID=0"
  , "ID_VIDEO_ID=0"
  , "ID_VIDEO_FPS=25.000"
  , "ID_VIDEO_WIDTH=700"
  ]

-- | `Video` parser based on `Permutation`.
video :: Parser Video
video = runPermutation (Video <$$> ("ID_VIDEO_WIDTH", int) <||> ("ID_VIDEO_HEIGHT", int))

-- | The final test.
test :: IO ()
test = parseTest video testdata1

Indeed a simple solution would be to parse the file into Map ByteString ByteString, checking for duplicates while parsing, and then build the target result from that, checking that all required fields are present.

parseMap :: Parsec (Map ByteString ByteString)
-- ...

parseValues :: Map ByteString ByteString -> Parsec MyDataStructure
-- ...

Function parseValues can use Parsec again to parse the fields (perhaps using runP on each one) and to report errors or missing fields.

The disadvantage of this solution that parsing is done on two levels (once to get ByteStrings and the second time to parse them). And that this way we can't report correctly the position of errors found in parseValues. However, Parsec allows to get and set the current position in a file, so it might be feasible to include them in the map, and then use them when parsing the individual strings:

parseMap :: Parsec (Map ByteString (SourcePos, ByteString))

Using Parsec directly to parse the full result might be possible, but I'm afraid it'd be tricky to accomplish to allow arbitrary order and at the same time different output types of the fields.

If you don't mind a slight performance loss, write one parser for the width-line and one for the length-line and do something like this:

let ls = lines input in 
  case ([x | Right x <- parseWidth ls], [x | Right x <- parseLength ls]) of
    ([w],[l]) -> ...
    _         -> parserError ...

It's easy to add separate error cases for repetated/missing values without repeating anything.

Related