Internal.hs

{-|
Copyright   : (c) Hisaket VioletRed, 2022
License     : AGPL-3.0-or-later
Maintainer  : hisaket@outlook.jp
Stability   : experimental
Portability : POSIX
-}

module Polysemy.FS.Scoped.ByteString.Internal where
import Polysemy
    ( Member, Sem, embed, Embed, InterpretersFor, Members, interpret )
import qualified Polysemy.SequentialAccess.ByteString as SAB
import qualified Polysemy.SequentialAccess as SA
import qualified Data.ByteString as BS
import qualified GHC.IO.Handle as IO
import qualified System.IO as IO
import Control.Category ( (>>>) )
import Polysemy.FS.Scoped.Internal ( seekToEnd )
import Polysemy.Internal.Kind ( Append )
import Polysemy.Resource ( Resource )
import Polysemy.Internal.Sing ( KnownList )
import qualified Polysemy.FS.Scoped.Internal as Scoped

readToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAB.ReadBytes ': SAB.ReadToEnd ': r) a -> Sem r a
readToIO h =
        interpret (\(SA.Read n) -> embed $ BS.hGet h $ fromIntegral n)
    >>> interpret
            ( \(SA.Read SA.ToEnd) ->
                embed $ (BS.hGetContents =<< IO.hDuplicate h) <* seekToEnd h
            )

cursorToIO :: Member (Embed IO) r => IO.Handle -> Sem (Append SAB.Cursor r) a -> Sem r a
cursorToIO h =
        interpret (\SA.GetPosition -> embed $ fromIntegral <$> IO.hTell h)
    >>> interpret (\(SA.Seek (SA.Absolute n)) -> embed $ IO.hSeek h IO.AbsoluteSeek $ fromIntegral n)
    >>> interpret (\(SA.Seek (SA.Relative i)) -> embed $ IO.hSeek h IO.RelativeSeek i)
    >>> interpret (\(SA.Seek (SA.FromEnd i)) -> embed $ IO.hSeek h IO.SeekFromEnd i)

overwriteToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAB.Overwrite ': r) a -> Sem r a
overwriteToIO h = interpret \(SA.Overwrite s) -> embed $ BS.hPut h s

resizeToIO :: Member (Embed IO) r => IO.Handle -> Sem (SAB.Resize ': r) a -> Sem r a
resizeToIO h = interpret \(SA.Resize n) -> embed $ IO.hSetFileSize h $ fromIntegral n

scopedBinaryFileToIO
    ::  (Members '[Embed IO, Resource] r, KnownList es)
    =>  IO.IOMode
    ->  (IO.Handle -> InterpretersFor es r)
    ->  (∀handle'. Sem (Scoped.ScopedFile mode es b handle' ': r) a)
    ->  Sem r a
scopedBinaryFileToIO = Scoped.scopedFileToIO IO.openBinaryFile