module DDC.Driver.Command.ToSalt
( cmdToSaltFromFile
, cmdToSaltSourceTetraFromFile
, cmdToSaltSourceTetraFromString
, cmdToSaltCoreFromFile
, cmdToSaltCoreFromString)
where
import DDC.Driver.Stage
import DDC.Driver.Config
import DDC.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.Error
import Control.Monad.IO.Class
import Control.Monad
import qualified DDC.Build.Language.Salt as Salt
import qualified DDC.Core.Check as C
cmdToSaltFromFile
:: Config
-> FilePath
-> ErrorT String IO ()
cmdToSaltFromFile config filePath
| ".dst" <- takeExtension filePath
= cmdToSaltSourceTetraFromFile config filePath
| Just language <- languageOfExtension (takeExtension filePath)
= cmdToSaltCoreFromFile config language filePath
| otherwise
= let ext = takeExtension filePath
in throwError $ "Cannot convert '" ++ ext ++ "' files to Salt."
cmdToSaltSourceTetraFromFile
:: Config
-> FilePath
-> ErrorT String IO ()
cmdToSaltSourceTetraFromFile config filePath
= do
exists <- liftIO $ doesFileExist filePath
when (not exists)
$ throwError $ "No such file " ++ show filePath
src <- liftIO $ readFile filePath
cmdToSaltSourceTetraFromString config (SourceFile filePath) src
cmdToSaltSourceTetraFromString
:: Config
-> Source
-> String
-> ErrorT String IO ()
cmdToSaltSourceTetraFromString config source str
= let
pmode = prettyModeOfConfig $ configPretty config
pipeLoad
= pipeText (nameOfSource source)
(lineStartOfSource source) str
$ stageSourceTetraLoad config source
[ PipeCoreReannotate (const ())
[ stageTetraToSalt config source
[ stageSaltOpt config source
[ PipeCoreCheck Salt.fragment C.Recon SinkDiscard
[ PipeCoreOutput pmode SinkStdout ]]]]]
in do
errs <- liftIO pipeLoad
case errs of
[] -> return ()
es -> throwError $ renderIndent $ vcat $ map ppr es
cmdToSaltCoreFromFile
:: Config
-> Language
-> FilePath
-> ErrorT String IO ()
cmdToSaltCoreFromFile config language filePath
= do
exists <- liftIO $ doesFileExist filePath
when (not exists)
$ throwError $ "No such file " ++ show filePath
src <- liftIO $ readFile filePath
cmdToSaltCoreFromString config language (SourceFile filePath) src
cmdToSaltCoreFromString
:: Config
-> Language
-> Source
-> String
-> ErrorT String IO ()
cmdToSaltCoreFromString config 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 == "Tetra"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) str
$ stageTetraLoad config source
[ stageTetraToSalt config source
[ stageSaltOpt config source
[ PipeCoreCheck Salt.fragment C.Recon SinkDiscard
[ PipeCoreOutput pmode SinkStdout]]]]
| fragName == "Lite"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) str
$ stageLiteLoad config source
[ stageLiteOpt config source
[ stageLiteToSalt config source
[ stageSaltOpt config source
[ PipeCoreCheck Salt.fragment C.Recon SinkDiscard
[ PipeCoreOutput pmode SinkStdout]]]]]
| otherwise
= throwError
$ "Cannot convert '" ++ fragName ++ "' modules to Salt."
errs <- compile
case errs of
[] -> return ()
es -> throwError $ renderIndent $ vcat $ map ppr es