module Hydra.Ext.Pegasus.Serde where

import Hydra.Util.Codetree.Script
import Hydra.Util.Formatting
import qualified Hydra.Util.Codetree.Ast as CT
import qualified Hydra.Ext.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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
javaStyleComment 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 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 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,
      BlockStyle -> [Expr] -> Expr
curlyBracesList BlockStyle
fullBlockStyle (RecordField -> Expr
exprRecordField 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,
      BlockStyle -> [Expr] -> Expr
curlyBracesList BlockStyle
fullBlockStyle (EnumField -> Expr
exprEnumField 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 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 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
L.intercalate String
"." forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
Y.catMaybes [Namespace -> String
h forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Namespace
ns, 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 forall a b. (a -> b) -> a -> b
$
  [Expr] -> Expr
spaceSep forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
Y.catMaybes [ -- TODO: default
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Expr
cst forall a b. (a -> b) -> a -> b
$ String
name forall a. [a] -> [a] -> [a]
++ String
":",
    if Bool
optional then forall a. a -> Maybe a
Just (String -> Expr
cst String
"optional") else forall a. Maybe a
Nothing,
    forall a. a -> Maybe a
Just 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 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 forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
Y.catMaybes
    [Maybe Expr
namespaceSec, Maybe Expr
packageSec, Maybe Expr
importsSec] forall a. [a] -> [a] -> [a]
++ [Expr]
schemaSecs
  where
    namespaceSec :: Maybe Expr
namespaceSec = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
spaceSep [String -> Expr
cst String
"namespace", String -> Expr
cst String
ns]
    packageSec :: Maybe Expr
packageSec = 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [QualifiedName]
imports
      then forall a. Maybe a
Nothing
      else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
newlineSep (QualifiedName -> Expr
exprImport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QualifiedName]
imports)
    schemaSecs :: [Expr]
schemaSecs = NamedSchema -> Expr
exprNamedSchema 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 forall a b. (a -> b) -> a -> b
$
  [Expr] -> Expr
spaceSep forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
Y.catMaybes [
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PDL.FieldName String
n) -> String -> Expr
cst forall a b. (a -> b) -> a -> b
$ String
n forall a. [a] -> [a] -> [a]
++ String
":") Maybe FieldName
alias,
    forall a. a -> Maybe a
Just 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 forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
Y.catMaybes [Annotations -> Maybe Expr
exprAnnotations Annotations
anns, forall a. a -> Maybe a
Y.Just Expr
expr]