content: 
  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 System.Directory
  import Control.Monad
  import Data.List
  import qualified System.FilePath.Posix as P
  
  
  -- | 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.dcs
          | FragmentTetra         -- File.dct
          deriving Show
  
  
  -- | Result of a compilation test.
  data Result
          = ResultSuccess Seconds
          | ResultUnexpectedFailure
          | ResultUnexpectedSuccess
  
  
  resultSuccess :: Result -> Bool
  resultSuccess result
   = case result of
          ResultSuccess{} -> True
          _               -> False
  
  
  instance Pretty Result where
   ppr result
    = case result of
          ResultSuccess seconds
           -> string "success" %% parens (ppr seconds)
  
          ResultUnexpectedFailure
           -> string "failed"
  
          ResultUnexpectedSuccess
           -> string "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 everything that looks like a source file to ensure
          -- it gets rebuilt.
          sources <- io
                  $  liftM (filter (\f -> isSuffixOf ".dcs" f
                                       || isSuffixOf ".dct" f
                                       || isSuffixOf ".dcl" f
                                       || isSuffixOf ".ds"  f))
                  $  lsFilesIn srcDir
  
          when (not $ null sources)
           $ do   ssystemq $ "touch " ++ (intercalate " " sources)
                  return ()
  
  
          -- 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
  
  