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

-- | Parser combinators for etags file format
--
module GhcTags.ETag.Parser
  ( parseTagsFile
  , parseTagFileSection
  , parseTag
  ) where

import           Control.Applicative (many, (<|>))
import           Data.ByteString (ByteString)
import           Data.Attoparsec.ByteString  (Parser, (<?>))
import qualified Data.Attoparsec.ByteString  as AB
import qualified Data.Attoparsec.ByteString.Char8  as AChar
import           Data.Functor (($>))
import           Data.Text (Text)
import qualified Data.Text.Encoding as Text
import qualified System.FilePath.ByteString as FilePath

import           GhcTags.Tag
import qualified GhcTags.Utils as Utils


-- | Parse whole etags file
--
parseTagsFile :: ByteString
              -> IO (Either String [ETag])
parseTagsFile :: ByteString -> IO (Either String [ETag])
parseTagsFile =
      (Result [ETag] -> Either String [ETag])
-> IO (Result [ETag]) -> IO (Either String [ETag])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Result [ETag] -> Either String [ETag]
forall r. Result r -> Either String r
AB.eitherResult
    (IO (Result [ETag]) -> IO (Either String [ETag]))
-> (ByteString -> IO (Result [ETag]))
-> ByteString
-> IO (Either String [ETag])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ByteString -> Parser [ETag] -> ByteString -> IO (Result [ETag])
forall (m :: * -> *) a.
Monad m =>
m ByteString -> Parser a -> ByteString -> m (Result a)
AB.parseWith (ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
forall a. Monoid a => a
mempty)
                   ([[ETag]] -> [ETag]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ETag]] -> [ETag]) -> Parser ByteString [[ETag]] -> Parser [ETag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ETag] -> Parser ByteString [[ETag]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser [ETag]
parseTagFileSection)


-- | Parse tags from a single file (a single section in etags file).
--
parseTagFileSection :: Parser [ETag]
parseTagFileSection :: Parser [ETag]
parseTagFileSection = do
      TagFilePath
tagFilePath <-
        Char -> Parser Char
AChar.char Char
'\x0c' Parser Char -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
endOfLine
                          Parser ByteString ()
-> Parser ByteString TagFilePath -> Parser ByteString TagFilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString TagFilePath
parseTagFilePath
      Parser ByteString ETag -> Parser [ETag]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (TagFilePath -> Parser ByteString ETag
parseTag TagFilePath
tagFilePath)

parseTagFilePath :: Parser TagFilePath
parseTagFilePath :: Parser ByteString TagFilePath
parseTagFilePath =
      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
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Char -> Bool
Utils.notNewLine Char
x)
  Parser ByteString TagFilePath
-> Parser Char -> Parser ByteString TagFilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AChar.char Char
','
  Parser ByteString TagFilePath
-> Parser ByteString Int -> Parser ByteString TagFilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  (Parser ByteString Int
forall a. Integral a => Parser a
AChar.decimal :: Parser Int)
  Parser ByteString TagFilePath
-> Parser ByteString () -> Parser ByteString TagFilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser ByteString ()
endOfLine
  Parser ByteString TagFilePath
-> String -> Parser ByteString TagFilePath
forall i a. Parser i a -> String -> Parser i a
<?> String
"parsing tag file name failed"


-- | Parse an 'ETag' from a single line.
--
parseTag :: TagFilePath -> Parser ETag
parseTag :: TagFilePath -> Parser ByteString ETag
parseTag TagFilePath
tagFilePath =
          Text -> Maybe TagName -> Int -> Int -> ETag
mkTag
      (Text -> Maybe TagName -> Int -> Int -> ETag)
