polysemy-scoped-fs-0.1.0.0: src/Polysemy/FS/Scoped.hs

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

The behavior about file access mode conforms 'System.IO.IOMode' and 'System.IO.openFile'.
-}

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use camelCase" #-}

module Polysemy.FS.Scoped
    ( module Polysemy.FS.Scoped
    , ScopedFile
    , sendBundle_
    , runScopedFile
    )
    where

import Polysemy.Path ( Path, File )
import Polysemy.Bundle ( injBundle, Bundle )
import Polysemy
    ( Member
    , Sem
    , raise2Under
    , raiseUnder
    , subsume
    , InterpretersFor
    , rewrite
    , transform
    )
import Polysemy.Scoped.Path ( ScopedP, scopedP )
import Polysemy.FS.Scoped.Internal
    ( ScopedFile (ScopedFile), sendBundle_, runScopedFile, unScopedFile )
import Polysemy.Input ( Input )
import Polysemy.Internal.Sing ( KnownList )
import Polysemy.Internal.Kind ( Append )
import Control.Category ((>>>))


scopedFile
    ::  ∀accessMode format es b r handle a
    .   (Member (ScopedFile (Mode format accessMode) es b handle) r, KnownList es)
    =>  Path b File -> Sem (Append es (Bundle es ': Input (Path b File) ': r)) a -> Sem r a
scopedFile path = scopedFile_bundle path . sendBundle_

scopedFile_single
    :: ∀accessMode format e es b r handle
    .  (Member (ScopedFile (Mode format accessMode) es b handle) r, Member e es)
    => Path b File -> InterpretersFor '[e, Input (Path b File)] r
scopedFile_single path = scopedFile_bundle path . rewrite injBundle

scopedFile_bundle
    :: ∀accessMode format es b r handle
    .  Member (ScopedFile (Mode format accessMode) es b handle) r
    => Path b File -> InterpretersFor '[Bundle es, Input (Path b File)] r
scopedFile_bundle path = transform ScopedFile . scopedP path . raise2Under


{- | A tag type that represents file open mode in POSIX.
-}
data Mode (fmt :: Format) (acc :: AccessMode)

data Format =
        TextFormat
    |   BytesFormat

data AccessMode =
      ReadAccess
    -- ^read only access mode ('System.IO.ReadMode')

    | WriteAccess
    -- ^write only access mode ('System.IO.WriteMode')

    | AppendAccess
    -- ^append access mode ('System.IO.AppendMode')

    | RwAccess
    -- ^read write access mode ('System.IO.ReadWriteMode')

-- | A type signature of interpreters for scoped file access.
type Access format accessMode es r b =
        ∀a
    .   (∀handle. Sem (ScopedFile (Mode format accessMode) es b handle ': r) a)
    ->  Sem r a


rewriteScopedFile
    ::  (Sem (ScopedP (Path b File) handle (Bundle es) ': r) a -> Sem (ScopedP (Path b' File) handle' (Bundle es') ': r) a)
    ->  Sem (ScopedFile mode es b handle ': r) a
    ->  Sem (ScopedFile mode es' b' handle' ': r) a
rewriteScopedFile f = rewrite unScopedFile >>> f >>> rewrite ScopedFile

transformerToRewriter
    ::  (Sem (e0 ': e1 ': r) a -> Sem (e1 ': r) a)
    ->  Sem (e0 ': r) a -> Sem (e1 ': r) a
transformerToRewriter f = raiseUnder >>> f

rewriterToTransformer
    ::  (∀r. Sem (e0 ': r) a -> Sem (e1 ': r) a)
    ->  (∀r. Member e1 r' => Sem (e0 ': r') a -> Sem r' a)
rewriterToTransformer f = f >>> subsume