module DDC.Driver.Command.ToC
( cmdToSeaFromFile
, cmdToSeaSourceTetraFromFile
, cmdToSeaSourceTetraFromString
, cmdToSeaCoreFromFile
, cmdToSeaCoreFromString)
where
import DDC.Driver.Stage
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
cmdToSeaFromFile
:: Config
-> FilePath
-> ErrorT String IO ()
cmdToSeaFromFile config filePath
| ".dst" <- takeExtension filePath
= cmdToSeaSourceTetraFromFile config filePath
| Just language <- languageOfExtension (takeExtension filePath)
= cmdToSeaCoreFromFile config language filePath
| otherwise
= let ext = takeExtension filePath
in throwError $ "Cannot convert '" ++ ext ++ "' files to C."
cmdToSeaSourceTetraFromFile
:: Config
-> FilePath
-> ErrorT String IO ()
cmdToSeaSourceTetraFromFile config filePath
= do
exists <- liftIO $ doesFileExist filePath
when (not exists)
$ throwError $ "No such file " ++ show filePath
src <- liftIO $ readFile filePath
cmdToSeaSourceTetraFromString config (SourceFile filePath) src
cmdToSeaSourceTetraFromString
:: Config
-> Source
-> String
-> ErrorT String IO ()
cmdToSeaSourceTetraFromString config source str
= let
pipeLoad
= pipeText (nameOfSource source) (lineStartOfSource source) str
$ stageSourceTetraLoad config source
[ PipeCoreReannotate (const ())
[ stageTetraToSalt config source
[ stageSaltOpt config source
[ stageSaltToC config source SinkStdout]]]]
in do
errs <- liftIO pipeLoad
case errs of
[] -> return ()
es -> throwError $ renderIndent $ vcat $ map ppr es
cmdToSeaCoreFromFile
:: Config
-> Language
-> FilePath
-> ErrorT String IO ()
cmdToSeaCoreFromFile config language filePath
= do
exists <- liftIO $ doesFileExist filePath
when (not exists)
$ throwError $ "No such file " ++ show filePath
src <- liftIO $ readFile filePath
cmdToSeaCoreFromString config language (SourceFile filePath) src
cmdToSeaCoreFromString
:: Config
-> Language
-> Source
-> String
-> ErrorT String IO ()
cmdToSeaCoreFromString config language source str
| Language bundle <- language
, fragment <- bundleFragment bundle
, profile <- fragmentProfile fragment
= do
let fragName = profileName profile
let compile
| fragName == "Tetra"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) str
$ stageTetraLoad config source
[ stageTetraToSalt config source
[ stageSaltOpt config source
[ stageSaltToC config source SinkStdout]]]
| fragName == "Lite"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) str
$ stageLiteLoad config source
[ stageLiteOpt config source
[ stageLiteToSalt config source
[ stageSaltOpt config source
[ stageSaltToC config source SinkStdout]]]]
| fragName == "Salt"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) str
$ stageSaltLoad config source
[ stageSaltOpt config source
[ stageSaltToC config source SinkStdout]]
| otherwise
= throwError $ "Cannot convert '" ++ fragName ++ "'modules to C."
errs <- compile
case errs of
[] -> return ()
es -> throwError $ renderIndent $ vcat $ map ppr es