module Hydra.Langs.Protobuf.Serde (
  deprecatedOptionName,
  descriptionOptionName,
  writeProtoFile) where

import Hydra.Tools.Serialization
import Hydra.Tools.Formatting
import qualified Hydra.Ast as CT
import qualified Hydra.Langs.Protobuf.Proto3 as P3

import qualified Data.List as L
import qualified Data.Maybe as Y


deprecatedOptionName :: String
deprecatedOptionName = String
"deprecated"
-- A special Protobuf option for descriptions (documentation)
descriptionOptionName :: String
descriptionOptionName = String
"_description"

excludeInternalOptions :: [P3.Option] -> [P3.Option]
excludeInternalOptions :: [Option] -> [Option]
excludeInternalOptions = (Option -> Bool) -> [Option] -> [Option]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\Option
opt -> String -> Char
forall a. HasCallStack => [a] -> a
L.head (Option -> String
P3.optionName Option
opt) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_' )

protoBlock :: [CT.Expr] -> CT.Expr
protoBlock :: [Expr] -> Expr
protoBlock = Brackets -> BlockStyle -> Expr -> Expr
brackets Brackets
curlyBraces BlockStyle
fullBlockStyle (Expr -> Expr) -> ([Expr] -> Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> Expr
doubleNewlineSep

semi :: CT.Expr -> CT.Expr
semi :: Expr -> Expr
semi Expr
e = [Expr] -> Expr
noSep [Expr
e, String -> Expr
cst String
";"]

optDesc :: Bool -> [P3.Option] -> CT.Expr -> CT.Expr
optDesc :: Bool -> [Option] -> Expr -> Expr
optDesc Bool
doubleNewline [Option]
opts Expr
expr = if [Option] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Option]
descs
    then Expr
expr
    else [Expr] -> Expr
sep [String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ String -> String
asComment (Value -> String
unValue (Value -> String) -> Value -> String
forall a b. (a -> b) -> a -> b
$ Option -> Value
P3.optionValue (Option -> Value) -> Option -> Value
forall a b. (a -> b) -> a -> b
$ [Option] -> Option
forall a. HasCallStack => [a] -> a
L.head [Option]
descs), Expr
expr]
  where
    sep :: [Expr] -> Expr
sep = if Bool
doubleNewline then [Expr] -> Expr
doubleNewlineSep else [Expr] -> Expr
newlineSep
    descs :: [Option]
descs = (Option -> Bool) -> [Option] -> [Option]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(P3.Option String
name Value
value) -> String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
descriptionOptionName) [Option]
opts
    asComment :: String -> String
asComment = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
s -> String
"// " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    unValue :: Value -> String
unValue Value
v = case Value
v of
      P3.ValueBoolean Bool
b -> if Bool
b then String
"true" else String
"false"
      P3.ValueString String
s -> String
s

writeDefinition :: P3.Definition -> CT.Expr
writeDefinition :: Definition -> Expr
writeDefinition Definition
def = case Definition
def of
  P3.DefinitionEnum EnumDefinition
enum -> EnumDefinition -> Expr
writeEnumDefinition EnumDefinition
enum
  P3.DefinitionMessage MessageDefinition
msg -> MessageDefinition -> Expr
writeMessageDefinition MessageDefinition
msg

writeEnumDefinition :: P3.EnumDefinition -> CT.Expr
writeEnumDefinition :: EnumDefinition -> Expr
writeEnumDefinition (P3.EnumDefinition TypeName
name [EnumValue]
values [Option]
options) = Bool -> [Option] -> Expr -> Expr
optDesc Bool
False [Option]
options (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
spaceSep [
  String -> Expr
cst String
"enum",
  String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ TypeName -> String
P3.unTypeName TypeName
name,
  [Expr] -> Expr
protoBlock (EnumValue -> Expr
writeEnumValue (EnumValue -> Expr) -> [EnumValue] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EnumValue]
values)]

