-- |
-- Module      :  Mcmc.Environment
-- Description :  Runtime environment
-- Copyright   :  2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Tue Nov 17 11:00:09 2020.
module Mcmc.Environment
  ( Environment (..),
    initializeEnvironment,
    closeEnvironment,
  )
where

import Control.Concurrent.MVar
import Control.Monad
import Data.Time
import Mcmc.Logger
import Mcmc.Settings
import System.IO

-- | The environment of an MCMC run.
data Environment s = Environment
  { -- | Use a polymorphic settings variable, because we have 'Settings', but
    -- also 'Mcmc.MarginalLikelihood.MLSettings'.
    forall s. Environment s -> s
settings :: s,
    -- | List will be empty if using 'Quiet'. If 'LogStdOutAndFile' is used
    -- 'logHandles' contains two handles to the standard output and the log
    -- file.
    forall s. Environment s -> [Handle]
logHandles :: [Handle],
    -- | MVar blocking output.
    forall s. Environment s -> MVar ()
outLock :: MVar (),
    -- | Used to calculate the ETA.
    forall s. Environment s -> UTCTime
startingTime :: UTCTime
  }
  deriving (Environment s -> Environment s -> Bool
forall s. Eq s => Environment s -> Environment s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment s -> Environment s -> Bool
$c/= :: forall s. Eq s => Environment s -> Environment s -> Bool
== :: Environment s -> Environment s -> Bool
$c== :: forall s. Eq s => Environment s -> Environment s -> Bool
Eq)

instance HasExecutionMode s => HasExecutionMode (Environment s) where
  getExecutionMode :: Environment s -> ExecutionMode
getExecutionMode = forall s. HasExecutionMode s => s -> ExecutionMode
getExecutionMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Environment s -> s
settings

instance HasLock (Environment s) where
  getLock :: Environment s -> MVar ()
getLock = forall s. Environment s -> MVar ()
outLock

instance HasLogHandles (Environment s) where
  getLogHandles :: Environment s -> [Handle]
getLogHandles = forall s. Environment s -> [Handle]
logHandles

instance HasStartingTime (Environment s) where
  getStartingTime :: Environment s -> UTCTime
getStartingTime = forall s. Environment s -> UTCTime
startingTime

instance HasLogMode s => HasLogMode (Environment s) where
  getLogMode :: Environment s -> LogMode
getLogMode = forall s. HasLogMode s => s -> LogMode
getLogMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Environment s -> s
settings

instance HasVerbosity s => HasVerbosity (Environment s) where
  getVerbosity :: Environment s -> Verbosity
getVerbosity = forall s. HasVerbosity s => s -> Verbosity
getVerbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Environment s -> s
settings

-- | Initialize the environment.
--
-- Open log file, get current time.
initializeEnvironment ::
  (HasAnalysisName s, HasExecutionMode s, HasLogMode s, HasVerbosity s) =>
  s ->
  IO (Environment s)
initializeEnvironment :: forall s.
(HasAnalysisName s, HasExecutionMode s, HasLogMode s,
 HasVerbosity s) =>
s -> IO (Environment s)
initializeEnvironment s
s = do
  UTCTime
t <- IO UTCTime
getCurrentTime
  [Handle]
mh <- case (forall s. HasLogMode s => s -> LogMode
getLogMode s
s, forall s. HasVerbosity s => s -> Verbosity
getVerbosity s
s) of
    (LogMode
_, Verbosity
Quiet) -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    (LogMode
LogStdOutAndFile, Verbosity
_) -> do
      Handle
h <- ExecutionMode -> FilePath -> IO Handle
openWithExecutionMode ExecutionMode
em FilePath
fn
      forall (m :: * -> *) a. Monad m => a -> m a
return [Handle
stdout, Handle
h]
    (LogMode
LogFileOnly, Verbosity
_) -> do
      Handle
h <- ExecutionMode -> FilePath -> IO Handle
openWithExecutionMode ExecutionMode
em FilePath
fn
      forall (m :: * -> *) a. Monad m => a -> m a
return [Handle
h]
    (LogMode
LogStdOutOnly, Verbosity
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return [Handle
stdout]
  MVar ()
lock <- forall a. a -> IO (MVar a)
newMVar ()
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. s -> [Handle] -> MVar () -> UTCTime -> Environment s
Environment s
s [Handle]
mh MVar ()
lock UTCTime
t
  where
    fn :: FilePath
fn = AnalysisName -> FilePath
fromAnalysisName (forall s. HasAnalysisName s => s -> AnalysisName
getAnalysisName s
s) forall a. [a] -> [a] -> [a]
++ FilePath
".mcmc.log"
    em :: ExecutionMode
em = forall s. HasExecutionMode s => s -> ExecutionMode
getExecutionMode s
s

-- | Close file handles.
closeEnvironment :: Environment s -> IO ()
closeEnvironment :: forall s. Environment s -> IO ()
closeEnvironment Environment s
e = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Handle]
hs Handle -> IO ()
hClose
  where
    hs :: [Handle]
hs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Handle
stdout) forall a b. (a -> b) -> a -> b
$ forall s. Environment s -> [Handle]
logHandles Environment s
e