{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module ELynx.Tools.ELynx
( ELynx,
eLynxWrapper,
out,
outHandle,
)
where
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader hiding (local)
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as BL
import ELynx.Tools.Environment
import ELynx.Tools.InputOutput
import ELynx.Tools.Logger
import ELynx.Tools.Options
import ELynx.Tools.Reproduction
import System.IO
import System.Random.Stateful
type ELynx a = ReaderT (Environment a) IO
fixSeed :: Reproducible a => a -> IO a
fixSeed :: forall a. Reproducible a => a -> IO a
fixSeed a
x = case forall a. Reproducible a => a -> Maybe SeedOpt
getSeed a
x of
(Just SeedOpt
RandomUnset) -> do
Int
s <- forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM AtomicGenM StdGen
globalStdGen :: IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Reproducible a => a -> SeedOpt -> a
setSeed a
x (Int -> SeedOpt
RandomSet Int
s)
Maybe SeedOpt
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
eLynxRun ::
forall a b.
(Eq a, Reproducible a, Reproducible b, Show a, ToJSON a) =>
(b -> a) ->
ELynx b () ->
ELynx b ()
eLynxRun :: forall a b.
(Eq a, Reproducible a, Reproducible b, Show a, ToJSON a) =>
(b -> a) -> ELynx b () -> ELynx b ()
eLynxRun b -> a
f ELynx b ()
worker = do
forall e.
(HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) =>
String -> [String] -> Logger e ()
logInfoHeader (forall a. Reproducible a => String
cmdName @b) (forall a. Reproducible a => [String]
cmdDsc @b)
Maybe SeedOpt
mso <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader (forall a. Reproducible a => a -> Maybe SeedOpt
getSeed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Environment a -> a
localArguments)
case Maybe SeedOpt
mso of
Maybe SeedOpt
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (RandomSet Int
s) -> forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Seed: random; set to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
s forall a. Semigroup a => a -> a -> a
<> String
"."
Just (Fixed Int
s) -> forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Seed: fixed to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
s forall a. Semigroup a => a -> a -> a
<> String
"."
Just SeedOpt
RandomUnset -> forall a. HasCallStack => String -> a
error String
"eLynxRun: Seed unset."
ELynx b ()
worker
Environment b
e <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let g :: GlobalArguments
g = forall a. Environment a -> GlobalArguments
globalArguments Environment b
e
l :: b
l = forall a. Environment a -> a
localArguments Environment b
e
case (GlobalArguments -> Bool
writeElynxFile GlobalArguments
g, GlobalArguments -> Maybe String
outFileBaseName GlobalArguments
g) of
(Bool
False, Maybe String
_) ->
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"No elynx file option --- skip writing ELynx file for reproducible runs."
(Bool
True, Maybe String
Nothing) ->
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"No output file given --- skip writing ELynx file for reproducible runs."
(Bool
True, Just String
bn) -> do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS String
"Write ELynx reproduction file."
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
(Eq a, Show a, Reproducible a, ToJSON a) =>
String -> a -> IO ()
writeReproduction String
bn (forall a. GlobalArguments -> a -> Arguments a
Arguments GlobalArguments
g (b -> a
f b
l))
forall e.
(HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) =>
Logger e ()
logInfoFooter
eLynxWrapper ::
(Eq a, Show a, Reproducible a, Reproducible b, ToJSON a) =>
GlobalArguments ->
b ->
(b -> a) ->
ELynx b () ->
IO ()
eLynxWrapper :: forall a b.
(Eq a, Show a, Reproducible a, Reproducible b, ToJSON a) =>
GlobalArguments -> b -> (b -> a) -> ELynx b () -> IO ()
eLynxWrapper GlobalArguments
gArgs b
lArgs b -> a
f ELynx b ()
worker = do
b
lArgs' <- forall a. Reproducible a => a -> IO a
fixSeed b
lArgs
Environment b
e <- forall a. GlobalArguments -> a -> IO (Environment a)
initializeEnvironment GlobalArguments
gArgs b
lArgs'
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall a b.
(Eq a, Reproducible a, Reproducible b, Show a, ToJSON a) =>
(b -> a) -> ELynx b () -> ELynx b ()
eLynxRun b -> a
f ELynx b ()
worker) Environment b
e
forall s. Environment s -> IO ()
closeEnvironment Environment b
e
getOutFilePath ::
forall a. Reproducible a => String -> ELynx a (Maybe FilePath)
getOutFilePath :: forall a. Reproducible a => String -> ELynx a (Maybe String)
getOutFilePath String
ext = do
Environment a
a <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let bn :: Maybe String
bn = GlobalArguments -> Maybe String
outFileBaseName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Environment a -> GlobalArguments
globalArguments forall a b. (a -> b) -> a -> b
$ Environment a
a
sfxs :: [String]
sfxs = forall a. Reproducible a => a -> [String]
outSuffixes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Environment a -> a
localArguments forall a b. (a -> b) -> a -> b
$ Environment a
a
if String
ext forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
sfxs
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a. [a] -> [a] -> [a]
++ String
ext) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
bn
else
forall a. HasCallStack => String -> a
error
String
"getOutFilePath: out file suffix not registered; please contact maintainer."
out :: Reproducible a => String -> BL.ByteString -> String -> ELynx a ()
out :: forall a.
Reproducible a =>
String -> ByteString -> String -> ELynx a ()
out String
name ByteString
res String
ext = do
Maybe String
mfp <- forall a. Reproducible a => String -> ELynx a (Maybe String)
getOutFilePath String
ext
case Maybe String
mfp of
Maybe String
Nothing -> do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Write " forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
" to standard output."
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BL.putStr ByteString
res
Just String
fp -> do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Write " forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
" to file '" forall a. Semigroup a => a -> a -> a
<> String
fp forall a. Semigroup a => a -> a -> a
<> String
"'."
ExecutionMode
em <- GlobalArguments -> ExecutionMode
executionMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Environment a -> GlobalArguments
globalArguments forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ExecutionMode -> String -> ByteString -> IO ()
writeGZFile ExecutionMode
em String
fp ByteString
res
outHandle :: Reproducible a => String -> String -> ELynx a Handle
outHandle :: forall a. Reproducible a => String -> String -> ELynx a Handle
outHandle String
name String
ext = do
Maybe String
mfp <- forall a. Reproducible a => String -> ELynx a (Maybe String)
getOutFilePath String
ext
case Maybe String
mfp of
Maybe String
Nothing -> do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Write " forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
" to standard output."
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdout
Just String
fp -> do
forall e.
(HasLock e, HasLogHandles e, HasVerbosity e) =>
String -> Logger e ()
logInfoS forall a b. (a -> b) -> a -> b
$ String
"Write " forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
" to file '" forall a. Semigroup a => a -> a -> a
<> String
fp forall a. Semigroup a => a -> a -> a
<> String
"'."
ExecutionMode
em <- GlobalArguments -> ExecutionMode
executionMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Environment a -> GlobalArguments
globalArguments forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ExecutionMode -> String -> IO Handle
openFileWithExecutionMode ExecutionMode
em String
fp