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

-- | Simple etags formatter. See <https://en.wikipedia.org/wiki/Ctags#Etags>
--
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           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 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
$
        -- TODO: get access to the original line or pretty print original
        -- declaration
           ByteString -> Builder
BB.byteString ByteString
tagDefinitionBS
        forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
'\DEL' -- or '\x7f'
        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' -- or '\x01'
        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 -- delimiters: '\DEL', '\SOH'
      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


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


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