{-# 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 :: 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 'CTAG
tagKind :: forall (tk :: TAG_KIND). Tag tk -> TagKind tk
tagKind :: TagKind 'CTAG
tagKind, tagFields :: forall (tk :: TAG_KIND). Tag tk -> TagFields tk
tagFields = TagFields [TagField]
tagFields } =
(ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (TagName -> ByteString) -> TagName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (TagName -> Text) -> TagName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagName -> Text
getTagName (TagName -> Builder) -> TagName -> Builder
forall a b. (a -> b) -> a -> b
$ TagName
tagName)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
'\t'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteString (Text -> ByteString
Text.encodeUtf8 (Text -> ByteString)
-> (TagFilePath -> Text) -> TagFilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagFilePath -> Text
getRawFilePath (TagFilePath -> ByteString) -> TagFilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ TagFilePath
tagFilePath)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
'\t'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TagAddress 'CTAG -> Builder
formatTagAddress TagAddress 'CTAG
tagAddr
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BS.stringUtf8 String
";\""
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TagKind 'CTAG -> Builder
formatKindChar TagKind 'CTAG
tagKind
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (TagField -> Builder) -> [TagField] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Char -> Builder
BS.charUtf8 Char
'\t' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> (TagField -> Builder) -> TagField -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagField -> Builder
formatField) [TagField]
tagFields
Builder -> Builder -> Builder
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
formatTagAddress (TagLine Int
lineNo) =
Int -> Builder
BS.intDec Int
lineNo
formatTagAddress (TagCommand ExCommand
exCommand) =
ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (ExCommand -> ByteString) -> ExCommand -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString)
-> (ExCommand -> Text) -> ExCommand -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExCommand -> Text
getExCommand (ExCommand -> Builder) -> ExCommand -> Builder
forall a b. (a -> b) -> a -> b
$ ExCommand
exCommand
formatKindChar :: CTagKind -> Builder
formatKindChar :: TagKind 'CTAG -> Builder
formatKindChar TagKind 'CTAG
tk =
case TagKind 'CTAG -> Maybe Char
tagKindToChar TagKind 'CTAG
tk of
Maybe Char
Nothing -> Builder
forall a. Monoid a => a
mempty
Just Char
c | Char -> Bool
isAscii Char
c -> Char -> Builder
BS.charUtf8 Char
'\t' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
c
| Bool
otherwise -> String -> Builder
BS.stringUtf8 String
"\tkind:" Builder -> Builder -> Builder
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)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
':'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteString (Text -> ByteString
Text.encodeUtf8 Text
fieldValue)
formatHeader :: Header -> Builder
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
Text
headerArg Text
headerComment
HeaderType ty
FileFormat ->
Text -> Maybe Text -> Int -> Text -> Builder
formatIntHeaderArgs Text
"FILE_FORMAT" Maybe Text
headerLanguage ty
Int
headerArg Text
headerComment
HeaderType ty
FileSorted ->
Text -> Maybe Text -> Int -> Text -> Builder
formatIntHeaderArgs Text
"FILE_SORTED" Maybe Text
headerLanguage ty
Int
headerArg Text
headerComment
HeaderType ty
OutputMode ->
Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"OUTPUT_MODE" Maybe Text
headerLanguage ty
Text
headerArg Text
headerComment
HeaderType ty
KindDescription ->
Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"KIND_DESCRIPTION" Maybe Text
headerLanguage ty
Text
headerArg Text
headerComment
HeaderType ty
KindSeparator ->
Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"KIND_SEPARATOR" Maybe Text
headerLanguage ty
Text
headerArg Text
headerComment
HeaderType ty
ProgramAuthor ->
Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"PROGRAM_AUTHOR" Maybe Text
headerLanguage ty
Text
headerArg Text
headerComment
HeaderType ty
ProgramName ->
Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"PROGRAM_NAME" Maybe Text
headerLanguage ty
Text
headerArg Text
headerComment
HeaderType ty
ProgramUrl ->
Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"PROGRAM_URL" Maybe Text
headerLanguage ty
Text
headerArg Text
headerComment
HeaderType ty
ProgramVersion ->
Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"PROGRAM_VERSION" Maybe Text
headerLanguage ty
Text
headerArg Text
headerComment
HeaderType ty
ExtraDescription ->
Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"EXTRA_DESCRIPTION" Maybe Text
headerLanguage ty
Text
headerArg Text
headerComment
HeaderType ty
FieldDescription ->
Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs Text
"FIELD_DESCRIPTION" Maybe Text
headerLanguage ty
Text
headerArg Text
headerComment
PseudoTag Text
name ->
(Text -> Builder)
-> String -> Text -> Maybe Text -> Text -> Text -> Builder
forall ty.
(ty -> Builder)
-> String -> Text -> Maybe Text -> ty -> Text -> Builder
formatHeaderArgs (ByteString -> Builder
BS.byteString (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8)
String
"!_" Text
name Maybe Text
headerLanguage ty
Text
headerArg Text
headerComment
where
formatHeaderArgs :: (ty -> Builder)
-> String
-> Text
-> Maybe Text
-> ty
-> Text
-> Builder
formatHeaderArgs :: (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
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteString (Text -> ByteString
Text.encodeUtf8 Text
headerName)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder) -> Maybe Text -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Char -> Builder
BS.charUtf8 Char
'!' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BS.byteString (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8) Maybe Text
language
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
'\t'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ty -> Builder
formatArg ty
arg
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BS.stringUtf8 String
"\t/"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteString (Text -> ByteString
Text.encodeUtf8 Text
comment)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BS.charUtf8 Char
'/'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BS.stringUtf8 String
endOfLine
formatTextHeaderArgs :: Text -> Maybe Text -> Text -> Text -> Builder
formatTextHeaderArgs = (Text -> Builder)
-> String -> Text -> Maybe Text -> Text -> Text -> Builder
forall ty.
(ty -> Builder)
-> String -> Text -> Maybe Text -> ty -> Text -> Builder
formatHeaderArgs (ByteString -> Builder
BS.byteString (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8) String
"!_TAG_"
formatIntHeaderArgs :: Text -> Maybe Text -> Int -> Text -> Builder
formatIntHeaderArgs = (Int -> Builder)
-> String -> Text -> Maybe Text -> Int -> Text -> Builder
forall ty.
(ty -> Builder)
-> String -> Text -> Maybe Text -> ty -> Text -> Builder
formatHeaderArgs Int -> Builder
BS.intDec String
"!_TAG_"
formatTagsFile :: [Either Header CTag]
-> Builder
formatTagsFile :: [Either Header CTag] -> Builder
formatTagsFile [Either Header CTag]
tags =
(Either Header CTag -> Builder) -> [Either Header CTag] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Header -> Builder
formatHeader (Header -> Builder)
-> (CTag -> Builder) -> Either Header CTag -> Builder
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