Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Code for normalization (reduction into a normal form) of Nix expressions. Nix language allows recursion, so some expressions do not converge. And so do not converge into a normal form.
Synopsis
- newtype NormalLoop t f m = NormalLoop (NValue t f m)
- normalizeValue :: forall e t m f. (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m, Ord (ThunkId m)) => NValue t f m -> m (NValue t f m)
- normalizeValueF :: forall e t m f. (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m, Ord (ThunkId m)) => (forall r. t -> (NValue t f m -> m r) -> m r) -> NValue t f m -> m (NValue t f m)
- normalForm :: (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m, HasCitations m (NValue t f m) t, HasCitations1 m (NValue t f m) f, Ord (ThunkId m)) => NValue t f m -> m (NValue t f m)
- normalForm_ :: (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m, Ord (ThunkId m)) => NValue t f m -> m ()
- opaqueVal :: NVConstraint f => NValue t f m
- stubCycles :: forall t f m. (MonadDataContext f m, HasCitations m (NValue t f m) t, HasCitations1 m (NValue t f m) f) => NValue t f m -> NValue t f m
- thunkStubVal :: NVConstraint f => NValue t f m
- bindComputedThunkOrStub :: (NVConstraint f, MonadThunk t m (NValue t f m)) => (NValue t f m -> m a) -> t -> m a
- removeEffects :: (MonadThunk t m (NValue t f m), MonadDataContext f m) => NValue t f m -> m (NValue t f m)
- dethunk :: (MonadThunk t m (NValue t f m), MonadDataContext f m) => t -> m (NValue t f m)
Documentation
newtype NormalLoop t f m Source #
NormalLoop (NValue t f m) |
Instances
MonadDataErrorContext t f m => Exception (NormalLoop t f m) Source # | |
Defined in Nix.Normal toException :: NormalLoop t f m -> SomeException # fromException :: SomeException -> Maybe (NormalLoop t f m) # displayException :: NormalLoop t f m -> String # | |
(Comonad f, Applicative f, Show t) => Show (NormalLoop t f m) Source # | |
Defined in Nix.Normal showsPrec :: Int -> NormalLoop t f m -> ShowS # show :: NormalLoop t f m -> String # showList :: [NormalLoop t f m] -> ShowS # |
normalizeValue :: forall e t m f. (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m, Ord (ThunkId m)) => NValue t f m -> m (NValue t f m) Source #
Normalize the value as much as possible, leaving only detected cycles.
normalizeValueF :: forall e t m f. (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m, Ord (ThunkId m)) => (forall r. t -> (NValue t f m -> m r) -> m r) -> NValue t f m -> m (NValue t f m) Source #
Normalization HOF (functorial) version of normalizeValue
. Accepts the special thunk operatingforcingnirmalizing function & internalizes it.
normalForm :: (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m, HasCitations m (NValue t f m) t, HasCitations1 m (NValue t f m) f, Ord (ThunkId m)) => NValue t f m -> m (NValue t f m) Source #
Normalize value. Detect cycles. If cycles were detected - put a stub on them.
normalForm_ :: (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m, Ord (ThunkId m)) => NValue t f m -> m () Source #
Monadic context of the result.
opaqueVal :: NVConstraint f => NValue t f m Source #
stubCycles :: forall t f m. (MonadDataContext f m, HasCitations m (NValue t f m) t, HasCitations1 m (NValue t f m) f) => NValue t f m -> NValue t f m Source #
Detect cycles & stub them.
thunkStubVal :: NVConstraint f => NValue t f m Source #
bindComputedThunkOrStub :: (NVConstraint f, MonadThunk t m (NValue t f m)) => (NValue t f m -> m a) -> t -> m a Source #
Check if thunk t
is computed,
then bind it into first arg.
else bind the thunk stub val.
removeEffects :: (MonadThunk t m (NValue t f m), MonadDataContext f m) => NValue t f m -> m (NValue t f m) Source #
dethunk :: (MonadThunk t m (NValue t f m), MonadDataContext f m) => t -> m (NValue t f m) Source #