{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
module GhcTags.ETag.Formatter
( formatETagsFile
, formatTagsFileMap
, formatTagsFile
, formatTag
, BuilderWithSize (..)
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.Char8
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BB
import Data.List (groupBy)
import Data.Function (on)
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 forall a. Semigroup a => a -> a -> a
<> Builder
b1) (Int
s0 forall a. Num a => a -> a -> a
+ Int
s1)
instance Monoid BuilderWithSize where
mempty :: BuilderWithSize
mempty = Builder -> Int -> BuilderWithSize
BuilderWithSize forall a. Monoid a => a
mempty Int
0
formatTag :: ETag -> BuilderWithSize
formatTag :: ETag -> BuilderWithSize
formatTag Tag {TagName
tagName :: forall (tk :: TAG_KIND). Tag tk -> TagName
tagName :: TagName
tagName, TagAddress 'ETAG
tagAddr :: forall (tk :: TAG_KIND). Tag tk -> TagAddress tk
tagAddr :: TagAddress 'ETAG
tagAddr, TagDefinition 'ETAG
tagDefinition :: forall (tk :: TAG_KIND). Tag tk -> TagDefinition tk
tagDefinition :: TagDefinition 'ETAG
tagDefinition} =
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> Int -> BuilderWithSize
BuilderWithSize Int
tagSize forall a b. (a -> b) -> a -> b
$
ByteString -> Builder
BB.byteString ByteString
tagDefinitionBS
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
'\DEL'
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
tagNameBS
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
'\SOH'
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
tagAddressBS
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BB.stringUtf8 String
endOfLine
where
tagNameBS :: BS.ByteString
tagNameBS :: ByteString
tagNameBS = Text -> ByteString
Text.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagName -> Text
getTagName forall a b. (a -> b) -> a -> b
$ TagName
tagName
tagNameSize :: Int
tagNameSize = ByteString -> Int
BS.length ByteString
tagNameBS
tagDefinitionBS :: BS.ByteString
tagDefinitionBS :: ByteString
tagDefinitionBS = case TagDefinition 'ETAG
tagDefinition of
TagDefinition 'ETAG
NoTagDefinition -> forall a. Monoid a => a
mempty
TagDefinition Text
def -> Text -> ByteString
Text.encodeUtf8 Text
def
tagDefinitionSize :: Int
tagDefinitionSize = ByteString -> Int
BS.length ByteString
tagDefinitionBS
tagAddressBS :: BS.ByteString
tagAddressBS :: ByteString
tagAddressBS = case TagAddress 'ETAG
tagAddr of
TagLine Int
lineNo ->
String -> ByteString
BS.Char8.pack (forall a. Show a => a -> String
show Int
lineNo)
forall a. Semigroup a => a -> a -> a
<> Char -> ByteString
BS.Char8.singleton Char
','
TagLineCol Int
lineNo Int
offset ->
String -> ByteString
BS.Char8.pack (forall a. Show a => a -> String
show Int
lineNo)
forall a. Semigroup a => a -> a -> a
<> Char -> ByteString
BS.Char8.singleton Char
','
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BS.Char8.pack (forall a. Show a => a -> String
show Int
offset)
TagAddress 'ETAG
NoAddress ->
Char -> ByteString
BS.Char8.singleton Char
','
tagAddressSize :: Int
tagAddressSize = ByteString -> Int
BS.length ByteString
tagAddressBS
tagSize :: Int
tagSize =
Int
2
forall a. Num a => a -> a -> a
+ Int
tagDefinitionSize
forall a. Num a => a -> a -> a
+ Int
tagNameSize
forall a. Num a => a -> a -> a
+ Int
tagAddressSize
forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
endOfLine
formatTagsFile :: [ETag] -> Builder
formatTagsFile :: [ETag] -> Builder
formatTagsFile [] = 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 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 forall a. Ord a => a -> a -> Bool
> Int
0
then Char -> Builder
BB.charUtf8 Char
'\x0c'
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BB.stringUtf8 String
endOfLine
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString (Text -> ByteString
Text.encodeUtf8 forall a b. (a -> b) -> a -> b
$ TagFilePath -> Text
getRawFilePath TagFilePath
tagFilePath)
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
','
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec Int
builderSize
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BB.stringUtf8 String
endOfLine
forall a. Semigroup a => a -> a -> a
<> Builder
builder
else forall a. Monoid a => a
mempty
formatETagsFile :: [ETag] -> Builder
formatETagsFile :: [ETag] -> Builder
formatETagsFile =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [ETag] -> Builder
formatTagsFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath)
formatTagsFileMap :: ETagMap -> Builder
formatTagsFileMap :: ETagMap -> Builder
formatTagsFileMap = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [ETag] -> Builder
formatTagsFile
endOfLine :: String
endOfLine :: String
endOfLine = String
"\n"