{-# LANGUAGE CPP #-}

module Nix.Diff where

import Control.Monad (forM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader, ReaderT, ask)
import Control.Monad.State (MonadState, StateT, get, put)
import Data.Attoparsec.Text (IResult(..), Parser)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Map (Map)
import Data.Maybe (catMaybes)
import Data.Set (Set)
import Data.Text (Text)
import Data.Vector (Vector)
import Nix.Derivation (Derivation, DerivationOutput)
import Prelude hiding (unzip)

import qualified Data.Attoparsec.Text
import qualified Data.ByteString
import qualified Data.Char            as Char
import qualified Data.List            as List
import qualified Data.List.NonEmpty
import qualified Data.Map
import qualified Data.Set
import qualified Data.String          as String
import qualified Data.Text            as Text
import qualified Data.Text.Encoding
import qualified Data.Text.Encoding.Error
import qualified Data.Vector
import qualified Nix.Derivation
import qualified Patience
import qualified System.FilePath      as FilePath
import qualified System.Process       as Process

#if !MIN_VERSION_base(4,15,1)
import Control.Monad.Fail (MonadFail)
#endif

import Nix.Diff.Types
import Nix.Diff.Store (StorePath (StorePath, unsafeStorePathFile))
import qualified Nix.Diff.Store       as Store

#if MIN_VERSION_base(4,19,0)
import Data.Functor (unzip)
#else
unzip :: Functor f => f (a, b) -> (f a, f b)
unzip :: forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzip f (a, b)
xs = ((a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> f (a, b) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, b)
xs, (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> f (a, b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, b)
xs)
#endif

newtype Status = Status { Status -> Set Diffed
visited :: Set Diffed }

data Diffed = Diffed
    { Diffed -> StorePath
leftDerivation  :: StorePath
    , Diffed -> OutputNames
leftOutput      :: OutputNames
    , Diffed -> StorePath
rightDerivation :: StorePath
    , Diffed -> OutputNames
rightOutput     :: OutputNames
    } deriving (Diffed -> Diffed -> Bool
(Diffed -> Diffed -> Bool)
-> (Diffed -> Diffed -> Bool) -> Eq Diffed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Diffed -> Diffed -> Bool
== :: Diffed -> Diffed -> Bool
$c/= :: Diffed -> Diffed -> Bool
/= :: Diffed -> Diffed -> Bool
Eq, Eq Diffed
Eq Diffed =>
(Diffed -> Diffed -> Ordering)
-> (Diffed -> Diffed -> Bool)
-> (Diffed -> Diffed -> Bool)
-> (Diffed -> Diffed -> Bool)
-> (Diffed -> Diffed -> Bool)
-> (Diffed -> Diffed -> Diffed)
-> (Diffed -> Diffed -> Diffed)
-> Ord Diffed
Diffed -> Diffed -> Bool
Diffed -> Diffed -> Ordering
Diffed -> Diffed -> Diffed
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Diffed -> Diffed -> Ordering
compare :: Diffed -> Diffed -> Ordering
$c< :: Diffed -> Diffed -> Bool
< :: Diffed -> Diffed -> Bool
$c<= :: Diffed -> Diffed -> Bool
<= :: Diffed -> Diffed -> Bool
$c> :: Diffed -> Diffed -> Bool
> :: Diffed -> Diffed -> Bool
$c>= :: Diffed -> Diffed -> Bool
>= :: Diffed -> Diffed -> Bool
$cmax :: Diffed -> Diffed -> Diffed
max :: Diffed -> Diffed -> Diffed
$cmin :: Diffed -> Diffed -> Diffed
min :: Diffed -> Diffed -> Diffed
Ord)

newtype Diff a = Diff { forall a. Diff a -> ReaderT DiffContext (StateT Status IO) a
unDiff :: ReaderT DiffContext (StateT Status IO) a }
    deriving newtype
    ( (forall a b. (a -> b) -> Diff a -> Diff b)
-> (forall a b. a -> Diff b -> Diff a) -> Functor Diff
forall a b. a -> Diff b -> Diff a
forall a b. (a -> b) -> Diff a -> Diff b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Diff a -> Diff b
fmap :: forall a b. (a -> b) -> Diff a -> Diff b
$c<$ :: forall a b. a -> Diff b -> Diff a
<$ :: forall a b. a -> Diff b -> Diff a
Functor
    , Functor Diff
Functor Diff =>
(forall a. a -> Diff a)
-> (forall a b. Diff (a -> b) -> Diff a -> Diff b)
-> (forall a b c. (a -> b -> c) -> Diff a -> Diff b -> Diff c)
-> (forall a b. Diff a -> Diff b -> Diff b)
-> (forall a b. Diff a -> Diff b -> Diff a)
-> Applicative Diff
forall a. a -> Diff a
forall a b. Diff a -> Diff b -> Diff a
forall a b. Diff a -> Diff b -> Diff b
forall a b. Diff (a -> b) -> Diff a -> Diff b
forall a b c. (a -> b -> c) -> Diff a -> Diff b -> Diff c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Diff a
pure :: forall a. a -> Diff a
$c<*> :: forall a b. Diff (a -> b) -> Diff a -> Diff b
<*> :: forall a b. Diff (a -> b) -> Diff a -> Diff b
$cliftA2 :: forall a b c. (a -> b -> c) -> Diff a -> Diff b -> Diff c
liftA2 :: forall a b c. (a -> b -> c) -> Diff a -> Diff b -> Diff c
$c*> :: forall a b. Diff a -> Diff b -> Diff b
*> :: forall a b. Diff a -> Diff b -> Diff b
$c<* :: forall a b. Diff a -> Diff b -> Diff a
<* :: forall a b. Diff a -> Diff b -> Diff a
Applicative
    , Applicative Diff
Applicative Diff =>
(forall a b. Diff a -> (a -> Diff b) -> Diff b)
-> (forall a b. Diff a -> Diff b -> Diff b)
-> (forall a. a -> Diff a)
-> Monad Diff
forall a. a -> Diff a
forall a b. Diff a -> Diff b -> Diff b
forall a b. Diff a -> (a -> Diff b) -> Diff b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Diff a -> (a -> Diff b) -> Diff b
>>= :: forall a b. Diff a -> (a -> Diff b) -> Diff b
$c>> :: forall a b. Diff a -> Diff b -> Diff b
>> :: forall a b. Diff a -> Diff b -> Diff b
$creturn :: forall a. a -> Diff a
return :: forall a. a -> Diff a
Monad
    , MonadReader DiffContext
    , MonadState Status
    , Monad Diff
Monad Diff => (forall a. IO a -> Diff a) -> MonadIO Diff
forall a. IO a -> Diff a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Diff a
liftIO :: forall a. IO a -> Diff a
MonadIO
#if MIN_VERSION_base(4,9,0)
    , Monad Diff
Monad Diff => (forall a. String -> Diff a) -> MonadFail Diff
forall a. String -> Diff a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall a. String -> Diff a
fail :: forall a. String -> Diff a
MonadFail
#endif
    )

data DiffContext = DiffContext
  { DiffContext -> Orientation
orientation :: Orientation
  , DiffContext -> Bool
environment :: Bool
  }

data Orientation = Character | Word | Line

{-| Extract the name of a derivation (i.e. the part after the hash)

    This is used to guess which derivations are related to one another, even
    though their hash might differ

    Note that this assumes that the path name is:

    > /nix/store/${32_CHARACTER_HASH}-${NAME}.drv

    Nix technically does not require that the Nix store is actually stored
    underneath `/nix/store`, but this is the overwhelmingly common use case
-}
derivationName :: StorePath -> Text
derivationName :: StorePath -> Text
derivationName StorePath
storePath = Int -> Text -> Text
Text.dropEnd Int
4 (Int -> Text -> Text
Text.drop Int
44 (String -> Text
Text.pack StorePath
storePath.unsafeStorePathFile))

-- | Group paths by their name
groupByName :: Map StorePath a -> Map Text (Map StorePath a)
groupByName :: forall a. Map StorePath a -> Map Text (Map StorePath a)
groupByName Map StorePath a
m = [(Text, Map StorePath a)] -> Map Text (Map StorePath a)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Text, Map StorePath a)]
assocs
  where
    toAssoc :: StorePath -> (Text, Map StorePath a)
