{-|
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 :: Access
  'BytesFormat 'ReadAccess (ReadBytes : ReadToEnd : Cursor) r b
readAccessToIO =
    IOMode
-> (Handle -> InterpretersFor (ReadBytes : ReadToEnd : Cursor) r)
-> (forall handle.
    Sem
      (ScopedFile
         (Mode 'BytesFormat 'ReadAccess)
         (ReadBytes : ReadToEnd : Cursor)
         b
         handle
         : r)
      a)
-> Sem r a
forall k (r :: EffectRow) (es :: EffectRow) (mode :: k) b a.
(Members '[Embed IO, Resource] r, KnownList es) =>
IOMode
-> (Handle -> InterpretersFor es r)
-> (forall handle'. Sem (ScopedFile mode es b handle' : r) a)
-> Sem r a
scopedBinaryFileToIO IOMode
IO.ReadMode
        \Handle
h -> Handle
-> Sem
     (ReadBytes
        : ReadToEnd : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem
     (GetPosition Natural
        : Seek (Absolute Natural) : Seek (Relative Integer)
        : Seek (FromEnd Integer) : r)
     a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (ReadBytes : ReadToEnd : r) a -> Sem r a
readToIO Handle
h (Sem
   (ReadBytes
      : ReadToEnd : GetPosition Natural : Seek (Absolute Natural)
      : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
   a
 -> Sem
      (GetPosition Natural
         : Seek (Absolute Natural) : Seek (Relative Integer)
         : Seek (FromEnd Integer) : r)
      a)
-> (Sem
      (GetPosition Natural
         : Seek (Absolute Natural) : Seek (Relative Integer)
         : Seek (FromEnd Integer) : r)
      a
    -> Sem r a)
-> Sem
     (ReadBytes
        : ReadToEnd : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Handle -> Sem (Append Cursor r) a -> Sem r a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (Append Cursor r) a -> Sem r a
cursorToIO Handle
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 :: Access 'BytesFormat 'WriteAccess (Overwrite : Resize : Cursor) r b
writeAccessToIO =
    IOMode
-> (Handle -> InterpretersFor (Overwrite : Resize : Cursor) r)
-> (forall handle.
    Sem
      (ScopedFile
         (Mode 'BytesFormat 'WriteAccess)
         (Overwrite : Resize : Cursor)
         b
         handle
         : r)
      a)
-> Sem r a
forall k (r :: EffectRow) (es :: EffectRow) (mode :: k) b a.
(Members '[Embed IO, Resource] r, KnownList es) =>
IOMode
-> (Handle -> InterpretersFor es r)
-> (forall handle'. Sem (ScopedFile mode es b handle' : r) a)
-> Sem r a
scopedBinaryFileToIO IOMode
IO.WriteMode
        \Handle
h -> Handle
-> Sem
     (Overwrite
        : Resize : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem
     (Resize
        : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (Overwrite : r) a -> Sem r a
overwriteToIO Handle
h (Sem
   (Overwrite
      : Resize : GetPosition Natural : Seek (Absolute Natural)
      : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
   a
 -> Sem
      (Resize
         : GetPosition Natural : Seek (Absolute Natural)
         : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
      a)
-> (Sem
      (Resize
         : GetPosition Natural : Seek (Absolute Natural)
         : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
      a
    -> Sem r a)
-> Sem
     (Overwrite
        : Resize : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Handle
-> Sem
     (Resize
        : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem
     (GetPosition Natural
        : Seek (Absolute Natural) : Seek (Relative Integer)
        : Seek (FromEnd Integer) : r)
     a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (Resize : r) a -> Sem r a
resizeToIO Handle
h (Sem
   (Resize
      : GetPosition Natural : Seek (Absolute Natural)
      : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
   a
 -> Sem
      (GetPosition Natural
         : Seek (Absolute Natural) : Seek (Relative Integer)
         : Seek (FromEnd Integer) : r)
      a)
-> (Sem
      (GetPosition Natural
         : Seek (Absolute Natural) : Seek (Relative Integer)
         : Seek (FromEnd Integer) : r)
      a
    -> Sem r a)
-> Sem
     (Resize
        : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Handle -> Sem (Append Cursor r) a -> Sem r a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (Append Cursor r) a -> Sem r a
cursorToIO Handle
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 :: Access
  'BytesFormat
  'WriteAccess
  (ReadBytes : ReadToEnd : Overwrite : Resize : Cursor)
  r
  b
rwAccessToIO =
    IOMode
-> (Handle
    -> InterpretersFor
         (ReadBytes : ReadToEnd : Overwrite : Resize : Cursor) r)
-> (forall handle.
    Sem
      (ScopedFile
         (Mode 'BytesFormat 'WriteAccess)
         (ReadBytes : ReadToEnd : Overwrite : Resize : Cursor)
         b
         handle
         : r)
      a)
-> Sem r a
forall k (r :: EffectRow) (es :: EffectRow) (mode :: k) b a.
(Members '[Embed IO, Resource] r, KnownList es) =>
IOMode
-> (Handle -> InterpretersFor es r)
-> (forall handle'. Sem (ScopedFile mode es b handle' : r) a)
-> Sem r a
scopedBinaryFileToIO IOMode
IO.ReadWriteMode
        \Handle
h -> Handle
-> Sem
     (ReadBytes
        : ReadToEnd : Overwrite : Resize : GetPosition Natural
        : Seek (Absolute Natural) : Seek (Relative Integer)
        : Seek (FromEnd Integer) : r)
     a
-> Sem
     (Overwrite
        : Resize : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (ReadBytes : ReadToEnd : r) a -> Sem r a
readToIO Handle
h (Sem
   (ReadBytes
      : ReadToEnd : Overwrite : Resize : GetPosition Natural
      : Seek (Absolute Natural) : Seek (Relative Integer)
      : Seek (FromEnd Integer) : r)
   a
 -> Sem
      (Overwrite
         : Resize : GetPosition Natural : Seek (Absolute Natural)
         : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
      a)
-> (Sem
      (Overwrite
         : Resize : GetPosition Natural : Seek (Absolute Natural)
         : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
      a
    -> Sem r a)
-> Sem
     (ReadBytes
        : ReadToEnd : Overwrite : Resize : GetPosition Natural
        : Seek (Absolute Natural) : Seek (Relative Integer)
        : Seek (FromEnd Integer) : r)
     a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Handle
-> Sem
     (Overwrite
        : Resize : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem
     (Resize
        : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (Overwrite : r) a -> Sem r a
overwriteToIO Handle
h (Sem
   (Overwrite
      : Resize : GetPosition Natural : Seek (Absolute Natural)
      : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
   a
 -> Sem
      (Resize
         : GetPosition Natural : Seek (Absolute Natural)
         : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
      a)
-> (Sem
      (Resize
         : GetPosition Natural : Seek (Absolute Natural)
         : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
      a
    -> Sem r a)
-> Sem
     (Overwrite
        : Resize : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Handle
-> Sem
     (Resize
        : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem
     (GetPosition Natural
        : Seek (Absolute Natural) : Seek (Relative Integer)
        : Seek (FromEnd Integer) : r)
     a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (Resize : r) a -> Sem r a
resizeToIO Handle
h (Sem
   (Resize
      : GetPosition Natural : Seek (Absolute Natural)
      : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
   a
 -> Sem
      (GetPosition Natural
         : Seek (Absolute Natural) : Seek (Relative Integer)
         : Seek (FromEnd Integer) : r)
      a)
-> (Sem
      (GetPosition Natural
         : Seek (Absolute Natural) : Seek (Relative Integer)
         : Seek (FromEnd Integer) : r)
      a
    -> Sem r a)
-> Sem
     (Resize
        : GetPosition Natural : Seek (Absolute Natural)
        : Seek (Relative Integer) : Seek (FromEnd Integer) : r)
     a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Handle -> Sem (Append Cursor r) a -> Sem r a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (Append Cursor r) a -> Sem r a
cursorToIO Handle
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 :: Access 'BytesFormat 'WriteAccess '[Append, Resize] r b
appendAccessToIO =
    IOMode
-> (Handle -> InterpretersFor '[Append, Resize] r)
-> (forall handle.
    Sem
      (ScopedFile
         (Mode 'BytesFormat 'WriteAccess) '[Append, Resize] b handle
         : r)
      a)
-> Sem r a
forall k (r :: EffectRow) (es :: EffectRow) (mode :: k) b a.
(Members '[Embed IO, Resource] r, KnownList es) =>
IOMode
-> (Handle -> InterpretersFor es r)
-> (forall handle'. Sem (ScopedFile mode es b handle' : r) a)
-> Sem r a
scopedBinaryFileToIO IOMode
IO.AppendMode
        \Handle
h -> Handle -> Sem (Resize : r) a -> Sem r a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (Resize : r) a -> Sem r a
resizeToIO Handle
h (Sem (Resize : r) a -> Sem r a)
-> (Sem (Append : Resize : r) a -> Sem (Resize : r) a)
-> Sem (Append : Resize : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (rInitial :: EffectRow) x.
 Append ByteString (Sem rInitial) x -> Sem (Resize : r) x)
-> Sem (Append : Resize : r) a -> Sem (Resize : r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret (\(SA.Append s) -> IO () -> Sem (Resize : r) ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem (Resize : r) ()) -> IO () -> Sem (Resize : r) ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
BS.hPut Handle
h ByteString
s)