-- | This module provides types and functions to generate .proto files.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedLists            #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}

module Proto3.Suite.DotProto.Rendering
  ( renderDotProto
  , defRenderingOptions
  , defSelectorName
  , defEnumMemberName
  , packageFromDefs
  , toProtoFile
  , toProtoFileDef
  , RenderingOptions(..)
  , Pretty(..)
  ) where

import           Proto3.Suite.DotProto.AST
import           Proto3.Wire.Types               (FieldNumber (..))
import           Text.PrettyPrint                (($$), (<+>))
import qualified Text.PrettyPrint                as PP
import           Text.PrettyPrint.HughesPJClass  (Pretty(..))

-- | Options for rendering a @.proto@ file.
data RenderingOptions = RenderingOptions
  { RenderingOptions
-> DotProtoIdentifier -> DotProtoIdentifier -> FieldNumber -> Doc
roSelectorName   :: DotProtoIdentifier -> DotProtoIdentifier -> FieldNumber -> PP.Doc
  -- ^ This function will be applied to each
  -- record selector name to turn it into a protobuf
  -- field name (default: uses the selector name, unchanged).
  , RenderingOptions -> DotProtoIdentifier -> DotProtoIdentifier -> Doc
roEnumMemberName :: DotProtoIdentifier -> DotProtoIdentifier -> PP.Doc
  -- ^ This function will be applied to each
  -- enum member name to turn it into a protobuf
  -- field name (default: uses the field name, unchanged).
  }

-- | Default rendering options.
defRenderingOptions :: RenderingOptions
defRenderingOptions :: RenderingOptions
defRenderingOptions =
    RenderingOptions { roSelectorName :: DotProtoIdentifier -> DotProtoIdentifier -> FieldNumber -> Doc
roSelectorName   = DotProtoIdentifier -> DotProtoIdentifier -> FieldNumber -> Doc
defSelectorName
                     , roEnumMemberName :: DotProtoIdentifier -> DotProtoIdentifier -> Doc
roEnumMemberName = DotProtoIdentifier -> DotProtoIdentifier -> Doc
defEnumMemberName
                     }

-- | The default choice of field name for a selector.
defSelectorName :: DotProtoIdentifier -> DotProtoIdentifier -> FieldNumber -> PP.Doc
defSelectorName :: DotProtoIdentifier -> DotProtoIdentifier -> FieldNumber -> Doc
defSelectorName DotProtoIdentifier
_ DotProtoIdentifier
fieldName FieldNumber
_ = DotProtoIdentifier -> Doc
forall a. Pretty a => a -> Doc
pPrint DotProtoIdentifier
fieldName

-- | The default choice of enum member name for an enum
defEnumMemberName :: DotProtoIdentifier -> DotProtoIdentifier -> PP.Doc
defEnumMemberName :: DotProtoIdentifier -> DotProtoIdentifier -> Doc
defEnumMemberName = (DotProtoIdentifier -> Doc)
-> DotProtoIdentifier -> DotProtoIdentifier -> Doc
forall a b. a -> b -> a
const DotProtoIdentifier -> Doc
forall a. Pretty a => a -> Doc
pPrint

-- | Traverses a DotProto AST and generates a .proto file from it
renderDotProto :: RenderingOptions -> DotProto -> PP.Doc
renderDotProto :: RenderingOptions -> DotProto -> Doc
renderDotProto RenderingOptions
opts DotProto{[DotProtoDefinition]
[DotProtoOption]
[DotProtoImport]
DotProtoMeta
DotProtoPackageSpec
protoImports :: [DotProtoImport]
protoOptions :: [DotProtoOption]
protoPackage :: DotProtoPackageSpec
protoDefinitions :: [DotProtoDefinition]
protoMeta :: DotProtoMeta
protoMeta :: DotProto -> DotProtoMeta
protoDefinitions :: DotProto -> [DotProtoDefinition]
protoPackage :: DotProto -> DotProtoPackageSpec
protoOptions :: DotProto -> [DotProtoOption]
protoImports :: DotProto -> [DotProtoImport]
..}
  = String -> Doc
PP.text String
"syntax = \"proto3\";"
 Doc -> Doc -> Doc
