{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
module GhcTags.ETag.Formatter
( withByteOffset
, formatETagsFile
, formatTagsFile
, formatTag
, BuilderWithSize (..)
) where
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BB
import Data.List (groupBy)
import Data.Function (on)
import Data.Foldable (foldl')
import qualified Data.Text.Encoding as Text
import GhcTags.Tag
data BuilderWithSize = BuilderWithSize {
BuilderWithSize -> Builder
builder :: Builder,
BuilderWithSize -> Int
builderSize :: !Int
}
instance Semigroup BuilderWithSize where
BuilderWithSize Builder
b0 Int
s0 <> :: BuilderWithSize -> BuilderWithSize -> BuilderWithSize
<> BuilderWithSize Builder
b1 Int
s1 =
Builder -> Int -> BuilderWithSize
BuilderWithSize (Builder
b0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b1) (Int
s0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s1)
instance Monoid BuilderWithSize where
mempty :: BuilderWithSize
mempty = Builder -> Int -> BuilderWithSize
BuilderWithSize Builder
forall a. Monoid a => a
mempty Int
0
computeByteOffset
:: [Int]
-> ETagAddress
-> ETagAddress
computeByteOffset :: [Int] -> ETagAddress -> ETagAddress
computeByteOffset [Int]
ll (TagLineCol Int
line Int
col) = Int -> Int -> ETagAddress
forall (tk :: TAG_KIND). Int -> Int -> TagAddress tk
TagLineCol Int
line Int
byteOffset
where
byteOffset :: Int
byteOffset =
(Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a. Enum a => a -> a
pred Int
line) [Int]
ll)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
col
withByteOffset :: [Int] -> ETag -> ETag
withByteOffset :: [Int] -> ETag -> ETag
withByteOffset [Int]
ll tag :: ETag
tag@Tag { ETagAddress
tagAddr :: forall (tk :: TAG_KIND). Tag tk -> TagAddress tk
tagAddr :: ETagAddress
tagAddr } = ETag
tag { tagAddr :: ETagAddress
tagAddr = [Int] -> ETagAddress -> ETagAddress
computeByteOffset [Int]
ll ETagAddress
tagAddr }
formatTag :: ETag -> BuilderWithSize
formatTag :: ETag -> BuilderWithSize
formatTag Tag {TagName
tagName :: forall (tk :: TAG_KIND). Tag tk -> TagName
tagName :: TagName
tagName, tagAddr :: forall (tk :: TAG_KIND). Tag tk -> TagAddress tk
tagAddr = TagLineCol Int
lineNr Int
byteOffset, TagDefinition 'ETAG
tagDefinition :: forall (tk :: TAG_KIND). Tag tk -> TagDefinition tk
tagDefinition :: TagDefinition 'ETAG
tagDefinition} =
(Builder -> Int -> BuilderWithSize)
-> Int -> Builder -> BuilderWithSize
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> Int -> BuilderWithSize
BuilderWithSize Int
tagSize (Builder -> BuilderWithSize) -> Builder -> BuilderWithSize
forall a b. (a -> b) -> a -> b
$
case TagDefinition 'ETAG
tagDefinition of
TagDefinition 'ETAG
NoTagDefinition -> ByteString -> Builder
BB.byteString ByteString
tagNameBS
TagDefinition Text
def -> ByteString -> Builder
BB.byteString (Text -> ByteString
Text.encodeUtf8 Text
def)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
'\DEL'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case TagDefinition 'ETAG
tagDefinition of
TagDefinition 'ETAG
NoTagDefinition -> Builder
forall a. Monoid a => a
mempty
TagDefinition Text
_ ->
ByteString -> Builder
BB.byteString ByteString
tagNameBS
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
'\SOH'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec Int
lineNr
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
','
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec Int
byteOffset
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BB.stringUtf8 String
endOfLine
where
tagNameBS :: ByteString
tagNameBS = Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (TagName -> Text) -> TagName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagName -> Text
getTagName (TagName -> ByteString) -> TagName -> ByteString
forall a b. (a -> b) -> a -> b
$ TagName
tagName
tagNameSize :: Int
tagNameSize = ByteString -> Int
BS.length ByteString
tagNameBS
tagDefinitionBS :: ByteString
tagDefinitionBS = case TagDefinition 'ETAG
tagDefinition of
TagDefinition 'ETAG
NoTagDefinition -> ByteString
tagNameBS
TagDefinition Text
def -> Text -> ByteString
Text.encodeUtf8 Text
def
tagDefinitionSize :: Int
tagDefinitionSize = ByteString -> Int
BS.length ByteString
tagDefinitionBS
tagSize :: Int
tagSize =
Int
3
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tagNameSize
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tagDefinitionSize
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
lineNr)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
byteOffset)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
endOfLine)
formatTagsFile :: [ETag] -> Builder
formatTagsFile :: [ETag] -> Builder
formatTagsFile [] = Builder
forall a. Monoid a => a
mempty
formatTagsFile ts :: [ETag]
ts@(Tag {TagFilePath
tagFilePath :: forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath :: TagFilePath
tagFilePath} : [ETag]
_) =
case (ETag -> BuilderWithSize) -> [ETag] -> BuilderWithSize
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ETag -> BuilderWithSize
formatTag [ETag]
ts of
BuilderWithSize {Builder
builder :: Builder
builder :: BuilderWithSize -> Builder
builder, Int
builderSize :: Int
builderSize :: BuilderWithSize -> Int
builderSize} ->
if Int
builderSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Char -> Builder
BB.charUtf8 Char
'\x0c'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BB.stringUtf8 String
endOfLine
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString (Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ TagFilePath -> Text
getRawFilePath TagFilePath
tagFilePath)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
','
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec Int
builderSize
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BB.stringUtf8 String
endOfLine
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
builder
else Builder
forall a. Monoid a => a
mempty
formatETagsFile :: [ETag] -> Builder
formatETagsFile :: [ETag] -> Builder
formatETagsFile =
([ETag] -> Builder) -> [[ETag]] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [ETag] -> Builder
formatTagsFile
([[ETag]] -> Builder) -> ([ETag] -> [[ETag]]) -> [ETag] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ETag -> ETag -> Bool) -> [ETag] -> [[ETag]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((TagFilePath -> TagFilePath -> Bool)
-> (ETag -> TagFilePath) -> ETag -> ETag -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagFilePath -> TagFilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) ETag -> TagFilePath
forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath)
endOfLine :: String
endOfLine :: String
endOfLine = String
"\n"