{-# language AllowAmbiguousTypes #-}
{-# language ConstraintKinds #-}
{-# language TypeFamilies #-}

{-# options_ghc -Wno-missing-pattern-synonym-signatures #-}

module Nix.Value.Equal where

import           Nix.Prelude             hiding ( Comparison )
import           Control.Comonad                ( Comonad(extract))
import           Control.Monad.Free             ( Free(Pure,Free) )
import           Control.Monad.Trans.Except     ( throwE )
import           Data.Semialign                 ( Align
                                                , Semialign(align)
                                                )
import qualified Data.HashMap.Lazy             as HashMap.Lazy
import           Data.These                     ( These(These) )
import           Nix.Atoms
import           Nix.Frames
import           Nix.String
import           Nix.Thunk
import           Nix.Value
import           Nix.Expr.Types                 ( AttrSet )

checkComparable
  :: ( Framed e m
     , MonadDataErrorContext t f m
     )
  => NValue t f m
  -> NValue t f m
  -> m ()
checkComparable :: forall e (m :: * -> *) t (f :: * -> *).
(Framed e m, MonadDataErrorContext t f m) =>
NValue t f m -> NValue t f m -> m ()
checkComparable NValue t f m
x NValue t f m
y =
  case (NValue t f m
x, NValue t f m
y) of
    (NVConstant (NInt   Integer
_), NVConstant (NInt   Integer
_)) -> m ()
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
    (NVConstant (NInt   Integer
_), NVConstant (NFloat Float
_)) -> m ()
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
    (NVConstant (NFloat Float
_), NVConstant (NInt   Integer
_)) -> m ()
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
    (NVConstant (NFloat Float
_), NVConstant (NFloat Float
_)) -> m ()
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
    (NVStr       NixString
_        , NVStr       NixString
_        ) -> m ()
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
    (NVPath      Path
_        , NVPath      Path
_        ) -> m ()
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
    (NValue t f m, NValue t f m)
_                                              -> ValueFrame t f m -> m ()
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ValueFrame t f m -> m ()) -> ValueFrame t f m -> m ()
forall a b. (a -> b) -> a -> b
$ NValue t f m -> NValue t f m -> ValueFrame t f m
forall t (f :: * -> *) (m :: * -> *).
NValue t f m -> NValue t f m -> ValueFrame t f m
Comparison NValue t f m
x NValue t f m
y

-- | Checks whether two containers are equal, using the given item equality
--   predicate. If there are any item slots that don't match between the two
--   containers, the result will be @False@.
alignEqM
  :: (Align f, Traversable f, Monad m)
  => (a -> b -> m Bool)
  -> f a
  -> f b
  -> m Bool
alignEqM :: forall (f :: * -> *) (m :: * -> *) a b.
(Align f, Traversable f, Monad m) =>
(a -> b -> m Bool) -> f a -> f b -> m Bool
alignEqM a -> b -> m Bool
eq f a
fa f b
fb =
  (Either () () -> Bool) -> m (Either () ()) -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (forall a b. Either a b -> Bool
isRight @() @())
    (m (Either () ()) -> m Bool) -> m (Either () ()) -> m Bool
forall a b. (a -> b) -> a -> b
$ ExceptT () m () -> m (Either () ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT () m () -> m (Either () ()))
-> ExceptT () m () -> m (Either () ())
forall a b. (a -> b) -> a -> b
$
      ((a, b) -> ExceptT () m ()) -> f (a, b) -> ExceptT () m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
        (Bool -> ExceptT () m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ExceptT () m ())
-> ((a, b) -> ExceptT () m Bool) -> (a, b) -> ExceptT () m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< m Bool -> ExceptT () m Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT () m Bool)
-> ((a, b) -> m Bool) -> (a, b) -> ExceptT () m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> m Bool) -> (a, b) -> m Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> m Bool
eq)
        (f (a, b) -> ExceptT () m ())
