{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module GhcTags.CTag.Parser
( parseTagsFile
, parseTagsFileMap
, parseTagLine
, parseTag
, parseHeader
) where
import Control.Arrow ((***))
import Control.Applicative (many, (<|>))
import Control.DeepSeq (NFData)
import Control.Monad (guard)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Attoparsec.ByteString (Parser, (<?>))
import qualified Data.Attoparsec.ByteString as AB
import qualified Data.Attoparsec.ByteString.Char8 as AChar
import Data.Either (partitionEithers)
import Data.Functor (void, ($>))
import Data.Function (on)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified System.FilePath.ByteString as FilePath
import GhcTags.Tag
import qualified GhcTags.Utils as Utils
import GhcTags.CTag.Header
import GhcTags.CTag.Utils
parseTag :: Parser CTag
parseTag :: Parser CTag
parseTag =
(\TagName
tagName TagFilePath
tagFilePath TagAddress 'CTAG
tagAddr (TagKind
tagKind, TagFields 'CTAG
tagFields)
-> Tag { TagName
tagName :: TagName
tagName :: TagName
tagName
, TagFilePath
tagFilePath :: TagFilePath
tagFilePath :: TagFilePath
tagFilePath
, TagAddress 'CTAG
tagAddr :: TagAddress 'CTAG
tagAddr :: TagAddress 'CTAG
tagAddr
, TagKind
tagKind :: TagKind
tagKind :: TagKind
tagKind
, TagFields 'CTAG
tagFields :: TagFields 'CTAG
tagFields :: TagFields 'CTAG
tagFields
, tagDefinition :: TagDefinition 'CTAG
tagDefinition = forall (tk :: TAG_KIND). TagDefinition tk
NoTagDefinition
})
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TagName
parseTagName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
separator
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TagFilePath
parseTagFileName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
separator
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (TagAddress 'CTAG)
parseTagAddress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (
((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Parser Char
separator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString TagKind
parseKindField )
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser Char
separator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (TagFields 'CTAG)
parseFields forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser ()
endOfLine forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Monoid a => a
mempty)
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a. a -> a
id TagKind
NoKind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Parser Char
separator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (TagFields 'CTAG)
parseFields forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser ()
endOfLine forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Monoid a => a
mempty
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Char -> TagKind
charToTagKind forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. a -> a
id)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Parser Char
separator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Char
AChar.satisfy Char -> Bool
notTabOrNewLine )
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser Char
separator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (TagFields 'CTAG)
parseFields forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser ()
endOfLine forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Monoid a => a
mempty
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
endOfLine forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (TagKind
NoKind, forall a. Monoid a => a
mempty)
)
where
separator :: Parser Char
separator :: Parser Char
separator = Char -> Parser Char
AChar.char Char
'\t'
parseTagName :: Parser TagName
parseTagName :: Parser TagName
parseTagName = Text -> TagName
TagName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\t')
forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"parsing tag name failed"
parseTagFileName :: Parser TagFilePath
parseTagFileName :: Parser TagFilePath
parseTagFileName =
Text -> TagFilePath
TagFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
FilePath.normalise
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\t')
parseExCommand :: Parser ExCommand
parseExCommand :: Parser ExCommand
parseExCommand = (\ByteString
x -> Text -> ExCommand
ExCommand forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take (ByteString -> Int
BS.length ByteString
x forall a. Num a => a -> a -> a
- Int
1) ByteString
x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. s -> (s -> Char -> Maybe s) -> Parser ByteString
AChar.scan [Char]
"" [Char] -> Char -> Maybe [Char]
go
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
AChar.anyChar
where
go :: String -> Char -> Maybe String
go :: [Char] -> Char -> Maybe [Char]
go ![Char]
s Char
c |
forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
Utils.endOfLine) (Char
c forall a. a -> [a] -> [a]
: [Char]
s)
forall a. Eq a => a -> a -> Bool
== forall a. [a] -> [a]
reverse [Char]
Utils.endOfLine
= forall a. Maybe a
Nothing
|
[Char]
l forall a. Eq a => a -> a -> Bool
== [Char]
"\";" = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just [Char]
l
where
l :: [Char]
l = forall a. Int -> [a] -> [a]
take Int
2 (Char
c forall a. a -> [a] -> [a]
: [Char]
s)
parseTagAddress :: Parser CTagAddress
parseTagAddress :: Parser (TagAddress 'CTAG)
parseTagAddress =
forall (tk :: TAG_KIND). Int -> TagAddress tk
TagLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => Parser a
AChar.decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ()
endOfLine forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> Parser ByteString
AB.string ByteString
";\""))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
ExCommand -> TagAddress 'CTAG
TagCommand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ExCommand
parseExCommand
parseKindField :: Parser TagKind
parseKindField :: Parser ByteString TagKind
parseKindField = do
Text
x <-
ByteString -> Text
Text.decodeUtf8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Parser ByteString
AB.string ByteString
"kind:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int
Text.length Text
x forall a. Eq a => a -> a -> Bool
== Int
1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char -> TagKind
charToTagKind (Text -> Char
Text.head Text
x)
parseFields :: Parser CTagFields
parseFields :: Parser ByteString (TagFields 'CTAG)
parseFields = [TagField] -> TagFields 'CTAG
TagFields forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
AChar.sepBy Parser TagField
parseField Parser Char
separator
parseField :: Parser TagField
parseField :: Parser TagField
parseField =
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Text -> Text -> TagField
TagField ByteString -> Text
Text.decodeUtf8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile (\Char
x -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
':' Bool -> Bool -> Bool
&& Char -> Bool
notTabOrNewLine Char
x)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
AChar.char Char
':'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine
parseTags :: Parser [Either Header CTag]
parseTags :: Parser [Either Header CTag]
parseTags = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Either Header CTag)
parseTagLine
parseTagLine :: Parser (Either Header CTag)
parseTagLine :: Parser (Either Header CTag)
parseTagLine =
forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
AChar.eitherP
(Parser ByteString Header
parseHeader forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"failed parsing tag")
(Parser CTag
parseTag forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"failed parsing header")
parseHeader :: Parser Header
= do
Bool
e <- ByteString -> Parser ByteString
AB.string ByteString
"!_TAG_" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
ByteString -> Parser ByteString
AB.string ByteString
"!_" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
if Bool
e then forall a b c. (a -> b -> c) -> b -> a -> c
flip forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HeaderType Text
PseudoTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Bool) -> Parser ByteString
AChar.takeWhile (\Char
x -> Char -> Bool
notTabOrNewLine Char
x Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
'!')
else do
SomeHeaderType
headerType <-
ByteString -> Parser ByteString
AB.string ByteString
"FILE_ENCODING" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Text
FileEncoding
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"FILE_FORMAT" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Int
FileFormat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"FILE_SORTED" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Int
FileSorted
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"OUTPUT_MODE" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Text
OutputMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"KIND_DESCRIPTION" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Text
KindDescription
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"KIND_SEPARATOR" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Text
KindSeparator
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"PROGRAM_AUTHOR" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Text
ProgramAuthor
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"PROGRAM_NAME" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Text
ProgramName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"PROGRAM_URL" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Text
ProgramUrl
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"PROGRAM_VERSION" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Text
ProgramVersion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"EXTRA_DESCRIPTION" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Text
ExtraDescription
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
AB.string ByteString
"FIELD_DESCRIPTION" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall ty. HeaderType ty -> SomeHeaderType
SomeHeaderType HeaderType Text
FieldDescription
case SomeHeaderType
headerType of
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
FileEncoding ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
FileFormat ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht forall a. Integral a => Parser a
AChar.decimal
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
FileSorted ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht forall a. Integral a => Parser a
AChar.decimal
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
OutputMode ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
KindDescription ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
KindSeparator ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
ProgramAuthor ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
ProgramName ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
ProgramUrl ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
ProgramVersion ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
ExtraDescription ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
SomeHeaderType ht :: HeaderType ty
ht@HeaderType ty
FieldDescription ->
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht (ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine)
SomeHeaderType PseudoTag {} ->
forall a. HasCallStack => [Char] -> a
error [Char]
"parseHeader: impossible happened"
where
parsePseudoTagArgs :: NFData ty
=> Show ty
=> HeaderType ty
-> Parser ty
-> Parser Header
parsePseudoTagArgs :: forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Parser ty -> Parser ByteString Header
parsePseudoTagArgs HeaderType ty
ht Parser ty
parseArg =
forall ty.
(NFData ty, Show ty) =>
HeaderType ty -> Maybe Text -> ty -> Text -> Header
Header HeaderType ty
ht
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
AChar.char Char
'!' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notTabOrNewLine))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
AChar.char Char
'\t' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ty
parseArg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
AChar.char Char
'\t' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
parseComment)
parseComment :: Parser Text
parseComment :: Parser ByteString Text
parseComment =
Char -> Parser Char
AChar.char Char
'/'
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text
Text.init forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString
AChar.takeWhile Char -> Bool
notNewLine)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine
parseTagsFile :: ByteString
-> IO (Either String [Either Header CTag])
parseTagsFile :: ByteString -> IO (Either [Char] [Either Header CTag])
parseTagsFile =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall r. Result r -> Either [Char] r
AChar.eitherResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
m ByteString -> Parser a -> ByteString -> m (Result a)
AChar.parseWith (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) Parser [Either Header CTag]
parseTags
parseTagsFileMap :: ByteString
-> IO (Either String ([Header], CTagMap))
parseTagsFileMap :: ByteString -> IO (Either [Char] ([Header], CTagMap))
parseTagsFileMap =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either Header CTag] -> ([Header], CTagMap)
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO (Either [Char] [Either Header CTag])
parseTagsFile
where
f :: [Either Header CTag] -> ([Header], CTagMap)
f :: [Either Header CTag] -> ([Header], CTagMap)
f [Either Header CTag]
as = case forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either Header CTag]
as of
([Header]
headers, [CTag]
tags) ->
([Header]
headers, forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) [(forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath CTag
tag, [CTag
tag]) | CTag
tag <- [CTag]
tags])
endOfLine :: Parser ()
endOfLine :: Parser ()
endOfLine = ByteString -> Parser ByteString
AB.string ByteString
"\r\n" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
AChar.char Char
'\r' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
AChar.char Char
'\n' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
notTabOrNewLine :: Char -> Bool
notTabOrNewLine :: Char -> Bool
notTabOrNewLine = \Char
x -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\t' Bool -> Bool -> Bool
&& Char -> Bool
notNewLine Char
x
notNewLine :: Char -> Bool
notNewLine :: Char -> Bool
notNewLine = \Char
x -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\r'