{-# LANGUAGE OverloadedStrings #-}
module Mcmc.Monitor
(
Monitor (..),
Period,
simpleMonitor,
MonitorStdOut,
monitorStdOut,
msHeader,
MonitorFile,
monitorFile,
BatchSize,
MonitorBatch,
monitorBatch,
getMonitorBatchSize,
mOpen,
mExec,
mClose,
)
where
import Control.Monad
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Int
import Data.List hiding (sum)
import Data.Time.Clock
import qualified Data.Vector as VB
import Mcmc.Chain.Link
import Mcmc.Chain.Trace
import Mcmc.Internal.ByteString
import Mcmc.Monitor.Log
import Mcmc.Monitor.Parameter
import Mcmc.Monitor.ParameterBatch
import Mcmc.Monitor.Time
import Mcmc.Settings
import Numeric.Log
import System.IO
import Prelude hiding (sum)
data Monitor a = Monitor
{
forall a. Monitor a -> MonitorStdOut a
mStdOut :: MonitorStdOut a,
forall a. Monitor a -> [MonitorFile a]
mFiles :: [MonitorFile a],
forall a. Monitor a -> [MonitorBatch a]
mBatches :: [MonitorBatch a]
}
type Period = Int
simpleMonitor :: Period -> Monitor a
simpleMonitor :: forall a. Int -> Monitor a
simpleMonitor Int
p
| Int
p forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. HasCallStack => [Char] -> a
error [Char]
"simpleMonitor: Monitor period must be 1 or larger."
| Bool
otherwise =
forall a.
MonitorStdOut a -> [MonitorFile a] -> [MonitorBatch a] -> Monitor a
Monitor (forall a. [MonitorParameter a] -> Int -> MonitorStdOut a
MonitorStdOut [] Int
p) [] []
data MonitorStdOut a = MonitorStdOut
{ forall a. MonitorStdOut a -> [MonitorParameter a]
msParams :: [MonitorParameter a],
forall a. MonitorStdOut a -> Int
msPeriod :: Period
}
monitorStdOut ::
[MonitorParameter a] ->
Period ->
MonitorStdOut a
monitorStdOut :: forall a. [MonitorParameter a] -> Int -> MonitorStdOut a
monitorStdOut [MonitorParameter a]
ps Int
p
| Int
p forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. HasCallStack => [Char] -> a
error [Char]
"monitorStdOut: Monitor period must be 1 or larger."
| Bool
otherwise = forall a. [MonitorParameter a] -> Int -> MonitorStdOut a
MonitorStdOut [MonitorParameter a]
ps Int
p
msIWidth :: Int
msIWidth :: Int
msIWidth = Int
9
msWidth :: Int
msWidth :: Int
msWidth = Int
22
msRenderRow :: [BL.ByteString] -> BL.ByteString
msRenderRow :: [ByteString] -> ByteString
msRenderRow [ByteString]
xs = Int -> ByteString -> ByteString
alignRight Int
msIWidth (forall a. [a] -> a
head [ByteString]
xs) forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteString
BL.concat [ByteString]
vals
where
vals :: [ByteString]
vals = forall a b. (a -> b) -> [a] -> [b]
map (Int -> ByteString -> ByteString
alignRight Int
msWidth) (forall a. [a] -> [a]
tail [ByteString]
xs)
msHeader :: MonitorStdOut a -> BL.ByteString
MonitorStdOut a
m = ByteString
row forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" forall a. Semigroup a => a -> a -> a
<> ByteString
sep
where
row :: ByteString
row =
[ByteString] -> ByteString
msRenderRow forall a b. (a -> b) -> a -> b
$
[ByteString
"Iteration", ByteString
"Log-Prior", ByteString
"Log-Likelihood", ByteString
"Log-Posterior"]
forall a. [a] -> [a] -> [a]
++ [ByteString]
nms
forall a. [a] -> [a] -> [a]
++ [ByteString
"Runtime", ByteString
"ETA"]
sep :: ByteString
sep = Int64 -> Char -> ByteString
BL.replicate (ByteString -> Int64
BL.length ByteString
row) Char
'-'
nms :: [ByteString]
nms = [[Char] -> ByteString
BL.pack forall a b. (a -> b) -> a -> b
$ forall a. MonitorParameter a -> [Char]
mpName MonitorParameter a
p | MonitorParameter a
p <- forall a. MonitorStdOut a -> [MonitorParameter a]
msParams MonitorStdOut a
m]
msDataLine ::
Int ->
Link a ->
Int ->
UTCTime ->
Int ->
MonitorStdOut a ->
IO BL.ByteString
msDataLine :: forall a.
Int
-> Link a
-> Int
-> UTCTime
-> Int
-> MonitorStdOut a
-> IO ByteString
msDataLine Int
i (Link a
x Log Double
p Log Double
l) Int
ss UTCTime
st Int
j MonitorStdOut a
m = do
UTCTime
ct <- IO UTCTime
getCurrentTime
let dt :: NominalDiffTime
dt = UTCTime
ct UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
st
timePerIter :: NominalDiffTime
timePerIter = NominalDiffTime
dt forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i forall a. Num a => a -> a -> a
- Int
ss)
eta :: ByteString
eta =
if (Int
i forall a. Num a => a -> a -> a
- Int
ss) forall a. Ord a => a -> a -> Bool
< Int
10
then ByteString
""
else NominalDiffTime -> ByteString
renderDuration forall a b. (a -> b) -> a -> b
$ NominalDiffTime
timePerIter forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
j forall a. Num a => a -> a -> a
- Int
i)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
[ByteString] -> ByteString
msRenderRow forall a b. (a -> b) -> a -> b
$
[[Char] -> ByteString
BL.pack (forall a. Show a => a -> [Char]
show Int
i), Log Double -> ByteString
renderLog Log Double
p, Log Double -> ByteString
renderLog Log Double
l, Log Double -> ByteString
renderLog (Log Double
p forall a. Num a => a -> a -> a
* Log Double
l)]
forall a. [a] -> [a] -> [a]
++ [Builder -> ByteString
BB.toLazyByteString forall a b. (a -> b) -> a -> b
$ forall a. MonitorParameter a -> a -> Builder
mpFunc MonitorParameter a
mp a
x | MonitorParameter a
mp <- forall a. MonitorStdOut a -> [MonitorParameter a]
msParams MonitorStdOut a
m]
forall a. [a] -> [a] -> [a]
++ [NominalDiffTime -> ByteString
renderDuration NominalDiffTime
dt, ByteString
eta]
msExec ::
Int ->
Link a ->
Int ->
UTCTime ->
Int ->
MonitorStdOut a ->
IO (Maybe BL.ByteString)
msExec :: forall a.
Int
-> Link a
-> Int
-> UTCTime
-> Int
-> MonitorStdOut a
-> IO (Maybe ByteString)
msExec Int
i Link a
it Int
ss UTCTime
st Int
j MonitorStdOut a
m
| Int
i forall a. Integral a => a -> a -> a
`mod` forall a. MonitorStdOut a -> Int
msPeriod MonitorStdOut a
m forall a. Eq a => a -> a -> Bool
/= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Int
-> Link a
-> Int
-> UTCTime
-> Int
-> MonitorStdOut a
-> IO ByteString
msDataLine Int
i Link a
it Int
ss UTCTime
st Int
j MonitorStdOut a
m
data MonitorFile a = MonitorFile
{ forall a. MonitorFile a -> [Char]
mfName :: String,
forall a. MonitorFile a -> Maybe Handle
mfHandle :: Maybe Handle,
forall a. MonitorFile a -> [MonitorParameter a]
mfParams :: [MonitorParameter a],
forall a. MonitorFile a -> Int
mfPeriod :: Period
}
monitorFile ::
String ->
[MonitorParameter a] ->
Period ->
MonitorFile a
monitorFile :: forall a. [Char] -> [MonitorParameter a] -> Int -> MonitorFile a
monitorFile [Char]
n [MonitorParameter a]
ps Int
p
| Int
p forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. HasCallStack => [Char] -> a
error [Char]
"monitorFile: Monitor period must be 1 or larger."
| Bool
otherwise = forall a.
[Char]
-> Maybe Handle -> [MonitorParameter a] -> Int -> MonitorFile a
MonitorFile [Char]
n forall a. Maybe a
Nothing [MonitorParameter a]
ps Int
p
mfRenderRow :: [BL.ByteString] -> BL.ByteString
mfRenderRow :: [ByteString] -> ByteString
mfRenderRow = ByteString -> [ByteString] -> ByteString
BL.intercalate ByteString
"\t"
mfOpen :: String -> String -> ExecutionMode -> MonitorFile a -> IO (MonitorFile a)
mfOpen :: forall a.
[Char]
-> [Char] -> ExecutionMode -> MonitorFile a -> IO (MonitorFile a)
mfOpen [Char]
pre [Char]
suf ExecutionMode
em MonitorFile a
m = do
let fn :: [Char]
fn = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Char]
pre, forall a. MonitorFile a -> [Char]
mfName MonitorFile a
m, [Char]
suf, [Char]
"monitor"]
Handle
h <- ExecutionMode -> [Char] -> IO Handle
openWithExecutionMode ExecutionMode
em [Char]
fn
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MonitorFile a
m {mfHandle :: Maybe Handle
mfHandle = forall a. a -> Maybe a
Just Handle
h}
mfHeader :: MonitorFile a -> IO ()
MonitorFile a
m = case forall a. MonitorFile a -> Maybe Handle
mfHandle MonitorFile a
m of
Maybe Handle
Nothing ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"mfHeader: No handle available for monitor with name "
forall a. Semigroup a => a -> a -> a
<> forall a. MonitorFile a -> [Char]
mfName MonitorFile a
m
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
Just Handle
h ->
Handle -> ByteString -> IO ()
BL.hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$
[ByteString] -> ByteString
mfRenderRow forall a b. (a -> b) -> a -> b
$
[ByteString
"Iteration", ByteString
"Log-Prior", ByteString
"Log-Likelihood", ByteString
"Log-Posterior"]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ByteString
BL.pack forall a b. (a -> b) -> a -> b
$ forall a. MonitorParameter a -> [Char]
mpName MonitorParameter a
p | MonitorParameter a
p <- forall a. MonitorFile a -> [MonitorParameter a]
mfParams MonitorFile a
m]
mfExec ::
Int ->
Link a ->
MonitorFile a ->
IO ()
mfExec :: forall a. Int -> Link a -> MonitorFile a -> IO ()
mfExec Int
i (Link a
x Log Double
p Log Double
l) MonitorFile a
m
| Int
i forall a. Integral a => a -> a -> a
`mod` forall a. MonitorFile a -> Int
mfPeriod MonitorFile a
m forall a. Eq a => a -> a -> Bool
/= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = case forall a. MonitorFile a -> Maybe Handle
mfHandle MonitorFile a
m of
Maybe Handle
Nothing ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"mfExec: No handle available for monitor with name "
forall a. Semigroup a => a -> a -> a
<> forall a. MonitorFile a -> [Char]
mfName MonitorFile a
m
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
Just Handle
h ->
Handle -> ByteString -> IO ()
BL.hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$
[ByteString] -> ByteString
mfRenderRow forall a b. (a -> b) -> a -> b
$
[Char] -> ByteString
BL.pack (forall a. Show a => a -> [Char]
show Int
i)
forall a. a -> [a] -> [a]
: Log Double -> ByteString
renderLog Log Double
p
forall a. a -> [a] -> [a]
: Log Double -> ByteString
renderLog Log Double
l
forall a. a -> [a] -> [a]
: Log Double -> ByteString
renderLog (Log Double
p forall a. Num a => a -> a -> a
* Log Double
l)
forall a. a -> [a] -> [a]
: [Builder -> ByteString
BB.toLazyByteString forall a b. (a -> b) -> a -> b
$ forall a. MonitorParameter a -> a -> Builder
mpFunc MonitorParameter a
mp a
x | MonitorParameter a
mp <- forall a. MonitorFile a -> [MonitorParameter a]
mfParams MonitorFile a
m]
mfClose :: MonitorFile a -> IO ()
mfClose :: forall a. MonitorFile a -> IO ()
mfClose MonitorFile a
m = case forall a. MonitorFile a -> Maybe Handle
mfHandle MonitorFile a
m of
Just Handle
h -> Handle -> IO ()
hClose Handle
h
Maybe Handle
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"mfClose: File was not opened for monitor " forall a. Semigroup a => a -> a -> a
<> forall a. MonitorFile a -> [Char]
mfName MonitorFile a
m forall a. Semigroup a => a -> a -> a
<> [Char]
"."
type BatchSize = Int
data MonitorBatch a = MonitorBatch
{ forall a. MonitorBatch a -> [Char]
mbName :: String,
forall a. MonitorBatch a -> Maybe Handle
mbHandle :: Maybe Handle,
forall a. MonitorBatch a -> [MonitorParameterBatch a]
mbParams :: [MonitorParameterBatch a],
forall a. MonitorBatch a -> Int
mbSize :: BatchSize
}
monitorBatch ::
String ->
[MonitorParameterBatch a] ->
BatchSize ->
MonitorBatch a
monitorBatch :: forall a.
[Char] -> [MonitorParameterBatch a] -> Int -> MonitorBatch a
monitorBatch [Char]
n [MonitorParameterBatch a]
ps Int
b
| Int
b forall a. Ord a => a -> a -> Bool
< Int
2 = forall a. HasCallStack => [Char] -> a
error [Char]
"monitorBatch: Batch size must be 2 or larger."
| Bool
otherwise = forall a.
[Char]
-> Maybe Handle
-> [MonitorParameterBatch a]
-> Int
-> MonitorBatch a
MonitorBatch [Char]
n forall a. Maybe a
Nothing [MonitorParameterBatch a]
ps Int
b
getMonitorBatchSize :: MonitorBatch a -> BatchSize
getMonitorBatchSize :: forall a. MonitorBatch a -> Int
getMonitorBatchSize = forall a. MonitorBatch a -> Int
mbSize
mbOpen :: String -> String -> ExecutionMode -> MonitorBatch a -> IO (MonitorBatch a)
mbOpen :: forall a.
[Char]
-> [Char] -> ExecutionMode -> MonitorBatch a -> IO (MonitorBatch a)
mbOpen [Char]
pre [Char]
suf ExecutionMode
em MonitorBatch a
m = do
let fn :: [Char]
fn = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Char]
pre, forall a. MonitorBatch a -> [Char]
mbName MonitorBatch a
m, [Char]
suf, [Char]
"batch"]
Handle
h <- ExecutionMode -> [Char] -> IO Handle
openWithExecutionMode ExecutionMode
em [Char]
fn
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MonitorBatch a
m {mbHandle :: Maybe Handle
mbHandle = forall a. a -> Maybe a
Just Handle
h}
mbHeader :: MonitorBatch a -> IO ()
MonitorBatch a
m = case forall a. MonitorBatch a -> Maybe Handle
mbHandle MonitorBatch a
m of
Maybe Handle
Nothing ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"mbHeader: No handle available for batch monitor with name "
forall a. Semigroup a => a -> a -> a
<> forall a. MonitorBatch a -> [Char]
mbName MonitorBatch a
m
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
Just Handle
h ->
Handle -> ByteString -> IO ()
BL.hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$
[ByteString] -> ByteString
mfRenderRow forall a b. (a -> b) -> a -> b
$
[ByteString
"Iteration", ByteString
"Mean log-Prior", ByteString
"Mean log-Likelihood", ByteString
"Mean log-Posterior"]
forall a. [a] -> [a] -> [a]
++ [[Char] -> ByteString
BL.pack forall a b. (a -> b) -> a -> b
$ forall a. MonitorParameterBatch a -> [Char]
mbpName MonitorParameterBatch a
mbp | MonitorParameterBatch a
mbp <- forall a. MonitorBatch a -> [MonitorParameterBatch a]
mbParams MonitorBatch a
m]
mean :: VB.Vector (Log Double) -> Log Double
mean :: Vector (Log Double) -> Log Double
mean Vector (Log Double)
xs = forall a. Num a => Vector a -> a
VB.sum Vector (Log Double)
xs forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
VB.length Vector (Log Double)
xs)
mbExec ::
Int ->
Trace a ->
MonitorBatch a ->
IO ()
mbExec :: forall a. Int -> Trace a -> MonitorBatch a -> IO ()
mbExec Int
i Trace a
t MonitorBatch a
m
| (Int
i forall a. Integral a => a -> a -> a
`mod` forall a. MonitorBatch a -> Int
mbSize MonitorBatch a
m forall a. Eq a => a -> a -> Bool
/= Int
0) Bool -> Bool -> Bool
|| (Int
i forall a. Eq a => a -> a -> Bool
== Int
0) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = case forall a. MonitorBatch a -> Maybe Handle
mbHandle MonitorBatch a
m of
Maybe Handle
Nothing ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"mbExec: No handle available for batch monitor with name "
forall a. Semigroup a => a -> a -> a
<> forall a. MonitorBatch a -> [Char]
mbName MonitorBatch a
m
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
Just Handle
h -> do
Vector (Link a)
xs <- forall a. Int -> Trace a -> IO (Vector (Link a))
takeT (forall a. MonitorBatch a -> Int
mbSize MonitorBatch a
m) Trace a
t
let lps :: Vector (Log Double)
lps = forall a b. (a -> b) -> Vector a -> Vector b
VB.map forall a. Link a -> Log Double
prior Vector (Link a)
xs
lls :: Vector (Log Double)
lls = forall a b. (a -> b) -> Vector a -> Vector b
VB.map forall a. Link a -> Log Double
likelihood Vector (Link a)
xs
los :: Vector (Log Double)
los = forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
VB.zipWith forall a. Num a => a -> a -> a
(*) Vector (Log Double)
lps Vector (Log Double)
lls
mlps :: Log Double
mlps = Vector (Log Double) -> Log Double
mean Vector (Log Double)
lps
mlls :: Log Double
mlls = Vector (Log Double) -> Log Double
mean Vector (Log Double)
lls
mlos :: Log Double
mlos = Vector (Log Double) -> Log Double
mean Vector (Log Double)
los
Handle -> ByteString -> IO ()
BL.hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$
[ByteString] -> ByteString
mfRenderRow forall a b. (a -> b) -> a -> b
$
[Char] -> ByteString
BL.pack (forall a. Show a => a -> [Char]
show Int
i)
forall a. a -> [a] -> [a]
: Log Double -> ByteString
renderLog Log Double
mlps
forall a. a -> [a] -> [a]
: Log Double -> ByteString
renderLog Log Double
mlls
forall a. a -> [a] -> [a]
: Log Double -> ByteString
renderLog Log Double
mlos
forall a. a -> [a] -> [a]
: [Builder -> ByteString
BB.toLazyByteString forall a b. (a -> b) -> a -> b
$ forall a. MonitorParameterBatch a -> Vector a -> Builder
mbpFunc MonitorParameterBatch a
mbp (forall a b. (a -> b) -> Vector a -> Vector b
VB.map forall a. Link a -> a
state Vector (Link a)
xs) | MonitorParameterBatch a
mbp <- forall a. MonitorBatch a -> [MonitorParameterBatch a]
mbParams MonitorBatch a
m]
mbClose :: MonitorBatch a -> IO ()
mbClose :: forall a. MonitorBatch a -> IO ()
mbClose MonitorBatch a
m = case forall a. MonitorBatch a -> Maybe Handle
mbHandle MonitorBatch a
m of
Just Handle
h -> Handle -> IO ()
hClose Handle
h
Maybe Handle
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"mfClose: File was not opened for batch monitor: " forall a. Semigroup a => a -> a -> a
<> forall a. MonitorBatch a -> [Char]
mbName MonitorBatch a
m forall a. Semigroup a => a -> a -> a
<> [Char]
"."
mOpen ::
String ->
String ->
ExecutionMode ->
Monitor a ->
IO (Monitor a)
mOpen :: forall a.
[Char] -> [Char] -> ExecutionMode -> Monitor a -> IO (Monitor a)
mOpen [Char]
pre [Char]
suf ExecutionMode
em (Monitor MonitorStdOut a
s [MonitorFile a]
fs [MonitorBatch a]
bs) = do
[MonitorFile a]
fs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a.
[Char]
-> [Char] -> ExecutionMode -> MonitorFile a -> IO (MonitorFile a)
mfOpen [Char]
pre [Char]
suf ExecutionMode
em) [MonitorFile a]
fs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExecutionMode
em forall a. Eq a => a -> a -> Bool
== ExecutionMode
Continue) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. MonitorFile a -> IO ()
mfHeader [MonitorFile a]
fs'
[MonitorBatch a]
bs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a.
[Char]
-> [Char] -> ExecutionMode -> MonitorBatch a -> IO (MonitorBatch a)
mbOpen [Char]
pre [Char]
suf ExecutionMode
em) [MonitorBatch a]
bs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExecutionMode
em forall a. Eq a => a -> a -> Bool
== ExecutionMode
Continue) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. MonitorBatch a -> IO ()
mbHeader [MonitorBatch a]
bs'
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
MonitorStdOut a -> [MonitorFile a] -> [MonitorBatch a] -> Monitor a
Monitor MonitorStdOut a
s [MonitorFile a]
fs' [MonitorBatch a]
bs'
mExec ::
Verbosity ->
Int ->
Int ->
UTCTime ->
Trace a ->
Int ->
Monitor a ->
IO (Maybe BL.ByteString)
mExec :: forall a.
Verbosity
-> Int
-> Int
-> UTCTime
-> Trace a
-> Int
-> Monitor a
-> IO (Maybe ByteString)
mExec Verbosity
v Int
i Int
ss UTCTime
st Trace a
xs Int
j (Monitor MonitorStdOut a
s [MonitorFile a]
fs [MonitorBatch a]
bs) = do
Link a
x <- forall a. Trace a -> IO (Link a)
headT Trace a
xs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. Int -> Link a -> MonitorFile a -> IO ()
mfExec Int
i Link a
x) [MonitorFile a]
fs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. Int -> Trace a -> MonitorBatch a -> IO ()
mbExec Int
i Trace a
xs) [MonitorBatch a]
bs
if Verbosity
v forall a. Eq a => a -> a -> Bool
== Verbosity
Quiet
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall a.
Int
-> Link a
-> Int
-> UTCTime
-> Int
-> MonitorStdOut a
-> IO (Maybe ByteString)
msExec Int
i Link a
x Int
ss UTCTime
st Int
j MonitorStdOut a
s
mClose :: Monitor a -> IO (Monitor a)
mClose :: forall a. Monitor a -> IO (Monitor a)
mClose m :: Monitor a
m@(Monitor MonitorStdOut a
_ [MonitorFile a]
fms [MonitorBatch a]
bms) = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. MonitorFile a -> IO ()
mfClose [MonitorFile a]
fms
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. MonitorBatch a -> IO ()
mbClose [MonitorBatch a]
bms
let fms' :: [MonitorFile a]
fms' = forall a b. (a -> b) -> [a] -> [b]
map (\MonitorFile a
fm -> MonitorFile a
fm {mfHandle :: Maybe Handle
mfHandle = forall a. Maybe a
Nothing}) [MonitorFile a]
fms
let bms' :: [MonitorBatch a]
bms' = forall a b. (a -> b) -> [a] -> [b]
map (\MonitorBatch a
bm -> MonitorBatch a
bm {mbHandle :: Maybe Handle
mbHandle = forall a. Maybe a
Nothing}) [MonitorBatch a]
bms
forall (m :: * -> *) a. Monad m => a -> m a
return Monitor a
m {mFiles :: [MonitorFile a]
mFiles = [MonitorFile a]
fms', mBatches :: [MonitorBatch a]
mBatches = [MonitorBatch a]
bms'}