{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module GhcTags.CTag.Formatter
( formatTagsFile
, formatTagsFileMap
, formatTag
, 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
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
forall a. Semigroup a => a -> a -> a
<> String -> Builder
BS.stringUtf8 String
";\""
forall a. Semigroup a => a -> a -> a
<> TagKind -> Builder
formatKindChar TagKind
tagKind
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
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
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_"
formatTagsFile :: [Either Header CTag]
-> 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
formatTagsFileMap :: [Header]
-> CTagMap
-> 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)