ByteString.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 where

import Polysemy ( embed, Embed, Members, interpret )
import Polysemy.Resource ( Resource )
import Polysemy.FS.Scoped
    ( Access
    , AccessMode ( ReadAccess, WriteAccess )
    , Format ( BytesFormat )
    )
import Polysemy.SequentialAccess.ByteString as SAB
    ( Cursor, Resize, Append, Overwrite, ReadToEnd, ReadBytes )
import qualified System.IO as IO

import Polysemy.FS.Scoped.ByteString.Internal
import Control.Category hiding ((.))
import qualified Polysemy.SequentialAccess as SA
import qualified Data.ByteString as BS


-- | An interpreter for read open mode with binary.
readAccessToIO
    ::  Members '[Embed IO, Resource] r
    =>  Access BytesFormat ReadAccess (SAB.ReadBytes ': SAB.ReadToEnd ': SAB.Cursor) r b
readAccessToIO =
    scopedBinaryFileToIO IO.ReadMode
        \h -> readToIO h >>> cursorToIO h

-- | An interpreter for write open mode with binary.
writeAccessToIO
    ::  Members '[Embed IO, Resource] r
    =>  Access BytesFormat WriteAccess (SAB.Overwrite ': SAB.Resize ': SAB.Cursor) r b
writeAccessToIO =
    scopedBinaryFileToIO IO.WriteMode
        \h -> overwriteToIO h >>> resizeToIO h >>> cursorToIO h

-- | An interpreter for read and write open mode with binary.
rwAccessToIO
    ::  Members '[Embed IO, Resource] r
    =>  Access BytesFormat WriteAccess
            (SAB.ReadBytes ': SAB.ReadToEnd ': SAB.Overwrite ': SAB.Resize ': SAB.Cursor) r b
rwAccessToIO =
    scopedBinaryFileToIO IO.ReadWriteMode
        \h -> readToIO h >>> overwriteToIO h >>> resizeToIO h >>> cursorToIO h

-- | An interpreter for append open mode with binary.
appendAccessToIO
    ::  Members '[Embed IO, Resource] r
    =>  Access BytesFormat WriteAccess '[SAB.Append, SAB.Resize] r b
appendAccessToIO =
    scopedBinaryFileToIO IO.AppendMode
        \h -> resizeToIO h . interpret (\(SA.Append s) -> embed $ BS.hPut h s)