{-| 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...