module Hydra.Ext.Scala.Coder (printModule) where

import Hydra.All
import Hydra.CoreDecoding
import Hydra.Impl.Haskell.Dsl.Terms
import qualified Hydra.Impl.Haskell.Dsl.Types as Types
import qualified Hydra.Ext.Scala.Meta as Scala
import qualified Hydra.Lib.Strings as Strings
import Hydra.Ext.Scala.Language
import Hydra.Ext.Scala.Utils
import Hydra.Adapters.Coders
import Hydra.Types.Inference
import Hydra.Types.Substitution
import Hydra.Util.Codetree.Script
import Hydra.Ext.Scala.Serde

import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Maybe as Y


printModule :: (Ord m, Read m, Show m) => Module m -> GraphFlow m (M.Map FilePath String)
printModule :: forall m.
(Ord m, Read m, Show m) =>
Module m -> GraphFlow m (Map FilePath FilePath)
printModule Module m
mod = do
  Pkg
pkg <- forall m. (Ord m, Read m, Show m) => Module m -> GraphFlow m Pkg
moduleToScalaPackage Module m
mod
  let s :: FilePath
s = Expr -> FilePath
printExpr forall a b. (a -> b) -> a -> b
$ Expr -> Expr
parenthesize forall a b. (a -> b) -> a -> b
$ Pkg -> Expr
writePkg Pkg
pkg
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Bool -> FileExtension -> Namespace -> FilePath
namespaceToFilePath Bool
False (FilePath -> FileExtension
FileExtension FilePath
"scala") forall a b. (a -> b) -> a -> b
$ forall m. Module m -> Namespace
moduleNamespace Module m
mod, FilePath
s)]

moduleToScalaPackage :: (Ord m, Read m, Show m) => Module m -> GraphFlow m Scala.Pkg
moduleToScalaPackage :: forall m. (Ord m, Read m, Show m) => Module m -> GraphFlow m Pkg
moduleToScalaPackage = forall m e d.
(Ord m, Read m, Show m) =>
Language m
-> (Term m -> GraphFlow m e)
-> (Module m
    -> Map (Type m) (Coder (Context m) (Context m) (Term m) e)
    -> [(Element m, TypedTerm m)]
    -> GraphFlow m d)
-> Module m
-> GraphFlow m d
transformModule forall m. Language m
scalaLanguage forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeUntypedTerm forall m.
(Ord m, Show m) =>
Module m
-> Map (Type m) (Coder (Context m) (Context m) (Term m) Data)
-> [(Element m, TypedTerm m)]
-> GraphFlow m Pkg
constructModule

constructModule :: (Ord m, Show m) => Module m -> M.Map (Type m) (Coder (Context m) (Context m) (Term m) Scala.Data) -> [(Element m, TypedTerm m)]
  -> GraphFlow m Scala.Pkg
constructModule :: forall m.
(Ord m, Show m) =>
Module m
-> Map (Type m) (Coder (Context m) (Context m) (Term m) Data)
-> [(Element m, TypedTerm m)]
-> GraphFlow m Pkg
constructModule Module m
mod Map (Type m) (Coder (Context m) (Context m) (Term m) Data)
coders [(Element m, TypedTerm m)]
pairs = do
    [Stat]
defs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall {m}. (Element m, TypedTerm m) -> Flow (Context m) Stat
toDef [(Element m, TypedTerm m)]
pairs
    let pname :: Data_Name
pname = FilePath -> Data_Name
toScalaName forall a b. (a -> b) -> a -> b
$ Namespace -> FilePath
h forall a b. (a -> b) -> a -> b
$ forall m. Module m -> Namespace
moduleNamespace Module m
mod
    let pref :: Data_Ref
pref = Data_Name -> Data_Ref
Scala.Data_RefName Data_Name
pname
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Data_Name -> Data_Ref -> [Stat] -> Pkg
Scala.Pkg Data_Name
pname Data_Ref
pref ([Stat]
imports forall a. [a] -> [a] -> [a]
++ [Stat]
defs)
  where
    h :: Namespace -> FilePath
