{-# LANGUAGE BangPatterns   #-}
{-# LANGUAGE GADTs          #-}
{-# LANGUAGE NamedFieldPuns #-}

-- | Simple etags formatter. See <https://en.wikipedia.org/wiki/Ctags#Etags>
--
module GhcTags.ETag.Formatter
  ( formatETagsFile
  , 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           Data.Foldable (foldl')
import qualified Data.Text.Encoding as Text

import           GhcTags.Tag


-- | A product of two monoids: 'Builder' and 'Sum'.
--
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

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} =
           (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
$
        -- TODO: get access to the original line or pretty print original
        -- declaration
           ByteString -> Builder
BB.byteString ByteString
tagDefinitionBS
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
'\DEL' -- or '\x7f'
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
tagNameBS
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
'\SOH' -- or '\x01'
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
tagAddressBS
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BB.stringUtf8 String
endOfLine
  where
    tagNameBS :: BS.ByteString
    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 :: BS.ByteString
    tagDefinitionBS :: ByteString
tagDefinitionBS = case TagDefinition 'ETAG
tagDefinition of
        TagDefinition 'ETAG
NoTagDefinition   -> ByteString
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 (Int -> String
forall a. Show a => a -> String
show Int
lineNo)
          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Char -> ByteString
BS.Char8.singleton Char
','
       TagLineCol Int
lineNo Int
offset ->
             String -> ByteString
BS.Char8.pack (Int -> String
forall a. Show a => a -> String
show Int
lineNo)
          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Char -> ByteString
BS.Char8.singleton Char
','
          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BS.Char8.pack (Int -> String
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 -- delimiters: '\DEL', '\SOH'
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tagDefinitionSize
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tagNameSize
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tagAddressSize
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
endOfLine


-- | The precondition is that all the tags come frome the same file.
--
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


-- | Format a list of tags as etags file.  Tags from the same file must be
-- groupped together.
--
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"