writeEnumValue :: P3.EnumValue -> CT.Expr
writeEnumValue :: EnumValue -> Expr
writeEnumValue (P3.EnumValue EnumValueName
name Int
number [Option]
options) = Bool -> [Option] -> Expr -> Expr
optDesc Bool
False [Option]
options (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
semi (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
spaceSep [
    String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ EnumValueName -> String
P3.unEnumValueName EnumValueName
name,
    String -> Expr
cst String
"=",
    String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
number]

writeField :: P3.Field -> CT.Expr
writeField :: Field -> Expr
writeField (P3.Field FieldName
name Maybe String
jsonName FieldType
typ Int
num [Option]
options) = Bool -> [Option] -> Expr -> Expr
optDesc Bool
False [Option]
options (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ case FieldType
typ of
  P3.FieldTypeOneof [Field]
fields -> [Expr] -> Expr
spaceSep [
    String -> Expr
cst String
"oneof",
    String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ FieldName -> String
P3.unFieldName FieldName
name,
    [Expr] -> Expr
protoBlock (Field -> Expr
writeField (Field -> Expr) -> [Field] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field]
fields)]
  FieldType
_ -> Expr -> Expr
semi (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
spaceSep ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [Maybe Expr] -> [Expr]
forall a. [Maybe a] -> [a]
Y.catMaybes [ -- TODO: jsonName
    Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ FieldType -> Expr
writeFieldType FieldType
typ,
    Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ FieldName -> String
P3.unFieldName FieldName
name,
    Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr
cst String
"=",
    Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
num,
    [Option] -> Maybe Expr
writeFieldOptions [Option]
options]

writeFieldOption :: P3.Option -> CT.Expr
writeFieldOption :: Option -> Expr
writeFieldOption (P3.Option String
name Value
value) = [Expr] -> Expr
spaceSep [String -> Expr
cst String
name, String -> Expr
cst String
"=", Value -> Expr
writeValue Value
value]

writeFieldOptions :: [P3.Option] -> Y.Maybe CT.Expr
writeFieldOptions :: [Option] -> Maybe Expr
writeFieldOptions [Option]
options0 = if [Option] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Option]
options
    then Maybe Expr
forall a. Maybe a
Nothing
    else Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ BlockStyle -> [Expr] -> Expr
bracketList BlockStyle
inlineStyle (Option -> Expr
writeFieldOption (Option -> Expr) -> [Option] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Option]
options)
  where
    options :: [Option]
options = [Option] -> [Option]
excludeInternalOptions [Option]
options0

writeFieldType :: P3.FieldType -> CT.Expr
writeFieldType :: FieldType -> Expr
writeFieldType FieldType
ftyp = case FieldType
ftyp of
  P3.FieldTypeMap SimpleType
st -> [Expr] -> Expr
noSep [String -> Expr
cst String
"map", BlockStyle -> [Expr] -> Expr
angleBracesList BlockStyle
inlineStyle [String -> Expr
cst String
"string", SimpleType -> Expr
writeSimpleType SimpleType
st]]
  P3.FieldTypeRepeated SimpleType
st -> [Expr] -> Expr
spaceSep [String -> Expr
cst String
"repeated", SimpleType -> Expr
writeSimpleType SimpleType
st]
  P3.FieldTypeSimple SimpleType
st -> SimpleType -> Expr
writeSimpleType SimpleType
st

writeFileOption :: P3.Option -> CT.Expr
writeFileOption :: Option -> Expr
writeFileOption (P3.Option String
name Value
value) = Expr -> Expr
semi (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
spaceSep [String -> Expr
cst String
"option", String -> Expr
cst String
name, String -> Expr
cst String
"=", Value -> Expr
writeValue Value
value]

writeFileOptions :: [P3.Option] -> Y.Maybe CT.Expr
writeFileOptions :: [Option] -> Maybe Expr
writeFileOptions [Option]
options0 = if [Option] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Option]
options
    then Maybe Expr
forall a. Maybe a
Nothing
    else Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
newlineSep ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ Option -> Expr
writeFileOption (Option -> Expr) -> [Option] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Option]
options
  where
    options :: [Option]
options = [Option] -> [Option]
excludeInternalOptions [Option]
options0

