Io.hs

module Lazy.Scope.Io where

import Control.DeepSeq (NFData)
import Control.Monad.Trans.Class (MonadTrans(lift))
import Data.ByteString qualified as S
import Data.ByteString.Lazy qualified as L
import Foreign.Ptr (Ptr)
import Lazy.Scope.Type (LazyT(..), HandlePosn(..), Handle(..), Bs, Scoped(Scoped))
import Relude
    ( ($), ($!), (<$>),
      Bool(..),
      ByteString,
      Char,
      Show,
      String,
      Maybe (..),
      Integer,
      Int,
      MonadIO(..),
      FilePath,
      IOMode )
import System.IO qualified as IO
import System.IO (SeekMode (..), BufferMode, TextEncoding, NewlineMode)
import UnliftIO (MonadUnliftIO (..))
import UnliftIO.IO qualified as U

class WithFile a where
  withFile       :: (NFData r, MonadUnliftIO m) =>
    a -> IOMode -> (forall s. Handle s -> LazyT s m r) -> m r
  withBinaryFile :: (NFData r, MonadUnliftIO m) =>
    a -> IOMode -> (forall s. Handle s -> LazyT s m r) -> m r

instance WithFile FilePath where
  {-# INLINE withFile #-}
  withFile fp mode cb =
    U.withFile fp mode (\h -> unLazy (cb (Handle h)))
  {-# INLINE withBinaryFile #-}
  withBinaryFile fp mode cb =
    U.withBinaryFile fp mode (\h -> unLazy (cb (Handle h)))

hSeek :: MonadIO m => Handle s -> SeekMode -> Integer -> LazyT s m ()
hSeek (Handle h) sm n = LazyT $! U.hSeek h sm n
{-# INLINE hSeek #-}

hTell :: MonadIO m => Handle s -> LazyT s m Integer
hTell (Handle h) = lift $! U.hTell h
{-# INLINE hTell #-}

hSetPosn :: MonadIO m => HandlePosn s -> LazyT s m ()
hSetPosn (HandlePosn hpn) = lift (liftIO $! IO.hSetPosn hpn)

hGetPosn :: MonadIO m => Handle s -> LazyT s m (HandlePosn s)
hGetPosn (Handle h) = lift (liftIO $! HandlePosn <$> IO.hGetPosn h)

hFlush :: MonadIO m => Handle s -> LazyT s m ()
hFlush (Handle h) = lift (U.hFlush h)

hGetBuffering :: MonadIO m => Handle s -> LazyT s m BufferMode
hGetBuffering (Handle h) = lift (U.hGetBuffering h)

hSetBuffering :: MonadIO m => Handle s -> BufferMode -> LazyT s m ()
hSetBuffering (Handle h) bm = lift (U.hSetBuffering h bm)

hIsEOF :: MonadIO m => Handle s -> LazyT s m Bool
hIsEOF (Handle h) = lift (U.hIsEOF h)

hSetFileSize :: MonadIO m => Handle s -> Integer -> LazyT s m ()
hSetFileSize (Handle h) n = lift (U.hSetFileSize h n)

hFileSize :: MonadIO m => Handle s -> LazyT s m Integer
hFileSize (Handle h) = lift (U.hFileSize h)

hSetEncoding :: MonadIO m => Handle s -> TextEncoding -> LazyT s m ()
hSetEncoding (Handle h) te = lift (liftIO $ IO.hSetEncoding h te)

hGetEncoding :: MonadIO m => Handle s -> LazyT s m (Maybe TextEncoding)
hGetEncoding (Handle h) = lift (liftIO $ IO.hGetEncoding h)

hSetBinaryMode :: MonadIO m => Handle s -> Bool -> LazyT s m ()
hSetBinaryMode (Handle h) b = lift (liftIO $ IO.hSetBinaryMode h b)

hPutBuf :: MonadIO m => Handle s -> Ptr a -> Int -> LazyT s m ()
hPutBuf (Handle h) p n = lift (liftIO $ IO.hPutBuf h p n)

hGetBuf :: MonadIO m => Handle s -> Ptr a -> Int -> LazyT s m Int
hGetBuf (Handle h) p n = lift (liftIO $ IO.hGetBuf h p n)

hGetBufSome :: MonadIO m => Handle s -> Ptr a -> Int -> LazyT s m Int
hGetBufSome (Handle h) p n = lift (liftIO $ IO.hGetBufSome h p n)

hPutBufNonBlocking :: MonadIO m => Handle s -> Ptr a -> Int -> LazyT s m Int
hPutBufNonBlocking (Handle h) p n = lift (liftIO $ IO.hPutBufNonBlocking h p n)

hGetBufNonBlocking :: MonadIO m => Handle s -> Ptr a -> Int -> LazyT s m Int
hGetBufNonBlocking (Handle h) p n = lift (liftIO $ IO.hGetBufNonBlocking h p n)

hSetNewlineMode :: MonadIO m => Handle s -> NewlineMode -> LazyT s m ()
hSetNewlineMode (Handle h) nlm = lift (liftIO $ IO.hSetNewlineMode h nlm)

hPrint :: (MonadIO m, Show a) => Handle s -> a -> LazyT s m ()
hPrint (Handle h) a = lift (liftIO $ IO.hPrint h a)

hGetChar :: MonadIO m => Handle s -> LazyT s m Char
hGetChar (Handle h) = lift (liftIO $ IO.hGetChar h)

hReady :: MonadIO m => Handle s -> LazyT s m Bool
hReady (Handle h) = lift (U.hReady h)

hWaitForInput :: MonadIO m => Handle s -> Int -> LazyT s m Bool
hWaitForInput (Handle h) n = lift (U.hWaitForInput h n)

hShow :: MonadIO m => Handle s -> LazyT s m String
hShow (Handle h) = lift $ (liftIO $ IO.hShow h)

hGetEcho :: MonadIO m => Handle s -> LazyT s m Bool
hGetEcho (Handle h) = lift (U.hGetEcho h)

hSetEcho :: MonadIO m => Handle s -> Bool -> LazyT s m ()
hSetEcho (Handle h) eb = lift (U.hSetEcho h eb)

hIsTerminalDevice :: MonadIO m => Handle s -> LazyT s m Bool
hIsTerminalDevice (Handle h) = lift (U.hIsTerminalDevice h)

hIsSeekable :: MonadIO m => (Handle s) -> LazyT s m Bool
hIsSeekable (Handle h) = lift (U.hIsSeekable h)

hIsWritable :: MonadIO m => Handle s -> LazyT s m Bool
hIsWritable (Handle h) = lift (U.hIsWritable h)

hIsReadable :: MonadIO m => Handle s -> LazyT s m Bool
hIsReadable (Handle h) = lift (U.hIsReadable h)

hPutStrLn :: MonadIO m => Handle s -> String -> LazyT s m ()
hPutStrLn (Handle h) s = lift (liftIO $ IO.hPutStrLn h s)

hPutStr :: MonadIO m => Handle s -> String -> LazyT s m ()
hPutStr (Handle h) s = lift (liftIO $ IO.hPutStr h s)

hPutBs :: MonadIO m => Handle s -> Bs s -> LazyT s m ()
hPutBs (Handle h) (Scoped lbs) = LazyT (liftIO $ L.hPut h lbs)

hPut :: MonadIO m => Handle s -> L.ByteString -> LazyT s m ()
hPut (Handle h) lbs = LazyT (liftIO $ L.hPut h lbs)

hPutChar :: MonadIO m => Handle s -> Char -> LazyT s m ()
hPutChar (Handle h) c = lift (liftIO $ IO.hPutChar h c)

hLookAhead :: MonadIO m => Handle s -> LazyT s m Char
hLookAhead (Handle h) = lift (liftIO $ IO.hLookAhead h)

hGetLine :: MonadIO m => Handle s -> LazyT s m String
hGetLine (Handle h) = lift (liftIO $ IO.hGetLine h)

hGet :: MonadIO m => Handle s -> Int -> LazyT s m ByteString
hGet (Handle h) n = lift (liftIO $ S.hGet h n)