h (Namespace FilePath
n) = FilePath
n
    imports :: [Stat]
imports = (Namespace -> Stat
toElImport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
S.toList (forall m. Bool -> Bool -> Bool -> Module m -> Set Namespace
moduleDependencyNamespaces Bool
True Bool
False Bool
True Module m
mod))
        forall a. [a] -> [a] -> [a]
++ (Namespace -> Stat
toPrimImport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
S.toList (forall m. Bool -> Bool -> Bool -> Module m -> Set Namespace
moduleDependencyNamespaces Bool
False Bool
True Bool
False Module m
mod))
      where
        toElImport :: Namespace -> Stat
toElImport (Namespace FilePath
ns) = ImportExportStat -> Stat
Scala.StatImportExport forall a b. (a -> b) -> a -> b
$ Import -> ImportExportStat
Scala.ImportExportStatImport forall a b. (a -> b) -> a -> b
$ [Importer] -> Import
Scala.Import [
          Data_Ref -> [Importee] -> Importer
Scala.Importer (Data_Name -> Data_Ref
Scala.Data_RefName forall a b. (a -> b) -> a -> b
$ FilePath -> Data_Name
toScalaName FilePath
ns) [Importee
Scala.ImporteeWildcard]]
        toPrimImport :: Namespace -> Stat
toPrimImport (Namespace FilePath
ns) = ImportExportStat -> Stat
Scala.StatImportExport forall a b. (a -> b) -> a -> b
$ Import -> ImportExportStat
Scala.ImportExportStatImport forall a b. (a -> b) -> a -> b
$ [Importer] -> Import
Scala.Import [
          Data_Ref -> [Importee] -> Importer
Scala.Importer (Data_Name -> Data_Ref
Scala.Data_RefName forall a b. (a -> b) -> a -> b
$ FilePath -> Data_Name
toScalaName FilePath
ns) []]
    toScalaName :: FilePath -> Data_Name
toScalaName FilePath
name = PredefString -> Data_Name
Scala.Data_Name forall a b. (a -> b) -> a -> b
$ FilePath -> PredefString
Scala.PredefString forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
L.intercalate FilePath
"." forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
Strings.splitOn FilePath
"/" FilePath
name
    toDef :: (Element m, TypedTerm m) -> Flow (Context m) Stat
toDef (Element m
el, TypedTerm Type m
typ Term m
term) = do
        let coder :: Coder (Context m) (Context m) (Term m) Data
coder = forall a. HasCallStack => Maybe a -> a
Y.fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Type m
typ Map (Type m) (Coder (Context m) (Context m) (Term m) Data)
coders
        Data
rhs <- forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder (Context m) (Context m) (Term m) Data
coder Term m
term
        Defn -> Stat
Scala.StatDefn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Data
rhs of
          Scala.DataApply Data_Apply
_ -> forall {f :: * -> *}. Applicative f => Data -> f Defn
toVal Data
rhs
          Scala.DataFunctionData Data_FunctionData
fun -> case forall m. Type m -> Type m
stripType Type m
typ of
            TypeFunction (FunctionType Type m
_ Type m
cod) -> forall {m}.
Show m =>
Data_FunctionData -> Type m -> Flow (Context m) Defn
toDefn Data_FunctionData
fun Type m
cod
            Type m
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"expected function type, but found " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Type m
typ
          Scala.DataLit Lit
_ -> forall {f :: * -> *}. Applicative f => Data -> f Defn
toVal Data
rhs
          Scala.DataRef Data_Ref
_ -> forall {f :: * -> *}. Applicative f => Data -> f Defn
toVal Data
rhs -- TODO
          Data
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"unexpected RHS: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Data
rhs
      where
        lname :: FilePath
lname = Name -> FilePath
localNameOfEager forall a b. (a -> b) -> a -> b
$ forall m. Element m -> Name
elementName Element m
el

        freeTypeVars :: [VariableType]
freeTypeVars = forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Set VariableType
freeVariablesInType Type m
typ

        toDefn :: Data_FunctionData -> Type m -> Flow (Context m) Defn
