-- | Entry point for Hydra code generation utilities

module Hydra.Codegen (
  modulesToGraph,
  writeGraphql,
  writeHaskell,
  writeJava,
  writePdl,
  writeProtobuf,
  writeScala,
  writeYaml,
  module Hydra.Sources.Tier4.All
) where

import Hydra.Kernel
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap
import Hydra.Langs.Graphql.Coder
import Hydra.Langs.Haskell.Coder
import Hydra.Langs.Java.Coder
import Hydra.Langs.Json.Coder
import Hydra.Langs.Pegasus.Coder
import Hydra.Langs.Protobuf.Coder
import Hydra.Langs.Scala.Coder
import Hydra.Langs.Yaml.Modules

import Hydra.Sources.Libraries
import Hydra.Sources.Tier4.All

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


generateSources :: (Module -> Flow (Graph) (M.Map FilePath String)) -> FilePath -> [Module] -> IO ()
generateSources :: (Module -> Flow Graph (Map FilePath FilePath))
-> FilePath -> [Module] -> IO ()
generateSources Module -> Flow Graph (Map FilePath FilePath)
printModule FilePath
basePath [Module]
mods = do
    Maybe [(FilePath, FilePath)]
mfiles <- Graph
-> Flow Graph [(FilePath, FilePath)]
-> IO (Maybe [(FilePath, FilePath)])
forall s a. s -> Flow s a -> IO (Maybe a)
runFlow Graph
bootstrapGraph Flow Graph [(FilePath, FilePath)]
forall {s}. Flow s [(FilePath, FilePath)]
generateFiles
    case Maybe [(FilePath, FilePath)]
mfiles of
      Maybe [(FilePath, FilePath)]
Nothing -> FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Transformation failed"
      Just [(FilePath, FilePath)]
