{-# LANGUAGE GADTs             #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}

-- | 'bytestring''s 'Builder' for a 'Tag'
--
module GhcTags.CTag.Formatter
  ( formatTagsFile
  , formatTagsFileMap
  -- * format a ctag
  , formatTag
  -- * format a pseudo-ctag
  , formatHeader
  ) where

import           Control.Arrow ((|||))
import           Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BS
import           Data.Char (isAscii)
import           Data.List (sortBy)
import qualified Data.Map.Strict as Map
import           Data.Text          (Text)
import qualified Data.Text.Encoding as Text

import           GhcTags.Tag
import           GhcTags.Utils (endOfLine)
import           GhcTags.CTag.Header
import           GhcTags.CTag.Utils


-- | 'ByteString' 'Builder' for a single line.
--
formatTag :: CTag -> Builder
formatTag :: CTag -> Builder
formatTag Tag { TagName
tagName :: forall (tk :: TAG_KIND). Tag tk -> TagName
tagName :: TagName
tagName, TagFilePath
tagFilePath :: forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath :: TagFilePath
tagFilePath, TagAddress 'CTAG
tagAddr :: forall (tk :: TAG_KIND). Tag tk -> TagAddress tk
tagAddr :: TagAddress 'CTAG
tagAddr, TagKind
tagKind :: forall (tk :: TAG_KIND). Tag tk -> TagKind
tagKind :: TagKind
tagKind, tagFields :: forall (tk :: TAG_KIND). Tag tk -> TagFields tk
tagFields = TagFields [TagField]
tagFields } =

       (ByteString -> Builder
BS.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
    forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
'\t'

    forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteString (Text -> ByteString
Text.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagFilePath -> Text
getRawFilePath forall a b. (a -> b) -> a -> b
$ TagFilePath
tagFilePath)
    forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
'\t'

    forall a. Semigroup a => a -> a -> a
<> TagAddress 'CTAG -> Builder
formatTagAddress TagAddress 'CTAG
tagAddr
    -- we are using extended format: '_TAG_FILE_FROMAT	2'
    forall a. Semigroup a => a -> a -> a
<> String -> Builder
BS.stringUtf8 String
";\""

    -- tag kind: we are encoding them using field syntax: this is because vim
    -- is using them in the right way: https://github.com/vim/vim/issues/5724
    forall a. Semigroup a => a -> a -> a
<> TagKind -> Builder
formatKindChar TagKind
tagKind

    -- tag fields
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Char -> Builder
BS.charUtf8 Char
'\t' forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagField -> Builder
formatField) [TagField]
tagFields

    forall a. Semigroup a => a -> a -> a
<> String -> Builder
BS.stringUtf8 String
endOfLine

  where

    formatTagAddress :: CTagAddress -> Builder
    formatTagAddress :: TagAddress 'CTAG -> Builder
formatTagAddress (TagLineCol Int
lineNo Int
_colNo) =
      Int -> Builder
BS.intDec Int
lineNo -- Vim only allows to use ranges; there's no way to
                       -- specify column (`c|` command is not allowed)
    formatTagAddress (TagLine Int
lineNo) =
      Int -> Builder
BS.intDec Int
lineNo
    formatTagAddress (TagCommand ExCommand
exCommand) =
      ByteString -> Builder
BS.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExCommand -> Text
getExCommand forall a b. (a -> b) -> a -> b
$ ExCommand
exCommand

    formatKindChar :: TagKind -> Builder
    formatKindChar :: TagKind -> Builder
formatKindChar TagKind
tk =
      case TagKind -> Maybe Char
tagKindToChar TagKind
tk of
        Maybe Char
Nothing -> forall a. Monoid a => a
mempty
        Just Char
c | Char -> Bool
isAscii Char
c -> Char -> Builder
BS.charUtf8 Char
'\t' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
c
               | Bool
otherwise -> String -> Builder
BS.stringUtf8 String
"\tkind:" forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
c


formatField :: TagField -> Builder
formatField :: TagField -> Builder
formatField TagField { Text
fieldName :: TagField -> Text
fieldName :: Text
fieldName, Text
fieldValue :: TagField -> Text
fieldValue :: Text
fieldValue } =
      ByteString -> Builder
BS.byteString (Text -> ByteString
Text.encodeUtf8 Text
fieldName)
   forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
':'
   forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteString (Text -> ByteString
Text.encodeUtf8 Text
fieldValue)


formatHeader :: Header -> Builder
formatHeader :: Header -> Builder
formatHeader Header { HeaderType ty
headerType :: ()
headerType :: HeaderType ty
headerType, Maybe Text
headerLanguage :: Header -> Maybe Text
headerLanguage :: Maybe Text
headerLanguage, ty
headerArg :: ()
headerArg :: ty
headerArg, Text
headerComment :: Header -> Text
headerComment :: Text
headerComment } =
    case HeaderType ty
headerType of
      HeaderType ty
FileEncoding ->
        Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"FILE_ENCODING"     Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
FileFormat ->
        Text -> Maybe Text -> Int -> Text -> Builder
formatIntHeaderArgs Text
"FILE_FORMAT"        Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
FileSorted ->
        Text -> Maybe Text -> Int -> Text -> Builder
formatIntHeaderArgs Text
"FILE_SORTED"        Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
OutputMode ->
        Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"OUTPUT_MODE"       Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
KindDescription ->
        Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"KIND_DESCRIPTION"  Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
KindSeparator ->
        Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"KIND_SEPARATOR"    Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
ProgramAuthor ->
        Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"PROGRAM_AUTHOR"    Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
ProgramName ->
        Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"PROGRAM_NAME"      Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
ProgramUrl ->
        Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"PROGRAM_URL"       Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
ProgramVersion ->
        Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"PROGRAM_VERSION"   Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
ExtraDescription ->
        Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"EXTRA_DESCRIPTION" Maybe Text
headerLanguage ty
headerArg Text
headerComment
      HeaderType ty
FieldDescription ->
        Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"FIELD_DESCRIPTION" Maybe Text
headerLanguage ty
headerArg Text
headerComment
      PseudoTag Text
name ->
        forall ty.
(ty -> Builder)
-> String -> Text -> Maybe Text -> ty -> Text -> Builder
formatHeaderArgs (ByteString -> Builder
BS.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8)
                         String
"!_" Text
name Maybe Text
headerLanguage ty
headerArg Text
headerComment
  where
    formatHeaderArgs :: (ty -> Builder)
                     -> String
                     -> Text
                     -> Maybe Text
                     -> ty
                     -> Text
                     -> Builder
    formatHeaderArgs :: forall ty.
(ty -> Builder)
-> String -> Text -> Maybe Text -> ty -> Text -> Builder
formatHeaderArgs ty -> Builder
formatArg String
prefix Text
headerName Maybe Text
language ty
arg Text
comment =
         String -> Builder
BS.stringUtf8 String
prefix
      forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteString (Text -> ByteString
Text.encodeUtf8 Text
headerName)
      forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Char -> Builder
BS.charUtf8 Char
'!' forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BS.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8) Maybe Text
language
      forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