-> Parser ByteString Text
-> Parser ByteString (Maybe TagName -> Int -> Int -> ETag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
parseTagDefinition
      Parser ByteString (Maybe TagName -> Int -> Int -> ETag)
-> Parser ByteString (Maybe TagName)
-> Parser ByteString (Int -> Int -> ETag)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((TagName -> Maybe TagName
forall a. a -> Maybe a
Just (TagName -> Maybe TagName)
-> Parser ByteString TagName -> Parser ByteString (Maybe TagName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString TagName
parseTagName) Parser ByteString (Maybe TagName)
-> Parser ByteString (Maybe TagName)
-> Parser ByteString (Maybe TagName)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TagName -> Parser ByteString (Maybe TagName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TagName
forall a. Maybe a
Nothing)
      Parser ByteString (Int -> Int -> ETag)
-> Parser ByteString Int -> Parser ByteString (Int -> ETag)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
AChar.decimal
      Parser ByteString (Int -> ETag)
-> Parser Char -> Parser ByteString (Int -> ETag)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AChar.char Char
','
      Parser ByteString (Int -> ETag)
-> Parser ByteString Int -> Parser ByteString ETag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
AChar.decimal
      Parser ByteString ETag
-> Parser ByteString () -> Parser ByteString ETag
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser ByteString ()
endOfLine
      Parser ByteString ETag -> String -> Parser ByteString ETag
forall i a. Parser i a -> String -> Parser i a
<?> String
"parsing tag failed"
  where
    mkTag :: Text -> Maybe TagName -> Int -> Int -> ETag
    mkTag :: Text -> Maybe TagName -> Int -> Int -> ETag
mkTag Text
tagDefinition Maybe TagName
mTagName Int
lineNo Int
byteOffset = 
      Tag :: forall (tk :: TAG_KIND).
TagName
-> TagKind tk
-> TagFilePath
-> TagAddress tk
-> TagDefinition tk
-> TagFields tk
-> Tag tk
Tag { tagName :: TagName
tagName       = case Maybe TagName
mTagName of
                              Maybe TagName
Nothing   -> Text -> TagName
TagName Text
tagDefinition
                              Just TagName
name -> TagName
name
          , tagKind :: TagKind 'ETAG
tagKind       = TagKind 'ETAG
forall (tk :: TAG_KIND). TagKind tk
NoKind
          , TagFilePath
tagFilePath :: TagFilePath
tagFilePath :: TagFilePath
tagFilePath
          , tagAddr :: TagAddress 'ETAG
tagAddr       = Int -> Int -> TagAddress 'ETAG
forall (tk :: TAG_KIND). Int -> Int -> TagAddress tk
TagLineCol Int
lineNo Int
byteOffset
          , tagDefinition :: TagDefinition 'ETAG
tagDefinition = case Maybe TagName
mTagName of
                              Maybe TagName
Nothing -> TagDefinition 'ETAG
forall (tk :: TAG_KIND). TagDefinition tk
NoTagDefinition
                              Just TagName
_  -> Text -> TagDefinition 'ETAG
TagDefinition Text
tagDefinition
          , tagFields :: TagFields 'ETAG
tagFields     = TagFields 'ETAG
NoTagFields
          }

    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
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\SOH' Bool -> Bool -> Bool
&& Char -> Bool
Utils.notNewLine Char
x)
      Parser ByteString TagName
-> Parser Char -> Parser ByteString TagName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AChar.char Char
'\SOH'
      Parser ByteString TagName -> String -> Parser ByteString TagName
forall i a. Parser i a -> String -> Parser i a
<?> String
"parsing tag name failed"

    parseTagDefinition :: Parser Text
    parseTagDefinition :: Parser ByteString Text
parseTagDefinition =
          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
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\DEL' Bool -> Bool -> Bool
&& Char -> Bool
Utils.notNewLine Char
x)
      Parser ByteString Text -> Parser Char -> Parser ByteString Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AChar.char Char
'\DEL'
      Parser ByteString Text -> String -> Parser ByteString Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"parsing tag definition failed"

endOfLine :: Parser ()
endOfLine :: Parser ByteString ()
endOfLine = ByteString -> Parser ByteString ByteString
AChar.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 Char
AChar.char Char
'\r' Parser 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 Char
AChar.char Char
'\n' Parser Char -> () -> Parser ByteString ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()