-> ExceptT () m (f (a, b)) -> ExceptT () m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (These a b -> ExceptT () m (a, b))
-> f (These a b) -> ExceptT () m (f (a, b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse
            (\case
              These a
a b
b -> (a, b) -> ExceptT () m (a, b)
forall a. a -> ExceptT () m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)
              These a b
_         -> () -> ExceptT () m (a, b)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ()
forall a. Monoid a => a
mempty
            )
            (f a -> f b -> f (These a b)
forall a b. f a -> f b -> f (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
Data.Semialign.align f a
fa f b
fb)

alignEq :: (Align f, Traversable f) => (a -> b -> Bool) -> f a -> f b -> Bool
alignEq :: forall (f :: * -> *) a b.
(Align f, Traversable f) =>
(a -> b -> Bool) -> f a -> f b -> Bool
alignEq a -> b -> Bool
eq f a
fa f b
fb =
  Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> b -> Identity Bool) -> f a -> f b -> Identity Bool
forall (f :: * -> *) (m :: * -> *) a b.
(Align f, Traversable f, Monad m) =>
(a -> b -> m Bool) -> f a -> f b -> m Bool
alignEqM ((Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> (b -> Bool) -> b -> Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((b -> Bool) -> b -> Identity Bool)
-> (a -> b -> Bool) -> a -> b -> Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> Bool
eq) f a
fa f b
fb

isDerivationM
  :: Monad m
  => ( t
     -> m (Maybe NixString)
     )
  -> AttrSet t
  -> m Bool
isDerivationM :: forall (m :: * -> *) t.
Monad m =>
(t -> m (Maybe NixString)) -> AttrSet t -> m Bool
isDerivationM t -> m (Maybe NixString)
f AttrSet t
m =
  Bool -> (NixString -> Bool) -> Maybe NixString -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    Bool
False
    -- (2019-03-18):
    -- We should probably really make sure the context is empty here
    -- but the C++ implementation ignores it.
    (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
"derivation" (Text -> Bool) -> (NixString -> Text) -> NixString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixString -> Text
ignoreContext)
    (Maybe NixString -> Bool)
-> (Maybe (Maybe NixString) -> Maybe NixString)
-> Maybe (Maybe NixString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe NixString) -> Maybe NixString
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe NixString) -> Bool)
-> m (Maybe (Maybe NixString)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t -> m (Maybe NixString))
-> Maybe t -> m (Maybe (Maybe NixString))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse t -> m (Maybe NixString)
f (VarName -> AttrSet t -> Maybe t
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.Lazy.lookup VarName
"type" AttrSet t
m)


isDerivation
  :: Monad m
  => ( t
     -> Maybe NixString
     )
  -> AttrSet t
  -> Bool
isDerivation :: forall (m :: * -> *) t.
Monad m =>
(t -> Maybe NixString) -> AttrSet t -> Bool
isDerivation t -> Maybe NixString
f = Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool)
-> (AttrSet t -> Identity Bool) -> AttrSet t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Identity (Maybe NixString)) -> AttrSet t -> Identity Bool
forall (m :: * -> *) t.
Monad m =>
(t -> m (Maybe NixString)) -> AttrSet t -> m Bool
isDerivationM (Maybe NixString -> Identity (Maybe NixString)
forall a. a -> Identity a
Identity (Maybe NixString -> Identity (Maybe NixString))
-> (t -> Maybe NixString) -> t -> Identity (Maybe NixString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe NixString
f)

valueFEqM
  :: Monad n
  => (  AttrSet a
     -> AttrSet a
     -> n Bool
     )
  -> (  a
     -> a
     -> n Bool
     )
  -> NValueF p m a
  -> NValueF p m a
  -> n Bool
valueFEqM :: forall (n :: * -> *) a p (m :: * -> *).
Monad n =>
(AttrSet a -> AttrSet a -> n Bool)
-> (a -> a -> n Bool) -> NValueF p m a -> NValueF p m a -> n Bool
valueFEqM AttrSet a -> AttrSet a -> n Bool
attrsEq a -> a -> n Bool
eq =
  ((NValueF p m a, NValueF p m a) -> n Bool)
-> NValueF p m a -> NValueF p m a -> n Bool
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((NValueF p m a, NValueF p m a) -> n Bool)
 -> NValueF p m a -> NValueF p m a -> n Bool)
