Учитывая, что вам нужно «элегантное» решение Parsec, я думаю, что вы ищете вариант парсера перестановки.
Для фонового чтения см. Документацию по Text.Parsec.Perm
и его более современному воплощению.в модуле Control.Applicative.Permutation
библиотеки parser-combinators
.Кроме того, эта статья «Функциональная жемчужина» «Разбор фраз перестановки» описывает подход и очень интересно читать.
У вашей проблемы есть два особых аспекта: во-первых, я не знаю осуществующий синтаксический анализатор перестановок, который допускает «непревзойденный» контент до, между и после совпавших частей чистым способом, и взламывает, например, встроение логики пропуска в анализаторы компонентов или получение дополнительного анализатора для идентификации пропускаемых строк для использования в intercalateEffect
из Control.Applicative.Permutation
кажется уродливым.Во-вторых, особая структура вашего ввода - тот факт, что строки могут распознаваться идентификатором, а не только общими анализаторами компонентов, - означает, что мы можем написать более эффективное решение, чем обычный анализатор перестановок, который ищет идентификаторы вкарта вместо того, чтобы пробовать список парсеров в последовательности.
Ниже приведено возможное решение.С одной стороны, он использует кувалду, чтобы убить муху.В вашей простой ситуации написание специального синтаксического анализатора для считывания идентификаторов и их RHS, проверки необходимых идентификаторов и дубликатов и последующего вызова специфичных для идентификаторов анализаторов для RHS кажется более простым.С другой стороны, возможно, существуют более сложные сценарии, в которых приведенное ниже решение было бы оправданным, и я думаю, что вполне возможно, что оно может быть полезным для других.
В любом случае, вот идея.Во-первых, некоторые предварительные сведения:
{-# 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
Допустим, у нас есть тип данных, представляющий окончательный результат анализа:
data Video = Video
{ width :: Int
, height :: Int
} deriving (Show)
Мы собираемся создать синтаксический анализатор Permutation a
.Тип a
- это то, что мы в конечном итоге вернем (и в этом случае это всегда Video
).Это Permutation
на самом деле будет Map
от «известных» идентификаторов, таких как ID_VIDEO_WIDTH
, до специального вида синтаксического анализатора, который будет анализировать правую часть для данного идентификатора (например, целое число, подобное 700
), а затемreturn - не проанализированное целое число - но продолжение Permutation a
, которое анализирует оставшиеся данные для построения Video
, с проанализированным целым числом (например, 700
), "запеченным" в продолжении.Продолжение будет иметь карту, которая распознает «оставшиеся» значения, и мы также будем отслеживать известные идентификаторы, которые мы уже прочитали, чтобы помечать дубликаты.
Мы будем использовать следующий тип:
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)
«Запуск» такого синтаксического анализатора включает преобразование его в обычный Parser
, и здесь мы реализуем логику для идентификации распознанных строк, пометки дубликатов и пропуска нераспознанных идентификаторов.Во-первых, вот парсер для идентификаторов.Если вы хотите быть более снисходительным, вы можете использовать many1 (noneOf "\n=")
или что-то еще.
ident :: Parser String
ident = (:) <$> letter' <*> many alphaNum'
where letter' = letter <|> underscore
alphaNum' = alphaNum <|> underscore
underscore = char '_'
, и вот парсер для пропуска оставшейся части строки, когда мы видим нераспознанный идентификатор:
skipLine :: Parser ()
skipLine = void $ many (noneOf "\n") >> newline
Наконец, вот как мы запускаем анализатор Permutation
:
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
Чтобы увидеть, как это должно работать, вот как мы напрямую можем создать Permutation
дляразбирать Video
.Это долго, но не так сложно:
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
Вы можете проверить это следующим образом:
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
Вы должны быть в состоянии убедиться, что он предоставляет соответствующие ошибки для отсутствующих ключей, повторяющихся записейдля известных ключей и принимает ключи в любом порядке.
Наконец, мы, очевидно, не хотим создавать парсеры перестановок, такие как perm2
, вручную, поэтому мы берем страницу из модуля Text.Parsec.Perm
и вводим следующеесинтаксис:
video :: Parser Video
video = runPermutation (Video <$$> ("ID_VIDEO_WIDTH", int) <||> ("ID_VIDEO_HEIGHT", int))
и определения операторов для создания необходимых Permutation
объектов.Эти определения немного хитры, но они довольно непосредственно следуют из определения 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)
и окончательного теста:
test :: IO ()
test = parseTest video testdata1
, дающего:
> test
Video {width = 700, height = 574}
>
Вот окончательный код, слегка переставленный:
{-# 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