module Hydra.Impl.Haskell.GraphIO where

import Hydra.All
import Hydra.Impl.Haskell.Dsl.Standard
import Hydra.CoreEncoding
import Hydra.Types.Inference

import qualified Hydra.Ext.Haskell.Coder as Haskell
import qualified Hydra.Ext.Java.Coder as Java
import qualified Hydra.Ext.Pegasus.Coder as PDL
import qualified Hydra.Ext.Scala.Coder as Scala
import qualified Hydra.Ext.Yaml.Modules as Yaml

import Hydra.Impl.Haskell.Sources.Adapters.Utils
import Hydra.Impl.Haskell.Sources.Basics
import Hydra.Impl.Haskell.Sources.Core
import Hydra.Impl.Haskell.Sources.Compute
import Hydra.Impl.Haskell.Sources.Grammar
import Hydra.Impl.Haskell.Sources.Libraries
import Hydra.Impl.Haskell.Sources.Mantle
import Hydra.Impl.Haskell.Sources.Module
import Hydra.Impl.Haskell.Sources.Phantoms

import Hydra.Impl.Haskell.Sources.Util.Codetree.Ast
import Hydra.Impl.Haskell.Sources.Ext.Avro.Schema
import Hydra.Impl.Haskell.Sources.Ext.Graphql.Syntax
import Hydra.Impl.Haskell.Sources.Ext.Haskell.Ast
import Hydra.Impl.Haskell.Sources.Ext.Java.Syntax
import Hydra.Impl.Haskell.Sources.Ext.Json.Model
import Hydra.Impl.Haskell.Sources.Ext.Pegasus.Pdl
import Hydra.Impl.Haskell.Sources.Ext.Owl.Syntax
import Hydra.Impl.Haskell.Sources.Ext.Scala.Meta
import Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Features
import Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.Typed
import Hydra.Impl.Haskell.Sources.Ext.Tinkerpop.V3
import Hydra.Impl.Haskell.Sources.Ext.Xml.Schema
import Hydra.Impl.Haskell.Sources.Ext.Yaml.Model
import Hydra.Impl.Haskell.Sources.Ext.Rdf.Syntax
import Hydra.Impl.Haskell.Sources.Ext.Shacl.Model
import Hydra.Impl.Haskell.Sources.Ext.Shex.Syntax

import qualified Control.Monad as CM
import qualified System.FilePath as FP
import qualified Data.List as L
import qualified Data.Map as M
import qualified System.Directory as SD
import qualified Data.Maybe as Y


addDeepTypeAnnotations :: (Ord m, Show m) => Module m -> GraphFlow m (Module m)
addDeepTypeAnnotations :: forall m. (Ord m, Show m) => Module m -> GraphFlow m (Module m)
addDeepTypeAnnotations Module m
mod = do
    [Element m]
els <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall m. (Ord m, Show m) => Element m -> GraphFlow m (Element m)
annotateElementWithTypes forall a b. (a -> b) -> a -> b
$ forall m. Module m -> [Element m]
moduleElements Module m
mod
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Module m
mod {moduleElements :: [Element m]
moduleElements = [Element m]
els}

allModules :: [Module Meta]
allModules :: [Module Meta]
allModules = [Module Meta]
coreModules forall a. [a] -> [a] -> [a]
++ [Module Meta]
extModules

assignSchemas :: (Ord m, Show m) => Bool -> Module m -> GraphFlow m (Module m)
assignSchemas :: forall m.
(Ord m, Show m) =>
Bool -> Module m -> GraphFlow m (Module m)
assignSchemas Bool
doInfer Module m
mod = do
    Context m
cx <- forall s. Flow s s
getState
    [Element m]
els <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (forall {m}.
(Ord m, Show m) =>
Context m -> Element m -> Flow (Context m) (Element m)
annotate Context m
cx) forall a b. (a -> b) -> a -> b
$ forall m. Module m -> [Element m]
moduleElements Module m
mod
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Module m
mod {moduleElements :: [Element m]
moduleElements = [Element m]
els}
  where
    annotate :: Context m -> Element m -> Flow (Context m) (Element m)
annotate Context m
cx Element m
el = do
      Maybe (Type m)
typ <- forall m. Context m -> Term m -> GraphFlow m (Maybe (Type m))
findType Context m
cx (forall m. Element m -> Term m
elementData Element m
el)
      case Maybe (Type m)
typ of
        Maybe (Type m)
Nothing -> if Bool
doInfer
          then do
            Type m
t <- forall m. TypeScheme m -> Type m
typeSchemeType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m.
(Ord m, Show m) =>
Term m
-> GraphFlow m (Term (m, Type m, [Constraint m]), TypeScheme m)
inferType (forall m. Element m -> Term m
elementData Element m
el)
            forall (m :: * -> *) a. Monad m => a -> m a