toDefn (Scala.Data_FunctionDataFunction (Scala.Data_Function [Data_Param]
params Data
body)) Type m
cod = do
          let tparams :: [Type_Param]
tparams = VariableType -> Type_Param
stparam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VariableType]
freeTypeVars
          Type
scod <- forall m. Show m => Type m -> GraphFlow m Type
encodeType Type m
cod
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Defn_Def -> Defn
Scala.DefnDef forall a b. (a -> b) -> a -> b
$ [Mod]
-> Data_Name
-> [Type_Param]
-> [[Data_Param]]
-> Maybe Type
-> Data
-> Defn_Def
Scala.Defn_Def []
            (PredefString -> Data_Name
Scala.Data_Name forall a b. (a -> b) -> a -> b
$ FilePath -> PredefString
Scala.PredefString FilePath
lname) [Type_Param]
tparams [[Data_Param]
params] (forall a. a -> Maybe a
Just Type
scod) Data
body

        toVal :: Data -> f Defn
toVal Data
rhs = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Defn_Val -> Defn
Scala.DefnVal forall a b. (a -> b) -> a -> b
$ [Mod] -> [Pat] -> Maybe Type -> Data -> Defn_Val
Scala.Defn_Val [] [Pat
namePat] forall a. Maybe a
Nothing Data
rhs
          where
            namePat :: Pat
namePat = Pat_Var -> Pat
Scala.PatVar forall a b. (a -> b) -> a -> b
$ Data_Name -> Pat_Var
Scala.Pat_Var forall a b. (a -> b) -> a -> b
$ PredefString -> Data_Name
Scala.Data_Name forall a b. (a -> b) -> a -> b
$ FilePath -> PredefString
Scala.PredefString FilePath
lname

encodeFunction :: (Eq m, Ord m, Read m, Show m) => m -> Function m -> Y.Maybe (Term m) -> GraphFlow m Scala.Data
encodeFunction :: forall m.
(Eq m, Ord m, Read m, Show m) =>
m -> Function m -> Maybe (Term m) -> GraphFlow m Data
encodeFunction m
meta Function m
fun Maybe (Term m)
arg = case Function m
fun of
    FunctionLambda (Lambda (Variable FilePath
v) Term m
body) -> FilePath -> Data -> Maybe Type -> Data
slambda FilePath
v forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
body forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Flow (Context m) (Maybe Type)
findSdom
    FunctionPrimitive Name
name -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> Data
sprim Name
name
    FunctionElimination Elimination m
e -> case Elimination m
e of
      Elimination m
EliminationElement -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Data
sname FilePath
"DATA" -- TODO
      EliminationNominal Name
name -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Data
sname forall a b. (a -> b) -> a -> b
$ FilePath
"ELIM-NOMINAL(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Name
name forall a. [a] -> [a] -> [a]
++ FilePath
")" -- TODO
      EliminationOptional OptionalCases m
c -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Data
sname FilePath
"ELIM-OPTIONAL" -- TODO
      EliminationRecord Projection
p -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"unapplied projection not yet supported"
      EliminationUnion (CaseStatement Name
_ [Field m]
cases) -> do
          let v :: FilePath
v = FilePath
"v"
          Type m
dom <- Flow (Context m) (Type m)
findDomain
          Map FieldName (Type m)
ftypes <- forall m a. GraphFlow m a -> GraphFlow m a
withSchemaContext forall a b. (a -> b) -> a -> b
$ forall m. Show m => Type m -> GraphFlow m (Map FieldName (Type m))
fieldTypes Type m
dom
          Context m
cx <- forall s. Flow s s
getState
          let sn :: Maybe Name
sn = forall m. Context m -> Type m -> Maybe Name
nameOfType Context m
cx Type m
dom
          [Case]
scases <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (forall {m} {m}.
(Ord m, Read m, Show m, Eq m) =>
Map FieldName (Type m)
-> Maybe Name -> Field m -> Flow (Context m) Case
encodeCase Map FieldName (Type m)
ftypes Maybe Name
sn) [Field m]
cases
          case Maybe (Term m)
