{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}

module Nix.Value.Equal where

import           Control.Comonad
import           Control.Monad
import           Control.Monad.Free
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           Data.Align
import           Data.Eq.Deriving
import           Data.Functor.Classes
import           Data.Functor.Identity
import qualified Data.HashMap.Lazy             as M
import           Data.These
import           Nix.Atoms
import           Nix.Frames
import           Nix.String
import           Nix.Thunk
import           Nix.Utils
import           Nix.Value

checkComparable
  :: (Framed e m, MonadDataErrorContext t f m)
  => NValue t f m
  -> NValue t f m
  -> m ()
checkComparable :: NValue t f m -> NValue t f m -> m ()
checkComparable x :: NValue t f m
x y :: NValue t f m
y = case (NValue t f m
x, NValue t f m
y) of
  (NVConstant (NFloat _), NVConstant (NInt _)) -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  (NVConstant (NInt _), NVConstant (NFloat _)) -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  (NVConstant (NInt _), NVConstant (NInt _)) -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  (NVConstant (NFloat _), NVConstant (NFloat _)) -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  (NVStr _, NVStr _) -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  (NVPath _, NVPath _) -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  _ -> 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 :: (a -> b -> m Bool) -> f a -> f b -> m Bool
alignEqM eq :: a -> b -> m Bool
eq fa :: f a
fa fb :: f b
fb = (Either () () -> Bool) -> m (Either () ()) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((() -> Bool) -> (() -> Bool) -> Either () () -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True)) (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
$ do
  f (a, b)
pairs <- f (These a b)
-> (These a b -> ExceptT () m (a, b)) -> ExceptT () m (f (a, b))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (f a -> f b -> f (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
Data.Align.align f a
fa f b
fb) ((These a b -> ExceptT () m (a, b)) -> ExceptT () m (f (a, b)))
-> (These a b -> ExceptT () m (a, b)) -> ExceptT () m (f (a, b))
forall a b. (a -> b) -> a -> b
$ \case
    These a :: a
a b :: b
b -> (a, b) -> ExceptT () m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
    _         -> () -> ExceptT () m (a, b)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ()
  f (a, b) -> ((a, b) -> ExceptT () m ()) -> ExceptT () m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ f (a, b)
pairs (((a, b) -> ExceptT () m ()) -> ExceptT () m ())
-> ((a, b) -> ExceptT () m ()) -> ExceptT () m ()
forall a b. (a -> b) -> a -> b
$ \(a :: a
a, b :: b
b) -> Bool -> ExceptT () m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ExceptT () m ()) -> ExceptT () m Bool -> ExceptT () m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Bool -> ExceptT () m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> b -> m Bool
eq a
a b
b)

alignEq :: (Align f, Traversable f) => (a -> b -> Bool) -> f a -> f b -> Bool
alignEq :: (a -> b -> Bool) -> f a -> f b -> Bool
alignEq eq :: a -> b -> Bool
eq fa :: f a
fa fb :: 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 (\x :: a
x y :: b
y -> Bool -> Identity Bool
forall a. a -> Identity a
Identity (a -> b -> Bool
eq a
x b
y)) f a
fa f b
fb

isDerivationM :: Monad m => (t -> m (Maybe NixString)) -> AttrSet t -> m Bool
isDerivationM :: (t -> m (Maybe NixString)) -> AttrSet t -> m Bool
isDerivationM f :: t -> m (Maybe NixString)
f m :: AttrSet t
m = case Text -> AttrSet t -> Maybe t
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup "type" AttrSet t
m of
  Nothing -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  Just t :: t
t  -> do
    Maybe NixString
mres <- t -> m (Maybe NixString)
f t
t
    case Maybe NixString
mres of
        -- We should probably really make sure the context is empty here
        -- but the C++ implementation ignores it.
      Just s :: NixString
s  -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ NixString -> Text
principledStringIgnoreContext NixString
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "derivation"
      Nothing -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

isDerivation :: Monad m => (t -> Maybe NixString) -> AttrSet t -> Bool
isDerivation :: (t -> Maybe NixString) -> AttrSet t -> Bool
isDerivation f :: 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 (\x :: t
x -> Maybe NixString -> Identity (Maybe NixString)
forall a. a -> Identity a
Identity (t -> Maybe NixString
f t
x))

valueFEqM
  :: 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)
-> (a -> a -> n Bool) -> NValueF p m a -> NValueF p m a -> n Bool
valueFEqM attrsEq :: AttrSet a -> AttrSet a -> n Bool
attrsEq eq :: 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 x :: Float
x), NVConstantF (NInt y :: Integer
y)  ) -> Bool -> n Bool
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   x :: Integer
x), NVConstantF (NFloat y :: Float
y)) -> Bool -> n Bool
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 lc :: NAtom
lc        , NVConstantF rc :: NAtom
rc        ) -> Bool -> n Bool
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 ls :: NixString
ls, NVStrF rs :: NixString
rs) ->
    Bool -> n Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> n Bool) -> Bool -> n Bool
