{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Parser combinators for vim style tags (ctags)
--
module GhcTags.CTag.Parser
  ( parseTagsFile
  , parseTagsFileMap
  , parseTagLine
  -- * parse a ctag
  , parseTag
  -- * parse a pseudo-ctag
  , 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


-- | Parser for a 'CTag' from a single text line.
--
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

    -- includes an optional ';"' 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
<*> (  -- kind field followed by list of fields or end of line, e.g.
           -- '(TagField, CTagFields)'.
              ((,) 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)
                       )

          -- list of fields (kind field might be later, but don't check it, we
          -- always format it as the first field) or end of line.
          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
                    )

          -- kind encoded as a single letter, followed by a list
          -- of fields or end of line.
          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 until either eol or ';"' sequence is found.
        go :: String -> Char -> Maybe String

        go :: [Char] -> Char -> Maybe [Char]
go ![Char]
s Char
c  | -- eol
                   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

                 | -- ';"' sequence
                   [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)

    -- We only parse `TagLine` or `TagCommand`.
    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


-- | A vim-style tag file parser.
--
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


-- | Parse either a header line ot a 'CTag'.
--
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
parseHeader :: Parser ByteString Header
parseHeader = 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



-- | Parse a vim-style tag file.
--
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



-- | Parse a vim-style tag file.
--
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])

--
-- Utils
--


-- | Unlike 'AChar.endOfLine', it also matches for a single '\r' characters (which
-- marks enf of lines on darwin).
--
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'