{-# 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 =
(Result [ETag] -> Either String [ETag])
-> IO (Result [ETag]) -> IO (Either String [ETag])
forall a b. (a -> b) -> IO a -> IO b
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 a. a -> IO a
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])
-> ([(TagFilePath, [ETag])] -> [[ETag]])
-> [(TagFilePath, [ETag])]
-> [ETag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TagFilePath, [ETag]) -> [ETag])
-> [(TagFilePath, [ETag])] -> [[ETag]]
forall a b. (a -> b) -> [a] -> [b]
map (TagFilePath, [ETag]) -> [ETag]
forall a b. (a, b) -> b
snd ([(TagFilePath, [ETag])] -> [ETag])
-> Parser ByteString [(TagFilePath, [ETag])] -> Parser [ETag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (TagFilePath, [ETag])
-> Parser ByteString [(TagFilePath, [ETag])]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString (TagFilePath, [ETag])
parseTagFileSection)
parseTagsFileMap :: ByteString
-> IO (Either String ETagMap)
parseTagsFileMap :: ByteString -> IO (Either String ETagMap)
parseTagsFileMap =
(Result ETagMap -> Either String ETagMap)
-> IO (Result ETagMap) -> IO (Either String ETagMap)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Result ETagMap -> Either String ETagMap
forall r. Result r -> Either String r
AB.eitherResult
(IO (Result ETagMap) -> IO (Either String ETagMap))
-> (ByteString -> IO (Result ETagMap))
-> ByteString
-> IO (Either String ETagMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ByteString
-> Parser ETagMap -> ByteString -> IO (Result ETagMap)
forall (m :: * -> *) a.
Monad m =>
m ByteString -> Parser a -> ByteString -> m (Result a)
AB.parseWith (ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
forall a. Monoid a => a
mempty)
([(TagFilePath, [ETag])] -> ETagMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TagFilePath, [ETag])] -> ETagMap)
-> Parser ByteString [(TagFilePath, [ETag])] -> Parser ETagMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (TagFilePath, [ETag])
-> Parser ByteString [(TagFilePath, [ETag])]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString (TagFilePath, [ETag])
parseTagFileSection)
parseTagFileSection :: Parser (TagFilePath, [ETag])
parseTagFileSection :: Parser ByteString (TagFilePath, [ETag])
parseTagFileSection = do
TagFilePath
tagFilePath <-
Char -> Parser Char
AChar.char Char
'\x0c' Parser Char -> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
endOfLine
Parser ByteString ()
-> Parser ByteString TagFilePath -> Parser ByteString TagFilePath
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString TagFilePath
parseTagFilePath
(TagFilePath
tagFilePath,) ([ETag] -> (TagFilePath, [ETag]))
-> Parser [ETag] -> Parser ByteString (TagFilePath, [ETag])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ETag -> Parser [ETag]
forall a. Parser ByteString a -> Parser ByteString [a]
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
. RawFilePath -> ByteString
rawFilePathToBS
(RawFilePath -> ByteString)
-> (ByteString -> RawFilePath) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> RawFilePath
normaliseRawFilePath
(RawFilePath -> RawFilePath)
-> (ByteString -> RawFilePath) -> ByteString -> RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RawFilePath
rawFilePathFromBS
(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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
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"
parseTag :: TagFilePath -> Parser ETag
parseTag :: TagFilePath -> Parser ByteString ETag
parseTag TagFilePath
tagFilePath =
TagDefinition 'ETAG -> TagName -> ETagAddress -> ETag
mkTag
(TagDefinition 'ETAG -> TagName -> ETagAddress -> ETag)
-> Parser ByteString (TagDefinition 'ETAG)
-> Parser ByteString (TagName -> ETagAddress -> ETag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (TagDefinition 'ETAG)
parseTagDefinition
Parser ByteString (TagName -> ETagAddress -> ETag)
-> Parser ByteString TagName
-> Parser ByteString (ETagAddress -> ETag)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString TagName
parseTagName
Parser ByteString (ETagAddress -> ETag)
-> Parser ByteString ETagAddress -> Parser ByteString ETag
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ETagAddress
parseAddress
Parser ByteString ETag -> String -> Parser ByteString ETag
forall i a. Parser i a -> String -> Parser i a
<?> String
"parsing tag failed"
where
parseAddress :: Parser ETagAddress
parseAddress :: Parser ByteString ETagAddress
parseAddress =
Int -> ETagAddress
forall (tk :: TAG_KIND). Int -> TagAddress tk
TagLine (Int -> ETagAddress)
-> Parser ByteString Int -> Parser ByteString ETagAddress
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 ETagAddress
-> Parser Char -> Parser ByteString ETagAddress
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
AChar.char Char
','
Parser ByteString ETagAddress
-> Parser ByteString () -> Parser ByteString ETagAddress
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
endOfLine
Parser ByteString ETagAddress
-> Parser ByteString ETagAddress -> Parser ByteString ETagAddress
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Int -> ETagAddress
forall (tk :: TAG_KIND). Int -> Int -> TagAddress tk
TagLineCol (Int -> Int -> ETagAddress)
-> Parser ByteString Int -> Parser ByteString (Int -> ETagAddress)
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 (Int -> ETagAddress)
-> Parser Char -> Parser ByteString (Int -> ETagAddress)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
AChar.char Char
','
Parser ByteString (Int -> ETagAddress)
-> Parser ByteString Int -> Parser ByteString ETagAddress
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
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 ETagAddress
-> Parser ByteString () -> Parser ByteString ETagAddress
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
endOfLine
Parser ByteString ETagAddress
-> Parser ByteString ETagAddress -> Parser ByteString ETagAddress
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ETagAddress
NoAddress ETagAddress -> Parser Char -> Parser ByteString ETagAddress
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
AChar.char Char
','
Parser ByteString ETagAddress
-> Parser ByteString () -> Parser ByteString ETagAddress
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
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 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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
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 (TagDefinition ETAG)
parseTagDefinition :: Parser ByteString (TagDefinition 'ETAG)
parseTagDefinition =
(\Text
t -> if Text -> Bool
Text.null Text
t
then TagDefinition 'ETAG
forall (tk :: TAG_KIND). TagDefinition tk
NoTagDefinition
else Text -> TagDefinition 'ETAG
TagDefinition Text
t)
(Text -> TagDefinition 'ETAG)
-> (ByteString -> Text) -> ByteString -> TagDefinition 'ETAG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8
(ByteString -> TagDefinition 'ETAG)
-> Parser ByteString ByteString
-> Parser ByteString (TagDefinition 'ETAG)
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 (TagDefinition 'ETAG)
-> Parser Char -> Parser ByteString (TagDefinition 'ETAG)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
AChar.char Char
'\DEL'
Parser ByteString (TagDefinition 'ETAG)
-> String -> Parser ByteString (TagDefinition 'ETAG)
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 a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
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 a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
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
$> ()