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

-- | Parser combinators for etags file format
--
module GhcTags.ETag.Parser
  ( parseTagsFile
  , parseTagsFileMap
  , 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 qualified Data.Map.Strict as Map
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


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

-- | Parse whole etags file
--
parseTagsFileMap :: ByteString
                 -> IO (Either String ETagMap)
parseTagsFileMap :: ByteString -> IO (Either String ETagMap)
parseTagsFileMap =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall r. Result r -> Either String r
AB.eitherResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
m ByteString -> Parser a -> ByteString -> m (Result a)
AB.parseWith (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)
                   (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (TagFilePath, [ETag])
parseTagFileSection)

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

parseTagFilePath :: Parser TagFilePath
parseTagFilePath :: Parser ByteString TagFilePath
parseTagFilePath =
      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 (\Char
x -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Char -> Bool
Utils.notNewLine 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 -> f b -> f a
<*  (forall a. Integral a => Parser a
AChar.decimal :: Parser Int)
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser ByteString ()
endOfLine
  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 ETag
parseTag TagFilePath
tagFilePath =
          TagDefinition 'ETAG -> TagName -> ETagAddress -> ETag
mkTag
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (TagDefinition 'ETAG)
parseTagDefinition
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TagName
parseTagName
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ETagAddress
parseAddress
      forall i a. Parser i a -> String -> Parser i a
<?> String
"parsing tag failed"
  where
    parseAddress :: Parser ETagAddress
    parseAddress :: Parser ETagAddress
parseAddress =
          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
<*  Char -> Parser Char
AChar.char Char
','
                     forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser ByteString ()
endOfLine
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (tk :: TAG_KIND). Int -> Int -> TagAddress tk
TagLineCol 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
<*  Char -> Parser Char
AChar.char Char
','
                     forall (f :: * -> *) a b. Applicative f => 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 ByteString ()
endOfLine
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ETagAddress
NoAddress  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  Char -> Parser Char
AChar.char Char
','
                     forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser ByteString ()
endOfLine

    mkTag :: TagDefinition ETAG -> TagName -> ETagAddress -> ETag
    mkTag :: TagDefinition 'ETAG -> TagName -> ETagAddress -> ETag
mkTag TagDefinition 'ETAG
tagDefinition TagName
tagName ETagAddress
tagAddr =
      Tag { tagName :: TagName
tagName       = TagName
tagName
          , tagKind :: TagKind
tagKind       = TagKind
NoKind
          , TagFilePath
tagFilePath :: TagFilePath
tagFilePath :: TagFilePath
tagFilePath
          , ETagAddress
tagAddr :: ETagAddress
tagAddr :: ETagAddress
tagAddr
          , TagDefinition 'ETAG
tagDefinition :: TagDefinition 'ETAG
tagDefinition :: TagDefinition 'ETAG
tagDefinition
          , tagFields :: TagFields 'ETAG
tagFields     = TagFields 'ETAG
NoTagFields
          }

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

    parseTagDefinition :: Parser (TagDefinition ETAG)
    parseTagDefinition :: Parser (TagDefinition 'ETAG)
parseTagDefinition =
            (\Text
t -> if Text -> Bool
Text.null Text
t
                     then forall (tk :: TAG_KIND). TagDefinition tk
NoTagDefinition
                     else Text -> TagDefinition 'ETAG
TagDefinition Text
t)
          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
x -> Char
x forall a. Eq a => a -> a -> Bool
/= Char
'\DEL' Bool -> Bool -> Bool
&& Char -> Bool
Utils.notNewLine Char
x)
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser Char
AChar.char Char
'\DEL'
      forall i a. Parser i a -> String -> Parser i a
<?> String
"parsing tag definition failed"

endOfLine :: Parser ()
endOfLine :: Parser ByteString ()
endOfLine = ByteString -> Parser ByteString
AChar.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
$> ()