{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      :  ELynx.Tools.InputOutput
-- Copyright   :  (c) Dominik Schrempf 2021
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Thu Feb 14 13:30:37 2019.
--
-- Tools involving input, output, and parsing.
module ELynx.Tools.InputOutput
  ( -- * Execution Mode
    ExecutionMode (..),
    openFileWithExecutionMode,

    -- * Input, output
    readGZFile,
    writeGZFile,

    -- * Parsing
    runParserOnFile,
    parseFileWith,
    parseIOWith,
    parseFileOrIOWith,
    parseStringWith,
    parseByteStringWith,
  )
where

import Codec.Compression.GZip
import Data.Aeson
import Data.Attoparsec.ByteString.Lazy hiding (Fail)
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.List (isSuffixOf)
import GHC.Generics
import System.Directory
import System.IO

-- | Overwrite existing output files or fail if output files exist.
data ExecutionMode = Overwrite | Fail
  deriving (ExecutionMode -> ExecutionMode -> Bool
(ExecutionMode -> ExecutionMode -> Bool)
-> (ExecutionMode -> ExecutionMode -> Bool) -> Eq ExecutionMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecutionMode -> ExecutionMode -> Bool
$c/= :: ExecutionMode -> ExecutionMode -> Bool
== :: ExecutionMode -> ExecutionMode -> Bool
$c== :: ExecutionMode -> ExecutionMode -> Bool
Eq, Int -> ExecutionMode -> ShowS
[ExecutionMode] -> ShowS
ExecutionMode -> String
(Int -> ExecutionMode -> ShowS)
-> (ExecutionMode -> String)
-> ([ExecutionMode] -> ShowS)
-> Show ExecutionMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutionMode] -> ShowS
$cshowList :: [ExecutionMode] -> ShowS
show :: ExecutionMode -> String
$cshow :: ExecutionMode -> String
showsPrec :: Int -> ExecutionMode -> ShowS
$cshowsPrec :: Int -> ExecutionMode -> ShowS
Show, (forall x. ExecutionMode -> Rep ExecutionMode x)
-> (forall x. Rep ExecutionMode x -> ExecutionMode)
-> Generic ExecutionMode
forall x. Rep ExecutionMode x -> ExecutionMode
forall x. ExecutionMode -> Rep ExecutionMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExecutionMode x -> ExecutionMode
$cfrom :: forall x. ExecutionMode -> Rep ExecutionMode x
Generic)

instance FromJSON ExecutionMode

instance ToJSON ExecutionMode

checkFile :: ExecutionMode -> FilePath -> IO ()
checkFile :: ExecutionMode -> String -> IO ()
checkFile ExecutionMode
Overwrite String
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkFile ExecutionMode
Fail 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 -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fp
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Please use --force to overwrite results of a previous analysis."
    Bool
False -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Open existing files only if 'Force' is true.
openFileWithExecutionMode :: ExecutionMode -> FilePath -> IO Handle
openFileWithExecutionMode :: ExecutionMode -> String -> IO Handle
openFileWithExecutionMode ExecutionMode
em String
fp = ExecutionMode -> String -> IO ()
checkFile ExecutionMode
em 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
WriteMode

-- | Read file. If file path ends with ".gz", assume gzipped file and decompress
-- before read.
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
BL.readFile String
f
  | Bool
otherwise = String -> IO ByteString
BL.readFile String
f

-- | Write file. If file path ends with ".gz", assume gzipped file and compress
-- before write.
writeGZFile :: ExecutionMode -> FilePath -> BL.ByteString -> IO ()
writeGZFile :: ExecutionMode -> String -> ByteString -> IO ()
writeGZFile ExecutionMode
frc String
f ByteString
r
  | String
".gz" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
f = ExecutionMode -> String -> IO ()
checkFile ExecutionMode
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 = ExecutionMode -> String -> IO ()
checkFile ExecutionMode
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

-- | Parse a possibly gzipped file.
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

-- | Parse a possibly gzipped file and extract the result.
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)

-- | Parse standard input.
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

-- | Parse a possibly gzipped file, or standard input, and extract the result.
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

-- | Parse a 'String' and extract the result.
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)

-- | Parse a 'BL.ByteString' and extract the result.
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