return Element m
el {elementSchema :: Term m
elementSchema = forall m. Type m -> Term m
encodeType Type m
t}
          else forall (m :: * -> *) a. Monad m => a -> m a
return Element m
el
        Just Type m
typ -> forall (m :: * -> *) a. Monad m => a -> m a
return Element m
el {elementSchema :: Term m
elementSchema = forall m. Type m -> Term m
encodeType Type m
typ}

coreModules :: [Module Meta]
coreModules :: [Module Meta]
coreModules = [
  Module Meta
adapterUtilsModule,
  Module Meta
codetreeAstModule,
  Module Meta
haskellAstModule,
  Module Meta
hydraBasicsModule,
  Module Meta
hydraCoreModule,
  Module Meta
hydraComputeModule,
  Module Meta
hydraMantleModule,
  Module Meta
hydraModuleModule,
  Module Meta
hydraGrammarModule,
--  hydraMonadsModule,
  Module Meta
hydraPhantomsModule,
  Module Meta
jsonModelModule]

extModules :: [Module Meta]
extModules :: [Module Meta]
extModules = [
  Module Meta
avroSchemaModule,
  Module Meta
graphqlSyntaxModule,
  Module Meta
javaSyntaxModule,
  Module Meta
pegasusPdlModule,
  Module Meta
owlSyntaxModule,
  Module Meta
rdfSyntaxModule,
  Module Meta
scalaMetaModule,
  Module Meta
shaclModelModule,
  Module Meta
shexSyntaxModule,
  Module Meta
tinkerpopFeaturesModule,
  Module Meta
tinkerpopTypedModule,
  Module Meta
tinkerpopV3Module,
  Module Meta
xmlSchemaModule,
  Module Meta
yamlModelModule]

findType :: Context m -> Term m -> GraphFlow m (Maybe (Type m))
findType :: forall m. Context m -> Term m -> GraphFlow m (Maybe (Type m))
findType Context m
cx Term m
term = 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

generateSources :: (Module Meta -> GraphFlow Meta (M.Map FilePath String)) -> [Module Meta] -> FilePath -> IO ()
generateSources :: (Module Meta -> GraphFlow Meta (Map FilePath FilePath))
-> [Module Meta] -> FilePath -> IO ()
generateSources Module Meta -> GraphFlow Meta (Map FilePath FilePath)
printModule [Module Meta]
mods0 FilePath
basePath = do
    Maybe [(FilePath, FilePath)]
mfiles <- forall s a. s -> Flow s a -> IO (Maybe a)
runFlow Context Meta
kernelContext Flow (Context Meta) [(FilePath, FilePath)]
generateFiles
    case Maybe [(FilePath, FilePath)]
mfiles of
      Maybe [(FilePath, FilePath)]
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Transformation failed"
      Just [(FilePath, FilePath)]
files -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath, FilePath) -> IO ()
writePair [(FilePath, FilePath)]
files
  where
    generateFiles :: Flow (Context Meta) [(FilePath, FilePath)]
generateFiles = do
      forall s a. FilePath -> Flow s a -> Flow s a
withTrace FilePath
"generate files" forall a b. (a -> b) -> a -> b
$ do
        [Module Meta]
mods1 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (forall m.
(Ord m, Show m) =>
Bool -> Module m -> GraphFlow m (Module m)
assignSchemas Bool
False) [Module Meta]
mods0
        forall s1 a s2. s1 -> Flow s1 a -> Flow s2 a
withState ([Module Meta] -> Context Meta
modulesToContext [Module Meta]
mods1) forall a b. (a -> b) -> a -> b
$ do
          [Module Meta]
mods2 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall m. (Ord m, Show m) => Module m -> GraphFlow m (Module m)
addDeepTypeAnnotations [Module Meta]
mods1
          [Map FilePath FilePath]
maps <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM Module Meta -> GraphFlow Meta (Map FilePath FilePath)
printModule [Module Meta]
mods2
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (forall k a. Map k a -> [(k, a)]
M.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Map FilePath FilePath]
maps)

    writePair :: (FilePath, FilePath) -> IO ()
writePair (FilePath
path, FilePath
s) = do
      let fullPath :: FilePath
fullPath = FilePath -> FilePath -> FilePath
FP.combine FilePath
basePath FilePath
path
      Bool -> FilePath -> IO ()
SD.createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
FP.takeDirectory FilePath
fullPath
      FilePath -> FilePath -> IO ()
writeFile FilePath
fullPath FilePath
s

