{-# LANGUAGE ApplicativeDo              #-}
{-# LANGUAGE BlockArguments             #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}

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(..))
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 qualified Control.Monad.Reader
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.Directory     as Directory
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

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

data Diffed = Diffed
    { Diffed -> [Char]
leftDerivation  :: FilePath
    , Diffed -> Set Text
leftOutput      :: Set Text
    , Diffed -> [Char]
rightDerivation :: FilePath
    , Diffed -> Set Text
rightOutput     :: Set Text
    } 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
    ( (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. [Char] -> Diff a) -> MonadFail Diff
forall a. [Char] -> Diff a
forall (m :: * -> *).
Monad m =>
(forall a. [Char] -> m a) -> MonadFail m
$cfail :: forall a. [Char] -> Diff a
fail :: forall a. [Char] -> 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 :: FilePath -> Text
derivationName :: [Char] -> Text
derivationName = Int -> Text -> Text
Text.dropEnd Int
4 (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop Int
44 (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack

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

    assocs :: [(Text, Map [Char] a)]
assocs = ([Char] -> (Text, Map [Char] a))
-> [[Char]] -> [(Text, Map [Char] a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> (Text, Map [Char] a)
toAssoc (Map [Char] a -> [[Char]]
forall k a. Map k a -> [k]
Data.Map.keys Map [Char] 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 :: FilePath -> Text
buildProductName :: [Char] -> Text
buildProductName = Int -> Text -> Text
Text.drop Int
44 (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack

-- | Like `groupByName`, but for `Set`s
groupSetsByName :: Set FilePath -> Map Text (Set FilePath)
groupSetsByName :: Set [Char] -> Map Text (Set [Char])
groupSetsByName Set [Char]
s = [(Text, Set [Char])] -> Map Text (Set [Char])
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList (([Char] -> (Text, Set [Char])) -> [[Char]] -> [(Text, Set [Char])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> (Text, Set [Char])
toAssoc (Set [Char] -> [[Char]]
forall a. Set a -> [a]
Data.Set.toList Set [Char]
s))
  where
    toAssoc :: [Char] -> (Text, Set [Char])
toAssoc [Char]
key = ([Char] -> Text
buildProductName [Char]
key, ([Char] -> Bool) -> Set [Char] -> Set [Char]
forall a. (a -> Bool) -> Set a -> Set a
Data.Set.filter [Char] -> Bool
predicate Set [Char]
s)
      where
        predicate :: [Char] -> Bool
predicate [Char]
key' = [Char] -> Text
buildProductName [Char]
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> Text
buildProductName [Char]
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 :: [Char] -> IO Text
readFileUtf8Lenient [Char]
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
<$> [Char] -> IO ByteString
Data.ByteString.readFile [Char]
file

-- | Read and parse a derivation from a file
readDerivation :: FilePath -> Diff (Derivation FilePath Text)
readDerivation :: [Char] -> Diff (Derivation [Char] Text)
readDerivation [Char]
path = do
    let string :: [Char]
string = [Char]
path
    Text
text <- IO Text -> Diff Text
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO Text
readFileUtf8Lenient [Char]
string)
    case Parser (Derivation [Char] Text)
-> Text -> Result (Derivation [Char] Text)
forall a. Parser a -> Text -> Result a
Data.Attoparsec.Text.parse Parser (Derivation [Char] Text)
Nix.Derivation.parseDerivation Text
text of
        Done Text
_ Derivation [Char] Text
derivation -> do
            Derivation [Char] Text -> Diff (Derivation [Char] Text)
forall a. a -> Diff a
forall (f :: * -> *) a. Applicative f => a -> f a
return Derivation [Char] Text
derivation
        Result (Derivation [Char] Text)
_ -> do
            [Char] -> Diff (Derivation [Char] Text)
forall a. [Char] -> Diff a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Could not parse a derivation from this file: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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 :: FilePath -> Diff (Derivation FilePath Text)
readInput :: [Char] -> Diff (Derivation [Char] Text)
readInput [Char]
pathAndMaybeOutput = do
    let ([Char]
path, [Char]
_) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!') [Char]
pathAndMaybeOutput
    if [Char] -> [Char] -> Bool
FilePath.isExtensionOf [Char]
".drv" [Char]
path
    then [Char] -> Diff (Derivation [Char] Text)
readDerivation [Char]
path
    else do
        let string :: [Char]
string = [Char]
path
        [Char]
result <- IO [Char] -> Diff [Char]
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> [[Char]] -> [Char] -> IO [Char]
Process.readProcess [Char]
"nix-store" [ [Char]
"--query", [Char]
"--deriver", [Char]
string ] [])
        case [Char] -> [[Char]]
String.lines [Char]
result of
            [] -> [Char] -> Diff (Derivation [Char] Text)
forall a. [Char] -> Diff a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Could not obtain the derivation of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
string)
            [Char]
l : [[Char]]
ls -> do
                let drv_path :: [Char]
drv_path = NonEmpty [Char] -> [Char]
forall a. NonEmpty a -> a
Data.List.NonEmpty.last ([Char]
l [Char] -> [[Char]] -> NonEmpty [Char]
forall a. a -> [a] -> NonEmpty a
:| [[Char]]
ls)
                [Char] -> Diff (Derivation [Char] Text)
readDerivation [Char]
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 FilePath Text)
    -- ^ Left derivation outputs
    -> (DerivationOutput FilePath Text)
    -- ^ Right derivation outputs
    -> (Maybe OutputDiff)
diffOutput :: Text
-> DerivationOutput [Char] Text
-> DerivationOutput [Char] Text
-> Maybe OutputDiff
diffOutput Text
outputName DerivationOutput [Char] Text
leftOutput DerivationOutput [Char] 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 [Char] Text -> Text
forall fp txt. DerivationOutput fp txt -> txt
Nix.Derivation.hashAlgo DerivationOutput [Char] Text
leftOutput
    let rightHashAlgo :: Text
rightHashAlgo = DerivationOutput [Char] Text -> Text
forall fp txt. DerivationOutput fp txt -> txt
Nix.Derivation.hashAlgo DerivationOutput [Char] 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 FilePath Text)
    -- ^ Left derivation outputs
    -> Map Text (DerivationOutput FilePath Text)
    -- ^ Right derivation outputs
    -> OutputsDiff
diffOutputs :: Map Text (DerivationOutput [Char] Text)
-> Map Text (DerivationOutput [Char] Text) -> OutputsDiff
diffOutputs Map Text (DerivationOutput [Char] Text)
leftOutputs Map Text (DerivationOutput [Char] Text)
rightOutputs = do
    let leftExtraOutputs :: Map Text (DerivationOutput [Char] Text)
leftExtraOutputs  = Map Text (DerivationOutput [Char] Text)
-> Map Text (DerivationOutput [Char] Text)
-> Map Text (DerivationOutput [Char] Text)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Data.Map.difference Map Text (DerivationOutput [Char] Text)
leftOutputs  Map Text (DerivationOutput [Char] Text)
rightOutputs
    let rightExtraOutputs :: Map Text (DerivationOutput [Char] Text)
rightExtraOutputs = Map Text (DerivationOutput [Char] Text)
-> Map Text (DerivationOutput [Char] Text)
-> Map Text (DerivationOutput [Char] Text)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Data.Map.difference Map Text (DerivationOutput [Char] Text)
rightOutputs Map Text (DerivationOutput [Char] Text)
leftOutputs

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

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

    Maybe (Changed (Map Text (DerivationOutput [Char] Text)))
-> [OutputDiff] -> OutputsDiff
OutputsDiff Maybe (Changed (Map Text (DerivationOutput [Char] 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' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)

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
orientation :: DiffContext -> Orientation
orientation :: Orientation
orientation } <- Diff DiffContext
forall r (m :: * -> *). MonadReader r m => m r
ask

    let leftString :: [Char]
leftString  = Text -> [Char]
Text.unpack Text
left
    let rightString :: [Char]
rightString = Text -> [Char]
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 [Char] -> Item Text) -> [Item [Char]] -> [Item Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> Text) -> Item [Char] -> Item Text
forall a b. (a -> b) -> Item a -> Item b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
Text.pack) ([Char] -> [Char] -> [Item [Char]]
forall a. Ord a => [a] -> [a] -> [Item [a]]
getGroupedDiff [Char]
leftString [Char]
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
    :: Set Text
    -- ^ Left derivation outputs
    -> Set Text
    -- ^ Right derivation outputs
    -> Map Text Text
    -- ^ Left environment to compare
    -> Map Text Text
    -- ^ Right environment to compare
    -> Diff EnvironmentDiff
diffEnv :: Set Text
-> Set Text
-> Map Text Text
-> Map Text Text
-> Diff EnvironmentDiff
diffEnv Set Text
leftOutputs 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 FilePath
    -- ^ Left input sources
    -> Set FilePath
    -- ^ Right inputSources
    -> Diff SourcesDiff
diffSrcs :: Set [Char] -> Set [Char] -> Diff SourcesDiff
diffSrcs Set [Char]
leftSrcs Set [Char]
rightSrcs = do
    let groupedLeftSrcs :: Map Text (Set [Char])
groupedLeftSrcs  = Set [Char] -> Map Text (Set [Char])
groupSetsByName Set [Char]
leftSrcs
    let groupedRightSrcs :: Map Text (Set [Char])
groupedRightSrcs = Set [Char] -> Map Text (Set [Char])
groupSetsByName Set [Char]
rightSrcs

    let leftNames :: Set Text
leftNames  = Map Text (Set [Char]) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (Set [Char])
groupedLeftSrcs
    let rightNames :: Set Text
rightNames = Map Text (Set [Char]) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (Set [Char])
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 [Char], Set [Char]))]
assocs = Map Text (Set [Char], Set [Char])
-> [(Text, (Set [Char], Set [Char]))]
forall k a. Map k a -> [(k, a)]
Data.Map.toList (Map Text (Set [Char])
-> Map Text (Set [Char]) -> Map Text (Set [Char], Set [Char])
forall k a b. Ord k => Map k a -> Map k b -> Map k (a, b)
innerJoin Map Text (Set [Char])
groupedLeftSrcs Map Text (Set [Char])
groupedRightSrcs)

    [Maybe SourceFileDiff]
srcFilesDiff <- [(Text, (Set [Char], Set [Char]))]
-> ((Text, (Set [Char], Set [Char]))
    -> 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 [Char], Set [Char]))]
