CompileDC.hs

module DDC.War.Job.CompileDC
        ( Spec     (..)
        , Fragment (..)
        , Result   (..)
        , resultSuccess
        , build)
where
import BuildBox.Command.File
import BuildBox.Command.System
import BuildBox.Build.Benchmark
import BuildBox.Data.Physical
import BuildBox.IO.Directory
import BuildBox.Pretty
import BuildBox
import System.FilePath
import qualified System.FilePath.Posix as P
import System.Directory
import Control.Monad
import Data.List


-- | Use ddci-core to compile/make file a DCE file
data Spec
        = Spec
        { -- | Root source file of the program (the 'Main.ds')
          specFile               :: FilePath 
                       
          -- | Extra DDC options for building in this way.
        , specOptionsDDC         :: [String]

          -- | Language fragment.
        , specFragment           :: Fragment

          -- | Scratch dir to do the build in.
        , specScratchDir         :: String

           -- | Put what DDC says to stdout here.
        , specCompileStdout      :: FilePath
                
           -- | Put what DDC says to stderr here.
        , specCompileStderr      :: FilePath 

          -- | If Just, then we're making an executable, and put the binary here.
          --   Otherwise simply compile it
        , specMaybeMainBin       :: Maybe FilePath 
                
          -- | True if the compile is expected to succeed, else not.
        , specShouldSucceed      :: Bool }
        deriving Show


-- | Language fragments that we can compile.
data Fragment
        = FragmentSalt          -- File.dce
        | FragmentLite          -- File.dcl
        deriving Show


-- | Result of a compilation test.
data Result
        = ResultSuccess Seconds
        | ResultUnexpectedFailure
        | ResultUnexpectedSuccess
        deriving Show


resultSuccess :: Result -> Bool
resultSuccess result
 = case result of
        ResultSuccess{} -> True
        _               -> False


instance Pretty Result where
 ppr result
  = case result of 
        ResultSuccess seconds   -> text "success" <+> parens (ppr seconds)
        ResultUnexpectedFailure -> text "failed"
        ResultUnexpectedSuccess -> text "unexpected"


-- Build ----------------------------------------------------------------------
-- | Compile a Disciple Core Sea source file.
build :: Spec -> Build Result
build   (Spec   srcDC_ optionsDDC _fragment 
                buildDir mainCompOut mainCompErr
                mMainBin shouldSucceed)

 = do   let ddcExe = "bin/ddc" <.> exe

        needs srcDC_
        needs ddcExe

        ddcBin  <- io $ canonicalizePath ddcExe

        -- Normalise the file name relative to the current directory
        -- so that error messages don't change between hosts.
        srcDC'  <- io $ makeRelativeToCurrentDirectory srcDC_

        -- Make the file path use consistent path separators across all hosts.
        let srcDC = flip map srcDC' $
                \c -> if isPathSeparator c
                        then P.pathSeparator
                        else c

        -- The directory holding the Main.dce file.
        let (srcDir, _srcFile)  = splitFileName srcDC
                
        -- Touch the .dce and .dcl files to the build directory to ensure they're built.
        sources <- io
                $  liftM (filter (\f -> isSuffixOf ".dcs" f || isSuffixOf ".dcl" f))
                $  lsFilesIn srcDir

        ssystemq $ "touch " ++ (intercalate " " sources)

        -- ensure the output directory exists
        ensureDir buildDir

        -- Do the compile.
        let compile
                | Just mainBin  <- mMainBin
                = do    -- If there is an existing binary then remove it.
                        ssystemq $ "rm -f " ++ mainBin

                        -- Build the program.
                        timeBuild
                         $ systemTee False 
                                (ddcBin
                                ++ " "               ++ intercalate " " optionsDDC
                                ++ " -output "       ++ mainBin
                                ++ " -output-dir "   ++ buildDir
                                ++ " -make "         ++ srcDC)
                                ""

                -- Compile the program.
                | otherwise
                = do    timeBuild
                         $ systemTee False
                                (ddcBin
                                ++ " "               ++ intercalate " " optionsDDC
                                ++ " -output-dir "   ++ buildDir
                                ++ " -compile "      ++ srcDC)
                                ""
        (time, (code, strOut, strErr))
                <- compile

        atomicWriteFile mainCompOut strOut
        atomicWriteFile mainCompErr strErr

        case code of
         ExitFailure _
          | shouldSucceed       -> return ResultUnexpectedFailure
        
         ExitSuccess
          | not shouldSucceed   -> return ResultUnexpectedSuccess

         _                      -> return $ ResultSuccess time