{-# 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 Tag { tagName, tagFilePath, tagAddr, tagKind, tagFields = TagFields tagFields } =

       (BS.byteString . Text.encodeUtf8 . getTagName $ tagName)
    <> BS.charUtf8 '\t'

    <> BS.byteString (Text.encodeUtf8 . getRawFilePath $ tagFilePath)
    <> BS.charUtf8 '\t'

    <> formatTagAddress tagAddr
    -- we are using extended format: '_TAG_FILE_FROMAT	2'
    <> BS.stringUtf8 ";\""

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

    -- tag fields
    <> foldMap ((BS.charUtf8 '\t' <>) . formatField) tagFields

    <> BS.stringUtf8 endOfLine

  where

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

    formatKindChar :: TagKind -> Builder
    formatKindChar tk =
      case tagKindToChar tk of
        Nothing -> mempty
        Just c | isAscii c -> BS.charUtf8 '\t' <> BS.charUtf8 c
               | otherwise -> BS.stringUtf8 "\tkind:" <> BS.charUtf8 c


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


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

    formatTextHeaderArgs = formatHeaderArgs (BS.byteString . Text.encodeUtf8) "!_TAG_"
    formatIntHeaderArgs  = formatHeaderArgs BS.intDec "!_TAG_"


-- | 'ByteString' 'Builder' for vim 'Tag' file.
--
formatTagsFile :: [Either Header CTag] -- ^ 'CTag's
               -> Builder
formatTagsFile tags =
    foldMap (formatHeader ||| formatTag) tags


-- | 'ByteString' 'Builder' for vim 'Tag' file.
--
formatTagsFileMap :: [Header] -- ^ Headers
                  -> CTagMap  -- ^ 'CTag's
                  -> Builder
formatTagsFileMap headers tags =
      foldMap formatHeader headers
   <> foldMap formatTag (sortBy compareTags . concat $ Map.elems tags)