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

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


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

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

          -- 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.
          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
                    )

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

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

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

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


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


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



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


--
-- Utils
--


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