{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.Thrift.Pretty
(
prettyPrintHighlighted
, prettyPrint
, program
, header
, include
, namespace
, definition
, constant
, typeDefinition
, service
, typedef
, enum
, struct
, union
, exception
, senum
, typeReference
, constantValue
, docstring
, Config(..)
, defaultConfig
) where
#if __GLASGOW_HASKELL__ >= 709
import Prelude hiding ((<$>))
#endif
import Data.Text (Text)
import qualified Data.Text as Text
import Text.PrettyPrint.ANSI.Leijen
( Doc
, Pretty (..)
, align
, bold
, cyan
, double
, dquotes
, dullblue
, empty
, enclose
, group
, hcat
, hsep
, integer
, line
, linebreak
, magenta
, nest
, plain
, space
, vsep
, yellow
, (<$$>)
, (<$>)
, (<+>)
, (<>)
)
import qualified Language.Thrift.Internal.AST as T
import qualified Text.PrettyPrint.ANSI.Leijen as P
data Config = Config
{ Config -> Int
indentWidth :: Int
} deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, Eq Config
Eq Config
-> (Config -> Config -> Ordering)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Bool)
-> (Config -> Config -> Config)
-> (Config -> Config -> Config)
-> Ord Config
Config -> Config -> Bool
Config -> Config -> Ordering
Config -> Config -> Config
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Config -> Config -> Config
$cmin :: Config -> Config -> Config
max :: Config -> Config -> Config
$cmax :: Config -> Config -> Config
>= :: Config -> Config -> Bool
$c>= :: Config -> Config -> Bool
> :: Config -> Config -> Bool
$c> :: Config -> Config -> Bool
<= :: Config -> Config -> Bool
$c<= :: Config -> Config -> Bool
< :: Config -> Config -> Bool
$c< :: Config -> Config -> Bool
compare :: Config -> Config -> Ordering
$ccompare :: Config -> Config -> Ordering
$cp1Ord :: Eq Config
Ord, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Int -> Config
Config Int
4
prettyPrint :: T.Program ann -> Doc
prettyPrint :: Program ann -> Doc
prettyPrint = Doc -> Doc
plain (Doc -> Doc) -> (Program ann -> Doc) -> Program ann -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program ann -> Doc
forall ann. Program ann -> Doc
prettyPrintHighlighted
prettyPrintHighlighted :: T.Program ann -> Doc
prettyPrintHighlighted :: Program ann -> Doc
prettyPrintHighlighted = Config -> Program ann -> Doc
forall ann. Config -> Program ann -> Doc
program Config
defaultConfig
program :: Config -> T.Program ann -> Doc
program :: Config -> Program ann -> Doc
program Config
c T.Program{[Header ann]
[Definition ann]
programDefinitions :: forall srcAnnot. Program srcAnnot -> [Definition srcAnnot]
programHeaders :: forall srcAnnot. Program srcAnnot -> [Header srcAnnot]
programDefinitions :: [Definition ann]
programHeaders :: [Header ann]
..} =
( if [Header ann] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Header ann]
programHeaders
then Doc
empty
else [Doc] -> Doc
vsep ((Header ann -> Doc) -> [Header ann] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Header ann -> Doc
forall ann. Header ann -> Doc
header [Header ann]
programHeaders) Doc -> Doc -> Doc
<$> Doc
line
) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Definition ann -> Doc) -> [Definition ann] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Config -> Definition ann -> Doc
forall ann. Config -> Definition ann -> Doc
definition Config
c) [Definition ann]
programDefinitions [Doc] -> Doc -> Doc
`sepBy` (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line)
instance Pretty (T.Program a) where
pretty :: Program a -> Doc
pretty = Config -> Program a -> Doc
forall ann. Config -> Program ann -> Doc
program Config
defaultConfig
header :: T.Header ann -> Doc
(T.HeaderInclude Include ann
inc) = Include ann -> Doc
forall ann. Include ann -> Doc
include Include ann
inc
header (T.HeaderNamespace Namespace ann
ns) = Namespace ann -> Doc
forall ann. Namespace ann -> Doc
namespace Namespace ann
ns
instance Pretty (T.Header a) where
pretty :: Header a -> Doc
pretty = Header a -> Doc
forall ann. Header ann -> Doc
header
include :: T.Include ann -> Doc
include :: Include ann -> Doc
include T.Include{ann
Text
includeSrcAnnot :: forall srcAnnot. Include srcAnnot -> srcAnnot
includePath :: forall srcAnnot. Include srcAnnot -> Text
includeSrcAnnot :: ann
includePath :: Text
..} = String -> Doc
reserved String
"include" Doc -> Doc -> Doc
<+> Text -> Doc
literal Text
includePath
instance Pretty (T.Include a) where
pretty :: Include a -> Doc
pretty = Include a -> Doc
forall ann. Include ann -> Doc
include
namespace :: T.Namespace ann -> Doc
namespace :: Namespace ann -> Doc
namespace T.Namespace{ann
Text
namespaceSrcAnnot :: forall srcAnnot. Namespace srcAnnot -> srcAnnot
namespaceName :: forall srcAnnot. Namespace srcAnnot -> Text
namespaceLanguage :: forall srcAnnot. Namespace srcAnnot -> Text
namespaceSrcAnnot :: ann
namespaceName :: Text
namespaceLanguage :: Text
..} = [Doc] -> Doc
hsep
[String -> Doc
reserved String
"namespace", Text -> Doc
text Text
namespaceLanguage, Text -> Doc
text Text
namespaceName]
instance Pretty (T.Namespace a) where
pretty :: Namespace a -> Doc
pretty = Namespace a -> Doc
forall ann. Namespace ann -> Doc
namespace
definition :: Config -> T.Definition ann -> Doc
definition :: Config -> Definition ann -> Doc
definition Config
c (T.ConstDefinition Const ann
cd) = Config -> Const ann -> Doc
forall ann. Config -> Const ann -> Doc
constant Config
c Const ann
cd
definition Config
c (T.TypeDefinition Type ann
def) = Config -> Type ann -> Doc
forall ann. Config -> Type ann -> Doc
typeDefinition Config
c Type ann
def
definition Config
c (T.ServiceDefinition Service ann
s) = Config -> Service ann -> Doc
forall ann. Config -> Service ann -> Doc
service Config
c Service ann
s
instance Pretty (T.Definition a) where
pretty :: Definition a -> Doc
pretty = Config -> Definition a -> Doc
forall ann. Config -> Definition ann -> Doc
definition Config
defaultConfig
constant :: Config -> T.Const ann -> Doc
constant :: Config -> Const ann -> Doc
constant Config
c T.Const{ann
Docstring
Text
TypeReference ann
ConstValue ann
constSrcAnnot :: forall srcAnnot. Const srcAnnot -> srcAnnot
constDocstring :: forall srcAnnot. Const srcAnnot -> Docstring
constValue :: forall srcAnnot. Const srcAnnot -> ConstValue srcAnnot
constName :: forall srcAnnot. Const srcAnnot -> Text
constValueType :: forall srcAnnot. Const srcAnnot -> TypeReference srcAnnot
constSrcAnnot :: ann
constDocstring :: Docstring
constValue :: ConstValue ann
constName :: Text
constValueType :: TypeReference ann
..} = Docstring
constDocstring Docstring -> Doc -> Doc
$$ [Doc] -> Doc
hsep
[ String -> Doc
reserved String
"const"
, Config -> TypeReference ann -> Doc
forall ann. Config -> TypeReference ann -> Doc
typeReference Config
c TypeReference ann
constValueType
, Text -> Doc
declare Text
constName
, Doc
equals
, Config -> ConstValue ann -> Doc
forall ann. Config -> ConstValue ann -> Doc
constantValue Config
c ConstValue ann
constValue
]
instance Pretty (T.Const a) where
pretty :: Const a -> Doc
pretty = Config -> Const a -> Doc
forall ann. Config -> Const ann -> Doc
constant Config
defaultConfig
service :: Config -> T.Service ann -> Doc
service :: Config -> Service ann -> Doc
service c :: Config
c@Config{Int
indentWidth :: Int
indentWidth :: Config -> Int
indentWidth} T.Service{ann
[Function ann]
[TypeAnnotation]
Docstring
Text
serviceSrcAnnot :: forall srcAnnot. Service srcAnnot -> srcAnnot
serviceDocstring :: forall srcAnnot. Service srcAnnot -> Docstring
serviceAnnotations :: forall srcAnnot. Service srcAnnot -> [TypeAnnotation]
serviceFunctions :: forall srcAnnot. Service srcAnnot -> [Function srcAnnot]
serviceExtends :: forall srcAnnot. Service srcAnnot -> Docstring
serviceName :: forall srcAnnot. Service srcAnnot -> Text
serviceSrcAnnot :: ann
serviceDocstring :: Docstring
serviceAnnotations :: [TypeAnnotation]
serviceFunctions :: [Function ann]
serviceExtends :: Docstring
serviceName :: Text
..} =
Docstring
serviceDocstring Docstring -> Doc -> Doc
$$
String -> Doc
reserved String
"service" Doc -> Doc -> Doc
<+> Text -> Doc
declare Text
serviceName Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
extends Doc -> Doc -> Doc
<+>
Int -> Doc -> [Doc] -> Doc
block Int
indentWidth (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line) ((Function ann -> Doc) -> [Function ann] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Config -> Function ann -> Doc
forall ann. Config -> Function ann -> Doc
function Config
c) [Function ann]
serviceFunctions) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
serviceAnnotations
where
extends :: Doc
extends = case Docstring
serviceExtends of
Docstring
Nothing -> Doc
empty
Just Text
name -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
reserved String
"extends" Doc -> Doc -> Doc
<+> Text -> Doc
text Text
name
instance Pretty (T.Service a) where
pretty :: Service a -> Doc
pretty = Config -> Service a -> Doc
forall ann. Config -> Service ann -> Doc
service Config
defaultConfig
function :: Config -> T.Function ann -> Doc
function :: Config -> Function ann -> Doc
function c :: Config
c@Config{Int
indentWidth :: Int
indentWidth :: Config -> Int
indentWidth} T.Function{ann
Bool
[Field ann]
[TypeAnnotation]
Maybe [Field ann]
Docstring
Maybe (TypeReference ann)
Text
functionSrcAnnot :: forall srcAnnot. Function srcAnnot -> srcAnnot
functionDocstring :: forall srcAnnot. Function srcAnnot -> Docstring
functionAnnotations :: forall srcAnnot. Function srcAnnot -> [TypeAnnotation]
functionExceptions :: forall srcAnnot. Function srcAnnot -> Maybe [Field srcAnnot]
functionParameters :: forall srcAnnot. Function srcAnnot -> [Field srcAnnot]
functionName :: forall srcAnnot. Function srcAnnot -> Text
functionReturnType :: forall srcAnnot.
Function srcAnnot -> Maybe (TypeReference srcAnnot)
functionOneWay :: forall srcAnnot. Function srcAnnot -> Bool
functionSrcAnnot :: ann
functionDocstring :: Docstring
functionAnnotations :: [TypeAnnotation]
functionExceptions :: Maybe [Field ann]
functionParameters :: [Field ann]
functionName :: Text
functionReturnType :: Maybe (TypeReference ann)
functionOneWay :: Bool
..} = Docstring
functionDocstring Docstring -> Doc -> Doc
$$
Doc
oneway Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
returnType Doc -> Doc -> Doc
<+> Text -> Doc
text Text
functionName Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep
Int
indentWidth Doc
lparen Doc
rparen Doc
comma
((Field ann -> Doc) -> [Field ann] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Config -> Field ann -> Doc
forall ann. Config -> Field ann -> Doc
field Config
c) [Field ann]
functionParameters) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc
exceptions Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
functionAnnotations Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
where
exceptions :: Doc
exceptions = case Maybe [Field ann]
functionExceptions of
Maybe [Field ann]
Nothing -> Doc
empty
Just [Field ann]
es -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
reserved String
"throws" Doc -> Doc -> Doc
<+>
Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Int
indentWidth Doc
lparen Doc
rparen Doc
comma ((Field ann -> Doc) -> [Field ann] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Config -> Field ann -> Doc
forall ann. Config -> Field ann -> Doc
field Config
c) [Field ann]
es)
returnType :: Doc
returnType = case Maybe (TypeReference ann)
functionReturnType of
Maybe (TypeReference ann)
Nothing -> String -> Doc
reserved String
"void"
Just TypeReference ann
rt -> Config -> TypeReference ann -> Doc
forall ann. Config -> TypeReference ann -> Doc
typeReference Config
c TypeReference ann
rt
oneway :: Doc
oneway =
if Bool
functionOneWay
then String -> Doc
reserved String
"oneway" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space
else Doc
empty
instance Pretty (T.Function a) where
pretty :: Function a -> Doc
pretty = Config -> Function a -> Doc
forall ann. Config -> Function ann -> Doc
function Config
defaultConfig
typeDefinition :: Config -> T.Type ann -> Doc
typeDefinition :: Config -> Type ann -> Doc
typeDefinition Config
c Type ann
td = case Type ann
td of
T.TypedefType Typedef ann
t -> Config
c Config -> Typedef ann -> Doc
forall ann. Config -> Typedef ann -> Doc
`typedef` Typedef ann
t
T.EnumType Enum ann
t -> Config
c Config -> Enum ann -> Doc
forall ann. Config -> Enum ann -> Doc
`enum` Enum ann
t
T.StructType Struct ann
t -> Config
c Config -> Struct ann -> Doc
forall ann. Config -> Struct ann -> Doc
`struct` Struct ann
t
T.SenumType Senum ann
t -> Config
c Config -> Senum ann -> Doc
forall ann. Config -> Senum ann -> Doc
`senum` Senum ann
t
instance Pretty (T.Type a) where
pretty :: Type a -> Doc
pretty = Config -> Type a -> Doc
forall ann. Config -> Type ann -> Doc
typeDefinition Config
defaultConfig
typedef :: Config -> T.Typedef ann -> Doc
typedef :: Config -> Typedef ann -> Doc
typedef Config
c T.Typedef{ann
[TypeAnnotation]
Docstring
Text
TypeReference ann
typedefSrcAnnot :: forall srcAnnot. Typedef srcAnnot -> srcAnnot
typedefDocstring :: forall srcAnnot. Typedef srcAnnot -> Docstring
typedefAnnotations :: forall srcAnnot. Typedef srcAnnot -> [TypeAnnotation]
typedefName :: forall srcAnnot. Typedef srcAnnot -> Text
typedefTargetType :: forall srcAnnot. Typedef srcAnnot -> TypeReference srcAnnot
typedefSrcAnnot :: ann
typedefDocstring :: Docstring
typedefAnnotations :: [TypeAnnotation]
typedefName :: Text
typedefTargetType :: TypeReference ann
..} = Docstring
typedefDocstring Docstring -> Doc -> Doc
$$
String -> Doc
reserved String
"typedef" Doc -> Doc -> Doc
<+> Config -> TypeReference ann -> Doc
forall ann. Config -> TypeReference ann -> Doc
typeReference Config
c TypeReference ann
typedefTargetType Doc -> Doc -> Doc
<+>
Text -> Doc
declare Text
typedefName Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
typedefAnnotations
instance Pretty (T.Typedef a) where
pretty :: Typedef a -> Doc
pretty = Config -> Typedef a -> Doc
forall ann. Config -> Typedef ann -> Doc
typedef Config
defaultConfig
enum :: Config -> T.Enum ann -> Doc
enum :: Config -> Enum ann -> Doc
enum c :: Config
c@Config{Int
indentWidth :: Int
indentWidth :: Config -> Int
indentWidth} T.Enum{ann
[EnumDef ann]
[TypeAnnotation]
Docstring
Text
enumSrcAnnot :: forall srcAnnot. Enum srcAnnot -> srcAnnot
enumDocstring :: forall srcAnnot. Enum srcAnnot -> Docstring
enumAnnotations :: forall srcAnnot. Enum srcAnnot -> [TypeAnnotation]
enumValues :: forall srcAnnot. Enum srcAnnot -> [EnumDef srcAnnot]
enumName :: forall srcAnnot. Enum srcAnnot -> Text
enumSrcAnnot :: ann
enumDocstring :: Docstring
enumAnnotations :: [TypeAnnotation]
enumValues :: [EnumDef ann]
enumName :: Text
..} = Docstring
enumDocstring Docstring -> Doc -> Doc
$$
String -> Doc
reserved String
"enum" Doc -> Doc -> Doc
<+> Text -> Doc
declare Text
enumName Doc -> Doc -> Doc
<+>
Int -> Doc -> [Doc] -> Doc
block Int
indentWidth (Doc
comma Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line) ((EnumDef ann -> Doc) -> [EnumDef ann] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Config -> EnumDef ann -> Doc
forall ann. Config -> EnumDef ann -> Doc
enumValue Config
c) [EnumDef ann]
enumValues)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
enumAnnotations
instance Pretty (T.Enum a) where
pretty :: Enum a -> Doc
pretty = Config -> Enum a -> Doc
forall ann. Config -> Enum ann -> Doc
enum Config
defaultConfig
struct :: Config -> T.Struct ann -> Doc
struct :: Config -> Struct ann -> Doc
struct c :: Config
c@Config{Int
indentWidth :: Int
indentWidth :: Config -> Int
indentWidth} T.Struct{ann
[Field ann]
[TypeAnnotation]
Docstring
Text
StructKind
structSrcAnnot :: forall srcAnnot. Struct srcAnnot -> srcAnnot
structDocstring :: forall srcAnnot. Struct srcAnnot -> Docstring
structAnnotations :: forall srcAnnot. Struct srcAnnot -> [TypeAnnotation]
structFields :: forall srcAnnot. Struct srcAnnot -> [Field srcAnnot]
structName :: forall srcAnnot. Struct srcAnnot -> Text
structKind :: forall srcAnnot. Struct srcAnnot -> StructKind
structSrcAnnot :: ann
structDocstring :: Docstring
structAnnotations :: [TypeAnnotation]
structFields :: [Field ann]
structName :: Text
structKind :: StructKind
..} = Docstring
structDocstring Docstring -> Doc -> Doc
$$
Doc
kind Doc -> Doc -> Doc
<+> Text -> Doc
declare Text
structName Doc -> Doc -> Doc
<+>
Int -> Doc -> [Doc] -> Doc
block Int
indentWidth Doc
line ((Field ann -> Doc) -> [Field ann] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\Field ann
f -> Config -> Field ann -> Doc
forall ann. Config -> Field ann -> Doc
field Config
c Field ann
f Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi) [Field ann]
structFields)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
structAnnotations
where
kind :: Doc
kind = case StructKind
structKind of
StructKind
T.StructKind -> String -> Doc
reserved String
"struct"
StructKind
T.UnionKind -> String -> Doc
reserved String
"union"
StructKind
T.ExceptionKind -> String -> Doc
reserved String
"exception"
instance Pretty (T.Struct a) where
pretty :: Struct a -> Doc
pretty = Config -> Struct a -> Doc
forall ann. Config -> Struct ann -> Doc
struct Config
defaultConfig
union :: Config -> T.Struct ann -> Doc
union :: Config -> Struct ann -> Doc
union = Config -> Struct ann -> Doc
forall ann. Config -> Struct ann -> Doc
struct
{-# DEPRECATED union "Use struct." #-}
exception :: Config -> T.Struct ann -> Doc
exception :: Config -> Struct ann -> Doc
exception = Config -> Struct ann -> Doc
forall ann. Config -> Struct ann -> Doc
struct
{-# DEPRECATED exception "Use struct." #-}
senum :: Config -> T.Senum ann -> Doc
senum :: Config -> Senum ann -> Doc
senum c :: Config
c@Config{Int
indentWidth :: Int
indentWidth :: Config -> Int
indentWidth} T.Senum{ann
[Text]
[TypeAnnotation]
Docstring
Text
senumSrcAnnot :: forall srcAnnot. Senum srcAnnot -> srcAnnot
senumDocstring :: forall srcAnnot. Senum srcAnnot -> Docstring
senumAnnotations :: forall srcAnnot. Senum srcAnnot -> [TypeAnnotation]
senumValues :: forall srcAnnot. Senum srcAnnot -> [Text]
senumName :: forall srcAnnot. Senum srcAnnot -> Text
senumSrcAnnot :: ann
senumDocstring :: Docstring
senumAnnotations :: [TypeAnnotation]
senumValues :: [Text]
senumName :: Text
..} = Docstring
senumDocstring Docstring -> Doc -> Doc
$$
String -> Doc
reserved String
"senum" Doc -> Doc -> Doc
<+> Text -> Doc
declare Text
senumName Doc -> Doc -> Doc
<+>
Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Int
indentWidth Doc
lbrace Doc
rbrace Doc
comma ((Text -> Doc) -> [Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc
literal [Text]
senumValues)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
senumAnnotations
instance Pretty (T.Senum a) where
pretty :: Senum a -> Doc
pretty = Config -> Senum a -> Doc
forall ann. Config -> Senum ann -> Doc
senum Config
defaultConfig
field :: Config -> T.Field ann -> Doc
field :: Config -> Field ann -> Doc
field Config
c T.Field{ann
[TypeAnnotation]
Maybe Integer
Docstring
Maybe FieldRequiredness
Maybe (ConstValue ann)
Text
TypeReference ann
fieldSrcAnnot :: forall srcAnnot. Field srcAnnot -> srcAnnot
fieldDocstring :: forall srcAnnot. Field srcAnnot -> Docstring
fieldAnnotations :: forall srcAnnot. Field srcAnnot -> [TypeAnnotation]
fieldDefaultValue :: forall srcAnnot. Field srcAnnot -> Maybe (ConstValue srcAnnot)
fieldName :: forall srcAnnot. Field srcAnnot -> Text
fieldValueType :: forall srcAnnot. Field srcAnnot -> TypeReference srcAnnot
fieldRequiredness :: forall srcAnnot. Field srcAnnot -> Maybe FieldRequiredness
fieldIdentifier :: forall srcAnnot. Field srcAnnot -> Maybe Integer
fieldSrcAnnot :: ann
fieldDocstring :: Docstring
fieldAnnotations :: [TypeAnnotation]
fieldDefaultValue :: Maybe (ConstValue ann)
fieldName :: Text
fieldValueType :: TypeReference ann
fieldRequiredness :: Maybe FieldRequiredness
fieldIdentifier :: Maybe Integer
..} = Docstring
fieldDocstring Docstring -> Doc -> Doc
$$ [Doc] -> Doc
hcat
[ case Maybe Integer
fieldIdentifier of
Maybe Integer
Nothing -> Doc
empty
Just Integer
i -> Doc -> Doc
yellow (Integer -> Doc
integer Integer
i) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space
, case Maybe FieldRequiredness
fieldRequiredness of
Maybe FieldRequiredness
Nothing -> Doc
empty
Just FieldRequiredness
r -> FieldRequiredness -> Doc
requiredness FieldRequiredness
r Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
space
, Config -> TypeReference ann -> Doc
forall ann. Config -> TypeReference ann -> Doc
typeReference Config
c TypeReference ann
fieldValueType
, Doc
space
, Text -> Doc
text Text
fieldName
, case Maybe (ConstValue ann)
fieldDefaultValue of
Maybe (ConstValue ann)
Nothing -> Doc
empty
Just ConstValue ann
v -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
equals Doc -> Doc -> Doc
<+> Config -> ConstValue ann -> Doc
forall ann. Config -> ConstValue ann -> Doc
constantValue Config
c ConstValue ann
v
, Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
fieldAnnotations
]
instance Pretty (T.Field a) where
pretty :: Field a -> Doc
pretty = Config -> Field a -> Doc
forall ann. Config -> Field ann -> Doc
field Config
defaultConfig
requiredness :: T.FieldRequiredness -> Doc
requiredness :: FieldRequiredness -> Doc
requiredness FieldRequiredness
T.Optional = String -> Doc
reserved String
"optional"
requiredness FieldRequiredness
T.Required = String -> Doc
reserved String
"required"
instance Pretty T.FieldRequiredness where
pretty :: FieldRequiredness -> Doc
pretty = FieldRequiredness -> Doc
requiredness
enumValue :: Config -> T.EnumDef ann -> Doc
enumValue :: Config -> EnumDef ann -> Doc
enumValue Config
c T.EnumDef{ann
[TypeAnnotation]
Maybe Integer
Docstring
Text
enumDefSrcAnnot :: forall srcAnnot. EnumDef srcAnnot -> srcAnnot
enumDefDocstring :: forall srcAnnot. EnumDef srcAnnot -> Docstring
enumDefAnnotations :: forall srcAnnot. EnumDef srcAnnot -> [TypeAnnotation]
enumDefValue :: forall srcAnnot. EnumDef srcAnnot -> Maybe Integer
enumDefName :: forall srcAnnot. EnumDef srcAnnot -> Text
enumDefSrcAnnot :: ann
enumDefDocstring :: Docstring
enumDefAnnotations :: [TypeAnnotation]
enumDefValue :: Maybe Integer
enumDefName :: Text
..} = Docstring
enumDefDocstring Docstring -> Doc -> Doc
$$
Text -> Doc
text Text
enumDefName Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
value Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
enumDefAnnotations
where
value :: Doc
value = case Maybe Integer
enumDefValue of
Maybe Integer
Nothing -> Doc
empty
Just Integer
v -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
equals Doc -> Doc -> Doc
<+> Integer -> Doc
integer Integer
v
instance Pretty (T.EnumDef a) where
pretty :: EnumDef a -> Doc
pretty = Config -> EnumDef a -> Doc
forall ann. Config -> EnumDef ann -> Doc
enumValue Config
defaultConfig
typeReference :: Config -> T.TypeReference ann -> Doc
typeReference :: Config -> TypeReference ann -> Doc
typeReference Config
c TypeReference ann
ft = case TypeReference ann
ft of
T.DefinedType Text
t ann
_ -> Text -> Doc
text Text
t
T.StringType [TypeAnnotation]
anns ann
_ -> String -> Doc
reserved String
"string" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.BinaryType [TypeAnnotation]
anns ann
_ -> String -> Doc
reserved String
"binary" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.SListType [TypeAnnotation]
anns ann
_ -> String -> Doc
reserved String
"slist" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.BoolType [TypeAnnotation]
anns ann
_ -> String -> Doc
reserved String
"bool" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.ByteType [TypeAnnotation]
anns ann
_ -> String -> Doc
reserved String
"byte" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.I16Type [TypeAnnotation]
anns ann
_ -> String -> Doc
reserved String
"i16" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.I32Type [TypeAnnotation]
anns ann
_ -> String -> Doc
reserved String
"i32" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.I64Type [TypeAnnotation]
anns ann
_ -> String -> Doc
reserved String
"i64" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.DoubleType [TypeAnnotation]
anns ann
_ -> String -> Doc
reserved String
"double" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.MapType TypeReference ann
k TypeReference ann
v [TypeAnnotation]
anns ann
_ ->
String -> Doc
reserved String
"map"
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> Doc -> Doc
enclose Doc
langle Doc
rangle
(Config -> TypeReference ann -> Doc
forall ann. Config -> TypeReference ann -> Doc
typeReference Config
c TypeReference ann
k Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+> Config -> TypeReference ann -> Doc
forall ann. Config -> TypeReference ann -> Doc
typeReference Config
c TypeReference ann
v)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.SetType TypeReference ann
v [TypeAnnotation]
anns ann
_ ->
String -> Doc
reserved String
"set"
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> Doc -> Doc
enclose Doc
langle Doc
rangle (Config -> TypeReference ann -> Doc
forall ann. Config -> TypeReference ann -> Doc
typeReference Config
c TypeReference ann
v)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
T.ListType TypeReference ann
v [TypeAnnotation]
anns ann
_ ->
String -> Doc
reserved String
"list"
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> Doc -> Doc
enclose Doc
langle Doc
rangle (Config -> TypeReference ann -> Doc
forall ann. Config -> TypeReference ann -> Doc
typeReference Config
c TypeReference ann
v)
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Config -> [TypeAnnotation] -> Doc
typeAnnots Config
c [TypeAnnotation]
anns
instance Pretty (T.TypeReference a) where
pretty :: TypeReference a -> Doc
pretty = Config -> TypeReference a -> Doc
forall ann. Config -> TypeReference ann -> Doc
typeReference Config
defaultConfig
constantValue :: Config -> T.ConstValue ann -> Doc
constantValue :: Config -> ConstValue ann -> Doc
constantValue c :: Config
c@Config{Int
indentWidth :: Int
indentWidth :: Config -> Int
indentWidth} ConstValue ann
value = case ConstValue ann
value of
T.ConstInt Integer
i ann
_ -> Integer -> Doc
integer Integer
i
T.ConstFloat Double
f ann
_ -> Double -> Doc
double Double
f
T.ConstLiteral Text
l ann
_ -> Text -> Doc
literal Text
l
T.ConstIdentifier Text
i ann
_ -> Text -> Doc
text Text
i
T.ConstList [ConstValue ann]
vs ann
_ ->
Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Int
indentWidth Doc
lbracket Doc
rbracket Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (ConstValue ann -> Doc) -> [ConstValue ann] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Config -> ConstValue ann -> Doc
forall ann. Config -> ConstValue ann -> Doc
constantValue Config
c) [ConstValue ann]
vs
T.ConstMap [(ConstValue ann, ConstValue ann)]
vs ann
_ ->
Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Int
indentWidth Doc
lbrace Doc
rbrace Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
((ConstValue ann, ConstValue ann) -> Doc)
-> [(ConstValue ann, ConstValue ann)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(ConstValue ann
k, ConstValue ann
v) -> Config -> ConstValue ann -> Doc
forall ann. Config -> ConstValue ann -> Doc
constantValue Config
c ConstValue ann
k Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> Config -> ConstValue ann -> Doc
forall ann. Config -> ConstValue ann -> Doc
constantValue Config
c ConstValue ann
v) [(ConstValue ann, ConstValue ann)]
vs
instance Pretty (T.ConstValue a) where
pretty :: ConstValue a -> Doc
pretty = Config -> ConstValue a -> Doc
forall ann. Config -> ConstValue ann -> Doc
constantValue Config
defaultConfig
typeAnnots :: Config -> [T.TypeAnnotation] -> Doc
typeAnnots :: Config -> [TypeAnnotation] -> Doc
typeAnnots Config
_ [] = Doc
empty
typeAnnots Config{Int
indentWidth :: Int
indentWidth :: Config -> Int
indentWidth} [TypeAnnotation]
anns =
Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Int
indentWidth Doc
lparen Doc
rparen Doc
comma ((TypeAnnotation -> Doc) -> [TypeAnnotation] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeAnnotation -> Doc
typeAnnot [TypeAnnotation]
anns)
typeAnnot :: T.TypeAnnotation -> Doc
typeAnnot :: TypeAnnotation -> Doc
typeAnnot T.TypeAnnotation{Docstring
Text
typeAnnotationValue :: TypeAnnotation -> Docstring
typeAnnotationName :: TypeAnnotation -> Text
typeAnnotationValue :: Docstring
typeAnnotationName :: Text
..} =
Text -> Doc
text Text
typeAnnotationName Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
value
where
value :: Doc
value = case Docstring
typeAnnotationValue of
Docstring
Nothing -> Doc
empty
Just Text
v -> Doc
space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
equals Doc -> Doc -> Doc
<+> Text -> Doc
literal Text
v
instance Pretty T.TypeAnnotation where
pretty :: TypeAnnotation -> Doc
pretty = TypeAnnotation -> Doc
typeAnnot
literal :: Text -> Doc
literal :: Text -> Doc
literal = Doc -> Doc
cyan (Doc -> Doc) -> (Text -> Doc) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
dquotes (Doc -> Doc) -> (Text -> Doc) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
text
text :: Text -> Doc
text :: Text -> Doc
text = String -> Doc
P.text (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
reserved :: String -> Doc
reserved :: String -> Doc
reserved = Doc -> Doc
magenta (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
P.text
op :: String -> Doc
op :: String -> Doc
op = Doc -> Doc
yellow (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
P.text
declare :: Text -> Doc
declare :: Text -> Doc
declare = Doc -> Doc
bold (Doc -> Doc) -> (Text -> Doc) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
text
($$) :: T.Docstring -> Doc -> Doc
$$ :: Docstring -> Doc -> Doc
($$) Docstring
Nothing Doc
y = Doc
y
($$) (Just Text
t) Doc
y =
if Text -> Bool
Text.null Text
t'
then Doc
y
else Text -> Doc
docstring Text
t' Doc -> Doc -> Doc
<$> Doc
y
where
t' :: Text
t' = Text -> Text
Text.strip Text
t
infixr 1 $$
docstring :: Text -> Doc
docstring :: Text -> Doc
docstring = Doc -> Doc
dullblue (Doc -> Doc) -> (Text -> Doc) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Doc
wrapComments ([Text] -> Doc) -> (Text -> [Text]) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
where
wrapComments :: [Text] -> Doc
wrapComments [Text]
ls = Doc -> Doc
align (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vsep
([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
text Text
"/**"
Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Text -> Doc) -> [Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
l -> Text -> Doc
text Text
" *" Doc -> Doc -> Doc
<+> Text -> Doc
text Text
l) [Text]
ls
[Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Text -> Doc
text Text
" */"]
block :: Int -> Doc -> [Doc] -> Doc
block :: Int -> Doc -> [Doc] -> Doc
block Int
indent Doc
s [Doc]
items = Doc -> Doc -> Doc -> Doc
enclose Doc
lbrace Doc
rbrace (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Doc -> Doc
nest Int
indent (Doc
linebreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ([Doc]
items [Doc] -> Doc -> Doc
`sepBy` Doc
s)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
linebreak
sepBy :: [Doc] -> Doc -> Doc
sepBy :: [Doc] -> Doc -> Doc
sepBy [] Doc
_ = Doc
empty
sepBy [Doc
x] Doc
_ = Doc
x
sepBy (Doc
x:[Doc]
xs) Doc
s = Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc -> Doc
sepBy [Doc]
xs Doc
s
encloseSep :: Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep :: Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Int
_ Doc
left Doc
right Doc
_ [] = Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right
encloseSep Int
_ Doc
left Doc
right Doc
_ [Doc
v] = Doc
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
right
encloseSep Int
indent Doc
left Doc
right Doc
s [Doc]
vs = Doc -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Int -> Doc -> Doc
nest Int
indent (Doc
left Doc -> Doc -> Doc
<$$> [Doc] -> Doc
go [Doc]
vs) Doc -> Doc -> Doc
<$$> Doc
right
where go :: [Doc] -> Doc
go [] = Doc
empty
go [Doc
x] = Doc
x
go (Doc
x:[Doc]
xs) = (Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
s) Doc -> Doc -> Doc
<$> [Doc] -> Doc
go [Doc]
xs
lbrace :: Doc
lbrace :: Doc
lbrace = String -> Doc
op String
"{"
rbrace :: Doc
rbrace :: Doc
rbrace = String -> Doc
op String
"}"
lparen :: Doc
lparen :: Doc
lparen = String -> Doc
op String
"("
rparen :: Doc
rparen :: Doc
rparen = String -> Doc
op String
")"
lbracket :: Doc
lbracket :: Doc
lbracket = String -> Doc
op String
"["
rbracket :: Doc
rbracket :: Doc
rbracket = String -> Doc
op String
"]"
langle :: Doc
langle :: Doc
langle = String -> Doc
op String
"<"
rangle :: Doc
rangle :: Doc
rangle = String -> Doc
op String
">"
comma :: Doc
comma :: Doc
comma = String -> Doc
op String
","
semi :: Doc
semi :: Doc
semi = String -> Doc
op String
";"
colon :: Doc
colon :: Doc
colon = String -> Doc
op String
":"
equals :: Doc
equals :: Doc
equals = String -> Doc
op String
"="