-> ((NValueF p m a, NValueF p m a) -> n Bool)
-> NValueF p m a
-> NValueF p m a
-> n Bool
forall a b. (a -> b) -> a -> b
$
    \case
      (NVConstantF (NFloat Float
x), NVConstantF (NInt   Integer
y)) -> Bool -> n Bool
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> n Bool) -> Bool -> n Bool
forall a b. (a -> b) -> a -> b
$             Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
y
      (NVConstantF (NInt   Integer
x), NVConstantF (NFloat Float
y)) -> Bool -> n Bool
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> n Bool) -> Bool -> n Bool
forall a b. (a -> b) -> a -> b
$ Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y
      (NVConstantF NAtom
lc        , NVConstantF NAtom
rc        ) -> Bool -> n Bool
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> n Bool) -> Bool -> n Bool
forall a b. (a -> b) -> a -> b
$            NAtom
lc NAtom -> NAtom -> Bool
forall a. Eq a => a -> a -> Bool
== NAtom
rc
      (NVStrF      NixString
ls        , NVStrF      NixString
rs        ) -> Bool -> n Bool
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> n Bool) -> Bool -> n Bool
forall a b. (a -> b) -> a -> b
$  (\ NixString -> Text
i -> NixString -> Text
i NixString
ls Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== NixString -> Text
i NixString
rs) NixString -> Text
ignoreContext
      (NVListF     [a]
ls        , NVListF     [a]
rs        ) ->          (a -> a -> n Bool) -> [a] -> [a] -> n Bool
forall (f :: * -> *) (m :: * -> *) a b.
(Align f, Traversable f, Monad m) =>
(a -> b -> m Bool) -> f a -> f b -> m Bool
alignEqM a -> a -> n Bool
eq [a]
ls [a]
rs
      (NVSetF      PositionSet
_      AttrSet a
lm , NVSetF      PositionSet
_      AttrSet a
rm ) ->          AttrSet a -> AttrSet a -> n Bool
attrsEq AttrSet a
lm AttrSet a
rm
      (NVPathF     Path
lp        , NVPathF     Path
rp        ) ->             Bool -> n Bool
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> n Bool) -> Bool -> n Bool
forall a b. (a -> b) -> a -> b
$ Path
lp Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
rp
      (NValueF p m a, NValueF p m a)
_                                                -> Bool -> n Bool
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

valueFEq
  :: (AttrSet a -> AttrSet a -> Bool)
  -> (a -> a -> Bool)
  -> NValueF p m a
  -> NValueF p m a
  -> Bool
valueFEq :: forall a p (m :: * -> *).
(AttrSet a -> AttrSet a -> Bool)
-> (a -> a -> Bool) -> NValueF p m a -> NValueF p m a -> Bool
valueFEq AttrSet a -> AttrSet a -> Bool
attrsEq a -> a -> Bool
eq NValueF p m a
x NValueF p m a
y =
  Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    (AttrSet a -> AttrSet a -> Identity Bool)
-> (a -> a -> Identity Bool)
-> NValueF p m a
-> NValueF p m a
-> Identity Bool
forall (n :: * -> *) a p (m :: * -> *).
Monad n =>
(AttrSet a -> AttrSet a -> n Bool)
-> (a -> a -> n Bool) -> NValueF p m a -> NValueF p m a -> n Bool
valueFEqM
      ((Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool)
-> (AttrSet a -> Bool) -> AttrSet a -> Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((AttrSet a -> Bool) -> AttrSet a -> Identity Bool)
-> (AttrSet a -> AttrSet a -> Bool)
-> AttrSet a
-> AttrSet a
-> Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrSet a -> AttrSet a -> Bool
attrsEq)
      ((Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> (a -> Bool) -> a -> Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Bool) -> a -> Identity Bool)