forall a b. (a -> b) -> a -> b
$ NixString -> Text
principledStringIgnoreContext NixString
ls Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== NixString -> Text
principledStringIgnoreContext NixString
rs
  (NVListF ls :: [a]
ls , NVListF rs :: [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 lm :: AttrSet a
lm _, NVSetF rm :: AttrSet a
rm _) -> AttrSet a -> AttrSet a -> n Bool
attrsEq AttrSet a
lm AttrSet a
rm
  (NVPathF lp :: FilePath
lp , NVPathF rp :: FilePath
rp ) -> Bool -> n Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> n Bool) -> Bool -> n Bool
forall a b. (a -> b) -> a -> b
$ FilePath
lp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
rp
  _                          -> Bool -> n Bool
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 :: (AttrSet a -> AttrSet a -> Bool)
-> (a -> a -> Bool) -> NValueF p m a -> NValueF p m a -> Bool
valueFEq attrsEq :: AttrSet a -> AttrSet a -> Bool
attrsEq eq :: a -> a -> Bool
eq x :: NValueF p m a
x y :: 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
  (\x' :: AttrSet a
x' y' :: AttrSet a
y' -> Bool -> Identity Bool
forall a. a -> Identity a
Identity (AttrSet a -> AttrSet a -> Bool
attrsEq AttrSet a
x' AttrSet a
y'))
  (\x' :: a
x' y' :: a
y' -> Bool -> Identity Bool
forall a. a -> Identity a
Identity (a -> a -> Bool
eq a
x' a
y'))
  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 :: (t -> m (Maybe NixString))
-> (t -> t -> m Bool) -> AttrSet t -> AttrSet t -> m Bool
compareAttrSetsM f :: t -> m (Maybe NixString)
f eq :: t -> t -> m Bool
eq lm :: AttrSet t
lm rm :: AttrSet t
rm = do
  (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 m Bool -> (Bool -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    True -> (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
rm m Bool -> (Bool -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      True
        | Just lp :: t
lp <- Text -> AttrSet t -> Maybe t
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup "outPath" AttrSet t
lm, Just rp :: t
rp <- Text -> AttrSet t -> Maybe t
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup "outPath" AttrSet t
rm -> t -> t -> m Bool
eq
          t
lp
          t
rp
      _ -> m Bool
compareAttrs
    _ -> m Bool
compareAttrs
  where 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 :: (t -> Maybe NixString)
-> (t -> t -> Bool) -> AttrSet t -> AttrSet t -> Bool
compareAttrSets f :: t -> Maybe NixString
f eq :: t -> t -> Bool
eq lm :: AttrSet t
lm rm :: 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 (\t :: t
t -> Maybe NixString -> Identity (Maybe NixString)
forall a. a -> Identity a
Identity (t -> Maybe NixString
f t
t)) (\x :: t
x y :: t
y -> Bool -> Identity Bool
forall a. a -> Identity a
Identity (t -> t -> Bool
eq t
x t
y)) AttrSet t
lm AttrSet t
rm

valueEqM
  :: forall t f m
   . (MonadThunk t m (NValue t f m), Comonad f)
  => NValue t f m
  -> NValue t f m
  -> m Bool
valueEqM :: NValue t f m -> NValue t f m -> m Bool
valueEqM (  Pure x :: t
x) (  Pure y :: t
y) = t -> t -> m Bool
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), Comonad f) =>
t -> t -> m Bool
thunkEqM t
x t
y
valueEqM (  Pure x :: t
x) y :: NValue t f m
y@(Free _) = t -> t -> m Bool
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), Comonad 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 (f :: * -> *) a. Applicative f => a -> f a
pure NValue t f m
y)
valueEqM x :: NValue t f m
x@(Free _) (  Pure y :: t
y) = t -> t -> m Bool
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), Comonad f) =>
t -> t -> m Bool
thunkEqM (t -> t -> m Bool) -> t -> t -> m Bool
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? 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 (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 (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 (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)
forall t (m :: * -> *) t (w :: * -> *) (m :: * -> *) a
       (w :: * -> *) t (m :: * -> *).
(MonadThunk t m (Free (NValue' t w m) a), Comonad w, Comonad w) =>
Free (NValue' t w m) t -> m (Maybe NixString)
f NValue t f m -> NValue t f m -> m Bool
forall t (f :: * -> *) (m :: * -> *).
(MonadThunk t m (NValue t f m), Comonad 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), Comonad 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
  f :: Free (NValue' t w m) t -> m (Maybe NixString)
f (Pure t :: t
t) = t
-> (Free (NValue' t w m) a -> m (Maybe NixString))
-> m (Maybe NixString)
forall t (m :: * -> *) a r.
MonadThunk t m a =>
t -> (a -> m r) -> m r
force t
t ((Free (NValue' t w m) a -> m (Maybe NixString))
 -> m (Maybe NixString))
-> (Free (NValue' t w m) a -> m (Maybe NixString))
-> m (Maybe NixString)
forall a b. (a -> b) -> a -> b
$ \case
    NVStr s :: NixString
s -> Maybe NixString -> m (Maybe NixString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NixString -> m (Maybe NixString))
-> Maybe NixString -> m (Maybe NixString)
forall a b. (a -> b) -> a -> b
$ NixString -> Maybe NixString
forall a. a -> Maybe a
Just NixString
s
    _       -> Maybe NixString -> m (Maybe NixString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NixString
forall a. Maybe a
Nothing
  f (Free v :: NValue' t w m (Free (NValue' t w m) t)
v) = case NValue' t w m (Free (NValue' t w m) t)
v of
    NVStr' s :: NixString
s -> Maybe NixString -> m (Maybe NixString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe NixString -> m (Maybe NixString))
-> Maybe NixString -> m (Maybe NixString)
forall a b. (a -> b) -> a -> b
$ NixString -> Maybe NixString
forall a. a -> Maybe a
Just NixString
s
    _        -> Maybe NixString -> m (Maybe NixString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NixString
forall a. Maybe a
Nothing

thunkEqM :: (MonadThunk t m (NValue t f m), Comonad f) => t -> t -> m Bool
thunkEqM :: t -> t -> m Bool
thunkEqM lt :: t
lt rt :: t
rt = t -> (NValue t f m -> m Bool) -> m Bool
forall t (m :: * -> *) a r.
MonadThunk t m a =>
t -> (a -> m r) -> m r
force t
lt ((NValue t f m -> m Bool) -> m Bool)
-> (NValue t f m -> m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ \lv :: NValue t f m
lv -> t -> (NValue t f m -> m Bool) -> m Bool
forall t (m :: * -> *) a r.
MonadThunk t m a =>
t -> (a -> m r) -> m r
force t
rt ((NValue t f m -> m Bool) -> m Bool)
-> (NValue t f m -> m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ \rv :: NValue t f m
rv ->
  let unsafePtrEq :: m Bool
unsafePtrEq = case (t
lt, t
rt) of
        (t -> ThunkId m
forall t (m :: * -> *) a. MonadThunk t m a => t -> ThunkId m
thunkId -> ThunkId m
lid, t -> ThunkId m
forall t (m :: * -> *) a. MonadThunk t m a => t -> ThunkId m
thunkId -> ThunkId m
rid) | ThunkId m
lid ThunkId m -> ThunkId m -> Bool
forall a. Eq a => a -> a -> Bool
== ThunkId m
rid -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        _ -> NValue t f m -> NValue t f m -> m Bool
forall t (f :: * -> *) (m :: * -> *).
(MonadThunk t m (NValue t f m), Comonad f) =>
NValue t f m -> NValue t f m -> m Bool
valueEqM NValue t f m
lv NValue t f m
rv
  in  case (NValue t f m
lv, NValue t f m
rv) of
        (NVClosure _ _, NVClosure _ _) -> m Bool
unsafePtrEq
        (NVList _     , NVList _     ) -> m Bool
unsafePtrEq
        (NVSet _ _    , NVSet _ _    ) -> m Bool
unsafePtrEq
        _                              -> NValue t f m -> NValue t f m -> m Bool
forall t (f :: * -> *) (m :: * -> *).
(MonadThunk t m (NValue t f m), Comonad f) =>
NValue t f m -> NValue t f m -> m Bool
valueEqM NValue t f m
lv NValue t f m
rv

instance Eq1 (NValueF p m) where
  liftEq :: (a -> b -> Bool) -> NValueF p m a -> NValueF p m b -> Bool
liftEq _  (NVConstantF x :: NAtom
x) (NVConstantF y :: NAtom
y) = NAtom
x NAtom -> NAtom -> Bool
forall a. Eq a => a -> a -> Bool
== NAtom
y
  liftEq _  (NVStrF      x :: NixString
x) (NVStrF      y :: NixString
y) = NixString
x NixString -> NixString -> Bool
forall a. Eq a => a -> a -> Bool
== NixString
y
  liftEq eq :: a -> b -> Bool
eq (NVListF     x :: [a]
x) (NVListF     y :: [b]
y) = (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq [a]
x [b]
y
  liftEq eq :: a -> b -> Bool
eq (NVSetF x :: AttrSet a
x _   ) (NVSetF y :: AttrSet b
y _   ) = (a -> b -> Bool) -> AttrSet a -> AttrSet b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq AttrSet a
x AttrSet b
y
  liftEq _  (NVPathF x :: FilePath
x    ) (NVPathF y :: FilePath
y    ) = FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
y
  liftEq _  _               _               = Bool
False

$(deriveEq1 ''NValue')