module Hydra.Langs.Pegasus.Serde where

import Hydra.Tools.Serialization
import Hydra.Tools.Formatting
import qualified Hydra.Ast as CT
import qualified Hydra.Langs.Pegasus.Pdl as PDL

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


exprAnnotations :: PDL.Annotations -> Y.Maybe CT.Expr
exprAnnotations :: Annotations -> Maybe Expr
exprAnnotations (PDL.Annotations Maybe String
doc Bool
_) = String -> Expr
cst (String -> Expr) -> (String -> String) -> String -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
javaStyleComment (String -> Expr) -> Maybe String -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
doc

exprEnumField :: PDL.EnumField -> CT.Expr
exprEnumField :: EnumField -> Expr
exprEnumField (PDL.EnumField (PDL.EnumFieldName String
name) Annotations
anns) = Annotations -> Expr -> Expr
withAnnotations Annotations
anns (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr
cst String
name

exprImport :: PDL.QualifiedName -> CT.Expr
exprImport :: QualifiedName -> Expr
exprImport QualifiedName
qn = [Expr] -> Expr
spaceSep [String -> Expr
cst String
"import", QualifiedName -> Expr
exprQualifiedName QualifiedName
qn]

exprNamedSchema :: PDL.NamedSchema -> CT.Expr
exprNamedSchema :: NamedSchema -> Expr
exprNamedSchema (PDL.NamedSchema QualifiedName
qn NamedSchema_Type
t Annotations
anns) = Annotations -> Expr -> Expr
withAnnotations Annotations
anns (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$
  case NamedSchema_Type
t of
    PDL.NamedSchema_TypeRecord (PDL.RecordSchema [RecordField]
fields [NamedSchema]
_) -> [Expr] -> Expr
spaceSep [String -> Expr
cst String
"record", QualifiedName -> Expr
exprQualifiedName QualifiedName
qn,
      Maybe String -> BlockStyle -> [Expr] -> Expr
curlyBracesList Maybe String
forall a. Maybe a
Nothing BlockStyle
fullBlockStyle (RecordField -> Expr
exprRecordField (RecordField -> Expr) -> [RecordField] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RecordField]
fields)]
    PDL.NamedSchema_TypeEnum (PDL.EnumSchema [EnumField]
fields) -> [Expr] -> Expr
spaceSep [String -> Expr
cst String
"enum", QualifiedName -> Expr
exprQualifiedName QualifiedName
qn,
      Maybe String -> BlockStyle -> [Expr] -> Expr
curlyBracesList Maybe String
forall a. Maybe a
Nothing BlockStyle
fullBlockStyle (EnumField -> Expr
exprEnumField (EnumField -> Expr) -> [EnumField] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EnumField]
fields)]
    PDL.NamedSchema_TypeTyperef Schema
schema -> [Expr] -> Expr
spaceSep [String -> Expr
cst String
"typeref", QualifiedName -> Expr
exprQualifiedName QualifiedName
qn, String -> Expr
cst String
"=", Schema -> Expr
exprSchema Schema
schema]

exprPrimitiveType :: PDL.PrimitiveType -> CT.Expr
exprPrimitiveType :: PrimitiveType -> Expr
exprPrimitiveType PrimitiveType
pt = String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ case PrimitiveType
pt of
  PrimitiveType
PDL.PrimitiveTypeBoolean -> String
"boolean"
  PrimitiveType
PDL.PrimitiveTypeBytes -> String
"bytes"
  PrimitiveType
PDL.PrimitiveTypeDouble -> String
"double"
  PrimitiveType
PDL.PrimitiveTypeFloat -> String
"float"
  PrimitiveType
PDL.PrimitiveTypeInt -> String
"int"
  PrimitiveType
PDL.PrimitiveTypeLong -> String
"long"
  PrimitiveType
PDL.PrimitiveTypeString -> String
"string"

exprQualifiedName :: PDL.QualifiedName -> CT.Expr
exprQualifiedName :: QualifiedName -> Expr
exprQualifiedName (PDL.QualifiedName (PDL.Name String
name) Maybe Namespace
ns) = String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
Y.catMaybes [Namespace -> String
h (Namespace -> String) -> Maybe Namespace -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Namespace
ns, String -> Maybe String
forall a. a -> Maybe a
Just String
name]
  where
    h :: Namespace -> String
h (PDL.Namespace String
ns) = String
ns