-> (a -> a -> Bool) -> a -> a -> Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Bool
eq)
      NValueF p m a
x
      NValueF p m a
y

compareAttrSetsM
  :: Monad m
  => (t -> m (Maybe NixString))
  -> (t -> t -> m Bool)
  -> AttrSet t
  -> AttrSet t
  -> m Bool
compareAttrSetsM :: forall (m :: * -> *) t.
Monad m =>
(t -> m (Maybe NixString))
-> (t -> t -> m Bool) -> AttrSet t -> AttrSet t -> m Bool
compareAttrSetsM t -> m (Maybe NixString)
f t -> t -> m Bool
eq AttrSet t
lm AttrSet t
rm =
  m Bool -> m Bool -> Bool -> m Bool
forall a. a -> a -> Bool -> a
bool
    m Bool
compareAttrs
    (m Bool -> Maybe (m Bool) -> m Bool
forall a. a -> Maybe a -> a
fromMaybe m Bool
compareAttrs Maybe (m Bool)
equalOutPaths)
    (Bool -> m Bool) -> m Bool -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Bool
areDerivations
 where
  areDerivations :: m Bool
areDerivations = (m Bool -> m Bool -> m Bool)
-> (AttrSet t -> m Bool) -> AttrSet t -> AttrSet t -> m Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on ((Bool -> Bool -> Bool) -> m Bool -> m Bool -> m Bool
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&)) ((t -> m (Maybe NixString)) -> AttrSet t -> m Bool
forall (m :: * -> *) t.
Monad m =>
(t -> m (Maybe NixString)) -> AttrSet t -> m Bool
isDerivationM t -> m (Maybe NixString)
f              ) AttrSet t
lm AttrSet t
rm
  equalOutPaths :: Maybe (m Bool)
equalOutPaths  = (Maybe t -> Maybe t -> Maybe (m Bool))
-> (AttrSet t -> Maybe t)
-> AttrSet t
-> AttrSet t
-> Maybe (m Bool)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on ((t -> t -> m Bool) -> Maybe t -> Maybe t -> Maybe (m Bool)
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2   t -> t -> m Bool
eq) (VarName -> AttrSet t -> Maybe t
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.Lazy.lookup VarName
"outPath") AttrSet t
lm AttrSet t
rm
  compareAttrs :: m Bool
compareAttrs   =     (t -> t -> m Bool) -> AttrSet t -> AttrSet t -> m Bool
forall (f :: * -> *) (m :: * -> *) a b.
(Align f, Traversable f, Monad m) =>
(a -> b -> m Bool) -> f a -> f b -> m Bool
alignEqM t -> t -> m Bool
eq                                  AttrSet t
lm AttrSet t
rm

compareAttrSets
  :: (t -> Maybe NixString)
  -> (t -> t -> Bool)
  -> AttrSet t
  -> AttrSet t
  -> Bool
compareAttrSets :: forall t.
(t -> Maybe NixString)
-> (t -> t -> Bool) -> AttrSet t -> AttrSet t -> Bool
compareAttrSets t -> Maybe NixString
f t -> t -> Bool
eq AttrSet t
lm AttrSet t
rm =
  Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (t -> Identity (Maybe NixString))
