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

        -- Inject base outofDir
        let injected = injectBase unit

        -- Precompile checks
        let pces = preCompileChecks injected
        when (not . null $ pces) $ throwError $ PreCompileError pces

        -- Compile this unit
        (deps, crfs) <- embedPureCompiler $ compileUnit injected

        -- Compile the rest of the units
        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"