parsing with haskell parser combinators
1.0.0
Нужно что -то проанализировать? Никогда не слышал о «комбинаторе анализатора»? Хотите узнать немного Хаскелла? Потрясающий! Ниже приведено все, что вам нужно, чтобы встать и анализировать с комбинаторами Haskell Parser. Отсюда вы можете попытаться заняться форматами сериализации эзотерических данных, передних концов компилятора, языков конкретных доменов - вы называете это!
В этом руководстве включены две демонстрационные программы.
version-number-parser анализируют файл для номера версии. srt-file-parser анализирует файл для субтитров SRT. Не стесняйтесь опробовать их с помощью файлов, найденных в test-input/ .
Загрузите стек инструментов Haskell, а затем запустите следующее.
git clone https://github.com/lettier/parsing-with-haskell-parser-combinators
cd parsing-with-haskell-parser-combinators
stack buildПри использовании Cabal вы можете запустить следующее.
git clone https://github.com/lettier/parsing-with-haskell-parser-combinators
cd parsing-with-haskell-parser-combinators
cabal sandbox init
cabal --require-sandbox build
cabal --require-sandbox installПосле создания двух демонстрационных программ вы можете запустить их так.
Чтобы попробовать анализатор номера версии, запустите следующее.
cd parsing-with-haskell-parser-combinators
stack exec -- version-number-parser
What is the version output file path ?
test-input/gifcurry-version-output.txtЧтобы попробовать анализатор файла SRT, запустите следующее.
cd parsing-with-haskell-parser-combinators
stack exec -- srt-file-parser
What is the SRT file path ?
test-input/subtitles.srtЧтобы попробовать анализатор номера версии, запустите следующее.
cd parsing-with-haskell-parser-combinators
.cabal-sandbox/bin/version-number-parser
What is the version output file path ?
test-input/gifcurry-version-output.txtЧтобы попробовать анализатор файла SRT, запустите следующее.
cd parsing-with-haskell-parser-combinators
.cabal-sandbox/bin/srt-file-parser
What is the SRT file path ?
test-input/subtitles.srtОдним из лучших способов узнать о стратегии анализа, комбинатора Parser, является рассмотрение реализации одной.
Парсеры, построенные с использованием комбинаторов, просты для строительства, читаемого, модульного, хорошо структурированного и легко подлежащего обслуживанию.
–Parser Combinator - Википедия
Давайте посмотрим под капотом Readp, библиотеки комбинатора синхронизаторов, найденной в базе. Поскольку он находится в базе, у вас это уже должно быть.
Обратите внимание, вы можете попробовать Parsec после знакомства с Readp. Это также библиотека комбинатора анализаторов, которую другие предпочитают читать. В качестве дополнительного бонуса он включен в библиотеки загрузки GHC по состоянию на GHC версии 8.4.1.
-- (c) The University of Glasgow 2002
data P a
= Get ( Char -> P a )
| Look ( String -> P a )
| Fail
| Result a ( P a )
| Final [( a , String )]
deriving Functor Мы начнем с типа данных P a in P a зависит от вас (пользователь библиотеки) и может быть тем, что вам нужно. Компилятор автоматически создает экземпляр Functor, и существуют рукописные экземпляры для Applicative, Monad, MonadFail и Alternative.
Обратите внимание, что для получения дополнительной информации о функторах, приложениях и монадах проверьте свое простое руководство по монадам, приложениям и функторам.
P - тип суммы с пятью случаями.
Get потребляет один символ из входной строки и возвращает новый PLook принимает дубликат входной строки и возвращает новый PFail указывает, что анализатор закончен без результата.Result содержит возможный анализ и еще один случай PFinal -это список двух турниров. Первый элемент корзин является возможным анализом ввода, а второй элемент кортежей - это остальная часть входной строки, которая не была поглощена Get . -- (c) The University of Glasgow 2002
run :: P a -> ReadS a
run ( Get f) (c : s) = run (f c) s
run ( Look f) s = run (f s) s
run ( Result x p) s = (x,s) : run p s
run ( Final r) _ = r
run _ _ = [] run - это сердце парсера Readp. Он делает всю тяжелую работу, поскольку рекурсивно проходит через все состояния анализатора, которые мы видели выше. Вы можете видеть, что он требует P и возвращает ReadS .
-- (c) The University of Glasgow 2002
type ReadS a = String -> [( a , String )] ReadS a -это псевдоним типа для String -> [(a,String)] . Поэтому всякий раз, когда вы видите, ReadS a , Think String -> [(a,String)] .
-- (c) The University of Glasgow 2002
run :: P a -> String -> [( a , String )]
run ( Get f) (c : s) = run (f c) s
run ( Look f) s = run (f s) s
run ( Result x p) s = (x,s) : run p s
run ( Final r) _ = r
run _ _ = [] run шаблона соответствует различным случаям P .
Get , он вызывает себя с новым P (возвращаемой передачей функции f , в Get f , следующий символ c в входной строке) и остальной частью входной строки s .Look , он вызывает себя новым P (возвращаемым путем передачи функции f , по Look f , входной строке s ) и входной строке. Обратите внимание, как Look не потребляет никаких символов из входной строки, например, Get Do.Result , он собирает двухверенный, содержит проанализированный результат и то, что осталось от входной строки-и подготавливает это к результату рекурсивного вызова, который работает с другим корпусом P и входной строкой.Final , run возвращает список двух турниров, содержащих анализируемые результаты и остатки ввода строки.run возвращает пустой список. Например, если дело Fail , run вернет пустой список. > run ( Get ( a -> Get ( b -> Result [a,b] Fail ))) " 12345 "
[( " 12 " , " 345 " )] READP не выставляет run , но если это так, вы могли бы назвать это так. Они Get S, потребляют '1' и '2' , оставляя "345" позади.
> run ( Get ( a -> Get ( b -> Result [a,b] Fail ))) " 12345 "
> run ( Get ( b -> Result [ ' 1 ' ,b] Fail )) " 2345 "
> run ( Result [ ' 1 ' , ' 2 ' ] Fail ) " 345 "
> ([ ' 1 ' , ' 2 ' ], " 345 " ) : run ( Fail ) " 345 "
> ([ ' 1 ' , ' 2 ' ], " 345 " ) : []
[( " 12 " , " 345 " )]Проходя через каждый рекурсивный вызов, вы можете увидеть, как мы достигли конечного результата.
> run ( Get ( a -> Get ( b -> Result [a,b] ( Final [([ ' a ' , ' b ' ], " c " )])))) " 12345 "
[( " 12 " , " 345 " ),( " ab " , " c " )] Используя Final , вы можете включить анализовый результат в окончательный список двух турниров.
-- (c) The University of Glasgow 2002
readP_to_S :: ReadP a -> ReadS a
-- readP_to_S :: ReadP a -> String -> [(a,String)]
readP_to_S ( R f) = run (f return ) В то время как READP не подвергает run напрямую, он выставляет его через readP_to_S . readP_to_S представляет newtype под названием ReadP . readP_to_S принимает ReadP a , string и возвращает список двух турниров.
-- (c) The University of Glasgow 2002
newtype ReadP a = R ( forall b . ( a -> P b ) -> P b ) Вот определение ReadP a . Существуют примеры для фанктора, применения, монады, MonadFail , альтернативы и MonadPlus . Конструктор R принимает функцию, которая выполняет другую функцию, и возвращает P Принятая функция берет все, что вы выбрали для a и возвращает P
-- (c) The University of Glasgow 2002
readP_to_S ( R f) = run (f return ) Напомним, что P -это монада, а тип return a -> ma . Таким образом, f -это функция (a -> P b) -> Pb , а return -это функция (a -> P b) . В конечном счете, run получает P b который он ожидает.
-- (c) The University of Glasgow 2002
readP_to_S ( R f) inputString = run (f return ) inputString
-- ^ ^^^^^^^^^^ ^^^^^^^^^^^ Он остался в исходном коде, но помните, что readP_to_S и run ожидает входной строки.
-- (c) The University of Glasgow 2002
instance Functor ReadP where
fmap h ( R f) = R ( k -> f (k . h)) Вот определение экземпляра Functor для ReadP .
> readP_to_S ( fmap toLower get) " ABC "
[( ' a ' , " BC " )]
> readP_to_S (toLower <$> get) " ABC "
[( ' a ' , " BC " )] Это позволяет нам делать что -то подобное. fmap Functor отображает toLower по get который ровный R Get . Напомним, что тип Get IS (Char -> P a) -> P a который принимает конструктор ReadP ( R ).
-- (c) The University of Glasgow 2002
fmap h ( R f ) = R ( k -> f (k . h ))
fmap toLower ( R Get ) = R ( k -> Get (k . toLower)) Здесь вы видите, что определение функции переписывается для примера fmap toLower get .
Посмотрев выше, как readP_to_S вернул [('a',"BC")] когда мы использовали только Get , который не завершает run ? Ответ заключается в применении определения для P .
-- (c) The University of Glasgow 2002
instance Applicative P where
pure x = Result x Fail
(<*>) = ap return равен pure поэтому мы могли бы переписать readP_to_S (R f) = run (f return) , чтобы быть readP_to_S (R f) = run (f pure) . Используя return или, скорее, pure , readP_to_S устанавливает Result x Fail , когда столкнется окончательный run корпуса. Если достигнут, run прекратится, и мы получим наш список парионов.
> readP_to_S ( fmap toLower get) " ABC "
-- Use the functor instance to transform fmap toLower get.
> readP_to_S ( R ( k -> Get (k . toLower))) " ABC "
-- Call run which removes R.
> run (( k -> Get (k . toLower)) pure ) " ABC "
-- Call function with pure to get rid of k.
> run ( Get ( pure . toLower)) " ABC "
-- Call run for Get case to get rid of Get.
> run (( pure . toLower) ' A ' ) " BC "
-- Call toLower with 'A' to get rid of toLower.
> run ( pure ' a ' ) " BC "
-- Use the applicative instance to transform pure 'a'.
> run ( Result ' a ' Fail ) " BC "
-- Call run for the Result case to get rid of Result.
> ( ' a ' , " BC " ) : run ( Fail ) " BC "
-- Call run for the Fail case to get rid of Fail.
> ( ' a ' , " BC " ) : []
-- Prepend.
[( ' a ' , " BC " )] Здесь вы видите поток от readP_to_S к аналитическому результату.
-- (c) The University of Glasgow 2002
instance Alternative P where
-- ...
-- most common case: two gets are combined
Get f1 <|> Get f2 = Get ( c -> f1 c <|> f2 c)
-- results are delivered as soon as possible
Result x p <|> q = Result x (p <|> q)
p <|> Result x q = Result x (p <|> q)
-- ... Alternative экземпляр для P позволяет нам разделить поток анализатора на левый и правый путь. Это пригодится, когда ввод не может идти ни один, один или (более редко) два из двух способов.
> readP_to_S ((get >>= a -> return a) <|> (get >> get >>= b -> return b)) " ABC "
[( ' A ' , " BC " ),( ' B ' , " C " )] <|> Оператор или функция вводит вилку в потоке анализатора. Сигнал будет проходить по левой и правой дорожке. Конечный результат будет содержать все возможные параметры, которые пошли налево, и все возможные остановки, которые пошли прямо. Если оба пути терпят неудачу, то весь анализатор терпит неудачу.
Обратите внимание, что в других реализациях комбинатора анализаторов при использовании оператора <|> анализатор будет идти влево или вправо, но не оба. Если слева преуспевает, право игнорируется. Право обрабатывается только в случае сбоя левой стороны.
> readP_to_S ((get >>= a -> return [a]) <|> look <|> (get >> get >>= a -> return [a])) " ABC "
[( " ABC " , " ABC " ),( " A " , " BC " ),( " B " , " C " )] Вы можете подцепить оператор <|> для того, как бы ни было много вариантов или альтернатив. Сигнал вернет возможный анализ с участием каждого.
-- (c) The University of Glasgow 2002
instance Monad ReadP where
fail _ = R ( _ -> Fail )
R m >>= f = R ( k -> m ( a -> let R m' = f a in m' k)) Вот экземпляр ReadP Monad. Обратите внимание на определение для fail .
> readP_to_S (( a b c -> [a,b,c]) <$> get <*> get <*> get) " ABC "
[( " ABC " , " " )]
> readP_to_S (( a b c -> [a,b,c]) <$> get <*> fail " " <*> get) " ABC "
[]
> readP_to_S (get >>= a -> get >>= b -> get >>= c -> return [a,b,c]) " ABC "
[( " ABC " , " " )]
> readP_to_S (get >>= a -> get >>= b -> fail " " >>= c -> return [a,b,c]) " ABC "
[] Вы можете вызвать целый путь анализатора, чтобы прервать, позвонив fail . Поскольку READP не предоставляет прямой способ генерирования Result или Final случая, возвращаемое значение будет пустым списком. Если неудачный путь - единственный путь, то весь результат будет пустым списком. Напомним, что при run Fail , он возвращает пустой список.
-- (c) The University of Glasgow 2002
instance Alternative P where
-- ...
-- fail disappears
Fail <|> p = p
p <|> Fail = p
-- ... Возвращаясь к альтернативному экземпляру P , вы можете увидеть, как сбой с обеих сторон (но не оба) не подведет весь анализатор.
> readP_to_S (get >>= a -> get >>= b -> pfail >>= c -> return [a,b,c]) " ABC "
[] Вместо использования fail , Readp предоставляет pfail , который позволяет напрямую генерировать случай Fail .
Gifcurry, видео-редактор, построенный в Haskell для производителей GIF, выходит на различные программы. Чтобы обеспечить совместимость, ему нужен номер версии для каждой из программ, в которых она выходит. Одна из этих программ - ImageMagick.
Version: ImageMagick 6.9.10-14 Q16 x86_64 2018-10-24 https://imagemagick.org
Copyright: © 1999-2018 ImageMagick Studio LLC
License: https://imagemagick.org/script/license.php
Features: Cipher DPC HDRI Modules OpenCL OpenMP Здесь вы видите вывод convert --version . Как вы могли разобрать это, чтобы захватить 6, 9, 10 и 14?
Глядя на вывод, мы знаем, что номер версии представляет собой набор чисел, разделенных либо периодом, либо чертой. Это определение также охватывает даты, поэтому мы позаботимся о том, чтобы первые два числа были разделены на период. Таким образом, если они поставит дату перед номером версии, мы не получим неправильный результат.
1. Consume zero or more characters that are not 0 through 9 and go to 2.
2. Consume zero or more characters that are 0 through 9, save this number, and go to 3.
3. Look at the rest of the input and go to 4.
4. If the input
- is empty, go to 6.
- starts with a period, go to 1.
- starts with a dash
- and you have exactly one number, go to 5.
- and you have more than one number, go to 1.
- doesn't start with a period or dash
- and you have exactly one number, go to 5.
- you have more than one number, go to 6.
5. Delete any saved numbers and go to 1.
6. Return the numbers found.Прежде чем мы погрузимся в код, вот алгоритм, за которым мы будем следить.
parseVersionNumber
:: [ String ]
-> ReadP [ String ]
parseVersionNumber
nums
= do
_ <- parseNotNumber
num <- parseNumber
let nums' = nums ++ [num]
parseSeparator nums' parseVersionNumber parseVersionNumber - это основной комбинатор синтаксического анализатора, который анализирует входную строку для номера версии. Он принимает список строк и возвращает список строк в контексте типа данных ReadP . Принятый список строк - это не тот вход, который проанализируется, а скорее список чисел, найденных до сих пор. Для первого вызова функции список пуст, так как он еще ничего не проанализировал.
parseVersionNumber
nums Начиная с вершины, parseVersionNumber берет список строк, которые являются текущим списком чисел, найденных до сих пор.
_ <- parseNotNumber parseNotNumber потребляет все, что не число от входной строки. Поскольку мы не заинтересованы в результате, мы отказываемся от него ( _ <- ).
num <- parseNumber
let nums' = nums ++ [num]Затем мы потребляем все, что является числом, а затем добавляем это в список найденных номеров.
parseSeparator nums' parseVersionNumber После того, как parseVersionNumber обработала следующее число, он передает список найденных чисел и себя parseSeparator .
parseSeparator
:: [ String ]
-> ([ String ] -> ReadP [ String ])
-> ReadP [ String ]
parseSeparator
nums
f
= do
next <- look
case next of
" " -> return nums
(c : _) ->
case c of
' . ' -> f nums
' - ' -> if length nums == 1 then f [] else f nums
_ -> if length nums == 1 then f [] else return nums Здесь вы видите parseSeparator .
next <- look
case next of
" " -> return nums
(c : _) -> look позволяет нам получить то, что осталось от входной строки, не потребляя ее. Если ничего не осталось, это возвращает найденные цифры. Однако, если что -то осталось, это анализирует первый персонаж.
case c of
' . ' -> f nums
' - ' -> if length nums == 1 then f [] else f nums
_ -> if length nums == 1 then f [] else return nums Если следующий символ является периодом, снова вызовите parseVersionNumber с текущим списком найденных номеров. Если это тире, и у нас есть ровно один номер, позвоните в parseVersionNumber с пустым списком номеров, так как это дата. Если это черта, и у нас нет точно одного номера, позвоните в parseVersionNumber со списком чисел, найденных до сих пор. В противном случае, вызовите parseVersionNumber с пустым списком, если у нас есть ровно один номер или вернуть номера, найденные, если у нас нет точно одного номера.
parseNotNumber
:: ReadP String
parseNotNumber
=
munch ( not . isNumber) parseNotNumber использует munch , который предоставляет ReadP . munch дается предикат (not . isNumber)
munch :: ( Char -> Bool ) -> ReadP String munch непрерывно вызовы get если следующий символ в входной строке удовлетворяет предикату. Если это не так, munch возвращает персонажей, которые сделали, если таковые имеются. Поскольку он использует только get , Мунк всегда добивается успеха.
Обратите внимание, parseNumber похоже на parseNotNumber . Вместо этого not . isNumber , предикат просто isNumber .
parseNotNumber'
:: ReadP String
parseNotNumber'
=
many (satisfy ( not . isNumber)) Вместо того, чтобы использовать munch , вы можете писать parseNotNumber , как это, используя many и satisfy - оба из которых предоставляет Readp. Глядя на подпись типа для many , он принимает единый комбинатор анализатора ( ReadP a ). В этом случае ему предоставляется satisfy анализатора.
> readP_to_S (satisfy ( not . isNumber)) " a "
[( ' a ' , " " )]
> readP_to_S (satisfy ( not . isNumber)) " 1 "
[] satisfy берет предикат и использует, get потреблять следующего персонажа. Если принятый предикат возвращает True, satisfy возвращает символ. В противном случае, satisfy звонкам pfail и терпит неудачу.
> readP_to_S (munch ( not . isNumber)) " abc123 "
[( " abc " , " 123 " )]
> readP_to_S (many (satisfy ( not . isNumber))) " abc123 "
[( " " , " abc123 " ),( " a " , " bc123 " ),( " ab " , " c123 " ),( " abc " , " 123 " )] Использование many может дать вам нежелательные результаты. В конечном счете, many вводят один или несколько случаев Result . Из -за этого many всегда добиваются успеха.
> readP_to_S (many look) " abc123 "
-- Runs forever. many будут запускать ваш анализатор до тех пор, пока он не выйдет из строя или не закончится входными. Если ваш анализатор никогда не терпит неудачу или никогда не заканчивает входные данные, many никогда не вернется.
> readP_to_S (many (get >>= a -> return ( read (a : " " ) :: Int ))) " 12345 "
[( [] , " 12345 " ),([ 1 ], " 2345 " ),([ 1 , 2 ], " 345 " ),([ 1 , 2 , 3 ], " 45 " ),([ 1 , 2 , 3 , 4 ], " 5 " ),([ 1 , 2 , 3 , 4 , 5 ], " " )]Для каждого индекса в результате проанализированный результат станет результатом того, что он запустил время индекса анализатора на всем входе.
> let parser = get >>= a -> return ( read (a : " " ) :: Int )
> let many' results = return results <|> (parser >>= result -> many' (results ++ [result]))
> readP_to_S (many' [] ) " 12345 "
[( [] , " 12345 " ),([ 1 ], " 2345 " ),([ 1 , 2 ], " 345 " ),([ 1 , 2 , 3 ], " 45 " ),([ 1 , 2 , 3 , 4 ], " 5 " ),([ 1 , 2 , 3 , 4 , 5 ], " " )] Вот альтернативное определение для many . На левой стороне <|> он возвращает текущие результаты анализатора. На правой стороне <|> он запускает анализатор, добавляет этот результат к текущим результатам анализатора и вызывает себя с обновленными результатами. Это имеет совокупный эффект типа суммы, в котором индекс i является результатом анализатора, добавленным к результату анализатора в i - 1 , i - 2 , ... и 1 .
Теперь, когда мы построили анализатор, давайте запустим его.
> let inputString =
> " Some Program (C) 1234-56-78 All rights reserved. n
> Version: 12.345.6-7 n
> License: Some open source license. "
> readP_to_S (parseVersionNumber [] ) inputString
[([ " 12 " , " 345 " , " 6 " , " 7 " ], " n License: Some open source license. " )]Вы можете увидеть, как он правильно извлек номер версии, даже с датой, представленной до него.
Теперь давайте проанализируем что -то более сложное - SCT -файлы.
Для выпуска Gifcurry Six мне нужно было проанализировать файлы SRT (текст SUPRIP). Файлы SRT содержат субтитры, которые программы обработки видео используют для отображения текста поверх видео. Как правило, этот текст является диалогом фильма, переведенного на различные языки. Удерживая текст отдельным от видео, должно быть только одно видео, которое экономит время, место для хранения и пропускную способность. Видеопрограммное обеспечение может заменить текст, не заменяя видео. Сравните это с сжиганием или жестким кодированием субтитров, где текст становится частью данных изображения, которые составляют видео. В этом случае вам понадобится видео для каждой коллекции субтитров.
Внутреннее видео © Blender Foundation | www.sintel.org
Gifcurry может взять файл SRT и сжечь субтитры для видео среза вашего выбора.
7
00:02:09,400 --> 00:02:13,800
What brings you to
the land of the gatekeepers?
8
00:02:15,000 --> 00:02:17,500
I'm searching for someone.
9
00:02:18,000 --> 00:02:22,200
Someone very dear?
A kindred spirit?Здесь вы видите английские субтитры для Sintel (© Blender Foundation | www.sintel.org).
SRT, пожалуй, самый базовый из всех форматов субтитров.
SRT Subtitle | Матроск
Формат файла SRT состоит из блоков, по одному для каждого подзаголовка, разделенного пустой линией.
2В верхней части блока есть индекс. Это определяет порядок субтитров. Надеемся, что субтитры уже в порядке, и все они имеют уникальные индексы, но это может быть не так.
01:04:13,000 --> 02:01:01,640 X1:167 X2:267 Y1:33 Y2:63После того, как индекс - время начала, время окончания и необязательный набор точек, указывающий прямоугольник, должен входить текст подзатинка.
01:04:13,000 Формат TimeStamp - hours:minutes:seconds,milliseconds .
Обратите внимание на запятую вместо периода, отделяющего секунды от миллисекундов.
This is the actual subtitle
text. It can span multiple lines.
It may include formating
like <b>bold</b>, <i>italic</i>,
<u>underline</u>,
and <font color="#010101">font color</font>.Третья и последняя часть блока - это текст подзаголовок. Он может охватывать несколько линий и концов, когда есть пустая линия. Текст может включать форматирование тегов, напоминающих HTML.
parseSrt
:: ReadP [ SrtSubtitle ]
parseSrt
=
manyTill parseBlock (skipSpaces >> eof) parseSrt - основной комбинатор синтаксического анализатора, который справляется со всем. Он анализирует каждый блок, пока не достигнет конца файла ( eof ) или входа. Чтобы быть на безопасной стороне, между последним блоком и окончанием файла может быть пробел. Чтобы справиться с этим, он анализирует ноль или более символов пробела ( skipSpaces ), прежде чем анализировать конец файла ( skipSpaces >> eof ). Если к тому времени, когда будет достигнут eof , останется вход, eof не удастся, и это ничего не вернет. Поэтому важно, чтобы parseBlock не оставил ничего, кроме как позади.
parseBlock
:: ReadP SrtSubtitle
parseBlock
= do
i <- parseIndex
(s, e) <- parseTimestamps
c <- parseCoordinates
t <- parseTextLines
return
SrtSubtitle
{ index = i
, start = s
, end = e
, coordinates = c
, taggedText = t
} Как мы пережили ранее, блок состоит из индекса, метки времени, возможно, некоторых координат и некоторых строк текста. В этой версии parseBlock вы видите более императивный стиль нотации с синтаксисом записи.
parseBlock'
:: ReadP SrtSubtitle
parseBlock'
=
SrtSubtitle
<$> parseIndex
<*> parseStartTimestamp
<*> parseEndTimestamp
<*> parseCoordinates
<*> parseTextLines Вот еще один способ написать parseBlock . Это притворный стиль. Просто обязательно сделайте заказ правильно. Например, я мог бы случайно смешать начальные и конечные временные метки.
parseIndex
:: ReadP Int
parseIndex
=
skipSpaces
>> readInt <$> parseNumber В верхней части блока есть индекс. Здесь вы снова видите skipSpaces . После прохождения пробелов, он анализирует вход для чисел и преобразует его в фактическое целое число.
readInt
:: String
-> Int
readInt
=
read readInt выглядит так.
> read " 123 " :: Int
123
> read " 1abc " :: Int
*** Exception : Prelude. read : no parse Обычно использование read непосредственно может быть опасным. read может быть не в состоянии преобразовать вход в указанный тип. Тем не менее, parseNumber будет возвращать только 10 цифрных символов ( ['0'..'9'] ), поэтому использование read напрямую становится безопасным.
Расположение временных метров немного более вовлечено, чем анализ индекса.
parseTimestamps
:: ReadP ( Timestamp , Timestamp )
parseTimestamps
= do
_ <- char ' n '
s <- parseTimestamp
_ <- skipSpaces
_ <- string " --> "
_ <- skipSpaces
e <- parseTimestamp
return (s, e)Это основной комбинатор для анализа временных метров.
char Saces дает персонаж, который вы ему даете, или он терпит неудачу. Если он не удается, то parseTimestamps не удается, в конечном итоге заставив parseSrt выходить из строя, поэтому после индекса должен быть новый символ.
string похожа на char , за исключением того, что вместо одного символа, он анализирует строку символов, которые вы его даете, или не удается.
parseStartTimestamp
:: ReadP Timestamp
parseStartTimestamp
=
char ' n '
>> parseTimestamp parseTimestamps Sanaings обе временные метки, но для применения ( parseSrt' ) нам нужен синтаксический анализатор только для начала временной метки.
parseEndTimestamp
:: ReadP Timestamp
parseEndTimestamp
=
skipSpaces
>> string " --> "
>> skipSpaces
>> parseTimestampЭто анализирует все между метками времени и возвращает конечную метку времени.
parseTimestamp
:: ReadP Timestamp
parseTimestamp
= do
h <- parseNumber
_ <- char ' : '
m <- parseNumber
_ <- char ' : '
s <- parseNumber
_ <- char ' , ' <|> char ' . '
m' <- parseNumber
return
Timestamp
{ hours = readInt h
, minutes = readInt m
, seconds = readInt s
, milliseconds = readInt m'
}Это анализирует четыре числа, которые составляют метку времени. Первые три числа разделены толстой кишкой, а последнее отделено запятой. Однако, чтобы быть более прощающим, мы допускаем возможность возникновения периода вместо запятой.
> readP_to_S (char ' . ' <|> char ' , ' ) " ... "
[( ' . ' , " .. " )]
> readP_to_S (char ' . ' <|> char ' , ' ) " ,.. "
[( ' , ' , " .. " )] Обратите внимание, что при использовании char с <|> только одна сторона может добиться успеха (два char ввода, один отпуск char ), так как char потребляет одного символа, а два символа не могут занимать одно и то же пространство.
Координаты являются необязательной частью блока, но в случае его включения будут на той же линии, что и временные метки.
parseCoordinates
:: ReadP ( Maybe SrtSubtitleCoordinates )
parseCoordinates
=
option Nothing $ do
_ <- skipSpaces1
x1 <- parseCoordinate ' x ' 1
_ <- skipSpaces1
x2 <- parseCoordinate ' x ' 2
_ <- skipSpaces1
y1 <- parseCoordinate ' y ' 1
_ <- skipSpaces1
y2 <- parseCoordinate ' y ' 2
return
$ Just
SrtSubtitleCoordinates
{ x1 = readInt x1
, x2 = readInt x2
, y1 = readInt y1
, y2 = readInt y2
} option принимает два аргумента. Первый аргумент возвращается, если второй аргумент, анализатор, терпит неудачу. Так что, если координат анализатор не удается, parseCoordinates Nothing вернут. Иными словами, сбой координатчанного анализатора не заставляет весь анализатор провалиться. Этот блок просто не будет иметь Nothing для его coordinates «Поле».
parseCoordinate
:: Char
-> Int
-> ReadP String
parseCoordinate
c
n
= do
_ <- char ( Data.Char. toUpper c) <|> char ( Data.Char. toLower c)
_ <- string $ show n ++ " : "
parseNumber Этот анализатор позволяет координатным меткам находиться в верхнем или нижнем регистре. Например, x1:1 X2:2 Y1:3 y2:4 удастся.
Расположение текста является наиболее вовлеченной частью из-за форматирования HTML-подобного тега.
Расположение тегов может быть сложным - просто спросите любого, кто анализирует их с регулярным выражением. Чтобы упростить это для нас - и для пользователя - мы будем использовать подход супа. Сигнал разрешит незаконные и/или неправильно вложенные теги. Это также позволит любой тег, а не только b , u , i и font .
parseTextLines
:: ReadP [ TaggedText ]
parseTextLines
=
char ' n '
>> (getTaggedText <$> manyTill parseAny parseEndOfTextLines) Мы начинаем с сопоставления с персонажем Newline. После этого мы Functor Map или FMAP ( <$> ) getTaggedText над текстовыми символами подзаголовок, пока не достигнем конца текстовых строк.
parseEndOfTextLines
:: ReadP ()
parseEndOfTextLines
=
void (string " nn " ) <|> eof Мы прекращаем собирать символы ( parseAny ), когда мы достигаем двух новых символов или конца файла. Это сигнализирует о конце блока.
getTaggedText
:: String
-> [ TaggedText ]
getTaggedText
s
=
fst
$ foldl
folder
( [] , [] )
parsed
where getTaggedText складывается через проанализированный текст слева направо, возвращая накопленный тег.
parsed
:: [ String ]
parsed
=
case readP_to_S (parseTaggedText [] ) s of
[] -> [s]
r @ (_ : _) -> ( fst . last ) r parsed возвращает список из одной или нескольких струн. Он пытается проанализировать входной текст для тегов. Если это не удается, parsed возвращает входную строку внутри списка. В противном случае, если parseTaggedText добивается успеха, parse возвращает последний возможный анализ ( (fst . last) r ).
folder
:: ([ TaggedText ], [ Tag ])
-> String
-> ([ TaggedText ], [ Tag ])
folder
(tt, t)
x
| isTag x = (tt, updateTags t x)
| otherwise = (tt ++ [ TaggedText { text = x, tags = t}], t) По мере того, как folder перемещается слева направо, через проанализированные строки, она проверяет, является ли тег -строка. Если это тег, он обновляет текущий набор активных тегов ( t ). В противном случае он добавляет еще одну тегнутую часть текста, связанный с набором активных тегов.
updateTags
:: [ Tag ]
-> String
-> [ Tag ]
updateTags
tags
x
| isClosingTag x = remove compare' tags (makeTag x)
| isOpeningTag x = add compare' tags (makeTag x)
| otherwise = tags
where
compare'
:: Tag
-> Tag
-> Bool
compare'
a
b
=
name a /= name b updateTags обновляет tags приведенные либо удалением, либо добавлением данного тега ( x ) в зависимости от того, является ли это закрывающим или открывающим тегом. Если это не так, это просто возвращает прошедший набор тегов. add будет перезаписать существующий тег, если tags уже имеют тег с тем же именем. Вы можете увидеть это в данной функции compare' .
Чтобы оставить анализатор простым, если найден открывающее тег T , T добавляется в список тегов или перезаписывает выход T если уже присутствует. Если найдено соответствующее закрытие /T , то T удаляется из списка тегов, если присутствует. Не имеет значения, есть ли два или более T S подряд, один или несколько T S без закрытия /T , и /или есть закрытие /T без открытия T .
makeTag
:: String
-> Tag
makeTag
s
=
Tag
{ name = getTagName s
, attributes = getTagAttributes s
} makeTag собирает тег из заданной s . Каждый Tag имеет имя и ноль или более атрибутов.
parseTaggedText
:: [ String ]
-> ReadP [ String ]
parseTaggedText
strings
= do
s <- look
case s of
" " -> return strings
_ -> do
r <- munch1 ( /= ' < ' ) <++ parseClosingTag <++ parseOpeningTag
parseTaggedText $ strings ++ [r] parseTaggedText возвращает входную строку, разбитую на части. Каждая часть является либо текстом, заключенным в теги, закрывающий тег, либо первым тегом. После того, как он разбивает кусок, он добавляет его к другим кусочкам и снова вызывает себя. Если оставшаяся входная строка пуста, она возвращает список найденных строк.
> readP_to_S (string " ab " <++ string " abc " ) " abcd "
[( " ab " , " cd " )]
> readP_to_S (string " ab " +++ string " abc " ) " abcd "
[( " ab " , " cd " ),( " abc " , " d " )]
> readP_to_S (string " ab " <|> string " abc " ) " abcd "
[( " ab " , " cd " ),( " abc " , " d " )] Оператор <++ остается смещенным, что означает, что если левая сторона будет успешной, он даже не будет беспокоиться о праве. Напомним, что когда мы запускаем анализатор, мы получаем список всех возможных перевозок. Все эти возможные повторения являются результатом того, что анализатор прошел все возможные пути. Используя <++ , мы получаем возможные прослушивания от левого пути и от правого пути, когда и только тогда, когда левая сторона не удалась. Если вы хотите, чтобы все возможные сравнения через левую и правую сторону вы можете использовать оператор +++ , предоставленный ReadP . +++ - это просто <|> , который мы видели выше.
parseOpeningTag
:: ReadP String
parseOpeningTag
= do
_ <- char ' < '
t <- munch1 ( c -> c /= ' / ' && c /= ' > ' )
_ <- char ' > '
return $ " < " ++ t ++ " > "Открывающаяся метка - это шахта для открытия, какой -то текст, который не включает в себя прямую черту, и следующий непосредственный угловой кронштейн закрытия.
parseClosingTag
:: ReadP String
parseClosingTag
= do
_ <- char ' < '
_ <- char ' / '
t <- munch1 ( /= ' > ' )
_ <- char ' > '
return $ " </ " ++ t ++ " > "Закрывающий тег представляет собой угловой кронштейн открытия, передняя черта, немного текста и следующий непосредственный закрывающий кронштейн.
getTagAttributes
:: String
-> [ TagAttribute ]
getTagAttributes
s
=
if isOpeningTag s
then
case readP_to_S (parseTagAttributes [] ) s of
[] -> []
(x : _) -> fst x
else
[] Открытые теги могут иметь атрибуты. Например, <font color="#101010"> . Каждый атрибут представляет собой двухпроходную пару, клавиш-значения. В приведенном выше примере color будет ключом, а #101010 будет значением.
getTagName
:: String
-> String
getTagName
s
=
case readP_to_S parseTagName s of
[] -> " "
(x : _) -> toLower' $ fst xЭто возвращает имя тега в нижнем регистре.
parseTagName
:: ReadP String
parseTagName
= do
_ <- char ' < '
_ <- munch ( == ' / ' )
_ <- skipSpaces
n <- munch1 ( c -> c /= ' ' && c /= ' > ' )
_ <- munch ( /= ' > ' )
_ <- char ' > '
return nИмя тега-это первая строка символов, не относящихся к бегству, после угла кронштейна открытия, возможной переходной черты и некоторых возможных пробелов и перед еще большим количеством пробелов и/или углового кронштейна закрытия.
parseTagAttributes
:: [ TagAttribute ]
-> ReadP [ TagAttribute ]
parseTagAttributes
tagAttributes
= do
s <- look
case s of
" " -> return tagAttributes
_ -> do
let h = head s
case h of
' > ' -> return tagAttributes
' < ' -> trimTagname >> parseTagAttributes'
_ -> parseTagAttributes'
where
parseTagAttributes'
:: ReadP [ TagAttribute ]
parseTagAttributes'
= do
tagAttribute <- parseTagAttribute
parseTagAttributes
( add
( a b -> fst a /= fst b)
tagAttributes
tagAttribute
) parseTagAttributes рекурсивно проходит через входную строку, собирая пары клавиш. В начале тега ( < ) он сначала обрезает имя тега, прежде чем заняться атрибутами. Он останавливает анализ для атрибутов, когда достигает углового кронштейна закрытия ( > ). Если тег имеет дублируемые атрибуты (на основе ключа), add обеспечит, чтобы только последний остался в списке.
trimTagname
:: ReadP ()
trimTagname
=
char ' < '
>> skipSpaces
>> munch1 ( c -> c /= ' ' && c /= ' > ' )
>> return ()Это обрезает или отбрасывает имя тега.
parseTagAttribute
:: ReadP TagAttribute
parseTagAttribute
= do
_ <- skipSpaces
k <- munch1 ( /= ' = ' )
_ <- string " = " "
v <- munch1 ( /= ' " ' )
_ <- char ' " '
_ <- skipSpaces
return (toLower' k, v)Ключ атрибута-это любая строка не сборочных символов перед равным знаком. Значение атрибута - это любые символы после равного знака и двойной цитаты и перед следующей немедленной двойной цитатой.
isTag
:: String
-> Bool
isTag
s
=
isOpeningTag s || isClosingTag sСтрока - это тег, если это либо открывающая тег, либо закрывающая тег.
isOpeningTag
:: String
-> Bool
isOpeningTag
s
=
isPresent $ readP_to_S parseOpeningTag sСтрока - это открывающая тег, если вступительный анализатор тега достигает успеха.
isClosingTag
:: String
-> Bool
isClosingTag
s
=
isPresent $ readP_to_S parseClosingTag sСтрока - это закрывающий тег, если подготовка для закрытия тега.
Теперь, когда мы собрали анализатор, давайте попробуем.
> let srt =
> " 1 n
> :0:0,1 --> 0:1:0.2 x1:1 X2:3 y1:4 y2:10 n
> <font color= " red " color= " blue " >This is some <b><u><i> n
> subtitle n
> </u>text.</b> "
> readP_to_S parseSrt srt
[([ SrtSubtitle
{ index = 1
, start = Timestamp {hours = 0 , minutes = 0 , seconds = 0 , milliseconds = 1 }
, end = Timestamp {hours = 0 , minutes = 1 , seconds = 0 , milliseconds = 2 }
, coordinates = Just ( SrtSubtitleCoordinates {x1 = 1 , x2 = 3 , y1 = 4 , y2 = 10 })
, taggedText = [ TaggedText
{ text = " This is some "
, tags = [ Tag {name = " font " , attributes = [( " color " , " blue " )]}
]
}
, TaggedText
{ text = " n subtitle n "
, tags = [ Tag {name = " font " , attributes = [( " color " , " blue " )]}
, Tag {name = " b " , attributes = [] }
, Tag {name = " u " , attributes = [] }
, Tag {name = " i " , attributes = [] }
]
}
, TaggedText
{ text = " text. "
, tags = [ Tag {name = " font " , attributes = [( " color " , " blue " )]}
, Tag {name = " b " , attributes = [] }
, Tag {name = " i " , attributes = [] }
]
}
, TaggedText
{ text = " "
, tags = [ Tag {name = " font " , attributes = [( " color " , " blue " )]}
, Tag {name = " i " , attributes = [] }
]
}
]
}
]
, " "
)]Здесь вы видите результат анализа тестовой строки. Обратите внимание на ошибки в тестовой строке, например, использование периода вместо запятой или атрибута дублированного тега.
(C) 2019 Дэвид Леттиер
lettier.com