files -> ((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
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 s [(FilePath, FilePath)]
generateFiles = do
      FilePath
-> Flow s [(FilePath, FilePath)] -> Flow s [(FilePath, FilePath)]
forall s a. FilePath -> Flow s a -> Flow s a
withTrace FilePath
"generate files" (Flow s [(FilePath, FilePath)] -> Flow s [(FilePath, FilePath)])
-> Flow s [(FilePath, FilePath)] -> Flow s [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ do
        Graph
-> Flow Graph [(FilePath, FilePath)]
-> Flow s [(FilePath, FilePath)]
forall s1 a s2. s1 -> Flow s1 a -> Flow s2 a
withState ([Module] -> Graph
modulesToGraph [Module]
mods) (Flow Graph [(FilePath, FilePath)]
 -> Flow s [(FilePath, FilePath)])
-> Flow Graph [(FilePath, FilePath)]
-> Flow s [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ do
          Graph
g' <- Flow Graph Graph
inferGraphTypes
          Graph
-> Flow Graph [(FilePath, FilePath)]
-> Flow Graph [(FilePath, FilePath)]
forall s1 a s2. s1 -> Flow s1 a -> Flow s2 a
withState Graph
g' (Flow Graph [(FilePath, FilePath)]
 -> Flow Graph [(FilePath, FilePath)])
-> Flow Graph [(FilePath, FilePath)]
-> Flow Graph [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ do
              [Map FilePath FilePath]
maps <- (Module -> Flow Graph (Map FilePath FilePath))
-> [Module] -> Flow Graph [Map FilePath FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Module -> Flow Graph (Map FilePath FilePath)
forModule ([Module] -> Flow Graph [Map FilePath FilePath])
-> [Module] -> Flow Graph [Map FilePath FilePath]
forall a b. (a -> b) -> a -> b
$ Map Name Element -> Module -> Module
refreshModule (Graph -> Map Name Element
graphElements Graph
g') (Module -> Module) -> [Module] -> [Module]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Module]
mods
              [(FilePath, FilePath)] -> Flow Graph [(FilePath, FilePath)]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, FilePath)] -> Flow Graph [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> Flow Graph [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ [[(FilePath, FilePath)]] -> [(FilePath, FilePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
M.toList (Map FilePath FilePath -> [(FilePath, FilePath)])
-> [Map FilePath FilePath] -> [[(FilePath, FilePath)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Map FilePath FilePath]
maps)
            where
              refreshModule :: Map Name Element -> Module -> Module
refreshModule Map Name Element
els Module
mod = Module
mod {
                moduleElements = Y.catMaybes ((\Element
e -> Name -> Map Name Element -> Maybe Element
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Element -> Name
elementName Element
e) Map Name Element
els) <$> moduleElements mod)}

    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 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
FP.takeDirectory FilePath
fullPath
      FilePath -> FilePath -> IO ()
writeFile FilePath
fullPath FilePath
s

    forModule :: Module -> Flow Graph (Map FilePath FilePath)
forModule Module
mod = FilePath
-> Flow Graph (Map FilePath FilePath)
-> Flow Graph (Map FilePath FilePath)
forall s a. FilePath -> Flow s a -> Flow s a
withTrace (FilePath
"module " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Namespace -> FilePath
unNamespace (Module -> Namespace
moduleNamespace Module
mod)) (Flow Graph (Map FilePath FilePath)
 -> Flow Graph (Map FilePath FilePath))
-> Flow Graph (Map FilePath FilePath)
-> Flow Graph (Map FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ Module -> Flow Graph (Map FilePath FilePath)
printModule Module
mod

modulesToGraph :: [Module] -> Graph
modulesToGraph :: [Module] -> Graph
modulesToGraph [Module]
mods = Graph -> Maybe Graph -> [Element] -> Graph
elementsToGraph Graph
parent (Graph -> Maybe Graph
forall a. a -> Maybe a
Just Graph
schemaGraph) [Element]
dataElements
  where
    parent :: Graph
parent = Graph
bootstrapGraph
    dataElements :: [Element]
dataElements = [[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Module -> [Element]
moduleElements (Module -> [Element]) -> [Module] -> [[Element]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Module]] -> [Module]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Module -> [Module]
close (Module -> [Module]) -> [Module] -> [[Module]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Module]
mods)))
    schemaElements :: [Element]
schemaElements = [[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Module -> [Element]
moduleElements (Module -> [Element]) -> [Module] -> [[Element]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Module]] -> [Module]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Module -> [Module]
close (Module -> [Module]) -> [Module] -> [[Module]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Module] -> [Module]
forall a. Eq a => [a] -> [a]
L.nub ([Module] -> [Module]) -> [Module] -> [Module]
forall a b. (a -> b) -> a -> b
$ [[Module]] -> [Module]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Module -> [Module]
moduleTypeDependencies (Module -> [Module]) -> [Module] -> [[Module]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Module]
mods)))))
    schemaGraph :: Graph
schemaGraph = Graph -> Maybe Graph -> [Element] -> Graph
elementsToGraph Graph
bootstrapGraph Maybe Graph
forall a. Maybe a
Nothing [Element]
schemaElements
    close :: Module -> [Module]
close Module
mod = Module
modModule -> [Module] -> [Module]
forall a. a -> [a] -> [a]
:([[Module]] -> [Module]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat (Module -> [Module]
close (Module -> [Module]) -> [Module] -> [[Module]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module -> [Module]
moduleTermDependencies Module
mod))

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

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
    Bool -> Trace -> IO ()
printTrace (Maybe a -> Bool
forall a. Maybe a -> Bool
Y.isNothing Maybe a
v) Trace
t
    Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
v
  where
    FlowState Maybe a
v s
_ Trace
t = Flow s a -> s -> Trace -> FlowState s a
forall s x. Flow s x -> s -> Trace -> FlowState s x
unFlow Flow s a
f s
cx Trace
emptyTrace

writeGraphql :: FP.FilePath -> [Module] -> IO ()
writeGraphql :: FilePath -> [Module] -> IO ()
writeGraphql = (Module -> Flow Graph (Map FilePath FilePath))
-> FilePath -> [Module] -> IO ()
generateSources Module -> Flow Graph (Map FilePath FilePath)
moduleToGraphql

writeHaskell :: FilePath -> [Module] -> IO ()
writeHaskell :: FilePath -> [Module] -> IO ()
writeHaskell = (Module -> Flow Graph (Map FilePath FilePath))
-> FilePath -> [Module] -> IO ()
generateSources Module -> Flow Graph (Map FilePath FilePath)
moduleToHaskell

writeJava :: FP.FilePath -> [Module] -> IO ()
writeJava :: FilePath -> [Module] -> IO ()
writeJava = (Module -> Flow Graph (Map FilePath FilePath))
-> FilePath -> [Module] -> IO ()
generateSources Module -> Flow Graph (Map FilePath FilePath)
moduleToJava

-- writeJson :: FP.FilePath -> [Module] -> IO ()
-- writeJson = generateSources Json.printModule

writePdl :: FP.FilePath -> [Module] -> IO ()
writePdl :: FilePath -> [Module] -> IO ()
writePdl = (Module -> Flow Graph (Map FilePath FilePath))
-> FilePath -> [Module] -> IO ()
generateSources Module -> Flow Graph (Map FilePath FilePath)
moduleToPdl

writeProtobuf :: FP.FilePath -> [Module] -> IO ()
writeProtobuf :: FilePath -> [Module] -> IO ()
writeProtobuf = (Module -> Flow Graph (Map FilePath FilePath))
-> FilePath -> [Module] -> IO ()
generateSources Module -> Flow Graph (Map FilePath FilePath)
moduleToProtobuf

writeScala :: FP.FilePath -> [Module] -> IO ()
writeScala :: FilePath -> [Module] -> IO ()
writeScala = (Module -> Flow Graph (Map FilePath FilePath))
-> FilePath -> [Module] -> IO ()
generateSources Module -> Flow Graph (Map FilePath FilePath)
moduleToScala

writeYaml :: FP.FilePath -> [Module] -> IO ()
writeYaml :: FilePath -> [Module] -> IO ()
writeYaml = (Module -> Flow Graph (Map FilePath FilePath))
-> FilePath -> [Module] -> IO ()
generateSources Module -> Flow Graph (Map FilePath FilePath)
moduleToYaml