writeImport :: P3.FileReference -> CT.Expr
writeImport :: FileReference -> Expr
writeImport (P3.FileReference String
path) = Expr -> Expr
semi (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
spaceSep [String -> Expr
cst String
"import", String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
path]

writeMessageDefinition :: P3.MessageDefinition -> CT.Expr
writeMessageDefinition :: MessageDefinition -> Expr
writeMessageDefinition (P3.MessageDefinition TypeName
name [Field]
fields [Option]
options) = Bool -> [Option] -> Expr -> Expr
optDesc Bool
False [Option]
options (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
spaceSep [
  String -> Expr
cst String
"message",
  String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ TypeName -> String
P3.unTypeName TypeName
name,
  [Expr] -> Expr
protoBlock (Field -> Expr
writeField (Field -> Expr) -> [Field] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field]
fields)]

writeProtoFile :: P3.ProtoFile -> CT.Expr
writeProtoFile :: ProtoFile -> Expr
writeProtoFile (P3.ProtoFile PackageName
pkg [FileReference]
imports [Definition]
defs [Option]
options) = Bool -> [Option] -> Expr -> Expr
optDesc Bool
True [Option]
options (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
doubleNewlineSep
    ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [Maybe Expr] -> [Expr]
forall a. [Maybe a] -> [a]
Y.catMaybes [Maybe Expr
headerSec, Maybe Expr
importsSec, Maybe Expr
optionsSec, Maybe Expr
defsSec]
  where
    headerSec :: Maybe Expr
headerSec = Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
newlineSep [
      Expr -> Expr
semi (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr
cst String
"syntax = \"proto3\"",
      Expr -> Expr
semi (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
spaceSep [String -> Expr
cst String
"package", String -> Expr
cst (PackageName -> String
P3.unPackageName PackageName
pkg)]]
    importsSec :: Maybe Expr
importsSec = if [FileReference] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [FileReference]
imports
      then Maybe Expr
forall a. Maybe a
Nothing
      else Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
newlineSep ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ FileReference -> Expr
writeImport (FileReference -> Expr) -> [FileReference] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FileReference]
imports
    optionsSec :: Maybe Expr
optionsSec = [Option] -> Maybe Expr
writeFileOptions [Option]
options1
    defsSec :: Maybe Expr
defsSec = if [Definition] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Definition]
defs
      then Maybe Expr
forall a. Maybe a
Nothing
      else Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
doubleNewlineSep ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ Definition -> Expr
writeDefinition (Definition -> Expr) -> [Definition] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Definition]
defs
    options1 :: [Option]
options1 = (Option -> Bool) -> [Option] -> [Option]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(P3.Option String
name Value
value) -> String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
descriptionOptionName) [Option]
options

writeScalarType :: P3.ScalarType -> CT.Expr
writeScalarType :: ScalarType -> Expr
writeScalarType ScalarType
sct = String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ case ScalarType
sct of
  ScalarType
P3.ScalarTypeBool -> String
"bool"
  ScalarType
P3.ScalarTypeBytes -> String
"bytes"
  ScalarType
P3.ScalarTypeDouble -> String
"double"
  ScalarType
P3.ScalarTypeFixed32 -> String
"fixed32"
  ScalarType
P3.ScalarTypeFixed64 -> String
"fixed64"
  ScalarType
P3.ScalarTypeFloat -> String
"float"
  ScalarType
P3.ScalarTypeInt32 -> String
"int32"
  ScalarType
P3.ScalarTypeInt64 -> String
"int64"
  ScalarType
P3.ScalarTypeSfixed32 -> String
"sfixed32"
  ScalarType
P3.ScalarTypeSfixed64 -> String
"sfixed64"
  ScalarType
P3.ScalarTypeSint32 -> String
"sint32"
  ScalarType
P3.ScalarTypeSint64 -> String
"sint64"
  ScalarType
P3.ScalarTypeString -> String
"string"
  ScalarType
P3.ScalarTypeUint32 -> String
"uint32"
  ScalarType
P3.ScalarTypeUint64 -> String
"uint64"

writeSimpleType :: P3.SimpleType -> CT.Expr
writeSimpleType :: SimpleType -> Expr
writeSimpleType SimpleType
st = case SimpleType
st of
  P3.SimpleTypeReference TypeName
name -> String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ TypeName -> String
P3.unTypeName TypeName
name
  P3.SimpleTypeScalar ScalarType
sct -> ScalarType -> Expr
writeScalarType ScalarType
sct

writeValue :: P3.Value -> CT.Expr
writeValue :: Value -> Expr
writeValue Value
v = String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ case Value
v of
  P3.ValueBoolean Bool
b -> if Bool
b then String
"true" else String
"false"
  P3.ValueString String
s -> String -> String
forall a. Show a => a -> String
show String
s