toAssoc StorePath
key = (StorePath -> Text
derivationName StorePath
key, (StorePath -> a -> Bool) -> Map StorePath a -> Map StorePath a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Data.Map.filterWithKey StorePath -> a -> Bool
forall {p}. StorePath -> p -> Bool
predicate Map StorePath a
m)
      where
        predicate :: StorePath -> p -> Bool
predicate StorePath
key' p
_ = StorePath -> Text
derivationName StorePath
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath -> Text
derivationName StorePath
key'

    assocs :: [(Text, Map StorePath a)]
assocs = (StorePath -> (Text, Map StorePath a))
-> [StorePath] -> [(Text, Map StorePath a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StorePath -> (Text, Map StorePath a)
toAssoc (Map StorePath a -> [StorePath]
forall k a. Map k a -> [k]
Data.Map.keys Map StorePath a
m)

{-| Extract the name of a build product

    Similar to `derivationName`, this assumes that the path name is:

    > /nix/store/${32_CHARACTER_HASH}-${NAME}.drv
-}
buildProductName :: StorePath -> Text
buildProductName :: StorePath -> Text
buildProductName StorePath
storePath = Int -> Text -> Text
Text.drop Int
44 (String -> Text
Text.pack StorePath
storePath.unsafeStorePathFile)

-- | Like `groupByName`, but for `Set`s
groupSetsByName :: Set StorePath -> Map Text (Set StorePath)
groupSetsByName :: Set StorePath -> Map Text (Set StorePath)
groupSetsByName Set StorePath
s = [(Text, Set StorePath)] -> Map Text (Set StorePath)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList ((StorePath -> (Text, Set StorePath))
-> [StorePath] -> [(Text, Set StorePath)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StorePath -> (Text, Set StorePath)
toAssoc (Set StorePath -> [StorePath]
forall a. Set a -> [a]
Data.Set.toList Set StorePath
s))
  where
    toAssoc :: StorePath -> (Text, Set StorePath)
toAssoc StorePath
key = (StorePath -> Text
buildProductName StorePath
key, (StorePath -> Bool) -> Set StorePath -> Set StorePath
forall a. (a -> Bool) -> Set a -> Set a
Data.Set.filter StorePath -> Bool
predicate Set StorePath
s)
      where
        predicate :: StorePath -> Bool
predicate StorePath
key' = StorePath -> Text
buildProductName StorePath
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath -> Text
buildProductName StorePath
key'

-- | Read a file as utf-8 encoded string, replacing non-utf-8 characters
-- with the unicode replacement character.
-- This is necessary since derivations (and nix source code!) can in principle
-- contain arbitrary bytes, but `nix-derivation` can only parse from 'Text'.
readFileUtf8Lenient :: FilePath -> IO Text
readFileUtf8Lenient :: String -> IO Text
readFileUtf8Lenient String
file =
    OnDecodeError -> ByteString -> Text
Data.Text.Encoding.decodeUtf8With OnDecodeError
Data.Text.Encoding.Error.lenientDecode
        (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
Data.ByteString.readFile String
file

storepathParser :: Parser StorePath
storepathParser :: Parser StorePath
storepathParser = do
    Text
text <- Parser Text
Nix.Derivation.textParser
    let str :: String
str = Text -> String
Text.unpack Text
text
    case (Text -> Maybe (Char, Text)
Text.uncons Text
text, String -> Bool
FilePath.isValid String
str) of
        (Just (Char
'/', Text
_), Bool
True) -> do
            StorePath -> Parser StorePath
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
return (String -> StorePath
StorePath String
str)
        (Maybe (Char, Text), Bool)
_ -> do
            String -> Parser StorePath
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"bad path ‘" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
text String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"’ in derivation")


-- | Read and parse a derivation from a file
readDerivation :: StorePath -> Diff (Derivation StorePath Text)
readDerivation :: StorePath -> Diff (Derivation StorePath Text)
readDerivation StorePath
sp = do
    String
path <- IO String -> Diff String
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (StorePath -> IO String
Store.toPhysicalPath StorePath
sp)
    let string :: String
string = String
path
    Text
text <- IO Text -> Diff Text
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
readFileUtf8Lenient String
string)
    let parser :: Parser (Derivation StorePath Text)
parser = Parser StorePath
-> Parser Text -> Parser (Derivation StorePath Text)
forall fp txt.
(Ord fp, Ord txt) =>
Parser fp -> Parser txt -> Parser (Derivation fp txt)
Nix.Derivation.parseDerivationWith Parser StorePath
storepathParser Parser Text
Nix.Derivation.textParser
    case Parser (Derivation StorePath Text)
-> Text -> Result (Derivation StorePath Text)
forall a. Parser a -> Text -> Result a
Data.Attoparsec.Text.parse Parser (Derivation StorePath Text)
parser Text
text of
        Done Text
_ Derivation StorePath Text
derivation -> do
            Derivation StorePath Text -> Diff (Derivation StorePath Text)
forall a. a -> Diff a
forall (f :: * -> *) a. Applicative f => a -> f a
return Derivation StorePath Text
derivation
        Result (Derivation StorePath Text)
_ -> do
            String -> Diff (Derivation StorePath Text)
forall a. String -> Diff a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Could not parse a derivation from this file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
string)

-- | Read and parse a derivation from a store path that can be a derivation
-- (.drv) or a realized path, in which case the corresponding derivation is
-- queried.
readInput :: StorePath -> Diff (Derivation StorePath Text)
readInput :: StorePath -> Diff (Derivation StorePath Text)
readInput StorePath
pathAndMaybeOutput = do
    let (String
path, String
_) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!') StorePath
pathAndMaybeOutput.unsafeStorePathFile
    if String -> String -> Bool
FilePath.isExtensionOf String
".drv" String
path
    then StorePath -> Diff (Derivation StorePath Text)
readDerivation (String -> StorePath
StorePath String
path)
    else do
        let string :: String
string = String
path
        String
result <- IO String -> Diff String
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> [String] -> String -> IO String
Process.readProcess String
"nix-store" [ String
"--query", String
"--deriver", String
string ] [])
        case String -> [String]
String.lines String
result of
            [] -> String -> Diff (Derivation StorePath Text)
forall a. String -> Diff a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Could not obtain the derivation of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
string)
            String
l : [String]
ls -> do
                let drv_path :: String
drv_path = NonEmpty String -> String
forall a. NonEmpty a -> a
Data.List.NonEmpty.last (String
l String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [String]
ls)
                StorePath -> Diff (Derivation StorePath Text)
readDerivation (String -> StorePath
StorePath String
drv_path)

{-| Join two `Map`s on shared keys, discarding keys which are not present in
    both `Map`s
-}
innerJoin :: Ord k => Map k a -> Map k b -> Map k (a, b)
innerJoin :: forall k a b. Ord k => Map k a -> Map k b -> Map k (a, b)
innerJoin = (k -> a -> b -> Maybe (a, b))
-> (Map k a -> Map k (a, b))
-> (Map k b -> Map k (a, b))
-> Map k a
-> Map k b
-> Map k (a, b)
forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Data.Map.mergeWithKey k -> a -> b -> Maybe (a, b)
forall {p} {a} {b}. p -> a -> b -> Maybe (a, b)
both Map k a -> Map k (a, b)
forall {p} {k} {a}. p -> Map k a
left Map k b -> Map k (a, b)
forall {p} {k} {a}. p -> Map k a
right
  where
    both :: p -> a -> b -> Maybe (a, b)
