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