-- Deactivate warning because it is painful to refactor functions with two
-- rebinded-do with different bind functions. Such as in the 'run'
-- function. Which is a good argument for having support for F#-style builders.
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_HADDOCK hide #-}

module System.IO.Resource.Linear.Internal where

import Control.Exception (finally, mask, onException)
import qualified Control.Functor.Linear as Control
import qualified Control.Monad as Ur (fmap)
import Data.Coerce
import qualified Data.Functor.Linear as Data
import Data.IORef (IORef)
import qualified Data.IORef as System
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Monoid (Ap (..))
import Data.Text (Text)
import qualified Data.Text.IO as Text
import Prelude.Linear hiding (IO)
import qualified System.IO as System
import qualified System.IO.Linear as Linear
import qualified Prelude

-- XXX: This would be better as a multiplicity-parametric relative monad, but
-- until we have multiplicity polymorphism, we use a linear monad.

newtype ReleaseMap = ReleaseMap (IntMap (Linear.IO ()))

-- | The resource-aware I/O monad. This monad guarantees that acquired resources
-- are always released.
newtype RIO a = RIO (IORef ReleaseMap -> Linear.IO a)
  deriving ((forall a b. (a %1 -> b) -> RIO a %1 -> RIO b) -> Functor RIO
forall a b. (a %1 -> b) -> RIO a %1 -> RIO b
forall (f :: * -> *).
(forall a b. (a %1 -> b) -> f a %1 -> f b) -> Functor f
fmap :: forall a b. (a %1 -> b) -> RIO a %1 -> RIO b
$cfmap :: forall a b. (a %1 -> b) -> RIO a %1 -> RIO b
Data.Functor, Functor RIO
Functor RIO
-> (forall a. a -> RIO a)
-> (forall a b. RIO (a %1 -> b) %1 -> RIO a %1 -> RIO b)
-> (forall a b c.
    (a %1 -> b %1 -> c) -> RIO a %1 -> RIO b %1 -> RIO c)
-> Applicative RIO
forall a. a -> RIO a
forall a b. RIO (a %1 -> b) %1 -> RIO a %1 -> RIO b
forall a b c. (a %1 -> b %1 -> c) -> RIO a %1 -> RIO b %1 -> RIO c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a %1 -> b) %1 -> f a %1 -> f b)
-> (forall a b c. (a %1 -> b %1 -> c) -> f a %1 -> f b %1 -> f c)
-> Applicative f
liftA2 :: forall a b c. (a %1 -> b %1 -> c) -> RIO a %1 -> RIO b %1 -> RIO c
$cliftA2 :: forall a b c. (a %1 -> b %1 -> c) -> RIO a %1 -> RIO b %1 -> RIO c
<*> :: forall a b. RIO (a %1 -> b) %1 -> RIO a %1 -> RIO b
$c<*> :: forall a b. RIO (a %1 -> b) %1 -> RIO a %1 -> RIO b
pure :: forall a. a -> RIO a
$cpure :: forall a. a -> RIO a
Data.Applicative) via (Control.Data RIO)
  deriving (RIO a %1 -> RIO a %1 -> RIO a
(RIO a %1 -> RIO a %1 -> RIO a) -> Semigroup (RIO a)
forall a. Semigroup a => RIO a %1 -> RIO a %1 -> RIO a
forall a. (a %1 -> a %1 -> a) -> Semigroup a
<> :: RIO a %1 -> RIO a %1 -> RIO a
$c<> :: forall a. Semigroup a => RIO a %1 -> RIO a %1 -> RIO a
Semigroup, Semigroup (RIO a)
RIO a
Semigroup (RIO a) -> RIO a -> Monoid (RIO a)
forall a. Semigroup a -> a -> Monoid a
forall {a}. Monoid a => Semigroup (RIO a)
forall a. Monoid a => RIO a
mempty :: RIO a
$cmempty :: forall a. Monoid a => RIO a
Monoid) via (Ap RIO a)

unRIO :: RIO a %1 -> IORef ReleaseMap -> Linear.IO a
unRIO :: forall a. RIO a %1 -> IORef ReleaseMap -> IO a
unRIO (RIO IORef ReleaseMap -> IO a
action) = IORef ReleaseMap -> IO a
action