both p
_ a
a b
b = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
b)

    left :: p -> Map k a
left p
_ = Map k a
forall k a. Map k a
Data.Map.empty

    right :: p -> Map k a
right p
_ = Map k a
forall k a. Map k a
Data.Map.empty

-- `getGroupedDiff` from `Diff` library, adapted for `patience`
getGroupedDiff :: Ord a => [a] -> [a] -> [Patience.Item [a]]
getGroupedDiff :: forall a. Ord a => [a] -> [a] -> [Item [a]]
getGroupedDiff [a]
oldList [a]
newList = [Item a] -> [Item [a]]
forall {a}. [Item a] -> [Item [a]]
go ([Item a] -> [Item [a]]) -> [Item a] -> [Item [a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [Item a]
forall a. Ord a => [a] -> [a] -> [Item a]
Patience.diff [a]
oldList [a]
newList
  where
    go :: [Item a] -> [Item [a]]
go = \case
      Patience.Old a
x : [Item a]
xs ->
        let ([a]
fs, [Item a]
rest) = [Item a] -> ([a], [Item a])
forall {a}. [Item a] -> ([a], [Item a])
goOlds [Item a]
xs
         in [a] -> Item [a]
forall a. a -> Item a
Patience.Old (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
fs) Item [a] -> [Item [a]] -> [Item [a]]
forall a. a -> [a] -> [a]
: [Item a] -> [Item [a]]
go [Item a]
rest
      Patience.New a
x : [Item a]
xs ->
        let ([a]
fs, [Item a]
rest) = [Item a] -> ([a], [Item a])
forall {a}. [Item a] -> ([a], [Item a])
goNews [Item a]
xs
         in [a] -> Item [a]
forall a. a -> Item a
Patience.New (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
fs) Item [a] -> [Item [a]] -> [Item [a]]
forall a. a -> [a] -> [a]
: [Item a] -> [Item [a]]
go [Item a]
rest
      Patience.Both a
x a
y : [Item a]
xs ->
        [a] -> [a] -> Item [a]
forall a. a -> a -> Item a
Patience.Both [a
x] [a
y] Item [a] -> [Item [a]] -> [Item [a]]
forall a. a -> [a] -> [a]
: [Item a] -> [Item [a]]
go [Item a]
xs
      [] -> []

    goOlds :: [Item a] -> ([a], [Item a])
goOlds = \case
      Patience.Old a
x : [Item a]
xs ->
        let ([a]
fs, [Item a]
rest) = [Item a] -> ([a], [Item a])
goOlds [Item a]
xs
         in (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
fs, [Item a]
rest)
      [Item a]
xs -> ([], [Item a]
xs)

    goNews :: [Item a] -> ([a], [Item a])
goNews = \case
      Patience.New a
x : [Item a]
xs ->
        let ([a]
fs, [Item a]
rest) = [Item a] -> ([a], [Item a])
goNews [Item a]
xs
         in (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
fs, [Item a]
rest)
      [Item a]
xs -> ([], [Item a]
xs)

-- | Diff two outputs
diffOutput
    :: Text
    -- ^ Output name
    -> DerivationOutput StorePath Text
    -- ^ Left derivation outputs
    -> DerivationOutput StorePath Text
    -- ^ Right derivation outputs
    -> Maybe OutputDiff
diffOutput :: Text
-> DerivationOutput StorePath Text
-> DerivationOutput StorePath Text
-> Maybe OutputDiff
diffOutput Text
outputName DerivationOutput StorePath Text
leftOutput DerivationOutput StorePath Text
rightOutput = do
    -- We deliberately do not include output paths or hashes in the diff since
    -- we already expect them to differ if the inputs differ.  Instead, we focus
    -- only displaying differing inputs.
    let leftHashAlgo :: Text
leftHashAlgo  = DerivationOutput StorePath Text -> Text
forall fp txt. DerivationOutput fp txt -> txt
Nix.Derivation.hashAlgo DerivationOutput StorePath Text
leftOutput
    let rightHashAlgo :: Text
rightHashAlgo = DerivationOutput StorePath Text -> Text
forall fp txt. DerivationOutput fp txt -> txt
Nix.Derivation.hashAlgo DerivationOutput StorePath Text
rightOutput
    if Text
leftHashAlgo Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rightHashAlgo
      then Maybe OutputDiff
forall a. Maybe a
Nothing
      else OutputDiff -> Maybe OutputDiff
forall a. a -> Maybe a
Just (Text -> Changed Text -> OutputDiff
OutputDiff Text
outputName (Text -> Text -> Changed Text
forall a. a -> a -> Changed a
Changed Text
leftHashAlgo Text
rightHashAlgo))

-- | Diff two sets of outputs
diffOutputs
    :: Map Text (DerivationOutput StorePath Text)
    -- ^ Left derivation outputs
    -> Map Text (DerivationOutput StorePath Text)
    -- ^ Right derivation outputs
    -> OutputsDiff
diffOutputs :: Map Text (DerivationOutput StorePath Text)
-> Map Text (DerivationOutput StorePath Text) -> OutputsDiff
diffOutputs Map Text (DerivationOutput StorePath Text)
leftOutputs Map Text (DerivationOutput StorePath Text)
rightOutputs = do
    let leftExtraOutputs :: Map Text (DerivationOutput StorePath Text)
leftExtraOutputs  = Map Text (DerivationOutput StorePath Text)
-> Map Text (DerivationOutput StorePath Text)
-> Map Text (DerivationOutput StorePath Text)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Data.Map.difference Map Text (DerivationOutput StorePath Text)
leftOutputs  Map Text (DerivationOutput StorePath Text)
rightOutputs
    let rightExtraOutputs :: Map Text (DerivationOutput StorePath Text)
rightExtraOutputs = Map Text (DerivationOutput StorePath Text)
-> Map Text (DerivationOutput StorePath Text)
-> Map Text (DerivationOutput StorePath Text)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Data.Map.difference Map Text (DerivationOutput StorePath Text)
rightOutputs Map Text (DerivationOutput StorePath Text)
leftOutputs

    let bothOutputs :: Map
  Text
  (DerivationOutput StorePath Text, DerivationOutput StorePath Text)
bothOutputs = Map Text (DerivationOutput StorePath Text)
-> Map Text (DerivationOutput StorePath Text)
-> Map
     Text
     (DerivationOutput StorePath Text, DerivationOutput StorePath Text)
forall k a b. Ord k => Map k a -> Map k b -> Map k (a, b)
innerJoin Map Text (DerivationOutput StorePath Text)
leftOutputs Map Text (DerivationOutput StorePath Text)
rightOutputs

    let
      extraOutputs :: Maybe (Changed (Map Text (DerivationOutput StorePath Text)))
extraOutputs =
        if Map Text (DerivationOutput StorePath Text) -> Bool
forall k a. Map k a -> Bool
Data.Map.null Map Text (DerivationOutput StorePath Text)
leftExtraOutputs Bool -> Bool -> Bool
&& Map Text (DerivationOutput StorePath Text) -> Bool
forall k a. Map k a -> Bool
Data.Map.null Map Text (DerivationOutput StorePath Text)
rightExtraOutputs
          then Maybe (Changed (Map Text (DerivationOutput StorePath Text)))
forall a. Maybe a
Nothing
          else Changed (Map Text (DerivationOutput StorePath Text))
-> Maybe (Changed (Map Text (DerivationOutput StorePath Text)))
forall a. a -> Maybe a
Just (Map Text (DerivationOutput StorePath Text)
-> Map Text (DerivationOutput StorePath Text)
-> Changed (Map Text (DerivationOutput StorePath Text))
forall a. a -> a -> Changed a
Changed Map Text (DerivationOutput StorePath Text)
leftExtraOutputs Map Text (DerivationOutput StorePath Text)
rightExtraOutputs)
    let
      outputDifference :: [Maybe (Maybe OutputDiff)]
outputDifference = (((Text,
   (DerivationOutput StorePath Text, DerivationOutput StorePath Text))
  -> Maybe (Maybe OutputDiff))
 -> [(Text,
      (DerivationOutput StorePath Text,
       DerivationOutput StorePath Text))]
 -> [Maybe (Maybe OutputDiff)])
-> [(Text,
     (DerivationOutput StorePath Text,
      DerivationOutput StorePath Text))]
-> ((Text,
     (DerivationOutput StorePath Text, DerivationOutput StorePath Text))
    -> Maybe (Maybe OutputDiff))
-> [Maybe (Maybe OutputDiff)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text,
  (DerivationOutput StorePath Text, DerivationOutput StorePath Text))
 -> Maybe (Maybe OutputDiff))
-> [(Text,
     (DerivationOutput StorePath Text,
      DerivationOutput StorePath Text))]
-> [Maybe (Maybe OutputDiff)]
forall a b. (a -> b) -> [a] -> [b]
map (Map
  Text
  (DerivationOutput StorePath Text, DerivationOutput StorePath Text)
-> [(Text,
     (DerivationOutput StorePath Text,
      DerivationOutput StorePath Text))]
forall k a. Map k a -> [(k, a)]
Data.Map.toList Map
  Text
  (DerivationOutput StorePath Text, DerivationOutput StorePath Text)
bothOutputs) \(Text
key, (DerivationOutput StorePath Text
leftOutput, DerivationOutput StorePath Text
rightOutput)) -> do
        if DerivationOutput StorePath Text
leftOutput DerivationOutput StorePath Text
-> DerivationOutput StorePath Text -> Bool
forall a. Eq a => a -> a -> Bool
== DerivationOutput StorePath Text
rightOutput
        then Maybe (Maybe OutputDiff)
forall a. Maybe a
Nothing
        else Maybe OutputDiff -> Maybe (Maybe OutputDiff)
forall a. a -> Maybe a
Just (Text
-> DerivationOutput StorePath Text
-> DerivationOutput StorePath Text
-> Maybe OutputDiff
diffOutput Text
key DerivationOutput StorePath Text
leftOutput DerivationOutput StorePath Text
rightOutput)

    Maybe (Changed (Map Text (DerivationOutput StorePath Text)))
-> [OutputDiff] -> OutputsDiff
OutputsDiff Maybe (Changed (Map Text (DerivationOutput StorePath Text)))
extraOutputs ([Maybe OutputDiff] -> [OutputDiff]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe OutputDiff] -> [OutputDiff])
-> ([Maybe (Maybe OutputDiff)] -> [Maybe OutputDiff])
-> [Maybe (Maybe OutputDiff)]
-> [OutputDiff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Maybe OutputDiff)] -> [Maybe OutputDiff]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Maybe OutputDiff)] -> [OutputDiff])
-> [Maybe (Maybe OutputDiff)] -> [OutputDiff]
forall a b. (a -> b) -> a -> b
$ [Maybe (Maybe OutputDiff)]
outputDifference)

