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

-- |
-- Module      :  ELynx.Tools.InputOutput
-- Copyright   :  2021 Dominik Schrempf
-- 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 hiding (String)
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
$c== :: ExecutionMode -> ExecutionMode -> Bool
== :: ExecutionMode -> ExecutionMode -> Bool
$c/= :: ExecutionMode -> ExecutionMode -> Bool
/= :: ExecutionMode -> ExecutionMode -> Bool
Eq, Int -> ExecutionMode -> ShowS
[ExecutionMode] -> ShowS
ExecutionMode -> [Char]
(Int -> ExecutionMode -> ShowS)
-> (ExecutionMode -> [Char])
-> ([ExecutionMode] -> ShowS)
-> Show ExecutionMode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutionMode -> ShowS
showsPrec :: Int -> ExecutionMode -> ShowS
$cshow :: ExecutionMode -> [Char]
show :: ExecutionMode -> [Char]
$cshowList :: [ExecutionMode] -> ShowS
showList :: [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
$cfrom :: forall x. ExecutionMode -> Rep ExecutionMode x
from :: forall x. ExecutionMode -> Rep ExecutionMode x
$cto :: forall x. Rep ExecutionMode x -> ExecutionMode
to :: forall x. Rep ExecutionMode x -> ExecutionMode
Generic)

instance FromJSON ExecutionMode

instance ToJSON ExecutionMode

checkFile :: ExecutionMode -> FilePath -> IO ()
checkFile :: ExecutionMode -> [Char] -> IO ()
checkFile ExecutionMode
Overwrite [Char]
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkFile ExecutionMode
Fail [Char]
fp =
  [Char] -> IO Bool
doesFileExist [Char]
fp IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True ->
      [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char]
"File exists: "
          [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
fp
          [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"."
          [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n"
          [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"Please use --force to overwrite results of a previous analysis."
    Bool
False -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Open existing files only if 'ExecutionMode' is 'Overwrite'.
openFileWithExecutionMode :: ExecutionMode -> FilePath -> IO Handle
openFileWithExecutionMode :: ExecutionMode -> [Char] -> IO Handle
openFileWithExecutionMode ExecutionMode
em [Char]
fp = ExecutionMode -> [Char] -> IO ()
checkFile ExecutionMode
em [Char]
fp IO () -> IO Handle -> IO Handle
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IOMode -> IO Handle
openFile [Char]
fp IOMode
WriteMode

-- | Read file. If file path ends with ".gz", assume gzipped file and decompress
-- before read.
readGZFile :: FilePath -> IO BL.ByteString
readGZFile :: [Char] -> IO ByteString
readGZFile [Char]
f
  | [Char]
".gz" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
f = ByteString -> ByteString
decompress (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
BL.readFile [Char]
f
  | Bool
otherwise = [Char] -> IO ByteString
BL.readFile [Char]
f

-- | Write file. If file path ends with ".gz", assume gzipped file and compress
-- before write.
writeGZFile :: ExecutionMode -> FilePath -> BL.ByteString -> IO ()
writeGZFile :: ExecutionMode -> [Char] -> ByteString -> IO ()
writeGZFile ExecutionMode
frc [Char]
f ByteString
r
  | [Char]
".gz" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
f = ExecutionMode -> [Char] -> IO ()
checkFile ExecutionMode
frc [Char]
f IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ByteString -> IO ()
BL.writeFile [Char]
f (ByteString -> ByteString
compress ByteString
r)
  | Bool
otherwise = ExecutionMode -> [Char] -> IO ()
checkFile ExecutionMode
frc [Char]
f IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ByteString -> IO ()
BL.writeFile [Char]
f ByteString
r

-- | Parse a possibly gzipped file.
runParserOnFile :: Parser a -> FilePath -> IO (Either String a)
runParserOnFile :: forall a. Parser a -> [Char] -> IO (Either [Char] a)
runParserOnFile Parser a
p [Char]
f = Result a -> Either [Char] a
forall r. Result r -> Either [Char] r
eitherResult (Result a -> Either [Char] a)
-> (ByteString -> Result a) -> ByteString -> Either [Char] 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 [Char] a)
-> IO ByteString -> IO (Either [Char] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
readGZFile [Char]
f

-- | Parse a possibly gzipped file and extract the result.
parseFileWith :: Parser a -> FilePath -> IO a
parseFileWith :: forall a. Parser a -> [Char] -> IO a
parseFileWith Parser a
p [Char]
f = Parser a -> Maybe [Char] -> IO a
forall a. Parser a -> Maybe [Char] -> IO a
parseFileOrIOWith Parser a
p ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
f)

-- | Parse standard input.
parseIOWith :: Parser a -> IO a
parseIOWith :: forall a. Parser a -> IO a
parseIOWith Parser a
p = Parser a -> Maybe [Char] -> IO a
forall a. Parser a -> Maybe [Char] -> IO a
parseFileOrIOWith Parser a
p Maybe [Char]
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 :: forall a. Parser a -> Maybe [Char] -> IO a
parseFileOrIOWith Parser a
p Maybe [Char]
mf = do
  ByteString
s <- IO ByteString
-> ([Char] -> IO ByteString) -> Maybe [Char] -> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ByteString
BL.getContents [Char] -> IO ByteString
readGZFile Maybe [Char]
mf
  a -> IO a
forall a. 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 :: forall a. Parser a -> [Char] -> a
parseStringWith Parser a
p [Char]
x = Parser a -> ByteString -> a
forall a. Parser a -> ByteString -> a
parseByteStringWith Parser a
p ([Char] -> ByteString
BL.pack [Char]
x)

-- | Parse a 'BL.ByteString' and extract the result.
parseByteStringWith :: Parser a -> BL.ByteString -> a
parseByteStringWith :: forall a. Parser a -> ByteString -> a
parseByteStringWith Parser a
p ByteString
x = case Result a -> Either [Char] a
forall r. Result r -> Either [Char] r
eitherResult (Result a -> Either [Char] a) -> Result a -> Either [Char] 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 [Char]
err -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
err
  Right a
val -> a
val