module Data.Git.Phoenix.Io where

import Data.ByteString.Lazy qualified as L
import Data.ByteString qualified as BS
import Data.Git.Phoenix.Prelude
import System.IO (openBinaryFile)

class HasInHandlesSem m where
  getInHandlesSem :: m QSem

instance (Monad m, HasInHandlesSem m) => HasInHandlesSem (ResourceT m) where
  getInHandlesSem :: ResourceT m QSem
getInHandlesSem = m QSem -> ResourceT m QSem
forall (m :: * -> *) a. Monad m => m a -> ResourceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m QSem
forall (m :: * -> *). HasInHandlesSem m => m QSem
getInHandlesSem

data Compressed

withHandleX :: (NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
  IOMode -> FilePath -> (Handle -> m a) -> m a
withHandleX :: forall a (m :: * -> *).
(NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
IOMode -> FilePath -> (Handle -> m a) -> m a
withHandleX IOMode
mode FilePath
fp Handle -> m a
a = do
  s <- m QSem
forall (m :: * -> *). HasInHandlesSem m => m QSem
getInHandlesSem
  bracket_ (waitQSem s) (signalQSem s) $
    -- withFile is not applicable because Handle might be closed twice
    -- https://github.com/haskell/bytestring/issues/707
    bracket (liftIO $ openBinaryFile fp mode)
      (\Handle
h -> m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Handle -> m Bool
forall (m :: * -> *). MonadIO m => Handle -> m Bool
hIsOpen Handle
h) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> m ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose Handle
h) go
  where
    go :: Handle -> m a
go Handle
h = do
      !r <- Handle -> m a
a Handle
h
      case rnf r of
        () -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r

withHandle :: (NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
  FilePath -> (Handle -> m a) -> m a
withHandle :: forall a (m :: * -> *).
(NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
FilePath -> (Handle -> m a) -> m a
withHandle = IOMode -> FilePath -> (Handle -> m a) -> m a
forall a (m :: * -> *).
(NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
IOMode -> FilePath -> (Handle -> m a) -> m a
withHandleX IOMode
ReadMode

withCompressedH :: (NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
  FilePath ->
  (Tagged Compressed LByteString -> LByteString -> m a) ->
  m a
withCompressedH :: forall a (m :: * -> *).
(NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
FilePath
-> (Tagged Compressed LByteString -> LByteString -> m a) -> m a
withCompressedH FilePath
fp Tagged Compressed LByteString -> LByteString -> m a
a =
  FilePath -> (Handle -> m a) -> m a
forall a (m :: * -> *).
(NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
FilePath -> (Handle -> m a) -> m a
withHandle ($(tr "/fp") FilePath
fp) ((Handle -> m a) -> m a) -> (Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Handle
inH -> Handle -> m LByteString
forall (m :: * -> *). MonadIO m => Handle -> m LByteString
hGetContents Handle
inH m LByteString -> (LByteString -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\LByteString
cbs -> Tagged Compressed LByteString -> LByteString -> m a
a (LByteString -> Tagged Compressed LByteString
forall {k} (s :: k) b. b -> Tagged s b
Tagged LByteString
cbs) (LByteString -> m a) -> LByteString -> m a
forall a b. (a -> b) -> a -> b
$ LByteString -> LByteString
decompress LByteString
cbs)

withCompressed :: (HasCallStack, NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
  FilePath -> (HasCallStack => L.ByteString -> m a) -> m a
withCompressed :: forall a (m :: * -> *).
(HasCallStack, NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
FilePath -> (HasCallStack => LByteString -> m a) -> m a
withCompressed FilePath
fp HasCallStack => LByteString -> m a
a = FilePath
-> (Tagged Compressed LByteString -> LByteString -> m a) -> m a
forall a (m :: * -> *).
(NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
FilePath
-> (Tagged Compressed LByteString -> LByteString -> m a) -> m a
withCompressedH FilePath
fp (\Tagged Compressed LByteString
_cbs LByteString
bs -> HasCallStack => LByteString -> m a
LByteString -> m a
a LByteString
bs)

hGet :: MonadIO m => Handle -> Int -> m ByteString
hGet :: forall (m :: * -> *). MonadIO m => Handle -> Int -> m ByteString
hGet Handle
h Int
n = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
BS.hGet Handle
h Int
n

hGetContents :: MonadIO m => Handle -> m LByteString
hGetContents :: forall (m :: * -> *). MonadIO m => Handle -> m LByteString
hGetContents Handle
h = IO LByteString -> m LByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LByteString -> m LByteString)
-> IO LByteString -> m LByteString
forall a b. (a -> b) -> a -> b
$ Handle -> IO LByteString
L.hGetContents Handle
h

hPut :: MonadIO m => Handle -> LByteString -> m ()
hPut :: forall (m :: * -> *). MonadIO m => Handle -> LByteString -> m ()
hPut Handle
h LByteString
bs = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> LByteString -> IO ()
L.hPut Handle
h LByteString
bs

-- | just 'copyFile' is not possible due to trash after archive
saveCompressedBs :: MonadUnliftIO m => FilePath -> LByteString -> m ()
saveCompressedBs :: forall (m :: * -> *).
MonadUnliftIO m =>
FilePath -> LByteString -> m ()
saveCompressedBs FilePath
fp LByteString
bs = do
  Bool -> FilePath -> m ()
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
createDirectoryIfMissing Bool
False (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropFileName FilePath
fp
  FilePath -> IOMode -> (Handle -> m ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> IOMode -> (Handle -> m a) -> m a
withBinaryFile ($(tr "/fp") FilePath
fp) IOMode
WriteMode ((Handle -> m ()) -> m ()) -> (Handle -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> LByteString -> m ()
forall (m :: * -> *). MonadIO m => Handle -> LByteString -> m ()
hPut Handle
h (LByteString -> m ()) -> LByteString -> m ()
forall a b. (a -> b) -> a -> b
$ LByteString -> LByteString
compress LByteString
bs

readNumber :: MonadIO m => Int -> Int -> m Int
readNumber :: forall (m :: * -> *). MonadIO m => Int -> Int -> m Int
readNumber Int
minVal Int
maxVal = m Int
go
  where
    go :: m Int
go = do
      s <- IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ IO Text
forall (m :: * -> *). MonadIO m => m Text
getLine
      case readMaybe $ toString s of
        Just Int
n
          | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minVal Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxVal ->
            Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n
          | Bool
otherwise -> do
            FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
putStrLn FilePath
"Value is out of range. Try again"
            m Int
go
        Maybe Int
Nothing -> do
            FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
putStrLn FilePath
"Value is number. Try again"
            m Int
go