{-| Split `Text` into spans of `Text` that alternatively fail and satisfy the
    given predicate

    The first span (if present) does not satisfy the predicate (even if the
    span is empty)

    >>> decomposeOn (== 'b') "aabbaa"
    ["aa","bb","aa"]
    >>> decomposeOn (== 'b') "bbaa"
    ["","bb","aa"]
    >>> decomposeOn (== 'b') ""
    []
-}
decomposeOn :: (Char -> Bool) -> Text -> [Text]
decomposeOn :: (Char -> Bool) -> Text -> [Text]
decomposeOn Char -> Bool
predicate = Text -> [Text]
unsatisfy
  where
    unsatisfy :: Text -> [Text]
unsatisfy Text
text
        | Text -> Bool
Text.null Text
text = []
        | Bool
otherwise      = Text
prefix Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
satisfy Text
suffix
      where
        (Text
prefix, Text
suffix) = (Char -> Bool) -> Text -> (Text, Text)
Text.break Char -> Bool
predicate Text
text

    satisfy :: Text -> [Text]
satisfy Text
text
        | Text -> Bool
Text.null Text
text = []
        | Bool
otherwise      = Text
prefix Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
unsatisfy Text
suffix
      where
        (Text
prefix, Text
suffix) = (Char -> Bool) -> Text -> (Text, Text)
Text.span Char -> Bool
predicate Text
text

lineBoundary :: Char -> Bool
lineBoundary :: Char -> Bool
lineBoundary = (Char
'\n' ==)

wordBoundary :: Char -> Bool
wordBoundary :: Char -> Bool
wordBoundary = Char -> Bool
Char.isSpace

-- | Diff two `Text` values
diffText
    :: Text
    -- ^ Left value to compare
    -> Text
    -- ^ Right value to compare
    -> Diff TextDiff
    -- ^ List of blocks of diffed text
diffText :: Text -> Text -> Diff TextDiff
diffText Text
left Text
right = do
    DiffContext{ Orientation
$sel:orientation:DiffContext :: DiffContext -> Orientation
orientation :: Orientation
orientation } <- Diff DiffContext
forall r (m :: * -> *). MonadReader r m => m r
ask

    let leftString :: String
leftString  = Text -> String
Text.unpack Text
left
    let rightString :: String
rightString = Text -> String
Text.unpack Text
right

    let decomposeWords :: Text -> [Text]
decomposeWords = (Char -> Bool) -> Text -> [Text]
decomposeOn Char -> Bool
wordBoundary

    let decomposeLines :: Text -> [Text]
decomposeLines Text
text = [Text] -> [Text]
forall {a}. Semigroup a => [a] -> [a]
loop ((Char -> Bool) -> Text -> [Text]
decomposeOn Char -> Bool
lineBoundary Text
text)
          where
            -- Groups each newline character with the preceding line
            loop :: [a] -> [a]