-> (t -> t -> Identity Bool)
-> AttrSet t
-> AttrSet t
-> Identity Bool
forall (m :: * -> *) t.
Monad m =>
(t -> m (Maybe NixString))
-> (t -> t -> m Bool) -> AttrSet t -> AttrSet t -> m Bool
compareAttrSetsM (Maybe NixString -> Identity (Maybe NixString)
forall a. a -> Identity a
Identity (Maybe NixString -> Identity (Maybe NixString))
-> (t -> Maybe NixString) -> t -> Identity (Maybe NixString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe NixString
f) ((Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> (t -> Bool) -> t -> Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((t -> Bool) -> t -> Identity Bool)
-> (t -> t -> Bool) -> t -> t -> Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t -> Bool
eq) AttrSet t
lm AttrSet t
rm

valueEqM
  :: forall t f m
   . (MonadThunk t m (NValue t f m), NVConstraint f)
  => NValue t f m
  -> NValue t f m
  -> m Bool
valueEqM :: forall t (f :: * -> *) (m :: * -> *).
(MonadThunk t m (NValue t f m), NVConstraint f) =>
NValue t f m -> NValue t f m -> m Bool
valueEqM (  Pure t
x) (  Pure t
y) = t -> t -> m Bool
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), NVConstraint f) =>
t -> t -> m Bool
thunkEqM t
x t
y
valueEqM (  Pure t
x) y :: NValue t f m
y@(Free NValue' t f m (NValue t f m)
_) = t -> t -> m Bool
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), NVConstraint f) =>
t -> t -> m Bool
thunkEqM t
x (t -> m Bool) -> m t -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (NValue t f m) -> m t
forall t (m :: * -> *) a. MonadThunk t m a => m a -> m t
thunk (NValue t f m -> m (NValue t f m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
y)
valueEqM x :: NValue t f m
x@(Free NValue' t f m (NValue t f m)
_) (  Pure t
y) = (t -> t -> m Bool
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), NVConstraint f) =>
t -> t -> m Bool
`thunkEqM` t
y) (t -> m Bool) -> m t -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (NValue t f m) -> m t
forall t (m :: * -> *) a. MonadThunk t m a => m a -> m t
thunk (NValue t f m -> m (NValue t f m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
x)
valueEqM (Free (NValue' (f (NValueF (NValue t f m) m (NValue t f m))
-> NValueF (NValue t f m) m (NValue t f m)
forall a. f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract -> NValueF (NValue t f m) m (NValue t f m)
x))) (Free (NValue' (f (NValueF (NValue t f m) m (NValue t f m))
-> NValueF (NValue t f m) m (NValue t f m)
forall a. f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract -> NValueF (NValue t f m) m (NValue t f m)
y))) =
  (AttrSet (NValue t f m) -> AttrSet (NValue t f m) -> m Bool)
-> (NValue t f m -> NValue t f m -> m Bool)
-> NValueF (NValue t f m) m (NValue t f m)
-> NValueF (NValue t f m) m (NValue t f m)
-> m Bool
forall (n :: * -> *) a p (m :: * -> *).
Monad n =>
(AttrSet a -> AttrSet a -> n Bool)
-> (a -> a -> n Bool) -> NValueF p m a -> NValueF p m a -> n Bool
valueFEqM
    ((NValue t f m -> m (Maybe NixString))
-> (NValue t f m -> NValue t f m -> m Bool)
-> AttrSet (NValue t f m)
-> AttrSet (NValue t f m)
-> m Bool
forall (m :: * -> *) t.
Monad m =>
(t -> m (Maybe NixString))
-> (t -> t -> m Bool) -> AttrSet t -> AttrSet t -> m Bool
compareAttrSetsM NValue t f m -> m (Maybe NixString)
findNVStr NValue t f m -> NValue t f m -> m Bool
forall t (f :: * -> *) (m :: * -> *).
(MonadThunk t m (NValue t f m), NVConstraint f) =>
NValue t f m -> NValue t f m -> m Bool
valueEqM)
    NValue t f m -> NValue t f m -> m Bool
forall t (f :: * -> *) (m :: * -> *).
(MonadThunk t m (NValue t f m), NVConstraint f) =>
NValue t f m -> NValue t f m -> m Bool
valueEqM
    NValueF (NValue t f m) m (NValue t f m)
x
    NValueF (NValue t f m) m (NValue t f m)
y
 where
  findNVStr :: NValue t f m -> m (Maybe NixString)
  findNVStr :: NValue t f m -> m (Maybe NixString)
