{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module ELynx.Tools.InputOutput
(
getOutFilePath,
openFile',
readGZFile,
writeGZFile,
out,
outHandle,
runParserOnFile,
parseFileWith,
parseIOWith,
parseFileOrIOWith,
parseStringWith,
parseByteStringWith,
)
where
import Codec.Compression.GZip
( compress,
decompress,
)
import Control.DeepSeq (force)
import Control.Exception (evaluate)
import Control.Monad ((<=<))
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Trans.Reader (ask)
import Data.Attoparsec.ByteString.Lazy
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.List (isSuffixOf)
import qualified Data.Text as T
import ELynx.Tools.Reproduction
( Arguments (..),
ELynx,
Force (..),
Reproducible (..),
forceReanalysis,
outFileBaseName,
)
import System.Directory (doesFileExist)
import System.IO
getOutFilePath ::
forall a. Reproducible a => String -> ELynx a (Maybe FilePath)
getOutFilePath :: String -> ELynx a (Maybe String)
getOutFilePath String
ext = do
Arguments a
a <- ReaderT (Arguments a) (LoggingT IO) (Arguments a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let bn :: Maybe String
bn = GlobalArguments -> Maybe String
outFileBaseName (GlobalArguments -> Maybe String)
-> (Arguments a -> GlobalArguments) -> Arguments a -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments a -> GlobalArguments
forall a. Arguments a -> GlobalArguments
global (Arguments a -> Maybe String) -> Arguments a -> Maybe String
forall a b. (a -> b) -> a -> b
$ Arguments a
a
sfxs :: [String]
sfxs = Arguments a -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes Arguments a
a
if String
ext String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
sfxs
then Maybe String -> ELynx a (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> ELynx a (Maybe String))
-> Maybe String -> ELynx a (Maybe String)
forall a b. (a -> b) -> a -> b
$ (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ext) (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
bn
else
String -> ELynx a (Maybe String)
forall a. HasCallStack => String -> a
error
String
"getOutFilePath: out file suffix not registered; please contact maintainer."
checkFile :: Force -> FilePath -> IO ()
checkFile :: Force -> String -> IO ()
checkFile (Force Bool
True) String
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkFile (Force Bool
False) String
fp =
String -> IO Bool
doesFileExist String
fp IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True ->
String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"File exists: "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". Please use the --force option to repeat an analysis."
Bool
False -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
openFile' :: Force -> FilePath -> IOMode -> IO Handle
openFile' :: Force -> String -> IOMode -> IO Handle
openFile' Force
frc String
fp IOMode
md = Force -> String -> IO ()
checkFile Force
frc String
fp IO () -> IO Handle -> IO Handle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IOMode -> IO Handle
openFile String
fp IOMode
md
readFile' :: FilePath -> IO BL.ByteString
readFile' :: String -> IO ByteString
readFile' String
fn = String -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
fn IOMode
ReadMode ((Handle -> IO ByteString) -> IO ByteString)
-> (Handle -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO ByteString
forall a. a -> IO a
evaluate (ByteString -> IO ByteString)
-> (ByteString -> ByteString) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. NFData a => a -> a
force) (ByteString -> IO ByteString)
-> (Handle -> IO ByteString) -> Handle -> IO ByteString
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Handle -> IO ByteString
BL.hGetContents
readGZFile :: FilePath -> IO BL.ByteString
readGZFile :: String -> IO ByteString
readGZFile String
f
| String
".gz" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
f = ByteString -> ByteString
decompress (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
readFile' String
f
| Bool
otherwise = String -> IO ByteString
readFile' String
f
writeGZFile :: Force -> FilePath -> BL.ByteString -> IO ()
writeGZFile :: Force -> String -> ByteString -> IO ()
writeGZFile Force
frc String
f ByteString
r
| String
".gz" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
f = Force -> String -> IO ()
checkFile Force
frc String
f IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ByteString -> IO ()
BL.writeFile String
f (ByteString -> ByteString
compress ByteString
r)
| Bool
otherwise = Force -> String -> IO ()
checkFile Force
frc String
f IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ByteString -> IO ()
BL.writeFile String
f ByteString
r
runParserOnFile :: Parser a -> FilePath -> IO (Either String a)
runParserOnFile :: Parser a -> String -> IO (Either String a)
runParserOnFile Parser a
p String
f = Result a -> Either String a
forall r. Result r -> Either String r
eitherResult (Result a -> Either String a)
-> (ByteString -> Result a) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
parse Parser a
p (ByteString -> Either String a)
-> IO ByteString -> IO (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
readGZFile String
f
parseFileWith :: Parser a -> FilePath -> IO a
parseFileWith :: Parser a -> String -> IO a
parseFileWith Parser a
p String
f = Parser a -> Maybe String -> IO a
forall a. Parser a -> Maybe String -> IO a
parseFileOrIOWith Parser a
p (String -> Maybe String
forall a. a -> Maybe a
Just String
f)
parseIOWith :: Parser a -> IO a
parseIOWith :: Parser a -> IO a
parseIOWith Parser a
p = Parser a -> Maybe String -> IO a
forall a. Parser a -> Maybe String -> IO a
parseFileOrIOWith Parser a
p Maybe String
forall a. Maybe a
Nothing
parseFileOrIOWith :: Parser a -> Maybe FilePath -> IO a
parseFileOrIOWith :: Parser a -> Maybe String -> IO a
parseFileOrIOWith Parser a
p Maybe String
mf = do
ByteString
s <- IO ByteString
-> (String -> IO ByteString) -> Maybe String -> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ByteString
BL.getContents String -> IO ByteString
readGZFile Maybe String
mf
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ Parser a -> ByteString -> a
forall a. Parser a -> ByteString -> a
parseByteStringWith Parser a
p ByteString
s
parseStringWith :: Parser a -> String -> a
parseStringWith :: Parser a -> String -> a
parseStringWith Parser a
p String
x = Parser a -> ByteString -> a
forall a. Parser a -> ByteString -> a
parseByteStringWith Parser a
p (String -> ByteString
BL.pack String
x)
parseByteStringWith :: Parser a -> BL.ByteString -> a
parseByteStringWith :: Parser a -> ByteString -> a
parseByteStringWith Parser a
p ByteString
x = case Result a -> Either String a
forall r. Result r -> Either String r
eitherResult (Result a -> Either String a) -> Result a -> Either String a
forall a b. (a -> b) -> a -> b
$ Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
parse Parser a
p ByteString
x of
Left String
err -> String -> a
forall a. HasCallStack => String -> a
error String
err
Right a
val -> a
val
out :: Reproducible a => String -> BL.ByteString -> String -> ELynx a ()
out :: String -> ByteString -> String -> ELynx a ()
out String
name ByteString
res String
ext = do
Maybe String
mfp <- String -> ELynx a (Maybe String)
forall a. Reproducible a => String -> ELynx a (Maybe String)
getOutFilePath String
ext
case Maybe String
mfp of
Maybe String
Nothing -> do
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx a ()
(Text -> ELynx a ()) -> (Text -> Text) -> Text -> ELynx a ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx a ()) -> Text -> ELynx a ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Write " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" to standard output."
IO () -> ELynx a ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ELynx a ()) -> IO () -> ELynx a ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BL.putStr ByteString
res
Just String
fp -> do
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ELynx a ()
(Text -> ELynx a ()) -> (Text -> Text) -> Text -> ELynx a ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ELynx a ()) -> Text -> ELynx a ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Write " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" to file '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'."
Force
frc <- GlobalArguments -> Force
forceReanalysis (GlobalArguments -> Force)
-> (Arguments a -> GlobalArguments) -> Arguments a -> Force
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments a -> GlobalArguments
forall a. Arguments a -> GlobalArguments
global (Arguments a -> Force)
-> ReaderT (Arguments a) (LoggingT IO) (Arguments a)
-> ReaderT (Arguments a) (LoggingT IO) Force
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Arguments a) (LoggingT IO) (Arguments a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
IO () -> ELynx a ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ELynx a ()) -> IO () -> ELynx a ()
forall a b. (a -> b) -> a -> b
$ Force -> String -> ByteString -> IO ()
writeGZFile Force
frc String
fp ByteString
res
outHandle :: Reproducible a => String -> String -> ELynx a Handle
outHandle :: String -> String -> ELynx a Handle
outHandle String
name String
ext = do
Maybe String
mfp <- String -> ELynx a (Maybe String)
forall a. Reproducible a => String -> ELynx a (Maybe String)
getOutFilePath String
ext
case Maybe String
mfp of
Maybe String
Nothing -> do
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT (Arguments a) (LoggingT IO) ()
(Text -> ReaderT (Arguments a) (LoggingT IO) ())
-> (Text -> Text) -> Text -> ReaderT (Arguments a) (LoggingT IO) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT (Arguments a) (LoggingT IO) ())
-> Text -> ReaderT (Arguments a) (LoggingT IO) ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Write " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" to standard output."
Handle -> ELynx a Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdout
Just String
fp -> do
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT (Arguments a) (LoggingT IO) ()
(Text -> ReaderT (Arguments a) (LoggingT IO) ())
-> (Text -> Text) -> Text -> ReaderT (Arguments a) (LoggingT IO) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT (Arguments a) (LoggingT IO) ())
-> Text -> ReaderT (Arguments a) (LoggingT IO) ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Write " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" to file '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'."
Force
frc <- GlobalArguments -> Force
forceReanalysis (GlobalArguments -> Force)
-> (Arguments a -> GlobalArguments) -> Arguments a -> Force
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments a -> GlobalArguments
forall a. Arguments a -> GlobalArguments
global (Arguments a -> Force)
-> ReaderT (Arguments a) (LoggingT IO) (Arguments a)
-> ReaderT (Arguments a) (LoggingT IO) Force
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Arguments a) (LoggingT IO) (Arguments a)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
IO Handle -> ELynx a Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> ELynx a Handle) -> IO Handle -> ELynx a Handle
forall a b. (a -> b) -> a -> b
$ Force -> String -> IOMode -> IO Handle
openFile' Force
frc String
fp IOMode
WriteMode