loop (a
x : a
y : [a]
zs) = (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
loop [a]
zs
            loop          [a]
zs  = [a]
zs

    let leftWords :: [Text]
leftWords  = Text -> [Text]
decomposeWords Text
left
    let rightWords :: [Text]
rightWords = Text -> [Text]
decomposeWords Text
right

    let leftLines :: [Text]
leftLines  = Text -> [Text]
decomposeLines Text
left
    let rightLines :: [Text]
rightLines = Text -> [Text]
decomposeLines Text
right

    let chunks :: [Item Text]
chunks =
            case Orientation
orientation of
                Orientation
Character ->
                    (Item String -> Item Text) -> [Item String] -> [Item Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Item String -> Item Text
forall a b. (a -> b) -> Item a -> Item b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack) (String -> String -> [Item String]
forall a. Ord a => [a] -> [a] -> [Item [a]]
getGroupedDiff String
leftString String
rightString)
                Orientation
Word ->
                    [Text] -> [Text] -> [Item Text]
forall a. Ord a => [a] -> [a] -> [Item a]
Patience.diff [Text]
leftWords [Text]
rightWords
                Orientation
Line ->
                    [Text] -> [Text] -> [Item Text]
forall a. Ord a => [a] -> [a] -> [Item a]
Patience.diff [Text]
leftLines [Text]
rightLines

    TextDiff -> Diff TextDiff
forall a. a -> Diff a
forall (f :: * -> *) a. Applicative f => a -> f a
return ([Item Text] -> TextDiff
TextDiff [Item Text]
chunks)

-- | Diff two environments
diffEnv
    :: OutputNames
    -- ^ Left derivation outputs
    -> OutputNames
    -- ^ Right derivation outputs
    -> Map Text Text
    -- ^ Left environment to compare
    -> Map Text Text
    -- ^ Right environment to compare
    -> Diff EnvironmentDiff
diffEnv :: OutputNames
-> OutputNames
-> Map Text Text
-> Map Text Text
-> Diff EnvironmentDiff
diffEnv (OutputNames Set Text
leftOutputs) (OutputNames Set Text
rightOutputs) Map Text Text
leftEnv Map Text Text
rightEnv = do
    let leftExtraEnv :: Map Text Text
leftExtraEnv  = Map Text Text -> Map Text Text -> Map Text Text
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Data.Map.difference Map Text Text
leftEnv  Map Text Text
rightEnv
    let rightExtraEnv :: Map Text Text
rightExtraEnv = Map Text Text -> Map Text Text -> Map Text Text
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Data.Map.difference Map Text Text
rightEnv Map Text Text
leftEnv

    let bothEnv :: Map Text (Text, Text)
bothEnv = Map Text Text -> Map Text Text -> Map Text (Text, Text)
forall k a b. Ord k => Map k a -> Map k b -> Map k (a, b)
innerJoin Map Text Text
leftEnv Map Text Text
rightEnv

    let predicate :: Text -> (a, a) -> Bool
predicate Text
key (a
left, a
right) =
                a
left a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
right
            Bool -> Bool -> Bool
||  (   Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Data.Set.member Text
key Set Text
leftOutputs
                Bool -> Bool -> Bool
&&  Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Data.Set.member Text
key Set Text
rightOutputs
                )
            Bool -> Bool -> Bool
||  Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"builder"
            Bool -> Bool -> Bool
||  Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"system"

    if     Map Text Text -> Bool
forall k a. Map k a -> Bool
Data.Map.null Map Text Text
leftExtraEnv
        Bool -> Bool -> Bool
&& Map Text Text -> Bool
forall k a. Map k a -> Bool
Data.Map.null Map Text Text
rightExtraEnv
        Bool -> Bool -> Bool
&& Map Text (Text, Text) -> Bool
forall k a. Map k a -> Bool
Data.Map.null
               ((Text -> (Text, Text) -> Bool)
-> Map Text (Text, Text) -> Map Text (Text, Text)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Data.Map.filterWithKey (\Text
k (Text, Text)
v -> Bool -> Bool
not (Text -> (Text, Text) -> Bool
forall {a}. Eq a => Text -> (a, a) -> Bool
predicate Text
k (Text, Text)
v)) Map Text (Text, Text)
bothEnv)
    then EnvironmentDiff -> Diff EnvironmentDiff
forall a. a -> Diff a
forall (m :: * -> *) a. Monad m => a -> m a
return EnvironmentDiff
EnvironmentsAreEqual
    else do
        let extraEnvDiff :: Changed (Map Text Text)
extraEnvDiff = Map Text Text -> Map Text Text -> Changed (Map Text Text)
forall a. a -> a -> Changed a
Changed Map Text Text
leftExtraEnv Map Text Text
rightExtraEnv
        [Maybe EnvVarDiff]
envDiff <- [(Text, (Text, Text))]
-> ((Text, (Text, Text)) -> Diff (Maybe EnvVarDiff))
-> Diff [Maybe EnvVarDiff]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map Text (Text, Text) -> [(Text, (Text, Text))]
forall k a. Map k a -> [(k, a)]
Data.Map.toList Map Text (Text, Text)
bothEnv) \(Text
key, (Text
leftValue, Text
rightValue)) -> do
            if      Text -> (Text, Text) -> Bool
forall {a}. Eq a => Text -> (a, a) -> Bool
predicate Text
key (Text
leftValue, Text
rightValue)
            then Maybe EnvVarDiff -> Diff (Maybe EnvVarDiff)
forall a. a -> Diff a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EnvVarDiff
forall a. Maybe a
Nothing
            else do
                TextDiff
valueDiff <- Text -> Text -> Diff TextDiff
diffText Text
leftValue Text
rightValue
                pure (EnvVarDiff -> Maybe EnvVarDiff
forall a. a -> Maybe a
Just (Text -> TextDiff -> EnvVarDiff
EnvVarDiff Text
key TextDiff
valueDiff))
        pure (Changed (Map Text Text) -> [EnvVarDiff] -> EnvironmentDiff
EnvironmentDiff Changed (Map Text Text)
extraEnvDiff ([Maybe EnvVarDiff] -> [EnvVarDiff]
forall a. [Maybe a] -> [a]
catMaybes [Maybe EnvVarDiff]
envDiff))


-- | Diff input sources
diffSrcs
    :: Set StorePath
    -- ^ Left input sources
    -> Set StorePath
    -- ^ Right inputSources
    -> Diff SourcesDiff
diffSrcs :: Set StorePath -> Set StorePath -> Diff SourcesDiff
diffSrcs Set StorePath
leftSrcs Set StorePath
rightSrcs = do
    let groupedLeftSrcs :: Map Text (Set StorePath)
groupedLeftSrcs  = Set StorePath -> Map Text (Set StorePath)
groupSetsByName Set StorePath
leftSrcs
    let groupedRightSrcs :: Map Text (Set StorePath)
groupedRightSrcs = Set StorePath -> Map Text (Set StorePath)
groupSetsByName Set StorePath
rightSrcs

    let leftNames :: Set Text
leftNames  = Map Text (Set StorePath) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (Set StorePath)
groupedLeftSrcs
    let rightNames :: Set Text
rightNames = Map Text (Set StorePath) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (Set StorePath)
groupedRightSrcs

    let leftExtraNames :: Set Text
leftExtraNames  = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set Text
leftNames  Set Text
rightNames
    let rightExtraNames :: Set Text
rightExtraNames = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set Text
rightNames Set Text
leftNames

    let extraSrcNames :: Maybe (Changed (Set Text))
extraSrcNames = if Set Text
leftNames Set Text -> Set Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Set Text
rightNames
        then Changed (Set Text) -> Maybe (Changed (Set Text))
forall a. a -> Maybe a
Just (Set Text -> Set Text -> Changed (Set Text)
forall a. a -> a -> Changed a
Changed Set Text
leftExtraNames Set Text
rightExtraNames)
        else Maybe (Changed (Set Text))
forall a. Maybe a
Nothing

    let assocs :: [(Text, (Set StorePath, Set StorePath))]
assocs = Map Text (Set StorePath, Set StorePath)
-> [(Text, (Set StorePath, Set StorePath))]
forall k a. Map k a -> [(k, a)]
Data.Map.toList (Map Text (Set StorePath)
-> Map Text (Set StorePath)
-> Map Text (Set StorePath, Set StorePath)
forall k a b. Ord k => Map k a -> Map k b -> Map k (a, b)
innerJoin Map Text (Set StorePath)
groupedLeftSrcs Map Text (Set StorePath)
groupedRightSrcs)

    [Maybe SourceFileDiff]
srcFilesDiff <- [(Text, (Set StorePath, Set StorePath))]
-> ((Text, (Set StorePath, Set StorePath))
    -> Diff (Maybe SourceFileDiff))
-> Diff [Maybe SourceFileDiff]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, (Set StorePath, Set StorePath))]
assocs \(Text
inputName, (Set StorePath
leftPaths, Set StorePath
rightPaths)) -> do
        let leftExtraPaths :: Set StorePath
leftExtraPaths  = Set StorePath -> Set StorePath -> Set StorePath
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set StorePath
leftPaths  Set StorePath
rightPaths
        let rightExtraPaths :: Set StorePath
rightExtraPaths = Set StorePath -> Set StorePath -> Set StorePath
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set StorePath
rightPaths Set StorePath
leftPaths
        case (Set StorePath -> [StorePath]
forall a. Set a -> [a]
Data.Set.toList Set StorePath
leftExtraPaths, Set StorePath -> [StorePath]
forall a. Set a -> [a]
Data.Set.toList Set StorePath
rightExtraPaths) of
            ([], []) -> Maybe SourceFileDiff -> Diff (Maybe SourceFileDiff)