arg of
            Maybe (Term m)
Nothing -> FilePath -> Data -> Maybe Type -> Data
slambda FilePath
v forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Data_Match -> Data
Scala.DataMatch forall a b. (a -> b) -> a -> b
$ Data -> [Case] -> Data_Match
Scala.Data_Match (FilePath -> Data
sname FilePath
v) [Case]
scases) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Flow (Context m) (Maybe Type)
findSdom
            Just Term m
a -> do
              Data
sa <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
a
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Data_Match -> Data
Scala.DataMatch forall a b. (a -> b) -> a -> b
$ Data -> [Case] -> Data_Match
Scala.Data_Match Data
sa [Case]
scases
        where
          encodeCase :: Map FieldName (Type m)
-> Maybe Name -> Field m -> Flow (Context m) Case
encodeCase Map FieldName (Type m)
ftypes Maybe Name
sn f :: Field m
f@(Field FieldName
fname Term m
fterm) = do
  --            dom <- findDomain (termMeta fterm)           -- Option #1: use type inference
              let dom :: Type m
dom = forall a. HasCallStack => Maybe a -> a
Y.fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldName
fname Map FieldName (Type m)
ftypes -- Option #2: look up the union type
              let patArgs :: [Pat]
patArgs = if Type m
dom forall a. Eq a => a -> a -> Bool
== forall m. Type m
Types.unit then [] else [Variable -> Pat
svar Variable
v]
              -- Note: PatExtract has the right syntax, though this may or may not be the Scalameta-intended way to use it
              let pat :: Pat
pat = Pat_Extract -> Pat
Scala.PatExtract forall a b. (a -> b) -> a -> b
$ Data -> [Pat] -> Pat_Extract
Scala.Pat_Extract (FilePath -> Data
sname forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Name -> FieldName -> FilePath
qualifyUnionFieldName FilePath
"MATCHED." Maybe Name
sn FieldName
fname) [Pat]
patArgs
              Data
body <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm forall a b. (a -> b) -> a -> b
$ forall {m}. Ord m => Term m -> Variable -> Term m
applyVar Term m
fterm Variable
v
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Pat -> Maybe Data -> Data -> Case
Scala.Case Pat
pat forall a. Maybe a
Nothing Data
body
            where
              v :: Variable
v = FilePath -> Variable
Variable FilePath
"y"
          applyVar :: Term m -> Variable -> Term m
applyVar Term m
fterm var :: Variable
var@(Variable FilePath
v) = case forall m. Term m -> Term m
stripTerm Term m
fterm of
            TermFunction (FunctionLambda (Lambda Variable
v1 Term m
body)) -> if forall m. Variable -> Term m -> Bool
isFreeIn Variable
v1 Term m
body
              then Term m
body
              else forall m. Ord m => Variable -> Variable -> Term m -> Term m
substituteVariable Variable
v1 Variable
var Term m
body
            Term m
_ -> forall m. Term m -> Term m -> Term m
apply Term m
fterm (forall m. FilePath -> Term m
variable FilePath
v)
    Function m
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"unexpected function: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Function m
fun
  where
    findSdom :: Flow (Context m) (Maybe Type)
findSdom = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Flow (Context m) (Type m)
findDomain forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. Show m => Type m -> GraphFlow m Type
encodeType)
    findDomain :: Flow (Context m) (Type m)
findDomain = do
        Context m
cx <- forall s. Flow s s
getState
        Maybe (Type m)
r <- forall m.
AnnotationClass m -> m -> Flow (Context m) (Maybe (Type m))
annotationClassTypeOf (forall m. Context m -> AnnotationClass m
contextAnnotations Context m
cx) m
meta
        case Maybe (Type m)
r of
          Maybe (Type m)
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"expected a typed term"
          Just Type m
t -> forall {f :: * -> *} {m}.
(MonadFail f, Show m) =>
Type m -> f (Type m)
domainOf Type m
t
      where
        domainOf :: Type m -> f (Type m)
