Oneshot.hs

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

Unscoped file access and interop with polysemy-fs package.
-}

{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use camelCase" #-}
{-# LANGUAGE PartialTypeSignatures #-}

module Polysemy.FS.Scoped.Oneshot where

import Polysemy ( Member, Sem, Members, interpret )
import Polysemy.FS.Scoped
    ( ScopedFile
    , AccessMode (ReadAccess, AppendAccess, WriteAccess)
    , Format (TextFormat, BytesFormat)
    , Mode
    , scopedFile_single
    )
import qualified Polysemy.SequentialAccess.Text as SAT
import qualified Polysemy.SequentialAccess.ByteString as SAB
import qualified Polysemy.SequentialAccess as SA
import Polysemy.Path
    ( toFilePath
    , parseSomeFile
    , Path
    , Abs
    , File
    , PathException
    , Rel
    , SomeBase
    )
import Polysemy.Error ( Error )
import Control.Category ( (>>>) )
import qualified Data.ByteString as BS
import Path ( SomeBase (..) )
import Prelude hiding ( readFile, appendFile )
import qualified Polysemy.FS.Scoped.Text as ST
import qualified Polysemy.FS.Scoped.ByteString as SB
import Polysemy.FS
    ( FSRead (ReadFileBS, ReadFileUtf8)
    , FSWrite (WriteFileBS, WriteFileUtf8)
    )

readFile
    ::  (Member (ScopedFile (Mode fmt ReadAccess) es b handle) r, Member (SA.Read SA.ToEnd i) es)
    =>  Path b File -> Sem r i
readFile path = scopedFile_single path $ SA.read SA.ToEnd

overwriteFile
    ::  (Member (ScopedFile (Mode fmt WriteAccess) es b handle) r, Member (SA.Overwrite o) es)
    =>  Path b File -> o -> Sem r ()
overwriteFile path o = scopedFile_single path $ SA.overwrite o

extendFile
    ::  (Member (ScopedFile (Mode fmt WriteAccess) es b handle) r, Member (SA.Extend o) es)
    =>  Path b File -> o -> Sem r ()
extendFile path o = scopedFile_single path $ SA.extend o

appendFile
    ::  (Member (ScopedFile (Mode fmt AppendAccess) es b handle) r, Member (SA.Append o) es)
    =>  Path b File -> o -> Sem r ()
appendFile path o = scopedFile_single path $ SA.append o

readFile_single
    ::  Member (ScopedFile (Mode fmt ReadAccess) '[SA.Read SA.ToEnd i] b handle) r
    =>  Path b File -> Sem r i
readFile_single = readFile

overwriteFile_single
    ::  Member (ScopedFile (Mode fmt WriteAccess) '[SA.Overwrite o] b handle) r
    =>  Path b File -> o -> Sem r ()
overwriteFile_single = overwriteFile

extendFile_single
    ::  Member (ScopedFile (Mode fmt WriteAccess) '[SA.Extend o] b handle) r
    =>  Path b File -> o -> Sem r ()
extendFile_single = extendFile

appendFile_single
    ::  Member (ScopedFile (Mode fmt AppendAccess) '[SA.Append o] b handle) r
    =>  Path b File -> o -> Sem r ()
appendFile_single = appendFile



{- | Example:

>>> import Polysemy.Resource ( resourceToIO )
>>> import qualified Polysemy.FS.Scoped.Text as ST
>>> import qualified Polysemy.FS.Scoped.ByteString as SB
>>> import Polysemy.Scoped.Path ( weakenScopedP )
>>> import Polysemy.FS.Scoped ( rewriteScopedFile, transformerToRewriter )
>>> import Polysemy ( runFinal, embedToFinal, subsume_ )
>>> import Polysemy.Error ( errorToIOFinal )
>>> :{
    fsReadToIO :: Sem '[FSRead] a -> IO (Either PathException a)
    fsReadToIO m =
        runFinal $ embedToFinal $ resourceToIO $ errorToIOFinal
            $   ST.readAccessToIO $ rewriteScopedFile (transformerToRewriter $ weakenScopedP @'[SAT.ReadToEnd] @_ @(Path Abs _))
            $   ST.readAccessToIO $ rewriteScopedFile (transformerToRewriter $ weakenScopedP @'[SAT.ReadToEnd] @_ @(Path Rel _))
            $   SB.readAccessToIO $ rewriteScopedFile (transformerToRewriter $ weakenScopedP @'[SAB.ReadToEnd] @_ @(Path Abs _))
            $   SB.readAccessToIO $ rewriteScopedFile (transformerToRewriter $ weakenScopedP @'[SAB.ReadToEnd] @_ @(Path Rel _))
            $   fsReadToScopedRead
            $   subsume_ m
:}

-}

fsReadToScopedRead
    ::  ∀handle0 handle1 handle2 handle3 r a
    .   Members
            '[  ScopedFile (Mode BytesFormat ReadAccess) '[SAB.ReadToEnd] Abs handle0
            ,   ScopedFile (Mode BytesFormat ReadAccess) '[SAB.ReadToEnd] Rel handle1
            ,   ScopedFile (Mode TextFormat ReadAccess) '[SAT.ReadToEnd] Abs handle2
            ,   ScopedFile (Mode TextFormat ReadAccess) '[SAT.ReadToEnd] Rel handle3
            ,   Error PathException
            ] r
    =>  Sem (FSRead ': r) a
    ->  Sem r a
fsReadToScopedRead = interpret \case
    ReadFileBS path ->
        toSomeBase path >>= \case
            Abs path -> readFile @BytesFormat path
            Rel path -> readFile @BytesFormat path
    ReadFileUtf8 path ->
        toSomeBase path >>= \case
            Abs path -> readFile @TextFormat path
            Rel path -> readFile @TextFormat path

fsWriteToScopedWrite
    ::  ∀handle0 handle1 handle2 handle3 r a
    .   Members
            '[  ScopedFile (Mode BytesFormat WriteAccess) '[SAB.Overwrite] Abs handle0
            ,   ScopedFile (Mode BytesFormat WriteAccess) '[SAB.Overwrite] Rel handle1
            ,   ScopedFile (Mode TextFormat WriteAccess) '[SAT.Extend] Abs handle2
            ,   ScopedFile (Mode TextFormat WriteAccess) '[SAT.Extend] Rel handle3
            ,   Error PathException
            ] r
    =>  Sem (FSWrite ': r) a
    ->  Sem r a
fsWriteToScopedWrite = interpret \case
    WriteFileBS path content ->
        toSomeBase path >>= \case
            Abs path -> overwriteFile @BytesFormat path content
            Rel path -> overwriteFile @BytesFormat path content
    WriteFileUtf8 path content ->
        toSomeBase path >>= \case
            Abs path -> extendFile @TextFormat path content
            Rel path -> extendFile @TextFormat path content

toSomeBase :: Members '[Error PathException] r => Path b File -> Sem r (SomeBase File)
toSomeBase = toFilePath >>> parseSomeFile
-- Perhaps, an error can't occur definitely so the error effect can be removed...