hydraKernel :: Graph Meta
hydraKernel :: Graph Meta
hydraKernel = forall m. Maybe (Graph m) -> [Element m] -> Graph m
elementsToGraph forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (forall m. Module m -> [Element m]
moduleElements forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Module Meta
hydraCoreModule, Module Meta
hydraMantleModule, Module Meta
hydraModuleModule])

kernelContext :: Context Meta
kernelContext = Graph Meta -> Context Meta
graphContext Graph Meta
hydraKernel

modulesToContext :: [Module Meta] -> Context Meta
modulesToContext :: [Module Meta] -> Context Meta
modulesToContext [Module Meta]
mods = Context Meta
kernelContext {contextGraph :: Graph Meta
contextGraph = forall m. Maybe (Graph m) -> [Element m] -> Graph m
elementsToGraph (forall a. a -> Maybe a
Just Graph Meta
hydraKernel) [Element Meta]
elements}
  where
    elements :: [Element Meta]
elements = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (forall m. Module m -> [Element m]
moduleElements forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Module Meta]
allModules)
    allModules :: [Module Meta]
allModules = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (forall {m}. Module m -> [Module m]
close forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Module Meta]
mods)
      where
        close :: Module m -> [Module m]
close Module m
mod = Module m
modforall a. a -> [a] -> [a]
:(forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Module m -> [Module m]
close forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m}. Module m -> [Module m]
moduleDependencies Module m
mod))

printTrace :: Bool -> Trace -> IO ()
printTrace :: Bool -> Trace -> IO ()
printTrace Bool
isError Trace
t = do
  if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null forall a b. (a -> b) -> a -> b
$ Trace -> [FilePath]
traceMessages Trace
t)
    then do
      FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ if Bool
isError then FilePath
"Flow failed. Messages:" else FilePath
"Messages:"
      FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
indentLines forall a b. (a -> b) -> a -> b
$ Trace -> FilePath
traceSummary Trace
t
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

runFlow :: s -> Flow s a -> IO (Maybe a)
runFlow :: forall s a. s -> Flow s a -> IO (Maybe a)
runFlow s
cx Flow s a
f = do
  let FlowState Maybe a
v s
_ Trace
t = forall s a. Flow s a -> s -> Trace -> FlowState s a
unFlow Flow s a
f s
cx Trace
emptyTrace
  Bool -> Trace -> IO ()
printTrace (forall a. Maybe a -> Bool
Y.isNothing Maybe a
v) Trace
t
  forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
v

writeHaskell :: [Module Meta] -> FilePath -> IO ()
writeHaskell :: [Module Meta] -> FilePath -> IO ()
writeHaskell = (Module Meta -> GraphFlow Meta (Map FilePath FilePath))
-> [Module Meta] -> FilePath -> IO ()
generateSources forall m.
(Ord m, Read m, Show m) =>
Module m -> GraphFlow m (Map FilePath FilePath)
Haskell.printModule

writeJava :: [Module Meta] -> FP.FilePath -> IO ()
writeJava :: [Module Meta] -> FilePath -> IO ()
writeJava = (Module Meta -> GraphFlow Meta (Map FilePath FilePath))
-> [Module Meta] -> FilePath -> IO ()
generateSources forall m.
(Ord m, Read m, Show m) =>
Module m -> GraphFlow m (Map FilePath FilePath)
Java.printModule

writePdl :: [Module Meta] -> FP.FilePath -> IO ()
writePdl :: [Module Meta] -> FilePath -> IO ()
writePdl = (Module Meta -> GraphFlow Meta (Map FilePath FilePath))
-> [Module Meta] -> FilePath -> IO ()
generateSources forall m.
(Ord m, Read m, Show m) =>
Module m -> GraphFlow m (Map FilePath FilePath)
PDL.printModule

writeScala :: [Module Meta] -> FP.FilePath -> IO ()
writeScala :: [Module Meta] -> FilePath -> IO ()
writeScala = (Module Meta -> GraphFlow Meta (Map FilePath FilePath))
-> [Module Meta] -> FilePath -> IO ()
generateSources forall m.
(Ord m, Read m, Show m) =>
Module m -> GraphFlow m (Map FilePath FilePath)
Scala.printModule

writeYaml :: [Module Meta] -> FP.FilePath -> IO ()
writeYaml :: [Module Meta] -> FilePath -> IO ()
writeYaml = (Module Meta -> GraphFlow Meta (Map FilePath FilePath))
-> [Module Meta] -> FilePath -> IO ()
generateSources forall m.
(Ord m, Read m, Show m) =>
Module m -> GraphFlow m (Map FilePath FilePath)
Yaml.printModule