$$ DotProtoPackageSpec -> Doc
forall a. Pretty a => a -> Doc
pPrint DotProtoPackageSpec
protoPackage
 Doc -> Doc -> Doc
$$ ([Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ DotProtoImport -> Doc
forall a. Pretty a => a -> Doc
pPrint    (DotProtoImport -> Doc) -> [DotProtoImport] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DotProtoImport]
protoImports)
 Doc -> Doc -> Doc
$$ ([Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ DotProtoOption -> Doc
topOption (DotProtoOption -> Doc) -> [DotProtoOption] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DotProtoOption]
protoOptions)
 Doc -> Doc -> Doc
$$ ([Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ RenderingOptions -> DotProtoDefinition -> Doc
prettyPrintProtoDefinition RenderingOptions
opts (DotProtoDefinition -> Doc) -> [DotProtoDefinition] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DotProtoDefinition]
protoDefinitions)

optionAnnotation :: [DotProtoOption] -> PP.Doc
optionAnnotation :: [DotProtoOption] -> Doc
optionAnnotation [] = Doc
PP.empty
optionAnnotation [DotProtoOption]
os = Doc -> Doc
PP.brackets
                    (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
PP.hcat
                    ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
PP.punctuate (String -> Doc
PP.text String
", ")
                    ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ DotProtoOption -> Doc
forall a. Pretty a => a -> Doc
pPrint (DotProtoOption -> Doc) -> [DotProtoOption] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DotProtoOption]
os

topOption :: DotProtoOption -> PP.Doc
topOption :: DotProtoOption -> Doc
topOption DotProtoOption
o = String -> Doc
PP.text String
"option" Doc -> Doc -> Doc
<+> DotProtoOption -> Doc
forall a. Pretty a => a -> Doc
pPrint DotProtoOption
o Doc -> Doc -> Doc
PP.<> String -> Doc
PP.text String
";"

renderComment :: String -> PP.Doc
renderComment :: String -> Doc
renderComment = [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Doc
PP.text String
"//" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
textIfNonempty) ([String] -> [Doc]) -> (String -> [String]) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
  where
    textIfNonempty :: String -> Doc
textIfNonempty [] = Doc
PP.empty
    textIfNonempty String
text = String -> Doc
PP.text String
text

-- Put the final closing brace on the next line.
-- This is important, since the final field might have a comment, and
-- the brace cannot be part of the comment.
-- We could use block comments instead, once the parser/lexer supports them.
vbraces :: PP.Doc -> PP.Doc -> PP.Doc
vbraces :: Doc -> Doc -> Doc
vbraces Doc
header Doc
body = Doc
header Doc -> Doc -> Doc
<+> Char -> Doc
PP.char Char
'{' Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
PP.nest Int
2 Doc
body Doc -> Doc -> Doc
$$ Char -> Doc
PP.char Char
'}'

prettyPrintProtoDefinition :: RenderingOptions -> DotProtoDefinition -> PP.Doc
prettyPrintProtoDefinition :: RenderingOptions -> DotProtoDefinition -> Doc
prettyPrintProtoDefinition RenderingOptions
opts = DotProtoDefinition -> Doc
defn where
  defn :: DotProtoDefinition -> PP.Doc
  defn :: DotProtoDefinition -> Doc
defn (DotProtoMessage String
comment DotProtoIdentifier
name [DotProtoMessagePart]
parts) = String -> Doc
renderComment String
comment Doc -> Doc -> Doc
$$
    Doc -> Doc -> Doc
vbraces (String -> Doc
PP.text String
"message" Doc -> Doc -> Doc
<+> DotProtoIdentifier -> Doc
forall a. Pretty a => a -> Doc
pPrint DotProtoIdentifier
name) ([Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ DotProtoIdentifier -> DotProtoMessagePart -> Doc
msgPart DotProtoIdentifier
name (DotProtoMessagePart -> Doc) -> [DotProtoMessagePart] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DotProtoMessagePart]
parts)
  defn (DotProtoEnum    String
comment DotProtoIdentifier
name [DotProtoEnumPart]
parts) = String -> Doc
renderComment String
comment Doc -> Doc -> Doc
$$
    Doc -> Doc -> Doc