domainOf Type m
t = case forall m. Type m -> Type m
stripType Type m
t of
          TypeFunction (FunctionType Type m
dom Type m
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Type m
dom
          TypeElement Type m
et -> Type m -> f (Type m)
domainOf Type m
et
          Type m
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"expected a function type, but found " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Type m
t

encodeLiteral :: Literal -> GraphFlow m Scala.Lit
encodeLiteral :: forall m. Literal -> GraphFlow m Lit
encodeLiteral Literal
av = case Literal
av of
    LiteralBoolean Bool
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Lit
Scala.LitBoolean Bool
b
    LiteralFloat FloatValue
fv -> case FloatValue
fv of
      FloatValueFloat32 Float
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Float -> Lit
Scala.LitFloat Float
f
      FloatValueFloat64 Double
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Lit
Scala.LitDouble Double
f
      FloatValue
_ -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
FilePath -> a1 -> m a2
unexpected FilePath
"floating-point number" FloatValue
fv
    LiteralInteger IntegerValue
iv -> case IntegerValue
iv of
      IntegerValueInt16 Int
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Lit
Scala.LitShort forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
      IntegerValueInt32 Int
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Lit
Scala.LitInt Int
i
      IntegerValueInt64 Integer
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Lit
Scala.LitLong forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
      IntegerValueUint8 Int
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Lit
Scala.LitByte forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
      IntegerValue
_ -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
FilePath -> a1 -> m a2
unexpected FilePath
"integer" IntegerValue
iv
    LiteralString FilePath
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Lit
Scala.LitString FilePath
s
    Literal
_ -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
FilePath -> a1 -> m a2
unexpected FilePath
"literal value" Literal
av

encodeTerm :: (Eq m, Ord m, Read m, Show m) => Term m -> GraphFlow m Scala.Data
encodeTerm :: forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
term = case forall m. Term m -> Term m
stripTerm Term m
term of
    TermApplication (Application Term m
fun Term m
arg) -> case forall m. Term m -> Term m
stripTerm Term m
fun of
        TermFunction Function m
f -> case Function m
f of
          FunctionElimination Elimination m
e -> case Elimination m
e of
            Elimination m
EliminationElement -> forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
arg
            EliminationNominal Name
name -> GraphFlow m Data
fallback
            EliminationOptional OptionalCases m
c -> GraphFlow m Data
fallback
            EliminationRecord (Projection Name
_ (FieldName FilePath
fname)) -> do
              Data
sarg <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
arg
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Data_Ref -> Data
Scala.DataRef forall a b. (a -> b) -> a -> b
$ Data_Select -> Data_Ref
Scala.Data_RefSelect forall a b. (a -> b) -> a -> b
$ Data -> Data_Name -> Data_Select
Scala.Data_Select Data
sarg
                (PredefString -> Data_Name
Scala.Data_Name forall a b. (a -> b) -> a -> b
$ FilePath -> PredefString
Scala.PredefString FilePath
fname)
            EliminationUnion CaseStatement m
_ -> do
              Context m
cx <- forall s. Flow s s
getState
              forall m.
(Eq m, Ord m, Read m, Show m) =>
m -> Function m -> Maybe (Term m) -> GraphFlow m Data
encodeFunction (forall m. Context m -> Term m -> m
termMeta Context m
cx Term m
fun) Function m
f (forall a. a -> Maybe a
Just Term m
arg)
          Function m
_ -> GraphFlow m Data
fallback
        Term m
_ -> GraphFlow m Data
fallback
      where
        fallback :: GraphFlow m Data
fallback = Data -> [Data] -> Data
sapply forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
fun forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
arg)
    TermElement Name
name -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Data
sname forall a b. (a -> b) -> a -> b
$ Name -> FilePath
localNameOfEager Name
name
    TermFunction Function m
f -> do
      Context m
cx <- forall s. Flow s s
getState
      forall m.
