{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module GhcTags.CTag.Formatter
( formatTagsFile
, formatTag
, formatHeader
) where
import Control.Arrow ((|||))
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BS
import Data.Char (isAscii)
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
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
<> BS.stringUtf8 ";\""
<> formatKindChar tagKind
<> foldMap ((BS.charUtf8 '\t' <>) . formatField) tagFields
<> BS.stringUtf8 endOfLine
where
formatTagAddress :: CTagAddress -> Builder
formatTagAddress (TagLineCol lineNo _colNo) =
BS.intDec lineNo
formatTagAddress (TagLine lineNo) =
BS.intDec lineNo
formatTagAddress (TagCommand exCommand) =
BS.byteString . Text.encodeUtf8 . getExCommand $ exCommand
formatKindChar :: CTagKind -> 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_"
formatTagsFile :: [Either Header CTag]
-> Builder
formatTagsFile tags =
foldMap (formatHeader ||| formatTag) tags