assocs \(Text
inputName, (Set [Char]
leftPaths, Set [Char]
rightPaths)) -> do
        let leftExtraPaths :: Set [Char]
leftExtraPaths  = Set [Char] -> Set [Char] -> Set [Char]
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set [Char]
leftPaths  Set [Char]
rightPaths
        let rightExtraPaths :: Set [Char]
rightExtraPaths = Set [Char] -> Set [Char] -> Set [Char]
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set [Char]
rightPaths Set [Char]
leftPaths
        case (Set [Char] -> [[Char]]
forall a. Set a -> [a]
Data.Set.toList Set [Char]
leftExtraPaths, Set [Char] -> [[Char]]
forall a. Set a -> [a]
Data.Set.toList Set [Char]
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
            ([[Char]
leftPath], [[Char]
rightPath]) ->  do
                Bool
leftExists  <- IO Bool -> Diff Bool
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO Bool
Directory.doesFileExist [Char]
leftPath)
                Bool
rightExists <- IO Bool -> Diff Bool
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO Bool
Directory.doesFileExist [Char]
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 ([Char] -> IO Text
readFileUtf8Lenient [Char]
leftPath)
                        Text
rightText <- IO Text -> Diff Text
forall a. IO a -> Diff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO Text
readFileUtf8Lenient [Char]
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))
            ([[Char]]
leftExtraPathsList, [[Char]]
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 [[Char]] -> SourceFileDiff
SomeSourceFileDiff Text
inputName ([[Char]] -> [[Char]] -> Changed [[Char]]
forall a. a -> a -> Changed a
Changed [[Char]]
leftExtraPathsList [[Char]]
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 -> FilePath -> Set Text -> FilePath -> Set Text -> Diff DerivationDiff
diff :: Bool
-> [Char] -> Set Text -> [Char] -> Set Text -> Diff DerivationDiff
diff Bool
topLevel [Char]
leftPath Set Text
leftOutputs [Char]
rightPath Set Text
rightOutputs = do
    Status { Set Diffed
visited :: Status -> Set Diffed
visited :: Set Diffed
visited } <- Diff Status
forall s (m :: * -> *). MonadState s m => m s
get
    let diffed :: Diffed
diffed = [Char] -> Set Text -> [Char] -> Set Text -> Diffed
Diffed [Char]
leftPath Set Text
leftOutputs [Char]
rightPath Set Text
rightOutputs
    if [Char]
leftPath [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
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
            ([Char] -> Set Text -> OutputStructure
OutputStructure [Char]
leftPath Set Text
leftOutputs)
            ([Char] -> Set Text -> OutputStructure
OutputStructure [Char]
rightPath Set Text
rightOutputs)

        if [Char] -> Text
derivationName [Char]
leftPath Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char] -> Text
derivationName [Char]
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 Set Text
leftOutputs Set Text -> Set Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Set Text
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 [Char] Text
leftDerivation  <- [Char] -> Diff (Derivation [Char] Text)
readInput [Char]
leftPath
            Derivation [Char] Text
rightDerivation <- [Char] -> Diff (Derivation [Char] Text)
readInput [Char]
rightPath

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

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

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

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

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

            let leftInputs :: Map Text (Map [Char] (Set Text))
leftInputs  = Map [Char] (Set Text) -> Map Text (Map [Char] (Set Text))
forall a. Map [Char] a -> Map Text (Map [Char] a)
groupByName (Derivation [Char] Text -> Map [Char] (Set Text)
forall fp txt. Derivation fp txt -> Map fp (Set txt)
Nix.Derivation.inputDrvs Derivation [Char] Text
leftDerivation)
            let rightInputs :: Map Text (Map [Char] (Set Text))
rightInputs = Map [Char] (Set Text) -> Map Text (Map [Char] (Set Text))
forall a. Map [Char] a -> Map Text (Map [Char] a)
groupByName (Derivation [Char] Text -> Map [Char] (Set Text)
forall fp txt. Derivation fp txt -> Map fp (Set txt)
Nix.Derivation.inputDrvs Derivation [Char] Text
rightDerivation)

            let leftNames :: Set Text
leftNames  = Map Text (Map [Char] (Set Text)) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (Map [Char] (Set Text))
leftInputs
            let rightNames :: Set Text
rightNames = Map Text (Map [Char] (Set Text)) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (Map [Char] (Set Text))
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 [Char] (Set Text), Map [Char] (Set Text)))]
assocs = Map Text (Map [Char] (Set Text), Map [Char] (Set Text))
-> [(Text, (Map [Char] (Set Text), Map [Char] (Set Text)))]
forall k a. Map k a -> [(k, a)]
Data.Map.toList (Map Text (Map [Char] (Set Text))
-> Map Text (Map [Char] (Set Text))
-> Map Text (Map [Char] (Set Text), Map [Char] (Set Text))
forall k a b. Ord k => Map k a -> Map k b -> Map k (a, b)
innerJoin Map Text (Map [Char] (Set Text))
leftInputs Map Text (Map [Char] (Set Text))
rightInputs)
            ([Bool]
descended, [Maybe InputDerivationsDiff]
mInputsDiff) <- [(Bool, Maybe InputDerivationsDiff)]
-> ([Bool], [Maybe InputDerivationsDiff])
forall a b. [(a, b)] -> ([a], [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 [Char] (Set Text), Map [Char] (Set Text)))]
-> ((Text, (Map [Char] (Set Text), Map [Char] (Set Text)))
    -> 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 [Char] (Set Text), Map [Char] (Set Text)))]