exprRecordField :: PDL.RecordField -> CT.Expr
exprRecordField :: RecordField -> Expr
exprRecordField (PDL.RecordField (PDL.FieldName String
name) Schema
schema Bool
optional Maybe Value
def Annotations
anns) = Annotations -> Expr -> Expr
withAnnotations Annotations
anns (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: default
    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
$ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":",
    if Bool
optional then Expr -> Maybe Expr
forall a. a -> Maybe a
Just (String -> Expr
cst String
"optional") else Maybe Expr
forall a. Maybe a
Nothing,
    Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ Schema -> Expr
exprSchema Schema
schema]

exprSchema :: PDL.Schema -> CT.Expr
exprSchema :: Schema -> Expr
exprSchema Schema
schema = case Schema
schema of
  PDL.SchemaArray Schema
s -> [Expr] -> Expr
noSep [String -> Expr
cst String
"array", BlockStyle -> [Expr] -> Expr
bracketList BlockStyle
inlineStyle [Schema -> Expr
exprSchema Schema
s]]
--  PDL.SchemaFixed i ->
--  PDL.SchemaInline ns ->
  PDL.SchemaMap Schema
s -> [Expr] -> Expr
noSep [String -> Expr
cst String
"map", BlockStyle -> [Expr] -> Expr
bracketList BlockStyle
inlineStyle [String -> Expr
cst String
"string", Schema -> Expr
exprSchema Schema
s]]
  PDL.SchemaNamed QualifiedName
qn -> QualifiedName -> Expr
exprQualifiedName QualifiedName
qn
  Schema
PDL.SchemaNull -> String -> Expr
cst String
"null"
  PDL.SchemaPrimitive PrimitiveType
pt -> PrimitiveType -> Expr
exprPrimitiveType PrimitiveType
pt
  PDL.SchemaUnion (PDL.UnionSchema [UnionMember]
us) -> [Expr] -> Expr
noSep [String -> Expr
cst String
"union", BlockStyle -> [Expr] -> Expr
bracketList BlockStyle
fullBlockStyle (UnionMember -> Expr
exprUnionMember (UnionMember -> Expr) -> [UnionMember] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UnionMember]
us)]

exprSchemaFile :: PDL.SchemaFile -> CT.Expr
exprSchemaFile :: SchemaFile -> Expr
exprSchemaFile (PDL.SchemaFile (PDL.Namespace String
ns) Maybe Package
pkg [QualifiedName]
imports [NamedSchema]
schemas) = [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
namespaceSec, Maybe Expr
packageSec, Maybe Expr
importsSec] [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr]
schemaSecs
  where
    namespaceSec :: Maybe Expr
namespaceSec = Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
spaceSep [String -> Expr
cst String
"namespace", String -> Expr
cst String
ns]
    packageSec :: Maybe Expr
packageSec = (Package -> Expr) -> Maybe Package -> Maybe Expr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PDL.Package String
p) -> [Expr] -> Expr
spaceSep [String -> Expr
cst String
"package", String -> Expr
cst String
p]) Maybe Package
pkg
    importsSec :: Maybe Expr
importsSec = if [QualifiedName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [QualifiedName]
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 (QualifiedName -> Expr
exprImport (QualifiedName -> Expr) -> [QualifiedName] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QualifiedName]
imports)
    schemaSecs :: [Expr]
schemaSecs = NamedSchema -> Expr
exprNamedSchema (NamedSchema -> Expr) -> [NamedSchema] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedSchema]
schemas

exprUnionMember :: PDL.UnionMember -> CT.Expr
exprUnionMember :: UnionMember -> Expr
exprUnionMember (PDL.UnionMember Maybe FieldName
alias Schema
schema Annotations
anns) = Annotations -> Expr -> Expr
withAnnotations Annotations
anns (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 [
    (FieldName -> Expr) -> Maybe FieldName -> Maybe Expr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PDL.FieldName String
n) -> String -> Expr
cst (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":") Maybe FieldName
alias,
    Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ Schema -> Expr
exprSchema Schema
schema]

withAnnotations :: PDL.Annotations -> CT.Expr -> CT.Expr
withAnnotations :: Annotations -> Expr -> Expr
withAnnotations Annotations
anns Expr
expr = [Expr] -> Expr
newlineSep ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [Maybe Expr] -> [Expr]
forall a. [Maybe a] -> [a]
Y.catMaybes [Annotations -> Maybe Expr
exprAnnotations Annotations
anns, Expr -> Maybe Expr
forall a. a -> Maybe a
Y.Just Expr
expr]