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

-- | Simple etags formatter. See <https://en.wikipedia.org/wiki/Ctags#Etags>
--
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


-- | 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

computeByteOffset
    :: [Int]
    -- ^ lengths of lines
    -> 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
$
        -- TODO: get access to the original line or pretty print original
        -- declaration
           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' -- or '\x7f'
        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' -- or '\x01'
        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 -- delimiters: '\DEL', '\SOH', ','
      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)


-- | 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"