assocs \(Text
inputName, (Map [Char] (Set Text)
leftPaths, Map [Char] (Set Text)
rightPaths)) -> do
                let leftExtraPaths :: Map [Char] (Set Text)
leftExtraPaths =
                        Map [Char] (Set Text)
-> Map [Char] (Set Text) -> Map [Char] (Set Text)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Data.Map.difference Map [Char] (Set Text)
leftPaths  Map [Char] (Set Text)
rightPaths
                let rightExtraPaths :: Map [Char] (Set Text)
rightExtraPaths =
                        Map [Char] (Set Text)
-> Map [Char] (Set Text) -> Map [Char] (Set Text)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Data.Map.difference Map [Char] (Set Text)
rightPaths Map [Char] (Set Text)
leftPaths
                case (Map [Char] (Set Text) -> [([Char], Set Text)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList Map [Char] (Set Text)
leftExtraPaths, Map [Char] (Set Text) -> [([Char], Set Text)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList Map [Char] (Set Text)
rightExtraPaths) of
                    ([([Char], Set Text)], [([Char], Set Text)])
_   | Map [Char] (Set Text)
leftPaths Map [Char] (Set Text) -> Map [Char] (Set Text) -> Bool
forall a. Eq a => a -> a -> Bool
== Map [Char] (Set Text)
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)
                    ([([Char]
leftPath', Set Text
leftOutputs')], [([Char]
rightPath', Set Text
rightOutputs')])
                        | Set Text
leftOutputs' Set Text -> Set Text -> Bool
forall a. Eq a => a -> a -> Bool
== Set Text
rightOutputs' -> do
                        DerivationDiff
drvDiff <- Bool
-> [Char] -> Set Text -> [Char] -> Set Text -> Diff DerivationDiff
diff Bool
False [Char]
leftPath' Set Text
leftOutputs' [Char]
rightPath' Set Text
rightOutputs'
                        return (Bool
True, InputDerivationsDiff -> Maybe InputDerivationsDiff
forall a. a -> Maybe a
Just (Text -> DerivationDiff -> InputDerivationsDiff
OneDerivationDiff Text
inputName DerivationDiff
drvDiff))
                    ([([Char], Set Text)], [([Char], Set Text)])
_ -> do
                        let extraPartsDiff :: Changed (Map [Char] (Set Text))
extraPartsDiff = Map [Char] (Set Text)
-> Map [Char] (Set Text) -> Changed (Map [Char] (Set Text))
forall a. a -> a -> Changed a
Changed Map [Char] (Set Text)
leftExtraPaths Map [Char] (Set Text)
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 [Char] (Set Text)) -> InputDerivationsDiff
SomeDerivationsDiff Text
inputName Changed (Map [Char] (Set Text))
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]
inputExtraNames :: Maybe (Changed (Set Text))
inputDerivationDiffs :: [InputDerivationsDiff]
..}

            DiffContext { Bool
environment :: 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 [Char] Text -> Map Text Text
forall fp txt. Derivation fp txt -> Map txt txt
Nix.Derivation.env Derivation [Char] Text
leftDerivation
                  let rightEnv :: Map Text Text
rightEnv = Derivation [Char] Text -> Map Text Text
forall fp txt. Derivation fp txt -> Map txt txt
Nix.Derivation.env Derivation [Char] Text
rightDerivation
                  let leftOutNames :: Set Text
leftOutNames  = Map Text (DerivationOutput [Char] Text) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (DerivationOutput [Char] Text)
leftOuts
                  let rightOutNames :: Set Text
rightOutNames = Map Text (DerivationOutput [Char] Text) -> Set Text
forall k a. Map k a -> Set k
Data.Map.keysSet Map Text (DerivationOutput [Char] 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
<$> Set Text
-> Set Text
-> Map Text Text
-> Map Text Text
-> Diff EnvironmentDiff
diffEnv Set Text
leftOutNames Set Text
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
outputStructure :: Changed OutputStructure
outputsDiff :: OutputsDiff
platformDiff :: Maybe (Changed Text)
builderDiff :: Maybe (Changed Text)
argumentsDiff :: Maybe ArgumentsDiff
sourcesDiff :: SourcesDiff
inputsDiff :: InputsDiff
envDiff :: Maybe EnvironmentDiff
..}