module DDC.Driver.Command.ToC
(cmdToC)
where
import DDC.Driver.Stage
import DDC.Driver.Source
import DDC.Build.Pipeline
import DDC.Build.Language
import DDC.Core.Fragment
import System.FilePath
import Control.Monad.Trans.Error
import Control.Monad.IO.Class
import qualified DDC.Build.Language.Salt as Salt
import qualified DDC.Build.Language.Lite as Lite
import qualified DDC.Base.Pretty as P
cmdToC :: Config
-> Language
-> Source
-> String
-> ErrorT String IO ()
cmdToC config language source sourceText
| Language bundle <- language
, fragment <- bundleFragment bundle
, profile <- fragmentProfile fragment
= do
let fragName = profileName profile
let mSuffix = case source of
SourceFile filePath -> Just $ takeExtension filePath
_ -> Nothing
let compile
| fragName == "Lite" || mSuffix == Just ".dcl"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) sourceText
$ PipeTextLoadCore Lite.fragment
[ PipeCoreStrip
[ stageLiteOpt config source
[ stageLiteToSalt config source
[ stageSaltOpt config source
[ stageSaltToC config source SinkStdout]]]]]
| fragName == "Salt" || mSuffix == Just ".dcs"
= liftIO
$ pipeText (nameOfSource source) (lineStartOfSource source) sourceText
$ PipeTextLoadCore Salt.fragment
[ PipeCoreStrip
[ stageSaltOpt config source
[ stageSaltToC config source SinkStdout]]]
| otherwise
= throwError "Don't know how to convert this to C"
errs <- compile
case errs of
[] -> return ()
es -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es