module B9.BuildInfo
( getBuildId
, getBuildDate
, getBuildDir
, getExecEnvType
, withBuildInfo
, BuildInfoReader
)
where
import B9.B9Config
import B9.B9Error
import B9.B9Logging
import B9.Environment
import Control.Eff
import Control.Eff.Reader.Lazy
import Control.Exception ( bracket )
import Control.Lens ( (?~) )
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Control ( MonadBaseControl
, control
)
import Data.Functor ( )
import Data.Hashable
import Data.Time.Clock
import Data.Time.Format
import System.Directory
import System.FilePath
import Text.Printf
data BuildInfo = BuildInfo
{ bsBuildId :: String
, bsBuildDate :: String
, bsBuildDir :: FilePath
, bsStartTime :: UTCTime
} deriving (Eq, Show)
type BuildInfoReader = Reader BuildInfo
withBuildInfo
:: ( Lifted IO e
, MonadBaseControl IO (Eff e)
, Member B9ConfigReader e
, Member ExcB9 e
, Member EnvironmentReader e
, Member LoggerReader e
)
=> Eff (BuildInfoReader ': e) a
-> Eff e a
withBuildInfo action = withRootDir $ do
now <- lift getCurrentTime
let buildDate = formatTime undefined "%F-%T" now
buildId <- generateBuildId buildDate
withBuildDir buildId (runImpl buildId buildDate now)
where
withRootDir f = do
mRoot <- _projectRoot <$> getB9Config
root <- lift $ case mRoot of
Nothing -> getCurrentDirectory >>= canonicalizePath
Just rootIn -> do
createDirectoryIfMissing True rootIn
canonicalizePath rootIn
localB9Config (projectRoot ?~ root)
(addLocalStringBinding ("projectRoot", root) f)
generateBuildId buildDate = do
unqiueBuildDir <- _uniqueBuildDirs <$> getB9Config
cfgHash <- hash . show <$> getB9Config
if unqiueBuildDir
then return (printf "%08X-%08X" cfgHash (hash buildDate))
else return (printf "%08X" cfgHash)
withBuildDir buildId f = do
root <- _projectRoot <$> getB9Config
cfg <- getB9Config
control $ \runInIO ->
bracket (createBuildDir root) (removeBuildDir cfg) (runInIO . f)
where
createBuildDir root = do
let buildDir = case root of
Just r -> r </> "BUILD-" ++ buildId
Nothing -> "BUILD-" ++ buildId
createDirectoryIfMissing True buildDir
canonicalizePath buildDir
removeBuildDir cfg buildDir =
when (_uniqueBuildDirs cfg && not (_keepTempDirs cfg))
$ removeDirectoryRecursive buildDir
runImpl buildId buildDate startTime buildDir =
let ctx = BuildInfo buildId buildDate buildDir startTime
in runReader ctx wrappedAction
where
wrappedAction = do
rootD <- getProjectRoot
traceL (printf "Project Root Directory: %s" rootD)
buildD <- getBuildDir
traceL (printf "Build Directory: %s" buildD)
r <- action
tsAfter <- liftIO getCurrentTime
let duration = show (tsAfter `diffUTCTime` startTime)
infoL (printf "DURATION: %s" duration)
return r
getBuildId :: Member BuildInfoReader e => Eff e String
getBuildId = bsBuildId <$> ask
getBuildDate :: Member BuildInfoReader e => Eff e String
getBuildDate = bsBuildDate <$> ask
getBuildDir :: Member BuildInfoReader e => Eff e FilePath
getBuildDir = bsBuildDir <$> ask