(Eq m, Ord m, Read m, Show m) =>
m -> Function m -> Maybe (Term m) -> GraphFlow m Data
encodeFunction (forall m. Context m -> Term m -> m
termMeta Context m
cx Term m
term) Function m
f forall a. Maybe a
Nothing
    TermList [Term m]
els -> Data -> [Data] -> Data
sapply (FilePath -> Data
sname FilePath
"Seq") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm [Term m]
els
    TermLiteral Literal
v -> Lit -> Data
Scala.DataLit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m. Literal -> GraphFlow m Lit
encodeLiteral Literal
v
    TermMap Map (Term m) (Term m)
m -> Data -> [Data] -> Data
sapply (FilePath -> Data
sname FilePath
"Map") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall {m}.
(Ord m, Read m, Show m) =>
(Term m, Term m) -> Flow (Context m) Data
toPair (forall k a. Map k a -> [(k, a)]
M.toList Map (Term m) (Term m)
m)
      where
        toPair :: (Term m, Term m) -> Flow (Context m) Data
toPair (Term m
k, Term m
v) = Data -> Data -> Data
sassign forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
k forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
v
    TermNominal (Named Name
_ Term m
term') -> forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
term'
    TermOptional Maybe (Term m)
m -> case Maybe (Term m)
m of
      Maybe (Term m)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Data
sname FilePath
"None"
      Just Term m
t -> (\Data
s -> Data -> [Data] -> Data
sapply (FilePath -> Data
sname FilePath
"Some") [Data
s]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
t
    TermRecord (Record Name
n [Field m]
fields) -> do
      Maybe Name
sn <- Flow (Context m) (Maybe Name)
schemaName
      case Maybe Name
sn of
        Maybe Name
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"unexpected anonymous record: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Term m
term
        Just Name
name -> do
          let n :: FilePath
n = Bool -> Name -> FilePath
scalaTypeName Bool
False Name
name
          [Data]
args <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm (forall m. Field m -> Term m
fieldTerm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field m]
fields)
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Data -> [Data] -> Data
sapply (FilePath -> Data
sname FilePath
n) [Data]
args
    TermSet Set (Term m)
s -> Data -> [Data] -> Data
sapply (FilePath -> Data
sname FilePath
"Set") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm (forall a. Set a -> [a]
S.toList Set (Term m)
s)
    TermUnion (Union Name
n (Field FieldName
fn Term m
ft)) -> do
      Maybe Name
sn <- Flow (Context m) (Maybe Name)
schemaName
      let lhs :: Data
lhs = FilePath -> Data
sname forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Name -> FieldName -> FilePath
qualifyUnionFieldName FilePath
"UNION." Maybe Name
sn FieldName
fn
      [Data]
args <- case forall m. Term m -> Term m
stripTerm Term m
ft of
        TermRecord (Record Name
_ []) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Term m
_ -> do
          Data
arg <- forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm Term m
ft
          forall (m :: * -> *) a. Monad m => a -> m a
return [Data
arg]
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Data -> [Data] -> Data
sapply Data
lhs [Data]
args
    TermVariable (Variable FilePath
v) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Data
sname FilePath
v
    Term m
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"unexpected term: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Term m
term
  where
    schemaName :: Flow (Context m) (Maybe Name)
schemaName = do
      Context m
cx <- forall s. Flow s s
getState
      Maybe (Type m)
r <- forall m.
AnnotationClass m -> Term m -> Flow (Context m) (Maybe (Type m))
annotationClassTermType (forall m. Context m -> AnnotationClass m
contextAnnotations Context m
cx) Term m
term
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe (Type m)
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m. Context m -> Type m -> Maybe Name
nameOfType Context m
cx

encodeType :: Show m => Type m -> GraphFlow m Scala.Type
encodeType :: forall m. Show m => Type m -> GraphFlow m Type
encodeType Type m
t = case forall m. Type m -> Type m
stripType Type m
t of
--  TypeElement et ->
  TypeFunction (FunctionType Type m
dom Type m
cod) -> do
    Type
sdom <- forall m. Show m => Type m -> GraphFlow m Type
encodeType Type m
dom
    Type
scod <- forall m. Show m => Type m -> GraphFlow m Type
encodeType Type m
cod
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Type_FunctionType -> Type
Scala.TypeFunctionType forall a b. (a -> b) -> a -> b
$ Type_Function -> Type_FunctionType
Scala.Type_FunctionTypeFunction forall a b. (a -> b) -> a -> b
$ [Type] -> Type -> Type_Function
Scala.Type_Function [Type
sdom] Type
scod
  TypeList Type m
lt -> Type -> Type -> Type
stapply1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Type
stref FilePath
"Seq") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall m. Show m => Type m -> GraphFlow m Type
encodeType Type m
lt
  TypeLiteral LiteralType