findNVStr =
    (t -> m (Maybe NixString))
-> (NValue' t f m (NValue t f m) -> m (Maybe NixString))
-> NValue t f m
-> m (Maybe NixString)
forall a b (f :: * -> *).
(a -> b) -> (f (Free f a) -> b) -> Free f a -> b
free
      (Maybe NixString -> m (Maybe NixString)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NixString -> m (Maybe NixString))
-> (NValue t f m -> Maybe NixString)
-> NValue t f m
-> m (Maybe NixString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (\case
          NVStr NixString
s -> NixString -> Maybe NixString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NixString
s
          NValue t f m
_       -> Maybe NixString
forall a. Monoid a => a
mempty
        ) (NValue t f m -> m (Maybe NixString))
-> (t -> m (NValue t f m)) -> t -> m (Maybe NixString)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< t -> m (NValue t f m)
forall t (m :: * -> *) a. MonadThunk t m a => t -> m a
force
      )
      (Maybe NixString -> m (Maybe NixString)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NixString -> m (Maybe NixString))
-> (NValue' t f m (NValue t f m) -> Maybe NixString)
-> NValue' t f m (NValue t f m)
-> m (Maybe NixString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        \case
          NVStr' NixString
s -> NixString -> Maybe NixString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NixString
s
          NValue' t f m (NValue t f m)
_        -> Maybe NixString
forall a. Monoid a => a
mempty
      )

-- This function has mutual recursion with `valueEqM`, and this function so far is not used across the project,
-- but that one is.
thunkEqM :: (MonadThunk t m (NValue t f m), NVConstraint f) => t -> t -> m Bool
thunkEqM :: forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), NVConstraint f) =>
t -> t -> m Bool
thunkEqM t
lt t
rt =
  do
    NValue t f m
lv <- t -> m (NValue t f m)
forall t (m :: * -> *) a. MonadThunk t m a => t -> m a
force t
lt
    NValue t f m
rv <- t -> m (NValue t f m)
forall t (m :: * -> *) a. MonadThunk t m a => t -> m a
force t
rt

    let
      unsafePtrEq :: m Bool
unsafePtrEq =
        m Bool -> m Bool -> Bool -> m Bool
forall a. a -> a -> Bool -> a
bool
          (NValue t f m -> NValue t f m -> m Bool
forall t (f :: * -> *) (m :: * -> *).
(MonadThunk t m (NValue t f m), NVConstraint f) =>
NValue t f m -> NValue t f m -> m Bool
valueEqM NValue t f m
lv NValue t f m
rv)
          (Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
          (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (ThunkId m -> ThunkId m -> Bool)
-> (t -> ThunkId m) -> t -> t -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on ThunkId m -> ThunkId m -> Bool
forall a. Eq a => a -> a -> Bool
(==) t -> ThunkId m
forall t (m :: * -> *) a. MonadThunk t m a => t -> ThunkId m
thunkId t
lt t
rt

    case (NValue t f m
lv, NValue t f m
rv) of
      (NVClosure Params ()
_ NValue t f m -> m (NValue t f m)
_, NVClosure Params ()
_ NValue t f m -> m (NValue t f m)
_) -> m Bool
unsafePtrEq
      (NVList [NValue t f m]
_     , NVList [NValue t f m]
_     ) -> m Bool
unsafePtrEq
      (NVSet PositionSet
_ AttrSet (NValue t f m)
_    , NVSet PositionSet
_ AttrSet (NValue t f m)
_    ) -> m Bool
unsafePtrEq
      (NValue t f m, NValue t f m)
_                              -> NValue t f m -> NValue t f m -> m Bool
forall t (f :: * -> *) (m :: * -> *).
(MonadThunk t m (NValue t f m), NVConstraint f) =>
NValue t f m -> NValue t f m -> m Bool
valueEqM NValue t f m
lv NValue t f m
rv