{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module Language.Thrift.Pretty
(
prettyPrintHighlighted
, prettyPrint
, program
, header
, include
, namespace
, functionParameters
, 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 qualified Data.List as List
import Data.Text (Text)
import qualified Data.Text as Text
import Text.PrettyPrint.ANSI.Leijen
( Doc
, align
, bold
, cyan
, double
, dquotes
, dullblue
, empty
, enclose
, group
, hardline
, hcat
, hsep
, integer
, line
, linebreak
, magenta
, nest
, plain
, space
, vsep
, yellow
, (<$$>)
, (<$>)
, (<+>)
)
import qualified Text.PrettyPrint.ANSI.Leijen as PP
import qualified Language.Thrift.Internal.AST as T
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
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> String
show :: Config -> String
$cshowList :: [Config] -> ShowS
showList :: [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
$ccompare :: Config -> Config -> Ordering
compare :: Config -> Config -> Ordering
$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
>= :: Config -> Config -> Bool
$cmax :: Config -> Config -> Config
max :: Config -> Config -> Config
$cmin :: Config -> Config -> Config
min :: Config -> Config -> Config
Ord, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
/= :: Config -> Config -> Bool
Eq)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Int -> Config
Config Int
4
prettyPrint :: T.Program ann -> Doc
prettyPrint :: forall ann. 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 :: forall ann. Program ann -> Doc
prettyPrintHighlighted = Config -> Program ann -> Doc
forall ann. Config -> Program ann -> Doc
program Config
defaultConfig
program :: Config -> T.Program ann -> Doc
program :: forall ann. Config -> Program ann -> Doc
program Config
c T.Program{[Header ann]
[Definition ann]
programHeaders :: [Header ann]
programDefinitions :: [Definition ann]
programHeaders :: forall srcAnnot. Program srcAnnot -> [Header srcAnnot]
programDefinitions :: forall srcAnnot. Program srcAnnot -> [Definition srcAnnot]
..} =
( if [Header ann] -> Bool
forall a. [a] -> 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)
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
include :: T.Include ann -> Doc
include :: forall ann. Include ann -> Doc
include T.Include{ann
Text
includePath :: Text
includeSrcAnnot :: ann
includePath :: forall srcAnnot. Include srcAnnot -> Text
includeSrcAnnot :: forall srcAnnot. Include srcAnnot -> srcAnnot
..} = String -> Doc
reserved String
"include" Doc -> Doc -> Doc
<+> Text -> Doc
literal Text
includePath
namespace :: T.Namespace ann -> Doc
namespace :: forall ann. Namespace ann -> Doc
namespace T.Namespace{ann
Text
namespaceLanguage :: Text
namespaceName :: Text
namespaceSrcAnnot :: ann
namespaceLanguage :: forall srcAnnot. Namespace srcAnnot -> Text
namespaceName :: forall srcAnnot. Namespace srcAnnot -> Text
namespaceSrcAnnot :: forall srcAnnot. Namespace srcAnnot -> srcAnnot
..} = [Doc] -> Doc
hsep
[String -> Doc
reserved String
"namespace", Text -> Doc
text Text
namespaceLanguage, Text -> Doc
text Text
namespaceName]
definition :: Config -> T.Definition ann -> Doc
definition :: forall ann. 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
constant :: Config -> T.Const ann -> Doc
constant :: forall ann. Config -> Const ann -> Doc
constant Config
c T.Const{ann
Docstring
Text
TypeReference ann
ConstValue ann
constValueType :: TypeReference ann
constName :: Text
constValue :: ConstValue ann
constDocstring :: Docstring
constSrcAnnot :: ann
constValueType :: forall srcAnnot. Const srcAnnot -> TypeReference srcAnnot
constName :: forall srcAnnot. Const srcAnnot -> Text
constValue :: forall srcAnnot. Const srcAnnot -> ConstValue srcAnnot
constDocstring :: forall srcAnnot. Const srcAnnot -> Docstring
constSrcAnnot :: forall srcAnnot. Const srcAnnot -> srcAnnot
..} = 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
]
service :: Config -> T.Service ann -> Doc
service :: forall ann. Config -> Service ann -> Doc
service c :: Config
c@Config{Int
indentWidth :: Config -> Int
indentWidth :: Int
indentWidth} T.Service{ann
[Function ann]
[TypeAnnotation]
Docstring
Text
serviceName :: Text
serviceExtends :: Docstring
serviceFunctions :: [Function ann]
serviceAnnotations :: [TypeAnnotation]
serviceDocstring :: Docstring
serviceSrcAnnot :: ann
serviceName :: forall srcAnnot. Service srcAnnot -> Text
serviceExtends :: forall srcAnnot. Service srcAnnot -> Docstring
serviceFunctions :: forall srcAnnot. Service srcAnnot -> [Function srcAnnot]
serviceAnnotations :: forall srcAnnot. Service srcAnnot -> [TypeAnnotation]
serviceDocstring :: forall srcAnnot. Service srcAnnot -> Docstring
serviceSrcAnnot :: forall srcAnnot. Service srcAnnot -> srcAnnot
..} =
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
functionParameters :: Config -> [T.Field ann] -> Doc
functionParameters :: forall ann. Config -> [Field ann] -> Doc
functionParameters c :: Config
c@Config{Int
indentWidth :: Config -> Int
indentWidth :: Int
..}
= Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
encloseSep Int
indentWidth Doc
lparen Doc
rparen Doc
comma
([Doc] -> Doc) -> ([Field ann] -> [Doc]) -> [Field ann] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
function :: Config -> T.Function ann -> Doc
function :: forall ann. Config -> Function ann -> Doc
function c :: Config
c@Config{Int
indentWidth :: Config -> Int
indentWidth :: Int
indentWidth} T.Function{functionParameters :: forall srcAnnot. Function srcAnnot -> [Field srcAnnot]
functionParameters = [Field ann]
params, ann
Bool
[TypeAnnotation]
Maybe [Field ann]
Docstring
Maybe (TypeReference ann)
Text
functionOneWay :: Bool
functionReturnType :: Maybe (TypeReference ann)
functionName :: Text
functionExceptions :: Maybe [Field ann]
functionAnnotations :: [TypeAnnotation]
functionDocstring :: Docstring
functionSrcAnnot :: ann
functionOneWay :: forall srcAnnot. Function srcAnnot -> Bool
functionReturnType :: forall srcAnnot.
Function srcAnnot -> Maybe (TypeReference srcAnnot)
functionName :: forall srcAnnot. Function srcAnnot -> Text
functionExceptions :: forall srcAnnot. Function srcAnnot -> Maybe [Field srcAnnot]
functionAnnotations :: forall srcAnnot. Function srcAnnot -> [TypeAnnotation]
functionDocstring :: forall srcAnnot. Function srcAnnot -> Docstring
functionSrcAnnot :: forall srcAnnot. Function srcAnnot -> srcAnnot
..} = 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
<> Config -> [Field ann] -> Doc
forall ann. Config -> [Field ann] -> Doc
functionParameters Config
c [Field ann]
params
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
typeDefinition :: Config -> T.Type ann -> Doc
typeDefinition :: forall ann. 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
typedef :: Config -> T.Typedef ann -> Doc
typedef :: forall ann. Config -> Typedef ann -> Doc
typedef Config
c T.Typedef{ann
[TypeAnnotation]
Docstring
Text
TypeReference ann
typedefTargetType :: TypeReference ann
typedefName :: Text
typedefAnnotations :: [TypeAnnotation]
typedefDocstring :: Docstring
typedefSrcAnnot :: ann
typedefTargetType :: forall srcAnnot. Typedef srcAnnot -> TypeReference srcAnnot
typedefName :: forall srcAnnot. Typedef srcAnnot -> Text
typedefAnnotations :: forall srcAnnot. Typedef srcAnnot -> [TypeAnnotation]
typedefDocstring :: forall srcAnnot. Typedef srcAnnot -> Docstring
typedefSrcAnnot :: forall srcAnnot. Typedef srcAnnot -> srcAnnot
..} = 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
enum :: Config -> T.Enum ann -> Doc
enum :: forall ann. Config -> Enum ann -> Doc
enum c :: Config
c@Config{Int
indentWidth :: Config -> Int
indentWidth :: Int
indentWidth} T.Enum{ann
[EnumDef ann]
[TypeAnnotation]
Docstring
Text
enumName :: Text
enumValues :: [EnumDef ann]
enumAnnotations :: [TypeAnnotation]
enumDocstring :: Docstring
enumSrcAnnot :: ann
enumName :: forall srcAnnot. Enum srcAnnot -> Text
enumValues :: forall srcAnnot. Enum srcAnnot -> [EnumDef srcAnnot]
enumAnnotations :: forall srcAnnot. Enum srcAnnot -> [TypeAnnotation]
enumDocstring :: forall srcAnnot. Enum srcAnnot -> Docstring
enumSrcAnnot :: forall srcAnnot. Enum srcAnnot -> srcAnnot
..} = 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
struct :: Config -> T.Struct ann -> Doc
struct :: forall ann. Config -> Struct ann -> Doc
struct c :: Config
c@Config{Int
indentWidth :: Config -> Int
indentWidth :: Int
indentWidth} T.Struct{ann
[Field ann]
[TypeAnnotation]
Docstring
Text
StructKind
structKind :: StructKind
structName :: Text
structFields :: [Field ann]
structAnnotations :: [TypeAnnotation]
structDocstring :: Docstring
structSrcAnnot :: ann
structKind :: forall srcAnnot. Struct srcAnnot -> StructKind
structName :: forall srcAnnot. Struct srcAnnot -> Text
structFields :: forall srcAnnot. Struct srcAnnot -> [Field srcAnnot]
structAnnotations :: forall srcAnnot. Struct srcAnnot -> [TypeAnnotation]
structDocstring :: forall srcAnnot. Struct srcAnnot -> Docstring
structSrcAnnot :: forall srcAnnot. Struct srcAnnot -> srcAnnot
..} = 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"
union :: Config -> T.Struct ann -> Doc
union :: forall ann. 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 :: forall ann. 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 :: forall ann. Config -> Senum ann -> Doc
senum c :: Config
c@Config{Int
indentWidth :: Config -> Int
indentWidth :: Int
indentWidth} T.Senum{ann
[Text]
[TypeAnnotation]
Docstring
Text
senumName :: Text
senumValues :: [Text]
senumAnnotations :: [TypeAnnotation]
senumDocstring :: Docstring
senumSrcAnnot :: ann
senumName :: forall srcAnnot. Senum srcAnnot -> Text
senumValues :: forall srcAnnot. Senum srcAnnot -> [Text]
senumAnnotations :: forall srcAnnot. Senum srcAnnot -> [TypeAnnotation]
senumDocstring :: forall srcAnnot. Senum srcAnnot -> Docstring
senumSrcAnnot :: forall srcAnnot. Senum srcAnnot -> srcAnnot
..} = 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
field :: Config -> T.Field ann -> Doc
field :: forall ann. Config -> Field ann -> Doc
field Config
c T.Field{ann
[TypeAnnotation]
Maybe Integer
Docstring
Maybe FieldRequiredness
Maybe (ConstValue ann)
Text
TypeReference ann
fieldIdentifier :: Maybe Integer
fieldRequiredness :: Maybe FieldRequiredness
fieldValueType :: TypeReference ann
fieldName :: Text
fieldDefaultValue :: Maybe (ConstValue ann)
fieldAnnotations :: [TypeAnnotation]
fieldDocstring :: Docstring
fieldSrcAnnot :: ann
fieldIdentifier :: forall srcAnnot. Field srcAnnot -> Maybe Integer
fieldRequiredness :: forall srcAnnot. Field srcAnnot -> Maybe FieldRequiredness
fieldValueType :: forall srcAnnot. Field srcAnnot -> TypeReference srcAnnot
fieldName :: forall srcAnnot. Field srcAnnot -> Text
fieldDefaultValue :: forall srcAnnot. Field srcAnnot -> Maybe (ConstValue srcAnnot)
fieldAnnotations :: forall srcAnnot. Field srcAnnot -> [TypeAnnotation]
fieldDocstring :: forall srcAnnot. Field srcAnnot -> Docstring
fieldSrcAnnot :: forall srcAnnot. Field srcAnnot -> srcAnnot
..} = 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
]
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"
enumValue :: Config -> T.EnumDef ann -> Doc
enumValue :: forall ann. Config -> EnumDef ann -> Doc
enumValue Config
c T.EnumDef{ann
[TypeAnnotation]
Maybe Integer
Docstring
Text
enumDefName :: Text
enumDefValue :: Maybe Integer
enumDefAnnotations :: [TypeAnnotation]
enumDefDocstring :: Docstring
enumDefSrcAnnot :: ann
enumDefName :: forall srcAnnot. EnumDef srcAnnot -> Text
enumDefValue :: forall srcAnnot. EnumDef srcAnnot -> Maybe Integer
enumDefAnnotations :: forall srcAnnot. EnumDef srcAnnot -> [TypeAnnotation]
enumDefDocstring :: forall srcAnnot. EnumDef srcAnnot -> Docstring
enumDefSrcAnnot :: forall srcAnnot. EnumDef srcAnnot -> srcAnnot
..} = 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
typeReference :: Config -> T.TypeReference ann -> Doc
typeReference :: forall ann. 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
constantValue :: Config -> T.ConstValue ann -> Doc
constantValue :: forall ann. Config -> ConstValue ann -> Doc
constantValue c :: Config
c@Config{Int
indentWidth :: Config -> Int
indentWidth :: 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
typeAnnots :: Config -> [T.TypeAnnotation] -> Doc
typeAnnots :: Config -> [TypeAnnotation] -> Doc
typeAnnots Config
_ [] = Doc
empty
typeAnnots Config{Int
indentWidth :: Config -> Int
indentWidth :: 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
typeAnnotationName :: Text
typeAnnotationValue :: Docstring
typeAnnotationName :: TypeAnnotation -> Text
typeAnnotationValue :: TypeAnnotation -> Docstring
..} =
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
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
PP.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
PP.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
PP.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
l] = Text -> Doc
text Text
"/** " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> 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
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
List.intersperse Doc
hardline
([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
"="