-- |
-- Module      :  ELynx.Tools.Environment
-- Description :  Runtime environment
-- Copyright   :  2021 Dominik Schrempf
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Creation date: Thu Sep  2 22:46:02 2021.
module ELynx.Tools.Environment
  ( Environment (..),
    initializeEnvironment,
    closeEnvironment,
  )
where

import Control.Concurrent.MVar
import Control.Monad
import Data.Time
import ELynx.Tools.InputOutput
import ELynx.Tools.Logger
import ELynx.Tools.Options
import System.IO

-- | The environment of an ELynx run.
data Environment a = Environment
  { -- | Global arguments.
    forall a. Environment a -> GlobalArguments
globalArguments :: GlobalArguments,
    -- | Local arguments of command.
    forall a. Environment a -> a
localArguments :: a,
    -- | List will be empty if using 'Quiet'. If an output base name is
    -- available, 'logHandles' will contain two handles: (1) the standard output
    -- and (2) the log file.
    forall a. Environment a -> [Handle]
logHandles :: [Handle],
    -- | MVar blocking output.
    forall a. Environment a -> MVar ()
outLock :: MVar (),
    -- | Used to calculate the ETA.
    forall a. Environment a -> UTCTime
startingTime :: UTCTime
  }
  deriving (Environment a -> Environment a -> Bool
forall a. Eq a => Environment a -> Environment a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment a -> Environment a -> Bool
$c/= :: forall a. Eq a => Environment a -> Environment a -> Bool
== :: Environment a -> Environment a -> Bool
$c== :: forall a. Eq a => Environment a -> Environment a -> Bool
Eq)

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

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

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

instance HasVerbosity (Environment a) where
  getVerbosity :: Environment a -> Verbosity
getVerbosity = GlobalArguments -> Verbosity
verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Environment a -> GlobalArguments
globalArguments

-- | Initialize the environment.
--
-- Open log file, get current time.
initializeEnvironment :: GlobalArguments -> a -> IO (Environment a)
initializeEnvironment :: forall a. GlobalArguments -> a -> IO (Environment a)
initializeEnvironment GlobalArguments
g a
l = do
  UTCTime
t <- IO UTCTime
getCurrentTime
  [Handle]
mh <- case (GlobalArguments -> Maybe FilePath
outFileBaseName GlobalArguments
g, GlobalArguments -> Verbosity
verbosity GlobalArguments
g) of
    (Maybe FilePath
_, Verbosity
Quiet) -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    (Just FilePath
bn, Verbosity
_) -> do
      let fn :: FilePath
fn = FilePath
bn forall a. [a] -> [a] -> [a]
++ FilePath
".log"
      Handle
h <- ExecutionMode -> FilePath -> IO Handle
openFileWithExecutionMode ExecutionMode
em FilePath
fn
      forall (m :: * -> *) a. Monad m => a -> m a
return [Handle
stdout, Handle
h]
    (Maybe FilePath
Nothing, 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 a.
GlobalArguments
-> a -> [Handle] -> MVar () -> UTCTime -> Environment a
Environment GlobalArguments
g a
l [Handle]
mh MVar ()
lock UTCTime
t
  where
    em :: ExecutionMode
em = GlobalArguments -> ExecutionMode
executionMode GlobalArguments
g

-- | 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 a. Environment a -> [Handle]
logHandles Environment s
e