module DDC.Driver.Command.Flow.ToTetra
( cmdFlowToTetraFromFile
, cmdFlowToTetraCoreFromFile
, cmdFlowToTetraCoreFromString
, pipelineFlowToTetra)
where
import DDC.Driver.Stage
import DDC.Driver.Config
import DDC.Driver.Interface.Source
import DDC.Build.Pipeline
import DDC.Build.Language
import DDC.Core.Fragment
import DDC.Base.Pretty
import System.FilePath
import System.Directory
import Control.Monad.Trans.Except
import Control.Monad.IO.Class
import Control.Monad
import qualified DDC.Build.Language.Salt as Salt
import qualified DDC.Core.Salt as Salt
import qualified DDC.Build.Language.Flow as Flow
import qualified DDC.Core.Flow as Flow
import qualified DDC.Core.Check as C
import DDC.Data.Canned
import qualified DDC.Core.Flow.Transform.Concretize as Concretize
cmdFlowToTetraFromFile
:: Config
-> Flow.Config
-> FilePath
-> ExceptT String IO ()
cmdFlowToTetraFromFile config configLower filePath
| Just language <- languageOfExtension (takeExtension filePath)
= cmdFlowToTetraCoreFromFile config configLower language filePath
| otherwise
= let ext = takeExtension filePath
in throwE $ "Cannot convert '" ++ ext ++ "' files to Tetra."
cmdFlowToTetraCoreFromFile
:: Config
-> Flow.Config
-> Language
-> FilePath
-> ExceptT String IO ()
cmdFlowToTetraCoreFromFile config configLower language filePath
= do
exists <- liftIO $ doesFileExist filePath
when (not exists)
$ throwE $ "No such file " ++ show filePath
src <- liftIO $ readFile filePath
cmdFlowToTetraCoreFromString config configLower language (SourceFile filePath) src
cmdFlowToTetraCoreFromString
:: Config
-> Flow.Config
-> Language
-> Source
-> String
-> ExceptT String IO ()
cmdFlowToTetraCoreFromString config configLower language source str
| Language bundle <- language
, fragment <- bundleFragment bundle
, profile <- fragmentProfile fragment
= do
let fragName = profileName profile
let pmode = prettyModeOfConfig $ configPretty config
let compile
| fragName == "Flow"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) str
$ pipelineFlowToTetra config configLower source
[ PipeCoreCheck Salt.fragment C.Recon SinkDiscard
[]
, PipeCoreOutput pmode SinkStdout]
| otherwise
= throwE $ "Cannot convert '" ++ fragName ++ "' modules to Salt."
errs <- compile
case errs of
[] -> return ()
es -> throwE $ renderIndent $ vcat $ map ppr es
pipelineFlowToTetra
:: Config
-> Flow.Config
-> Source
-> [PipeCore () Salt.Name]
-> PipeText Flow.Name Flow.Error
pipelineFlowToTetra config configLower source pipesSalt
= stageFlowLoad config source
[ stageFlowRate config source
[ stageFlowPrep config source
[ PipeCoreCheck Flow.fragment C.Recon SinkDiscard
[ stageFlowLower config configLower source
[ PipeCoreHacks (Canned $ \m -> return $ Concretize.concretizeModule m)
[ PipeCoreCheck Flow.fragment C.Recon SinkDiscard
[ stageFlowWind config source
[ PipeCoreCheck Flow.fragment C.Recon SinkDiscard
[ stageFlowToTetra config source
pipesSalt]]]]]]]]]