{-# 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 ext = do
a <- ask
let bn = outFileBaseName . global $ a
sfxs = outSuffixes a
if ext `elem` sfxs
then return $ (++ ext) <$> bn
else
error
"getOutFilePath: out file suffix not registered. Please contact maintainer."
checkFile :: Force -> FilePath -> IO ()
checkFile (Force True) _ = return ()
checkFile (Force False) fp =
doesFileExist fp >>= \case
True ->
error $
"File exists: "
<> fp
<> ". Please use the --force option to repeat an analysis."
False -> return ()
openFile' :: Force -> FilePath -> IOMode -> IO Handle
openFile' frc fp md = checkFile frc fp >> openFile fp md
readFile' :: FilePath -> IO BL.ByteString
readFile' fn = withFile fn ReadMode $ (evaluate . force) <=< BL.hGetContents
readGZFile :: FilePath -> IO BL.ByteString
readGZFile f
| ".gz" `isSuffixOf` f = decompress <$> readFile' f
| otherwise = readFile' f
writeGZFile :: Force -> FilePath -> BL.ByteString -> IO ()
writeGZFile frc f r
| ".gz" `isSuffixOf` f = checkFile frc f >> BL.writeFile f (compress r)
| otherwise = checkFile frc f >> BL.writeFile f r
runParserOnFile :: Parser a -> FilePath -> IO (Either String a)
runParserOnFile p f = eitherResult . parse p <$> readGZFile f
parseFileWith :: Parser a -> FilePath -> IO a
parseFileWith p f = parseFileOrIOWith p (Just f)
parseIOWith :: Parser a -> IO a
parseIOWith p = parseFileOrIOWith p Nothing
parseFileOrIOWith :: Parser a -> Maybe FilePath -> IO a
parseFileOrIOWith p mf = do
s <- maybe BL.getContents readGZFile mf
return $ parseByteStringWith p s
parseStringWith :: Parser a -> String -> a
parseStringWith p x = parseByteStringWith p (BL.pack x)
parseByteStringWith :: Parser a -> BL.ByteString -> a
parseByteStringWith p x = case eitherResult $ parse p x of
Left err -> error err
Right val -> val
out :: Reproducible a => String -> BL.ByteString -> String -> ELynx a ()
out name res ext = do
mfp <- getOutFilePath ext
case mfp of
Nothing -> do
$(logInfo) $ T.pack $ "Write " <> name <> " to standard output."
liftIO $ BL.putStr res
Just fp -> do
$(logInfo) $ T.pack $ "Write " <> name <> " to file '" <> fp <> "'."
frc <- forceReanalysis . global <$> ask
liftIO $ writeGZFile frc fp res
outHandle :: Reproducible a => String -> String -> ELynx a Handle
outHandle name ext = do
mfp <- getOutFilePath ext
case mfp of
Nothing -> do
$(logInfo) $ T.pack $ "Write " <> name <> " to standard output."
return stdout
Just fp -> do
$(logInfo) $ T.pack $ "Write " <> name <> " to file '" <> fp <> "'."
frc <- forceReanalysis . global <$> ask
liftIO $ openFile' frc fp WriteMode