-- | Entry point for Hydra code generation utilities module Hydra.Impl.Haskell.Codegen where import Hydra.Kernel 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 mod = do els <- CM.mapM annotateElementWithTypes $ moduleElements mod return $ mod {moduleElements = els} allModules :: [Module Meta] allModules = coreModules ++ utilModules ++ extModules assignSchemas :: (Ord m, Show m) => Bool -> Module m -> GraphFlow m (Module m) assignSchemas doInfer mod = do cx <- getState els <- CM.mapM (annotate cx) $ moduleElements mod return $ mod {moduleElements = els} where annotate cx el = do typ <- findType cx (elementData el) case typ of Nothing -> if doInfer then do t <- typeSchemeType . snd <$> inferType (elementData el) return el {elementSchema = encodeType t} else return el Just typ -> return el {elementSchema = encodeType typ} coreModules :: [Module Meta] coreModules = [ codetreeAstModule, haskellAstModule, hydraCoreModule, hydraComputeModule, hydraMantleModule, hydraModuleModule, hydraGrammarModule, -- hydraMonadsModule, hydraPhantomsModule, jsonModelModule] utilModules = [ adapterUtilsModule, hydraBasicsModule] extModules :: [Module Meta] extModules = [ avroSchemaModule, graphqlSyntaxModule, javaSyntaxModule, pegasusPdlModule, owlSyntaxModule, rdfSyntaxModule, scalaMetaModule, shaclModelModule, shexSyntaxModule, tinkerpopFeaturesModule, tinkerpopTypedModule, tinkerpopV3Module, xmlSchemaModule, yamlModelModule] findType :: Context m -> Term m -> GraphFlow m (Maybe (Type m)) findType cx term = annotationClassTermType (contextAnnotations cx) term generateSources :: (Module Meta -> GraphFlow Meta (M.Map FilePath String)) -> [Module Meta] -> FilePath -> IO () generateSources printModule mods0 basePath = do mfiles <- runFlow kernelContext generateFiles case mfiles of Nothing -> fail "Transformation failed" Just files -> mapM_ writePair files where generateFiles = do withTrace "generate files" $ do mods1 <- CM.mapM (assignSchemas False) mods0 withState (modulesToContext mods1) $ do mods2 <- CM.mapM addDeepTypeAnnotations mods1 maps <- CM.mapM printModule mods2 return $ L.concat (M.toList <$> maps) writePair (path, s) = do let fullPath = FP.combine basePath path SD.createDirectoryIfMissing True $ FP.takeDirectory fullPath writeFile fullPath s hydraKernel :: Graph Meta hydraKernel = elementsToGraph Nothing $ L.concat (moduleElements <$> [hydraCoreModule, hydraMantleModule, hydraModuleModule]) kernelContext = graphContext hydraKernel modulesToContext :: [Module Meta] -> Context Meta modulesToContext mods = kernelContext {contextGraph = elementsToGraph (Just hydraKernel) elements} where elements = L.concat (moduleElements <$> allModules) allModules = L.concat (close <$> mods) where close mod = mod:(L.concat (close <$> moduleDependencies mod)) printTrace :: Bool -> Trace -> IO () printTrace isError t = do if not (L.null $ traceMessages t) then do putStrLn $ if isError then "Flow failed. Messages:" else "Messages:" putStrLn $ indentLines $ traceSummary t else pure () runFlow :: s -> Flow s a -> IO (Maybe a) runFlow cx f = do let FlowState v _ t = unFlow f cx emptyTrace printTrace (Y.isNothing v) t return v writeHaskell :: [Module Meta] -> FilePath -> IO () writeHaskell = generateSources Haskell.printModule writeJava :: [Module Meta] -> FP.FilePath -> IO () writeJava = generateSources Java.printModule writePdl :: [Module Meta] -> FP.FilePath -> IO () writePdl = generateSources PDL.printModule writeScala :: [Module Meta] -> FP.FilePath -> IO () writeScala = generateSources Scala.printModule writeYaml :: [Module Meta] -> FP.FilePath -> IO () writeYaml = generateSources Yaml.printModule