forall a. a -> Diff a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SourceFileDiff
forall a. Maybe a
Nothing
            ([StorePath
leftPath], [StorePath
rightPath]) ->  do
                Bool
leftExists  <- IO Bool -> Diff Bool
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (StorePath -> IO Bool
Store.doesFileExist StorePath
leftPath)
                Bool
rightExists <- IO Bool -> Diff Bool
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (StorePath -> IO Bool
Store.doesFileExist StorePath
rightPath)
                Maybe TextDiff
srcContentDiff <- if Bool
leftExists Bool -> Bool -> Bool
&& Bool
rightExists
                    then do
                        Text
leftText  <- IO Text -> Diff Text
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (StorePath -> IO Text
Store.readFileUtf8Lenient StorePath
leftPath)
                        Text
rightText <- IO Text -> Diff Text
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (StorePath -> IO Text
Store.readFileUtf8Lenient StorePath
rightPath)

                        TextDiff
text <- Text -> Text -> Diff TextDiff
diffText Text
leftText Text
rightText
                        return (TextDiff -> Maybe TextDiff
forall a. a -> Maybe a
Just TextDiff
text)
                    else do
                        Maybe TextDiff -> Diff (Maybe TextDiff)
forall a. a -> Diff a
forall (f :: * -> *) a. Applicative f => a -> f a
return Maybe TextDiff
forall a. Maybe a
Nothing
                return (SourceFileDiff -> Maybe SourceFileDiff
forall a. a -> Maybe a
Just (Text -> Maybe TextDiff -> SourceFileDiff
OneSourceFileDiff Text
inputName Maybe TextDiff
srcContentDiff))
            ([StorePath]
leftExtraPathsList, [StorePath]
rightExtraPathsList) -> do
                Maybe SourceFileDiff -> Diff (Maybe SourceFileDiff)
forall a. a -> Diff a
forall (f :: * -> *) a. Applicative f => a -> f a
return (SourceFileDiff -> Maybe SourceFileDiff
forall a. a -> Maybe a
Just (Text -> Changed [StorePath] -> SourceFileDiff
SomeSourceFileDiff Text
inputName ([StorePath] -> [StorePath] -> Changed [StorePath]
forall a. a -> a -> Changed a
Changed [StorePath]
leftExtraPathsList [StorePath]
rightExtraPathsList)))
    return (Maybe (Changed (Set Text)) -> [SourceFileDiff] -> SourcesDiff
SourcesDiff Maybe (Changed (Set Text))
extraSrcNames ([Maybe SourceFileDiff] -> [SourceFileDiff]
forall a. [Maybe a] -> [a]
catMaybes [Maybe SourceFileDiff]
srcFilesDiff))

diffPlatform :: Text -> Text -> Maybe (Changed Platform)
diffPlatform :: Text -> Text -> Maybe (Changed Text)
diffPlatform Text
leftPlatform Text
rightPlatform = do
    if Text
leftPlatform Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rightPlatform
    then Maybe (Changed Text)
forall a. Maybe a
Nothing
    else Changed Text -> Maybe (Changed Text)
forall a. a -> Maybe a
Just (Text -> Text -> Changed Text
forall a. a -> a -> Changed a
Changed Text
leftPlatform Text
rightPlatform)

diffBuilder :: Text -> Text -> Maybe (Changed Builder)
diffBuilder :: Text -> Text -> Maybe (Changed Text)
diffBuilder Text
leftBuilder Text
rightBuilder = do
    if Text
leftBuilder Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rightBuilder
    then Maybe (Changed Text)
forall a. Maybe a
Nothing
    else Changed Text -> Maybe (Changed Text)
forall a. a -> Maybe a
Just (Text -> Text -> Changed Text
forall a. a -> a -> Changed a
Changed Text
leftBuilder Text
rightBuilder)

diffArgs :: Vector Text -> Vector Text -> Maybe ArgumentsDiff
diffArgs :: Vector Text -> Vector Text -> Maybe ArgumentsDiff
diffArgs Vector Text
leftArgs Vector Text
rightArgs = (NonEmpty (Item Text) -> ArgumentsDiff)
-> Maybe (NonEmpty (Item Text)) -> Maybe ArgumentsDiff
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (Item Text) -> ArgumentsDiff
ArgumentsDiff do
    if Vector Text
leftArgs Vector Text -> Vector Text -> Bool
forall a. Eq a => a -> a -> Bool
== Vector Text
rightArgs
    then Maybe (NonEmpty (Item Text))
forall a. Maybe a
Nothing
    else do
        let leftList :: [Text]
leftList  = Vector Text -> [Text]
forall a. Vector a -> [a]
Data.Vector.toList Vector Text
leftArgs
        let rightList :: [Text]
rightList = Vector Text -> [Text]
forall a. Vector a -> [a]
Data.Vector.toList Vector Text
rightArgs
        [Item Text] -> Maybe (NonEmpty (Item Text))
forall a. [a] -> Maybe (NonEmpty a)
Data.List.NonEmpty.nonEmpty ([Text] -> [Text] -> [Item Text]
forall a. Ord a => [a] -> [a] -> [Item a]
Patience.diff [Text]
leftList [Text]
rightList)

diff :: Bool
     -- ^ Is this the top-level call for a comparison?
     --
     -- If so, the diff will be more detailed.
     -> StorePath
     -- ^ Store path of left derivation.
     -> OutputNames
     -- ^ Output names of left derivation.
     -> StorePath
     -- ^ Store path of right derivation.
     -> OutputNames
     -- ^ Output names of right derivation.
     -> Diff DerivationDiff
     -- ^ Description of how the two derivations differ.
diff :: Bool
-> StorePath
-> OutputNames
-> StorePath
-> OutputNames
-> Diff DerivationDiff
diff Bool
topLevel StorePath
leftPath OutputNames
leftOutputs StorePath
rightPath OutputNames
rightOutputs = do
    Status { Set Diffed
$sel:visited:Status :: Status -> Set Diffed
visited :: Set Diffed
visited } <- Diff Status
forall s (m :: * -> *). MonadState s m => m s
get
    let diffed :: Diffed
diffed = StorePath -> OutputNames -> StorePath -> OutputNames -> Diffed
Diffed StorePath
leftPath OutputNames
leftOutputs StorePath
rightPath OutputNames
rightOutputs
    if StorePath
leftPath StorePath -> StorePath -> Bool
forall a. Eq a => a -> a -> Bool
== StorePath
rightPath
    then DerivationDiff -> Diff DerivationDiff
forall a. a -> Diff a
forall (m :: * -> *) a. Monad m => a -> m a
return DerivationDiff
DerivationsAreTheSame
    else if Diffed -> Set Diffed -> Bool
forall a. Ord a => a -> Set a -> Bool
Data.Set.member Diffed
diffed Set Diffed
visited
    then do
        DerivationDiff -> Diff DerivationDiff
forall a. a -> Diff a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DerivationDiff
AlreadyCompared
    else do
        Status -> Diff ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Set Diffed -> Status
Status (Diffed -> Set Diffed -> Set Diffed
forall a. Ord a => a -> Set a -> Set a
Data.Set.insert Diffed
diffed Set Diffed
visited))
        let
          outputStructure :: Changed OutputStructure
outputStructure = OutputStructure -> OutputStructure -> Changed OutputStructure
forall a. a -> a -> Changed a
Changed
            (StorePath -> OutputNames -> OutputStructure
OutputStructure StorePath
leftPath OutputNames
leftOutputs)
            (StorePath -> OutputNames -> OutputStructure
OutputStructure StorePath
rightPath OutputNames
rightOutputs)

        if StorePath -> Text
derivationName StorePath
leftPath Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= StorePath -> Text
derivationName StorePath
rightPath Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
topLevel
        then do
            DerivationDiff -> Diff DerivationDiff
