Exec.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}

-- | The pass-execution monad and its resource accessors.
module Fragr.Exec
  ( Exec
  , askCtx
  , get
  , getDesc
  ) where

import Control.Exception (throwIO)
import Control.Monad (unless)
import Control.Monad.Trans.Reader (ReaderT (..), asks)
import Data.IORef (readIORef)
import Data.IntSet qualified as IntSet
import Data.Text (Text)

import Fragr.Error (FragrError (..))
import Fragr.Graph (PassNode (..), ResourceEntry, Resources (..), castEntry, entryOf)
import Fragr.Resource (Resource (..))
import Fragr.Types (Handle, SomeHandle (..), handleId)

{- |
The pass-execution monad: the exec argument of 'Fragr.Builder.addPass'.
A 'MonadIO' — recording commands is what the callback is for. A reader
over 'Resources', carrying:

* the executing pass's resource accessor — 'get' and 'getDesc' are
  restricted to the handles the pass declared;
* the context given to 'Fragr.Execute.execute' ('askCtx').

'MonadFail' delegates to 'IO', so failable pattern binds on 'get' results
behave like they would in a plain IO callback.
-}
type Exec ctx alloc = ReaderT (Resources ctx alloc) IO

{- | The context 'Fragr.Execute.execute' / 'Fragr.Execute.executeQueued'
was given for this frame.
-}
{-# INLINE askCtx #-}
askCtx :: Exec ctx alloc ctx
askCtx = asks (.ctx)

{- |
The live resource object behind the handle (after 'createResource' has run
for transients; the very object given to 'importResource' for imports).

Fatal error: the pass never declared the handle (a stale handle is never
in the declarations — that is the "obsolete handle" error).
-}
{-# INLINEABLE get #-}
get
  :: forall r ctx alloc
   . (Resource r)
  => Handle r
  -> Exec ctx alloc r
get h = ReaderT \res -> do
  entry <- declaredEntry "get" res h
  (_, objRef) <- castEntry @r "get" entry
  readIORef objRef >>= \case
    Nothing -> throwIO $ InternalInvariant "resource not materialized"
    Just obj -> pure obj

{- | Like 'Fragr.Graph.getDescriptor', but through the pass accessor:
restricted to handles the pass declared.
-}
{-# INLINEABLE getDesc #-}
getDesc
  :: forall r ctx alloc
   . (Resource r)
  => Handle r
  -> Exec ctx alloc (Desc r)
getDesc h = ReaderT \res -> do
  entry <- declaredEntry "getDesc" res h
  (desc, _) <- castEntry @r "getDesc" entry
  pure desc

declaredEntry :: Text -> Resources ctx alloc -> Handle r -> IO (ResourceEntry ctx alloc)
declaredEntry who res h = do
  unless (handleId h `IntSet.member` res.pass.declared) $
    throwIO $
      Undeclared who (SomeHandle h) res.pass.name
  entryOf res.graph h