lt -> case LiteralType
lt of
--    TypeBinary ->
    LiteralType
LiteralTypeBoolean -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Type
stref FilePath
"Boolean"
    LiteralTypeFloat FloatType
ft -> case FloatType
ft of
--      FloatTypeBigfloat ->
      FloatType
FloatTypeFloat32 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Type
stref FilePath
"Float"
      FloatType
FloatTypeFloat64 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Type
stref FilePath
"Double"
    LiteralTypeInteger IntegerType
it -> case IntegerType
it of
--      IntegerTypeBigint ->
--      IntegerTypeInt8 ->
      IntegerType
IntegerTypeInt16 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Type
stref FilePath
"Short"
      IntegerType
IntegerTypeInt32 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Type
stref FilePath
"Int"
      IntegerType
IntegerTypeInt64 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Type
stref FilePath
"Long"
      IntegerType
IntegerTypeUint8 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Type
stref FilePath
"Byte"
--      IntegerTypeUint16 ->
--      IntegerTypeUint32 ->
--      IntegerTypeUint64 ->
    LiteralType
LiteralTypeString -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Type
stref FilePath
"String"
  TypeMap (MapType Type m
kt Type m
vt) -> Type -> Type -> Type -> Type
stapply2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Type
stref FilePath
"Map") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall m. Show m => Type m -> GraphFlow m Type
encodeType Type m
kt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall m. Show m => Type m -> GraphFlow m Type
encodeType Type m
vt
  TypeNominal Name
name -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Type
stref forall a b. (a -> b) -> a -> b
$ Bool -> Name -> FilePath
scalaTypeName Bool
True Name
name
  TypeOptional Type m
ot -> Type -> Type -> Type
stapply1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Type
stref FilePath
"Option") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall m. Show m => Type m -> GraphFlow m Type
encodeType Type m
ot
--  TypeRecord sfields ->
  TypeSet Type m
st -> Type -> Type -> Type
stapply1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Type
stref FilePath
"Set") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall m. Show m => Type m -> GraphFlow m Type
encodeType Type m
st
--  TypeUnion sfields ->
  TypeLambda (LambdaType VariableType
v Type m
body) -> do
    Type
sbody <- forall m. Show m => Type m -> GraphFlow m Type
encodeType Type m
body
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Type_Lambda -> Type
Scala.TypeLambda forall a b. (a -> b) -> a -> b
$ [Type_Param] -> Type -> Type_Lambda
Scala.Type_Lambda [VariableType -> Type_Param
stparam VariableType
v] Type
sbody
  TypeVariable (VariableType FilePath
v) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Type_Var -> Type
Scala.TypeVar forall a b. (a -> b) -> a -> b
$ Type_Name -> Type_Var
Scala.Type_Var forall a b. (a -> b) -> a -> b
$ FilePath -> Type_Name
Scala.Type_Name FilePath
v
  Type m
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"can't encode unsupported type in Scala: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Type m
t

encodeUntypedTerm :: (Eq m, Ord m, Read m, Show m) => Term m -> GraphFlow m Scala.Data
encodeUntypedTerm :: forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeUntypedTerm Term m
term = forall m. (Ord m, Show m) => Term m -> GraphFlow m (Term m)
annotateTermWithTypes Term m
term forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m.
(Eq m, Ord m, Read m, Show m) =>
Term m -> GraphFlow m Data
encodeTerm