forall a. a -> Diff a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Changed OutputStructure -> DerivationDiff
NamesDontMatch Changed OutputStructure
outputStructure)
        else if OutputNames
leftOutputs OutputNames -> OutputNames -> Bool
forall a. Eq a => a -> a -> Bool
/= OutputNames
rightOutputs
        then do
            DerivationDiff -> Diff DerivationDiff
forall a. a -> Diff a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Changed OutputStructure -> DerivationDiff
OutputsDontMatch Changed OutputStructure
outputStructure)
        else do
            Derivation StorePath Text
leftDerivation  <- StorePath -> Diff (Derivation StorePath Text)
readInput StorePath
leftPath
            Derivation StorePath Text
rightDerivation <- StorePath -> Diff (Derivation StorePath Text)
readInput StorePath
rightPath

            let leftOuts :: Map Text (DerivationOutput StorePath Text)
leftOuts = Derivation StorePath Text
-> Map Text (DerivationOutput StorePath Text)
forall fp txt.
Derivation fp txt -> Map txt (DerivationOutput fp txt)
Nix.Derivation.outputs Derivation StorePath Text
leftDerivation
            let rightOuts :: Map Text (DerivationOutput StorePath Text)
rightOuts = Derivation StorePath Text
-> Map Text (DerivationOutput StorePath Text)
forall fp txt.
Derivation fp txt -> Map txt (DerivationOutput fp txt)
Nix.Derivation.outputs Derivation StorePath Text
rightDerivation
            let outputsDiff :: OutputsDiff
outputsDiff = Map Text (DerivationOutput StorePath Text)
-> Map Text (DerivationOutput StorePath Text) -> OutputsDiff
diffOutputs Map Text (DerivationOutput StorePath Text)
leftOuts Map Text (DerivationOutput StorePath Text)
rightOuts

            let leftPlatform :: Text
leftPlatform  = Derivation StorePath Text -> Text
forall fp txt. Derivation fp txt -> txt
Nix.Derivation.platform Derivation StorePath Text
leftDerivation
            let rightPlatform :: Text
rightPlatform = Derivation StorePath Text -> Text
forall fp txt. Derivation fp txt -> txt
Nix.Derivation.platform Derivation StorePath Text
rightDerivation
            let platformDiff :: Maybe (Changed Text)
platformDiff = Text -> Text -> Maybe (Changed Text)
diffPlatform Text
leftPlatform Text
rightPlatform

            let leftBuilder :: Text
leftBuilder  = Derivation StorePath Text -> Text
forall fp txt. Derivation fp txt -> txt
Nix.Derivation.builder Derivation StorePath Text
leftDerivation
            let rightBuilder :: Text
rightBuilder = Derivation StorePath Text -> Text
forall fp txt. Derivation fp txt -> txt
Nix.Derivation.builder Derivation StorePath Text
rightDerivation
            let builderDiff :: Maybe (Changed Text)
builderDiff = Text -> Text -> Maybe (Changed Text)
diffBuilder Text
leftBuilder Text
rightBuilder

            let leftArgs :: Vector Text
leftArgs  = Derivation StorePath Text -> Vector Text
forall fp txt. Derivation fp txt -> Vector txt
Nix.Derivation.args Derivation StorePath Text
leftDerivation
            let rightArgs :: Vector Text
rightArgs = Derivation StorePath Text -> Vector Text
forall fp txt. Derivation fp txt -> Vector txt
Nix.Derivation.args Derivation StorePath Text
rightDerivation
            let argumentsDiff :: Maybe ArgumentsDiff
argumentsDiff = Vector Text -> Vector Text -> Maybe ArgumentsDiff
diffArgs Vector Text
leftArgs Vector Text
rightArgs

            let leftSrcs :: Set StorePath
leftSrcs  = Derivation StorePath Text -> Set StorePath
forall fp txt. Derivation fp txt -> Set fp
Nix.Derivation.inputSrcs Derivation StorePath Text
leftDerivation
            let rightSrcs :: Set StorePath
rightSrcs = Derivation StorePath Text -> Set StorePath
forall fp txt. Derivation fp txt -> Set fp
Nix.Derivation.inputSrcs Derivation StorePath Text
rightDerivation
            SourcesDiff
sourcesDiff <- Set StorePath -> Set StorePath -> Diff SourcesDiff
diffSrcs Set StorePath
leftSrcs Set StorePath
rightSrcs

            let leftInputs :: Map Text (Map StorePath OutputNames)
leftInputs  = Map StorePath OutputNames -> Map Text (Map StorePath OutputNames)
forall a. Map StorePath a -> Map Text (Map StorePath a)
groupByName ((Set Text -> OutputNames)
-> Map StorePath (Set Text) -> Map StorePath OutputNames
forall a b k. (a -> b) -> Map k a -> Map k b
Data.Map.map Set Text -> OutputNames
OutputNames (Derivation StorePath Text -> Map StorePath (Set Text)
forall fp txt. Derivation fp txt -> Map fp (Set txt)
Nix.Derivation.inputDrvs Derivation StorePath Text
leftDerivation))
            let rightInputs :: Map Text (Map StorePath OutputNames)
rightInputs = Map StorePath OutputNames -> Map Text (Map StorePath OutputNames)
forall a. Map StorePath a -> Map Text (Map StorePath a)
groupByName ((Set Text -> OutputNames)
-> Map StorePath (Set Text) -> Map StorePath OutputNames
forall a b k. (a -> b) -> Map k a -> Map k b
Data.Map.map Set Text -> OutputNames
OutputNames (Derivation StorePath Text -> Map StorePath (Set Text)
forall fp txt. Derivation fp txt -> Map fp (Set txt)
Nix.Derivation.inputDrvs Derivation StorePath Text
rightDerivation))

            let leftNames :: Set Text
leftNames  = Map Text (Map StorePath OutputNames) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (Map StorePath OutputNames)
leftInputs
            let rightNames :: Set Text
rightNames = Map Text (Map StorePath OutputNames) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (Map StorePath OutputNames)
rightInputs
            let leftExtraNames :: Set Text
leftExtraNames  = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set Text
leftNames  Set Text
rightNames
            let rightExtraNames :: Set Text
rightExtraNames = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set Text
rightNames Set Text
leftNames

            let inputExtraNames :: Maybe (Changed (Set Text))
inputExtraNames = if Set Text
leftNames Set Text -> Set Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Set Text
rightNames
                then Changed (Set Text) -> Maybe (Changed (Set Text))
forall a. a -> Maybe a
Just (Set Text -> Set Text -> Changed (Set Text)
forall a. a -> a -> Changed a
Changed Set Text
leftExtraNames Set Text
rightExtraNames)
                else Maybe (Changed (Set Text))
forall a. Maybe a
Nothing

            let assocs :: [(Text, (Map StorePath OutputNames, Map StorePath OutputNames))]
assocs = Map Text (Map StorePath OutputNames, Map StorePath OutputNames)
-> [(Text, (Map StorePath OutputNames, Map StorePath OutputNames))]
forall k a. Map k a -> [(k, a)]
Data.Map.toList (Map Text (Map StorePath OutputNames)
-> Map Text (Map StorePath OutputNames)
-> Map Text (Map StorePath OutputNames, Map StorePath OutputNames)
forall k a b. Ord k => Map k a -> Map k b -> Map k (a, b)
innerJoin Map Text (Map StorePath OutputNames)
leftInputs Map Text (Map StorePath OutputNames)
rightInputs)
            ([Bool]
descended, [Maybe InputDerivationsDiff]
mInputsDiff) <- [(Bool, Maybe InputDerivationsDiff)]
-> ([Bool], [Maybe InputDerivationsDiff])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
unzip ([(Bool, Maybe InputDerivationsDiff)]
 -> ([Bool], [Maybe InputDerivationsDiff]))
