-- |
-- 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
  { 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.
    Environment s -> [Handle]
logHandles :: [Handle],
    -- | MVar blocking output.
    Environment s -> MVar ()
outLock :: MVar (),
    -- | Used to calculate the ETA.
    Environment s -> UTCTime
startingTime :: UTCTime
  }
  deriving (Environment s -> Environment s -> Bool
(Environment s -> Environment s -> Bool)
-> (Environment s -> Environment s -> Bool) -> Eq (Environment s)
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 = s -> ExecutionMode
forall s. HasExecutionMode s => s -> ExecutionMode
getExecutionMode (s -> ExecutionMode)
-> (Environment s -> s) -> Environment s -> ExecutionMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment s -> s
forall s. Environment s -> s
settings

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

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

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

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

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

-- | Close file handles.
closeEnvironment :: Environment s -> IO ()
closeEnvironment :: Environment s -> IO ()
closeEnvironment Environment s
e = [Handle] -> (Handle -> IO ()) -> IO ()
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 = (Handle -> Bool) -> [Handle] -> [Handle]
forall a. (a -> Bool) -> [a] -> [a]
filter (Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
/= Handle
stdout) ([Handle] -> [Handle]) -> [Handle] -> [Handle]
forall a b. (a -> b) -> a -> b
$ Environment s -> [Handle]
forall s. Environment s -> [Handle]
logHandles Environment s
e