vbraces (String -> Doc
PP.text String
"enum"    Doc -> Doc -> Doc
<+> DotProtoIdentifier -> Doc
forall a. Pretty a => a -> Doc
pPrint DotProtoIdentifier
name) ([Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ DotProtoIdentifier -> DotProtoEnumPart -> Doc
enumPart DotProtoIdentifier
name (DotProtoEnumPart -> Doc) -> [DotProtoEnumPart] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DotProtoEnumPart]
parts)
  defn (DotProtoService String
comment DotProtoIdentifier
name [DotProtoServicePart]
parts) = String -> Doc
renderComment String
comment Doc -> Doc -> Doc
$$
    Doc -> Doc -> Doc
vbraces (String -> Doc
PP.text String
"service" Doc -> Doc -> Doc
<+> DotProtoIdentifier -> Doc
forall a. Pretty a => a -> Doc
pPrint DotProtoIdentifier
name) ([Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ DotProtoServicePart -> Doc
forall a. Pretty a => a -> Doc
pPrint (DotProtoServicePart -> Doc) -> [DotProtoServicePart] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DotProtoServicePart]
parts)

  msgPart :: DotProtoIdentifier -> DotProtoMessagePart -> PP.Doc
  msgPart :: DotProtoIdentifier -> DotProtoMessagePart -> Doc
msgPart DotProtoIdentifier
msgName (DotProtoMessageField DotProtoField
f)           = DotProtoIdentifier -> DotProtoField -> Doc
field DotProtoIdentifier
msgName DotProtoField
f
  msgPart DotProtoIdentifier
_       (DotProtoMessageDefinition DotProtoDefinition
definition) = DotProtoDefinition -> Doc
defn DotProtoDefinition
definition
  msgPart DotProtoIdentifier
_       (DotProtoMessageReserved [DotProtoReservedField]
reservations)
    =   String -> Doc
PP.text String
"reserved"
    Doc -> Doc -> Doc
<+> ([Doc] -> Doc
PP.hcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
PP.punctuate (String -> Doc
PP.text String
", ") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ DotProtoReservedField -> Doc
forall a. Pretty a => a -> Doc
pPrint (DotProtoReservedField -> Doc) -> [DotProtoReservedField] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DotProtoReservedField]
reservations)
    Doc -> Doc -> Doc
PP.<> String -> Doc
PP.text String
";"
  msgPart DotProtoIdentifier
msgName (DotProtoMessageOneOf DotProtoIdentifier
name [DotProtoField]
fields)     = Doc -> Doc -> Doc
vbraces (String -> Doc
PP.text String
"oneof" Doc -> Doc -> Doc
<+> DotProtoIdentifier -> Doc
forall a. Pretty a => a -> Doc
pPrint DotProtoIdentifier
name) ([Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ DotProtoIdentifier -> DotProtoField -> Doc
field DotProtoIdentifier
msgName (DotProtoField -> Doc) -> [DotProtoField] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DotProtoField]
fields)
  msgPart DotProtoIdentifier
_       (DotProtoMessageOption DotProtoOption
opt)
    = String -> Doc
PP.text String
"option" Doc -> Doc -> Doc
<+> DotProtoOption -> Doc
forall a. Pretty a => a -> Doc
pPrint DotProtoOption
opt Doc -> Doc -> Doc
PP.<> String -> Doc
PP.text String
";"

  field :: DotProtoIdentifier -> DotProtoField -> PP.Doc
  field :: DotProtoIdentifier -> DotProtoField -> Doc
field DotProtoIdentifier
msgName (DotProtoField FieldNumber
number DotProtoType
mtype DotProtoIdentifier
name [DotProtoOption]
options String
comments)
    =   DotProtoType -> Doc
forall a. Pretty a => a -> Doc
pPrint DotProtoType
mtype
    Doc -> Doc -> Doc
<+> RenderingOptions
-> DotProtoIdentifier -> DotProtoIdentifier -> FieldNumber -> Doc
roSelectorName RenderingOptions
opts DotProtoIdentifier
msgName DotProtoIdentifier
name FieldNumber
number
    Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"="
    Doc -> Doc -> Doc
<+> FieldNumber -> Doc
pPrintFieldNumber FieldNumber
number
    Doc -> Doc -> Doc
