module Compiler where
import Compiler.Internal
import Compiler.Types
import Control.Monad (when)
import Data.Aeson (eitherDecode)
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.List (find, stripPrefix)
import Language.Types
import Parser
import PreCompiler
import System.FilePath (takeDirectory, (</>))
import Types
compileJob :: CardFileReference -> Sparker [Deployment]
compileJob cr@(CardFileReference root _) = go "" cr
where
go :: FilePath -> CardFileReference -> Sparker [Deployment]
go base (CardFileReference fp mcn) = do
sf <- parseFile fp
let scope = sparkFileCards sf
unit <- case mcn of
Nothing -> case scope of
[] -> throwError $ CompileError $ "No cards found for compilation in file:" ++ fp
(first:_) -> return first
Just (CardNameReference name) -> do
case find (\c -> cardName c == name) scope of
Nothing -> throwError $ CompileError $ unwords ["Card", name, "not found for compilation."]
Just cu -> return cu
let injected = injectBase unit
let pces = preCompileChecks injected
when (not . null $ pces) $ throwError $ PreCompileError pces
(deps, crfs) <- embedPureCompiler $ compileUnit injected
restDeps <- fmap concat
$ mapM compileCardReference
$ map (resolveCardReferenceRelativeTo fp) crfs
return $ deps ++ restDeps
where
injectBase :: Card -> Card
injectBase c@(Card name s) | null base = c
| otherwise = Card name $ Block [OutofDir base, s]
stripRoot :: FilePath -> FilePath
stripRoot orig = case stripPrefix (takeDirectory root) orig of
Nothing -> orig
Just ('/':new) -> new
Just new -> new
composeBases :: FilePath -> FilePath -> FilePath
composeBases base [] = base
composeBases _ base2 = takeDirectory (stripRoot base2)
compileCardReference :: CardReference -> Sparker [Deployment]
compileCardReference (CardFile cfr@(CardFileReference base2 _)) = go (composeBases base base2) cfr
compileCardReference (CardName cnr) = go base (CardFileReference fp $ Just cnr)
resolveCardReferenceRelativeTo :: FilePath -> CardReference -> CardReference
resolveCardReferenceRelativeTo fp (CardFile (CardFileReference cfp mcn)) = CardFile $ CardFileReference (takeDirectory fp </> cfp) mcn
resolveCardReferenceRelativeTo _ cn = cn
embedPureCompiler :: PureCompiler a -> Sparker a
embedPureCompiler func = withExceptT CompileError $ mapExceptT (mapReaderT idToIO) func
where
idToIO :: Identity a -> IO a
idToIO = return . runIdentity
outputCompiled :: [Deployment] -> Sparker ()
outputCompiled deps = do
form <- asks conf_compile_format
out <- asks conf_compile_output
liftIO $ case form of
FormatJson -> do
let bs = encodePretty deps
case out of
Nothing -> BS.putStrLn bs
Just fp -> BS.writeFile fp bs
_ -> error $ "unrecognized format"
inputCompiled :: FilePath -> Sparker [Deployment]
inputCompiled fp = do
form <- asks conf_compile_format
case form of
FormatJson -> do
bs <- liftIO $ BS.readFile fp
case eitherDecode bs of
Left err -> throwError $ CompileError $ "Something went wrong while deserialising json data: " ++ err
Right ds -> return ds
_ -> error $ "unrecognized format"