{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeFamilies #-}
module Nix.Thunk where
import Control.Monad.Trans.Writer ( WriterT )
import qualified Text.Show
class
( Monad m
, Eq (ThunkId m)
, Ord (ThunkId m)
, Show (ThunkId m)
, Typeable (ThunkId m)
)
=> MonadThunkId m
where
type ThunkId m :: Type
freshId :: m (ThunkId m)
default freshId
:: ( MonadThunkId m'
, MonadTrans t
, m ~ t m'
, ThunkId m ~ ThunkId m'
)
=> m (ThunkId m)
freshId = m' (ThunkId m) -> t m' (ThunkId m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' (ThunkId m)
forall (m :: * -> *). MonadThunkId m => m (ThunkId m)
freshId
instance
MonadThunkId m
=> MonadThunkId (ReaderT r m)
where
type ThunkId (ReaderT r m) = ThunkId m
instance
( Monoid w
, MonadThunkId m
)
=> MonadThunkId (WriterT w m)
where
type ThunkId (WriterT w m) = ThunkId m
instance
MonadThunkId m
=> MonadThunkId (ExceptT e m)
where
type ThunkId (ExceptT e m) = ThunkId m
instance
MonadThunkId m
=> MonadThunkId (StateT s m)
where
type ThunkId (StateT s m) = ThunkId m
class
MonadThunkId m
=> MonadThunk t m a | t -> m, t -> a
where
thunkId :: t -> ThunkId m
thunk :: m a -> m t
query :: m a -> t -> m a
force :: t -> m a
forceEff :: t -> m a
further :: t -> m t
class
MonadThunkF t m a | t -> m, t -> a
where
queryF :: (a -> m r) -> m r -> t -> m r
forceF :: (a -> m r) -> t -> m r
forceEffF :: (a -> m r) -> t -> m r
furtherF :: (m a -> m a) -> t -> m t
newtype ThunkLoop = ThunkLoop Text
deriving Typeable
instance Show ThunkLoop where
show :: ThunkLoop -> String
show (ThunkLoop Text
i) = Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"ThunkLoop " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i
instance Exception ThunkLoop
thunkStubText :: Text
thunkStubText :: Text
thunkStubText = Text
"<thunk>"