<+> [DotProtoOption] -> Doc
optionAnnotation [DotProtoOption]
options
    Doc -> Doc -> Doc
PP.<> String -> Doc
PP.text String
";"
    Doc -> Doc -> Doc
$$  Int -> Doc -> Doc
PP.nest Int
2 (String -> Doc
renderComment String
comments)

  enumPart :: DotProtoIdentifier -> DotProtoEnumPart -> PP.Doc
  enumPart :: DotProtoIdentifier -> DotProtoEnumPart -> Doc
enumPart DotProtoIdentifier
msgName (DotProtoEnumField DotProtoIdentifier
name DotProtoEnumValue
value [DotProtoOption]
options)
    = RenderingOptions -> DotProtoIdentifier -> DotProtoIdentifier -> Doc
roEnumMemberName RenderingOptions
opts DotProtoIdentifier
msgName DotProtoIdentifier
name
    Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"="
    Doc -> Doc -> Doc
<+> Int -> Doc
forall a. Pretty a => a -> Doc
pPrint (DotProtoEnumValue -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral DotProtoEnumValue
value :: Int)
    Doc -> Doc -> Doc
<+> [DotProtoOption] -> Doc
optionAnnotation [DotProtoOption]
options
    Doc -> Doc -> Doc
PP.<> String -> Doc
PP.text String
";"
  enumPart DotProtoIdentifier
_       (DotProtoEnumReserved [DotProtoReservedField]
reservedFields)
    = String -> Doc
PP.text String
"reserved" Doc -> Doc -> Doc
<+> ([Doc] -> Doc
PP.hcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
PP.punctuate (String -> Doc
PP.text String
", ") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ DotProtoReservedField -> Doc
forall a. Pretty a => a -> Doc
pPrint (DotProtoReservedField -> Doc) -> [DotProtoReservedField] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DotProtoReservedField]
reservedFields)
  enumPart DotProtoIdentifier
_       (DotProtoEnumOption DotProtoOption
opt)
    = String -> Doc
PP.text String
"option" Doc -> Doc -> Doc
<+> DotProtoOption -> Doc
forall a. Pretty a => a -> Doc
pPrint DotProtoOption
opt Doc -> Doc -> Doc
PP.<> String -> Doc
PP.text String
";"

pPrintFieldNumber :: FieldNumber -> PP.Doc
pPrintFieldNumber :: FieldNumber -> Doc
pPrintFieldNumber = String -> Doc
PP.text (String -> Doc) -> (FieldNumber -> String) -> FieldNumber -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String)
-> (FieldNumber -> Word64) -> FieldNumber -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> Word64
getFieldNumber

-- | Render protobufs metadata as a .proto file stringy
toProtoFile :: RenderingOptions -> DotProto -> String
toProtoFile :: RenderingOptions -> DotProto -> String
toProtoFile RenderingOptions
opts = Doc -> String
PP.render (Doc -> String) -> (DotProto -> Doc) -> DotProto -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderingOptions -> DotProto -> Doc
renderDotProto RenderingOptions
opts

-- | Render protobufs metadata as a .proto file string,
-- using the default rendering options.

toProtoFileDef :: DotProto -> String
toProtoFileDef :: DotProto -> String
toProtoFileDef = RenderingOptions -> DotProto -> String
toProtoFile RenderingOptions
defRenderingOptions

packageFromDefs :: String -> [DotProtoDefinition] -> DotProto
packageFromDefs :: String -> [DotProtoDefinition] -> DotProto
packageFromDefs String
package [DotProtoDefinition]
defs =
  [DotProtoImport]
-> [DotProtoOption]
-> DotProtoPackageSpec
-> [DotProtoDefinition]
-> DotProtoMeta
-> DotProto
DotProto [] [] (DotProtoIdentifier -> DotProtoPackageSpec
DotProtoPackageSpec (DotProtoIdentifier -> DotProtoPackageSpec)
-> DotProtoIdentifier -> DotProtoPackageSpec
forall a b. (a -> b) -> a -> b
$ String -> DotProtoIdentifier
Single String
package) [DotProtoDefinition]
defs (Path -> DotProtoMeta
DotProtoMeta Path
fakePath)