-> Diff [(Bool, Maybe InputDerivationsDiff)]
-> Diff ([Bool], [Maybe InputDerivationsDiff])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, (Map StorePath OutputNames, Map StorePath OutputNames))]
-> ((Text, (Map StorePath OutputNames, Map StorePath OutputNames))
    -> Diff (Bool, Maybe InputDerivationsDiff))
-> Diff [(Bool, Maybe InputDerivationsDiff)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, (Map StorePath OutputNames, Map StorePath OutputNames))]
assocs \(Text
inputName, (Map StorePath OutputNames
leftPaths, Map StorePath OutputNames
rightPaths)) -> do
                let leftExtraPaths :: Map StorePath OutputNames
leftExtraPaths =
                        Map StorePath OutputNames
-> Map StorePath OutputNames -> Map StorePath OutputNames
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Data.Map.difference Map StorePath OutputNames
leftPaths  Map StorePath OutputNames
rightPaths
                let rightExtraPaths :: Map StorePath OutputNames
rightExtraPaths =
                        Map StorePath OutputNames
-> Map StorePath OutputNames -> Map StorePath OutputNames
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Data.Map.difference Map StorePath OutputNames
rightPaths Map StorePath OutputNames
leftPaths
                case (Map StorePath OutputNames -> [(StorePath, OutputNames)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList Map StorePath OutputNames
leftExtraPaths, Map StorePath OutputNames -> [(StorePath, OutputNames)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList Map StorePath OutputNames
rightExtraPaths) of
                    ([(StorePath, OutputNames)], [(StorePath, OutputNames)])
_   | Map StorePath OutputNames
leftPaths Map StorePath OutputNames -> Map StorePath OutputNames -> Bool
forall a. Eq a => a -> a -> Bool
== Map StorePath OutputNames
rightPaths -> do
                        (Bool, Maybe InputDerivationsDiff)
-> Diff (Bool, Maybe InputDerivationsDiff)
forall a. a -> Diff a
forall (f :: * -> *) a. Applicative f => a -> f a
return (Bool
False, Maybe InputDerivationsDiff
forall a. Maybe a
Nothing)
                    ([(StorePath
leftPath', OutputNames
leftOutputs')], [(StorePath
rightPath', OutputNames
rightOutputs')])
                        | OutputNames
leftOutputs' OutputNames -> OutputNames -> Bool
forall a. Eq a => a -> a -> Bool
== OutputNames
rightOutputs' -> do
                        DerivationDiff
drvDiff <- Bool
-> StorePath
-> OutputNames
-> StorePath
-> OutputNames
-> Diff DerivationDiff
diff Bool
False StorePath
leftPath' OutputNames
leftOutputs' StorePath
rightPath' OutputNames
rightOutputs'
                        return (Bool
True, InputDerivationsDiff -> Maybe InputDerivationsDiff
forall a. a -> Maybe a
Just (Text -> DerivationDiff -> InputDerivationsDiff
OneDerivationDiff Text
inputName DerivationDiff
drvDiff))
                    ([(StorePath, OutputNames)], [(StorePath, OutputNames)])
_ -> do
                        let extraPartsDiff :: Changed (Map StorePath OutputNames)
extraPartsDiff = Map StorePath OutputNames
-> Map StorePath OutputNames -> Changed (Map StorePath OutputNames)
forall a. a -> a -> Changed a
Changed Map StorePath OutputNames
leftExtraPaths Map StorePath OutputNames
rightExtraPaths
                        (Bool, Maybe InputDerivationsDiff)
-> Diff (Bool, Maybe InputDerivationsDiff)
forall a. a -> Diff a
forall (f :: * -> *) a. Applicative f => a -> f a
return (Bool
False, InputDerivationsDiff -> Maybe InputDerivationsDiff
forall a. a -> Maybe a
Just (Text -> Changed (Map StorePath OutputNames) -> InputDerivationsDiff
SomeDerivationsDiff Text
inputName Changed (Map StorePath OutputNames)
extraPartsDiff))

            let inputDerivationDiffs :: [InputDerivationsDiff]
inputDerivationDiffs = [Maybe InputDerivationsDiff] -> [InputDerivationsDiff]
forall a. [Maybe a] -> [a]
catMaybes [Maybe InputDerivationsDiff]
mInputsDiff
            let inputsDiff :: InputsDiff
inputsDiff = InputsDiff {[InputDerivationsDiff]
Maybe (Changed (Set Text))
inputExtraNames :: Maybe (Changed (Set Text))
inputDerivationDiffs :: [InputDerivationsDiff]
$sel:inputExtraNames:InputsDiff :: Maybe (Changed (Set Text))
$sel:inputDerivationDiffs:InputsDiff :: [InputDerivationsDiff]
..}

            DiffContext { Bool
$sel:environment:DiffContext :: DiffContext -> Bool
environment :: Bool
environment } <- Diff DiffContext
forall r (m :: * -> *). MonadReader r m => m r
ask

            Maybe EnvironmentDiff
envDiff <- if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
descended Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
environment
                then Maybe EnvironmentDiff -> Diff (Maybe EnvironmentDiff)
forall a. a -> Diff a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EnvironmentDiff
forall a. Maybe a
Nothing
                else do
                  let leftEnv :: Map Text Text
leftEnv  = Derivation StorePath Text -> Map Text Text
forall fp txt. Derivation fp txt -> Map txt txt
Nix.Derivation.env Derivation StorePath Text
leftDerivation
                  let rightEnv :: Map Text Text
rightEnv = Derivation StorePath Text -> Map Text Text
forall fp txt. Derivation fp txt -> Map txt txt
Nix.Derivation.env Derivation StorePath Text
rightDerivation
                  let leftOutNames :: OutputNames
leftOutNames  = Set Text -> OutputNames
OutputNames (Map Text (DerivationOutput StorePath Text) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (DerivationOutput StorePath Text)
leftOuts)
                  let rightOutNames :: OutputNames
rightOutNames = Set Text -> OutputNames
OutputNames (Map Text (DerivationOutput StorePath Text) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (DerivationOutput StorePath Text)
rightOuts)
                  EnvironmentDiff -> Maybe EnvironmentDiff
forall a. a -> Maybe a
Just (EnvironmentDiff -> Maybe EnvironmentDiff)
-> Diff EnvironmentDiff -> Diff (Maybe EnvironmentDiff)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OutputNames
-> OutputNames
-> Map Text Text
-> Map Text Text
-> Diff EnvironmentDiff
diffEnv OutputNames
leftOutNames OutputNames
rightOutNames Map Text Text
leftEnv Map Text Text
rightEnv
            pure DerivationDiff{Maybe EnvironmentDiff
Maybe ArgumentsDiff
Maybe (Changed Text)
InputsDiff
SourcesDiff
OutputsDiff
Changed OutputStructure
outputStructure :: Changed OutputStructure
outputsDiff :: OutputsDiff
platformDiff :: Maybe (Changed Text)
builderDiff :: Maybe (Changed Text)
argumentsDiff :: Maybe ArgumentsDiff
sourcesDiff :: SourcesDiff
inputsDiff :: InputsDiff
envDiff :: Maybe EnvironmentDiff
$sel:outputStructure:DerivationsAreTheSame :: Changed OutputStructure
$sel:outputsDiff:DerivationsAreTheSame :: OutputsDiff
$sel:platformDiff:DerivationsAreTheSame :: Maybe (Changed Text)
$sel:builderDiff:DerivationsAreTheSame :: Maybe (Changed Text)
$sel:argumentsDiff:DerivationsAreTheSame :: Maybe ArgumentsDiff
$sel:sourcesDiff:DerivationsAreTheSame :: SourcesDiff
$sel:inputsDiff:DerivationsAreTheSame :: InputsDiff
$sel:envDiff:DerivationsAreTheSame :: Maybe EnvironmentDiff
..}