{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
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 GhcTags.Tag
import qualified GhcTags.Utils as Utils
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)
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)
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
rawFilePathToBS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
normaliseRawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
rawFilePathFromBS
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"
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
$> ()