'\t'
      forall a. Semigroup a => a -> a -> a
<> ty -> Builder
formatArg ty
arg
      forall a. Semigroup a => a -> a -> a
<> String -> Builder
BS.stringUtf8 String
"\t/"
      forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteString (Text -> ByteString
Text.encodeUtf8 Text
comment)
      forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
'/'
      forall a. Semigroup a => a -> a -> a
<> String -> Builder
BS.stringUtf8 String
endOfLine

    formatTextHeaderArgs :: Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs = forall ty.
(ty -> Builder)
-> String -> Text -> Maybe Text -> ty -> Text -> Builder
formatHeaderArgs (ByteString -> Builder
BS.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8) String
"!_TAG_"
    formatIntHeaderArgs :: Text -> Maybe Text -> Int -> Text -> Builder
formatIntHeaderArgs  = forall ty.
(ty -> Builder)
-> String -> Text -> Maybe Text -> ty -> Text -> Builder
formatHeaderArgs Int -> Builder
BS.intDec String
"!_TAG_"


-- | 'ByteString' 'Builder' for vim 'Tag' file.
--
formatTagsFile :: [Either Header CTag] -- ^ 'CTag's
               -> Builder
formatTagsFile :: [Either Header CTag] -> Builder
formatTagsFile [Either Header CTag]
tags =
    forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Header -> Builder
formatHeader forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| CTag -> Builder
formatTag) [Either Header CTag]
tags


-- | 'ByteString' 'Builder' for vim 'Tag' file.
--
formatTagsFileMap :: [Header] -- ^ Headers
                  -> CTagMap  -- ^ 'CTag's
                  -> Builder
formatTagsFileMap :: [Header] -> CTagMap -> Builder
formatTagsFileMap [Header]
headers CTagMap
tags =
      forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Header -> Builder
formatHeader [Header]
headers
   forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CTag -> Builder
formatTag (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall (tk :: TAG_KIND).
Ord (TagAddress tk) =>
Tag tk -> Tag tk -> Ordering
compareTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems CTagMap
tags)