{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | 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.
module Nix.Normal where

import           Control.Monad
import           Control.Monad.Free
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.State
import           Data.Set
import           Nix.Cited
import           Nix.Frames
import           Nix.String
import           Nix.Thunk
import           Nix.Value
import           Nix.Utils

newtype NormalLoop t f m = NormalLoop (NValue t f m)
    deriving Int -> NormalLoop t f m -> ShowS
[NormalLoop t f m] -> ShowS
NormalLoop t f m -> String
(Int -> NormalLoop t f m -> ShowS)
-> (NormalLoop t f m -> String)
-> ([NormalLoop t f m] -> ShowS)
-> Show (NormalLoop t f m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
Int -> NormalLoop t f m -> ShowS
forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
[NormalLoop t f m] -> ShowS
forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
NormalLoop t f m -> String
showList :: [NormalLoop t f m] -> ShowS
$cshowList :: forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
[NormalLoop t f m] -> ShowS
show :: NormalLoop t f m -> String
$cshow :: forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
NormalLoop t f m -> String
showsPrec :: Int -> NormalLoop t f m -> ShowS
$cshowsPrec :: forall t (f :: * -> *) (m :: * -> *).
(Comonad f, Show t) =>
Int -> NormalLoop t f m -> ShowS
Show

instance MonadDataErrorContext t f m => Exception (NormalLoop t f m)

-- | Normalize the value as much as possible, leaving only detected cycles.
normalizeValue
  :: 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)
normalizeValue :: (forall r. t -> (NValue t f m -> m r) -> m r)
-> NValue t f m -> m (NValue t f m)
normalizeValue forall r. t -> (NValue t f m -> m r) -> m r
f = ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
-> m (NValue t f m)
forall r. ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r
run (ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
 -> m (NValue t f m))
-> (NValue t f m
    -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r. ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r)
-> (t
    -> (NValue t f m
        -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
    -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> (NValue'
      t f m (ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
    -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> NValue t f m
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
forall (f :: * -> *) (m :: * -> *) (n :: * -> *) t r.
(MonadDataContext f m, Monad n) =>
(forall x. n x -> m x)
-> (t -> (NValue t f m -> n r) -> n r)
-> (NValue' t f m (n r) -> n r)
-> NValue t f m
-> n r
iterNValueM forall r. ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r
run t
-> (NValue t f m
    -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
go ((NValue' t f m (NValue t f m) -> NValue t f m)
-> ReaderT
     Int (StateT (Set (ThunkId m)) m) (NValue' t f m (NValue t f m))
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (ReaderT
   Int (StateT (Set (ThunkId m)) m) (NValue' t f m (NValue t f m))
 -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> (NValue'
      t f m (ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
    -> ReaderT
         Int (StateT (Set (ThunkId m)) m) (NValue' t f m (NValue t f m)))
-> NValue'
     t f m (ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r. ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r)
-> NValue'
     t f m (ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> ReaderT
     Int (StateT (Set (ThunkId m)) m) (NValue' t f m (NValue t f m))
forall (n :: * -> *) (f :: * -> *) (m :: * -> *) t a.
(Functor n, Traversable f, Monad m, Applicative n) =>
(forall x. n x -> m x)
-> NValue' t f m (n a) -> n (NValue' t f m a)
sequenceNValue' forall r. ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r
run)
 where
  start :: Int
start = Int
0 :: Int
  table :: Set (ThunkId m)
table = Set (ThunkId m)
forall a. Monoid a => a
mempty

  run :: ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r
  run :: ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r
run = (StateT (Set (ThunkId m)) m r -> Set (ThunkId m) -> m r
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` Set (ThunkId m)
table) (StateT (Set (ThunkId m)) m r -> m r)
-> (ReaderT Int (StateT (Set (ThunkId m)) m) r
    -> StateT (Set (ThunkId m)) m r)
-> ReaderT Int (StateT (Set (ThunkId m)) m) r
-> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Int (StateT (Set (ThunkId m)) m) r
-> Int -> StateT (Set (ThunkId m)) m r
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Int
start)

  go
    :: t
    -> (  NValue t f m
       -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
       )
    -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
  go :: t
-> (NValue t f m
    -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
go t
t NValue t f m
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
k = do
    Bool
b <- t -> ReaderT Int (StateT (Set (ThunkId m)) m) Bool
forall t (m :: * -> *) a (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadThunk t m a, MonadTrans t, Monad m) =>
t -> t (StateT (Set (ThunkId m)) m) Bool
seen t
t
    if Bool
b
      then NValue t f m
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m
 -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> NValue t f m
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
forall a b. (a -> b) -> a -> b
$ t -> NValue t f m
forall (f :: * -> *) a. a -> Free f a
Pure t
t
      else do
        Int
i <- ReaderT Int (StateT (Set (ThunkId m)) m) Int
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        Bool
-> ReaderT Int (StateT (Set (ThunkId m)) m) ()
-> ReaderT Int (StateT (Set (ThunkId m)) m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2000)
          (ReaderT Int (StateT (Set (ThunkId m)) m) ()
 -> ReaderT Int (StateT (Set (ThunkId m)) m) ())
-> ReaderT Int (StateT (Set (ThunkId m)) m) ()
-> ReaderT Int (StateT (Set (ThunkId m)) m) ()
forall a b. (a -> b) -> a -> b
$ String -> ReaderT Int (StateT (Set (ThunkId m)) m) ()
forall a. HasCallStack => String -> a
error String
"Exceeded maximum normalization depth of 2000 levels"
        ((NValue t f m
  -> StateT (Set (ThunkId m)) m (StT (ReaderT Int) (NValue t f m)))
 -> StateT (Set (ThunkId m)) m (StT (ReaderT Int) (NValue t f m)))
-> (NValue t f m
    -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
forall (u :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTransControl u, Monad (u m), Monad m) =>
((a -> m (StT u b)) -> m (StT u b)) -> (a -> u m b) -> u m b
lifted (((NValue t f m
  -> m (StT (StateT (Set (ThunkId m))) (NValue t f m)))
 -> m (StT (StateT (Set (ThunkId m))) (NValue t f m)))
-> (NValue t f m -> StateT (Set (ThunkId m)) m (NValue t f m))
-> StateT (Set (ThunkId m)) m (NValue t f m)
forall (u :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTransControl u, Monad (u m), Monad m) =>
((a -> m (StT u b)) -> m (StT u b)) -> (a -> u m b) -> u m b
lifted (t
-> (NValue t f m -> m (NValue t f m, Set (ThunkId m)))
-> m (NValue t f m, Set (ThunkId m))
forall r. t -> (NValue t f m -> m r) -> m r
f t
t)) ((NValue t f m
  -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
 -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> (NValue t f m
    -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
forall a b. (a -> b) -> a -> b
$ (Int -> Int)
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local Int -> Int
forall a. Enum a => a -> a
succ (ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
 -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> (NValue t f m
    -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m))
-> NValue t f m
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m
-> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)
k

  seen :: t -> t (StateT (Set (ThunkId m)) m) Bool
seen t
t = do
    let tid :: ThunkId m
tid = t -> ThunkId m
forall t (m :: * -> *) a. MonadThunk t m a => t -> ThunkId m
thunkId t
t
    StateT (Set (ThunkId m)) m Bool
-> t (StateT (Set (ThunkId m)) m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Set (ThunkId m)) m Bool
 -> t (StateT (Set (ThunkId m)) m) Bool)
-> StateT (Set (ThunkId m)) m Bool
-> t (StateT (Set (ThunkId m)) m) Bool
forall a b. (a -> b) -> a -> b
$ do
      Bool
res <- (Set (ThunkId m) -> Bool) -> StateT (Set (ThunkId m)) m Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (ThunkId m -> Set (ThunkId m) -> Bool
forall a. Ord a => a -> Set a -> Bool
member ThunkId m
tid)
      Bool
-> StateT (Set (ThunkId m)) m () -> StateT (Set (ThunkId m)) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
res (StateT (Set (ThunkId m)) m () -> StateT (Set (ThunkId m)) m ())
-> StateT (Set (ThunkId m)) m () -> StateT (Set (ThunkId m)) m ()
forall a b. (a -> b) -> a -> b
$ (Set (ThunkId m) -> Set (ThunkId m))
-> StateT (Set (ThunkId m)) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (ThunkId m -> Set (ThunkId m) -> Set (ThunkId m)
forall a. Ord a => a -> Set a -> Set a
insert ThunkId m
tid)
      Bool -> StateT (Set (ThunkId m)) m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
res

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 :: NValue t f m -> m (NValue t f m)
normalForm = (NValue t f m -> NValue t f m)
-> m (NValue t f m) -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NValue t f m -> NValue t f m
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
stubCycles (m (NValue t f m) -> m (NValue t f m))
-> (NValue t f m -> m (NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r. t -> (NValue t f m -> m r) -> m r)
-> NValue t f m -> m (NValue t f m)
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)
normalizeValue forall r. t -> (NValue t f m -> m r) -> m r
forall t (m :: * -> *) a r.
MonadThunk t m a =>
t -> (a -> m r) -> m r
force

normalForm_
  :: ( Framed e m
     , MonadThunk t m (NValue t f m)
     , MonadDataErrorContext t f m
     , Ord (ThunkId m)
     )
  => NValue t f m
  -> m ()
normalForm_ :: NValue t f m -> m ()
normalForm_ = m (NValue t f m) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (NValue t f m) -> m ())
-> (NValue t f m -> m (NValue t f m)) -> NValue t f m -> m ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. t -> (NValue t f m -> m r) -> m r)
-> NValue t f m -> m (NValue t f m)
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)
normalizeValue forall r. t -> (NValue t f m -> m r) -> m r
forall t (m :: * -> *) a r.
MonadThunk t m a =>
t -> (a -> m r) -> m r
forceEff

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
stubCycles :: NValue t f m -> NValue t f m
stubCycles = ((t -> (NValue t f m -> NValue t f m) -> NValue t f m)
 -> (NValue' t f m (NValue t f m) -> NValue t f m)
 -> NValue t f m
 -> NValue t f m)
-> (NValue' t f m (NValue t f m) -> NValue t f m)
-> (t -> (NValue t f m -> NValue t f m) -> NValue t f m)
-> NValue t f m
-> NValue t f m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (t -> (NValue t f m -> NValue t f m) -> NValue t f m)
-> (NValue' t f m (NValue t f m) -> NValue t f m)
-> NValue t f m
-> NValue t f m
forall t (f :: * -> *) (m :: * -> *) r.
MonadDataContext f m =>
(t -> (NValue t f m -> r) -> r)
-> (NValue' t f m r -> r) -> NValue t f m -> r
iterNValue NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free ((t -> (NValue t f m -> NValue t f m) -> NValue t f m)
 -> NValue t f m -> NValue t f m)
-> (t -> (NValue t f m -> NValue t f m) -> NValue t f m)
-> NValue t f m
-> NValue t f m
forall a b. (a -> b) -> a -> b
$ \t
t NValue t f m -> NValue t f m
_ ->
  NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free
    (NValue' t f m (NValue t f m) -> NValue t f m)
-> NValue' t f m (NValue t f m) -> NValue t f m
forall a b. (a -> b) -> a -> b
$ f (NValueF (NValue t f m) m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue
    (f (NValueF (NValue t f m) m (NValue t f m))
 -> NValue' t f m (NValue t f m))
-> f (NValueF (NValue t f m) m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall a b. (a -> b) -> a -> b
$ (Provenance m (NValue t f m)
 -> f (NValueF (NValue t f m) m (NValue t f m))
 -> f (NValueF (NValue t f m) m (NValue t f m)))
-> f (NValueF (NValue t f m) m (NValue t f m))
-> [Provenance m (NValue t f m)]
-> f (NValueF (NValue t f m) m (NValue t f m))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr (forall (f :: * -> *) a.
HasCitations1 m (NValue t f m) f =>
Provenance m (NValue t f m) -> f a -> f a
forall (m :: * -> *) v (f :: * -> *) a.
HasCitations1 m v f =>
Provenance m v -> f a -> f a
addProvenance1 @m @(NValue t f m)) f (NValueF (NValue t f m) m (NValue t f m))
forall a (m :: * -> *). f (NValueF (NValue a f m) m (NValue a f m))
cyc
    ([Provenance m (NValue t f m)]
 -> f (NValueF (NValue t f m) m (NValue t f m)))
-> [Provenance m (NValue t f m)]
-> f (NValueF (NValue t f m) m (NValue t f m))
forall a b. (a -> b) -> a -> b
$ [Provenance m (NValue t f m)] -> [Provenance m (NValue t f m)]
forall a. [a] -> [a]
reverse
    ([Provenance m (NValue t f m)] -> [Provenance m (NValue t f m)])
-> [Provenance m (NValue t f m)] -> [Provenance m (NValue t f m)]
forall a b. (a -> b) -> a -> b
$ t -> [Provenance m (NValue t f m)]
forall (m :: * -> *) v a.
HasCitations m v a =>
a -> [Provenance m v]
citations @m @(NValue t f m) t
t
 where
  Free (NValue f (NValueF (NValue a f m) m (NValue a f m))
cyc) = NValue a f m
forall (f :: * -> *) t (m :: * -> *). Applicative f => NValue t f m
opaque

removeEffects
  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
  => NValue t f m
  -> m (NValue t f m)
removeEffects :: NValue t f m -> m (NValue t f m)
removeEffects =
  (forall x. m x -> m x)
-> (t -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> (NValue' t f m (m (NValue t f m)) -> m (NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall (f :: * -> *) (m :: * -> *) (n :: * -> *) t r.
(MonadDataContext f m, Monad n) =>
(forall x. n x -> m x)
-> (t -> (NValue t f m -> n r) -> n r)
-> (NValue' t f m (n r) -> n r)
-> NValue t f m
-> n r
iterNValueM
    forall a. a -> a
forall x. m x -> m x
id
    (t
-> m (NValue t f m)
-> (NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
forall t (m :: * -> *) a r.
MonadThunk t m a =>
t -> m r -> (a -> m r) -> m r
`queryM` NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
forall (f :: * -> *) t (m :: * -> *). Applicative f => NValue t f m
opaque)
    ((NValue' t f m (NValue t f m) -> NValue t f m)
-> m (NValue' t f m (NValue t f m)) -> m (NValue t f m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (m (NValue' t f m (NValue t f m)) -> m (NValue t f m))
-> (NValue' t f m (m (NValue t f m))
    -> m (NValue' t f m (NValue t f m)))
-> NValue' t f m (m (NValue t f m))
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. m x -> m x)
-> NValue' t f m (m (NValue t f m))
-> m (NValue' t f m (NValue t f m))
forall (n :: * -> *) (f :: * -> *) (m :: * -> *) t a.
(Functor n, Traversable f, Monad m, Applicative n) =>
(forall x. n x -> m x)
-> NValue' t f m (n a) -> n (NValue' t f m a)
sequenceNValue' forall a. a -> a
forall x. m x -> m x
id)

opaque :: Applicative f => NValue t f m
opaque :: NValue t f m
opaque = NixString -> NValue t f m
forall (f :: * -> *) t (m :: * -> *).
Applicative f =>
NixString -> NValue t f m
nvStr (NixString -> NValue t f m) -> NixString -> NValue t f m
forall a b. (a -> b) -> a -> b
$ Text -> NixString
principledMakeNixStringWithoutContext Text
"<CYCLE>"

dethunk
  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
  => t
  -> m (NValue t f m)
dethunk :: t -> m (NValue t f m)
dethunk t
t = t
-> m (NValue t f m)
-> (NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
forall t (m :: * -> *) a r.
MonadThunk t m a =>
t -> m r -> (a -> m r) -> m r
queryM t
t (NValue t f m -> m (NValue t f m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
forall (f :: * -> *) t (m :: * -> *). Applicative f => NValue t f m
opaque) NValue t f m -> m (NValue t f m)
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), MonadDataContext f m) =>
NValue t f m -> m (NValue t f m)
removeEffects