-- | Take a @RIO@ computation with a value @a@ that is not linearly bound and
-- make it a "System.IO" computation.
run :: RIO (Ur a) -> System.IO a
run :: forall a. RIO (Ur a) -> IO a
run (RIO IORef ReleaseMap -> IO (Ur a)
action) = do
  IORef ReleaseMap
rrm <- ReleaseMap -> IO (IORef ReleaseMap)
forall a. a -> IO (IORef a)
System.newIORef (IntMap (IO ()) -> ReleaseMap
ReleaseMap IntMap (IO ())
forall a. IntMap a
IntMap.empty)
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask
    ( \forall a. IO a -> IO a
restore ->
        IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
onException
          (IO a -> IO a
forall a. IO a -> IO a
restore (IO (Ur a) -> IO a
forall a. IO (Ur a) -> IO a
Linear.withLinearIO (IORef ReleaseMap -> IO (Ur a)
action IORef ReleaseMap
rrm)))
          ( do
              -- release stray resources
              ReleaseMap IntMap (IO ())
releaseMap <- IORef ReleaseMap -> IO ReleaseMap
forall a. IORef a -> IO a
System.readIORef IORef ReleaseMap
rrm
              [IO ()] -> IO ()
safeRelease ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ ((Key, IO ()) -> IO ()) -> [(Key, IO ())] -> [IO ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Ur.fmap (Key, IO ()) -> IO ()
forall a b. (a, b) -> b
snd ([(Key, IO ())] -> [IO ()]) -> [(Key, IO ())] -> [IO ()]
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ IntMap (IO ()) -> [(Key, IO ())]
forall a. IntMap a -> [(Key, a)]
IntMap.toList IntMap (IO ())
releaseMap
          )
    )
  where
    -- Remarks: resources are guaranteed to be released on non-exceptional
    -- return. So, contrary to a standard bracket/ResourceT implementation, we
    -- only release exceptions in the release map upon exception.

    safeRelease :: [Linear.IO ()] -> System.IO ()
    safeRelease :: [IO ()] -> IO ()
safeRelease [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return ()
    safeRelease (IO ()
finalizer : [IO ()]
fs) =
      IO (Ur ()) -> IO ()
forall a. IO (Ur a) -> IO a
Linear.withLinearIO (IO () %1 -> IO (Ur ())
forall a. Movable a => IO a %1 -> IO (Ur a)
moveLinearIO IO ()
finalizer)
        IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` [IO ()] -> IO ()
safeRelease [IO ()]
fs
    -- Should be just an application of a linear `(<$>)`.
    moveLinearIO :: Movable a => Linear.IO a %1 -> Linear.IO (Ur a)
    moveLinearIO :: forall a. Movable a => IO a %1 -> IO (Ur a)
moveLinearIO IO a
action' = Control.do
      a
result <- IO a
action'
      Ur a %1 -> IO (Ur a)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Ur a %1 -> IO (Ur a)) -> Ur a %1 -> IO (Ur a)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ a %1 -> Ur a
forall a. Movable a => a %1 -> Ur a
move a
result

-- | Should not be applied to a function that acquires or releases resources.
unsafeFromSystemIO :: System.IO a %1 -> RIO a
unsafeFromSystemIO :: forall a. IO a %1 -> RIO a
unsafeFromSystemIO IO a
action = (IORef ReleaseMap -> IO a) %1 -> RIO a
forall a. (IORef ReleaseMap -> IO a) -> RIO a
RIO (\IORef ReleaseMap
_ -> IO a %1 -> IO a
forall a. IO a %1 -> IO a
Linear.fromSystemIO IO a
action)

-- monad

instance Control.Functor RIO where
  fmap :: forall a b. (a %1 -> b) %1 -> RIO a %1 -> RIO b
fmap a %1 -> b
f (RIO IORef ReleaseMap -> IO a
action) = (IORef ReleaseMap -> IO b) %1 -> RIO b
forall a. (IORef ReleaseMap -> IO a) -> RIO a
RIO ((IORef ReleaseMap -> IO b) %1 -> RIO b)
-> (IORef ReleaseMap -> IO b) %1 -> RIO b
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \IORef ReleaseMap
releaseMap ->
    (a %1 -> b) %1 -> IO a %1 -> IO b
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.fmap a %1 -> b
f (IORef ReleaseMap -> IO a
action IORef ReleaseMap
releaseMap)

instance Control.Applicative RIO where
  pure :: forall a. a %1 -> RIO a
pure a
a = (IORef ReleaseMap -> IO a) %1 -> RIO a
forall a. (IORef ReleaseMap -> IO a) -> RIO a
RIO ((IORef ReleaseMap -> IO a) %1 -> RIO a)
-> (IORef ReleaseMap -> IO a) %1 -> RIO a
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \IORef ReleaseMap
_releaseMap -> a %1 -> IO a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure a
a
  <*> :: forall a b. RIO (a %1 -> b) %1 -> RIO a %1 -> RIO b
(<*>) = RIO (a %1 -> b) %1 -> RIO a %1 -> RIO b
forall (m :: * -> *) a b.
Monad m =>
m (a %1 -> b) %1 -> m a %1 -> m b
Control.ap

instance Control.Monad RIO where
  RIO a
x >>= :: forall a b. RIO a %1 -> (a %1 -> RIO b) %1 -> RIO b
>>= a %1 -> RIO b
f = (IORef ReleaseMap -> IO b) %1 -> RIO b
forall a. (IORef ReleaseMap -> IO a) -> RIO a
RIO ((IORef ReleaseMap -> IO b) %1 -> RIO b)
-> (IORef ReleaseMap -> IO b) %1 -> RIO b
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \IORef ReleaseMap
releaseMap -> Control.do
    a
a <- RIO a %1 -> IORef ReleaseMap -> IO a
forall a. RIO a %1 -> IORef ReleaseMap -> IO a
unRIO RIO a
x IORef ReleaseMap
releaseMap
    RIO b %1 -> IORef ReleaseMap -> IO b
forall a. RIO a %1 -> IORef ReleaseMap -> IO a
unRIO (a %1 -> RIO b
f a
a) IORef ReleaseMap
releaseMap

  RIO ()
x >> :: forall a. RIO () %1 -> RIO a %1 -> RIO a
>> RIO a
y = (IORef ReleaseMap -> IO a) %1 -> RIO a
forall a. (IORef ReleaseMap -> IO a) -> RIO a
RIO ((IORef ReleaseMap -> IO a) %1 -> RIO a)
-> (IORef ReleaseMap -> IO a) %1 -> RIO a
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \IORef ReleaseMap
releaseMap -> Control.do
    RIO () %1 -> IORef ReleaseMap -> IO ()
forall a. RIO a %1 -> IORef ReleaseMap -> IO a
unRIO RIO ()
x IORef ReleaseMap
releaseMap
    RIO a %1 -> IORef ReleaseMap -> IO a
forall a. RIO a %1 -> IORef ReleaseMap -> IO a
unRIO RIO a
y IORef ReleaseMap
releaseMap

-- files

-- Remark: Handle needs to be private otherwise `Data.Coerce.coerce` could wreak
-- Havoc on the abstraction. But we could provide a smart constructor/view to
-- unsafely convert to file handles in order for the Handle API to be
-- extensible.

newtype Handle = Handle (UnsafeResource System.Handle)

-- | See 'System.IO.openFile'
openFile :: FilePath -> System.IOMode -> RIO Handle
openFile :: FilePath -> IOMode -> RIO Handle
openFile FilePath
path IOMode
mode = Control.do
  UnsafeResource Handle
h <-
    IO (Ur Handle) -> (Handle -> IO ()) -> RIO (UnsafeResource Handle)
forall a. IO (Ur a) -> (a -> IO ()) -> RIO (UnsafeResource a)
unsafeAcquire
      (IO Handle -> IO (Ur Handle)
forall a. IO a -> IO (Ur a)
Linear.fromSystemIOU (IO Handle -> IO (Ur Handle)) -> IO Handle -> IO (Ur Handle)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ FilePath -> IOMode -> IO Handle
System.openFile FilePath
path IOMode
mode)
      (\Handle
h -> IO () %1 -> IO ()
forall a. IO a %1 -> IO a
Linear.fromSystemIO (IO () %1 -> IO ()) -> IO () %1 -> IO ()
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ Handle -> IO ()
System.hClose Handle
h)
  Handle %1 -> RIO Handle
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (Handle %1 -> RIO Handle) -> Handle %1 -> RIO Handle
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ UnsafeResource Handle %1 -> Handle
UnsafeResource Handle -> Handle
Handle UnsafeResource Handle
h

hClose :: Handle %1 -> RIO ()
hClose :: Handle %1 -> RIO ()
hClose (Handle UnsafeResource Handle
h) = UnsafeResource Handle %1 -> RIO ()
forall a. UnsafeResource a %1 -> RIO ()
unsafeRelease UnsafeResource Handle
h

hIsEOF :: Handle %1 -> RIO (Ur Bool, Handle)
hIsEOF :: Handle %1 -> RIO (Ur Bool, Handle)
hIsEOF = (UnsafeResource Handle %1 -> RIO (Ur Bool, UnsafeResource Handle))
-> Handle %1 -> RIO (Ur Bool, Handle)
coerce ((Handle -> IO Bool)
-> UnsafeResource Handle %1 -> RIO (Ur Bool, UnsafeResource Handle)
forall a b.
(a -> IO b) -> UnsafeResource a %1 -> RIO (Ur b, UnsafeResource a)
unsafeFromSystemIOResource Handle -> IO Bool
System.hIsEOF)

hGetChar :: Handle %1 -> RIO (Ur Char, Handle)
hGetChar :: Handle %1 -> RIO (Ur Char, Handle)
hGetChar = (UnsafeResource Handle %1 -> RIO (Ur Char, UnsafeResource Handle))
-> Handle %1 -> RIO (Ur Char, Handle)
coerce ((Handle -> IO Char)
-> UnsafeResource Handle %1 -> RIO (Ur Char, UnsafeResource Handle)
forall a b.
(a -> IO b) -> UnsafeResource a %1 -> RIO (Ur b, UnsafeResource a)
unsafeFromSystemIOResource Handle -> IO Char
System.hGetChar)

hPutChar :: Handle %1 -> Char -> RIO Handle
hPutChar :: Handle %1 -> Char -> RIO Handle
hPutChar Handle
h Char
c = Char -> Handle %1 -> RIO Handle
flipHPutChar Char
c Handle
h -- needs a multiplicity polymorphic flip
  where
    flipHPutChar :: Char -> Handle %1 -> RIO Handle
    flipHPutChar :: Char -> Handle %1 -> RIO Handle
flipHPutChar Char
c =
      (UnsafeResource Handle %1 -> RIO (UnsafeResource Handle))
-> Handle %1 -> RIO Handle
coerce ((Handle -> IO ())
-> UnsafeResource Handle %1 -> RIO (UnsafeResource Handle)
forall a.
(a -> IO ()) -> UnsafeResource a %1 -> RIO (UnsafeResource a)
unsafeFromSystemIOResource_ (\Handle
h' -> Handle -> Char -> IO ()
System.hPutChar Handle
h' Char
c))

hGetLine :: Handle %1 -> RIO (Ur Text, Handle)
hGetLine :: Handle %1 -> RIO (Ur Text, Handle)
hGetLine = (UnsafeResource Handle %1 -> RIO (Ur Text, UnsafeResource Handle))
-> Handle %1 -> RIO (Ur Text, Handle)
coerce ((Handle -> IO Text)
-> UnsafeResource Handle %1 -> RIO (Ur Text, UnsafeResource Handle)
forall a b.
(a -> IO b) -> UnsafeResource a %1 -> RIO (Ur b, UnsafeResource a)
unsafeFromSystemIOResource Handle -> IO Text
Text.hGetLine)

hPutStr :: Handle %1 -> Text -> RIO Handle
hPutStr :: Handle %1 -> Text -> RIO Handle
hPutStr Handle
h Text
s = Text -> Handle %1 -> RIO Handle
flipHPutStr Text
s Handle
h -- needs a multiplicity polymorphic flip
  where
    flipHPutStr :: Text -> Handle %1 -> RIO Handle
    flipHPutStr :: Text -> Handle %1 -> RIO Handle
flipHPutStr Text
s =
      (UnsafeResource Handle %1 -> RIO (UnsafeResource Handle))
-> Handle %1 -> RIO Handle
coerce ((Handle -> IO ())
-> UnsafeResource Handle %1 -> RIO (UnsafeResource Handle)
forall a.
(a -> IO ()) -> UnsafeResource a %1 -> RIO (UnsafeResource a)
unsafeFromSystemIOResource_ (\Handle
h' -> Handle -> Text -> IO ()
Text.hPutStr Handle
h' Text
s))

hPutStrLn :: Handle %1 -> Text -> RIO Handle
hPutStrLn :: Handle %1 -> Text -> RIO Handle
hPutStrLn Handle
h Text
s = Text -> Handle %1 -> RIO Handle
flipHPutStrLn Text
s Handle
h -- needs a multiplicity polymorphic flip
  where
    flipHPutStrLn :: Text -> Handle %1 -> RIO Handle
    flipHPutStrLn :: Text -> Handle %1 -> RIO Handle
flipHPutStrLn Text
s =
      (UnsafeResource Handle %1 -> RIO (UnsafeResource Handle))
-> Handle %1 -> RIO Handle
coerce ((Handle -> IO ())
-> UnsafeResource Handle %1 -> RIO (UnsafeResource Handle)
forall a.
(a -> IO ()) -> UnsafeResource a %1 -> RIO (UnsafeResource a)
unsafeFromSystemIOResource_ (\Handle
h' -> Handle -> Text -> IO ()
Text.hPutStrLn Handle
h' Text
s))

-- new-resources

-- | The type of system resources.  To create and use resources, you need to
-- use the API since the constructor is not released.
data UnsafeResource a where
  UnsafeResource :: Int -> a -> UnsafeResource a

-- Note that both components are unrestricted.

-- | Given an unsafe resource, release it with the linear IO action provided
-- when the resrouce was acquired.
unsafeRelease :: UnsafeResource a %1 -> RIO ()
unsafeRelease :: forall a. UnsafeResource a %1 -> RIO ()
unsafeRelease (UnsafeResource Key
key a
_) = (IORef ReleaseMap -> IO ()) -> RIO ()
forall a. (IORef ReleaseMap -> IO a) -> RIO a
RIO (\IORef ReleaseMap
st -> IO () -> IO ()
forall a. IO a -> IO a
Linear.mask_ (Key -> IORef ReleaseMap -> IO ()
releaseWith Key
key IORef ReleaseMap
st))
  where
    releaseWith :: Key -> IORef ReleaseMap -> IO ()
releaseWith Key
key IORef ReleaseMap
rrm = Control.do
      Ur (ReleaseMap IntMap (IO ())
releaseMap) <- IORef ReleaseMap -> IO (Ur ReleaseMap)
forall a. IORef a -> IO (Ur a)
Linear.readIORef IORef ReleaseMap
rrm
      () <- IntMap (IO ())
releaseMap IntMap (IO ()) -> Key -> IO ()
forall a. IntMap a -> Key -> a
IntMap.! Key
key
      IORef ReleaseMap -> ReleaseMap -> IO ()
forall a. IORef a -> a -> IO ()
Linear.writeIORef IORef ReleaseMap
rrm (IntMap (IO ()) -> ReleaseMap
ReleaseMap (Key -> IntMap (IO ()) -> IntMap (IO ())
forall a. Key -> IntMap a -> IntMap a
IntMap.delete Key
key IntMap (IO ())
releaseMap))

-- | Given a resource in the "System.IO.Linear.IO" monad, and
-- given a function to release that resource, provides that resource in
-- the @RIO@ monad. For example, releasing a @Handle@ from "System.IO"
-- would be done with @fromSystemIO hClose@. Because this release function
-- is an input, and could be wrong, this function is unsafe.
unsafeAcquire ::
  Linear.IO (Ur a) ->
  (a -> Linear.IO ()) ->
  RIO (UnsafeResource a)
unsafeAcquire :: forall a. IO (Ur a) -> (a -> IO ()) -> RIO (UnsafeResource a)
unsafeAcquire IO (Ur a)
acquire a -> IO ()
release = (IORef ReleaseMap -> IO (UnsafeResource a))
-> RIO (UnsafeResource a)
forall a. (IORef ReleaseMap -> IO a) -> RIO a
RIO ((IORef ReleaseMap -> IO (UnsafeResource a))
 -> RIO (UnsafeResource a))
-> (IORef ReleaseMap -> IO (UnsafeResource a))
-> RIO (UnsafeResource a)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \IORef ReleaseMap
rrm ->
  IO (UnsafeResource a) -> IO (UnsafeResource a)
forall a. IO a -> IO a
Linear.mask_
    ( Control.do
        Ur a
resource <- IO (Ur a)
acquire
        Ur (ReleaseMap IntMap (IO ())
releaseMap) <- IORef ReleaseMap -> IO (Ur ReleaseMap)
forall a. IORef a -> IO (Ur a)
Linear.readIORef IORef ReleaseMap
rrm
        () <-
          IORef ReleaseMap -> ReleaseMap -> IO ()
forall a. IORef a -> a -> IO ()
Linear.writeIORef
            IORef ReleaseMap
rrm
            ( IntMap (IO ()) -> ReleaseMap
ReleaseMap
                (Key -> IO () -> IntMap (IO ()) -> IntMap (IO ())
forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert (IntMap (IO ()) -> Key
forall {b}. IntMap b -> Key
releaseKey IntMap (IO ())
releaseMap) (a -> IO ()
release a
resource) IntMap (IO ())
releaseMap)
            )
        UnsafeResource a %1 -> IO (UnsafeResource a)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return (UnsafeResource a %1 -> IO (UnsafeResource a))
-> UnsafeResource a %1 -> IO (UnsafeResource a)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ Key -> a -> UnsafeResource a
forall a. Key -> a -> UnsafeResource a
UnsafeResource (IntMap (IO ()) -> Key
forall {b}. IntMap b -> Key
releaseKey IntMap (IO ())
releaseMap) a
resource
    )
  where
    releaseKey :: IntMap b -> Key
releaseKey IntMap b
releaseMap =
      case IntMap b -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap b
releaseMap of
        Bool
True -> Key
0
        Bool
False -> (Key, b) -> Key
forall a b. (a, b) -> a
fst (IntMap b -> (Key, b)
forall a. IntMap a -> (Key, a)
IntMap.findMax IntMap b
releaseMap) Key %1 -> Key %1 -> Key
forall a. Additive a => a %1 -> a %1 -> a
+ Key
1

-- | Given a "System.IO" computation on an unsafe resource,
-- lift it to @RIO@ computaton on the acquired resource.
-- That is function of type @a -> IO b@ turns into a function of type
-- @UnsafeResource a %1-> RIO (Ur b)@
-- along with threading the @UnsafeResource a@.
--
-- Note that the result @b@ can be used non-linearly.
unsafeFromSystemIOResource ::
  (a -> System.IO b) ->
  (UnsafeResource a %1 -> RIO (Ur b, UnsafeResource a))
unsafeFromSystemIOResource :: forall a b.
(a -> IO b) -> UnsafeResource a %1 -> RIO (Ur b, UnsafeResource a)
unsafeFromSystemIOResource a -> IO b
action (UnsafeResource Key
key a
resource) =
  IO (Ur b, UnsafeResource a) %1 -> RIO (Ur b, UnsafeResource a)
forall a. IO a %1 -> RIO a
unsafeFromSystemIO
    ( do
        b
c <- a -> IO b
action a
resource
        (Ur b, UnsafeResource a) -> IO (Ur b, UnsafeResource a)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return (b -> Ur b
forall a. a -> Ur a
Ur b
c, Key -> a -> UnsafeResource a
forall a. Key -> a -> UnsafeResource a
UnsafeResource Key
key a
resource)
    )

unsafeFromSystemIOResource_ ::
  (a -> System.IO ()) ->
  (UnsafeResource a %1 -> RIO (UnsafeResource a))
unsafeFromSystemIOResource_ :: forall a.
(a -> IO ()) -> UnsafeResource a %1 -> RIO (UnsafeResource a)
unsafeFromSystemIOResource_ a -> IO ()
action UnsafeResource a
resource = Control.do
  (Ur ()
_, UnsafeResource a
resource) <- (a -> IO ())
-> UnsafeResource a %1 -> RIO (Ur (), UnsafeResource a)
forall a b.
(a -> IO b) -> UnsafeResource a %1 -> RIO (Ur b, UnsafeResource a)
unsafeFromSystemIOResource a -> IO ()
action UnsafeResource a
resource
  UnsafeResource a %1 -> RIO (UnsafeResource a)
forall (m :: * -> *) a. Monad m => a %1 -> m a
Control.return UnsafeResource a
resource