{-# 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
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
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)
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
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'
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
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)
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
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 :: 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)
diffOutput
:: Text
-> (DerivationOutput FilePath Text)
-> (DerivationOutput FilePath Text)
-> (Maybe OutputDiff)
diffOutput :: Text
-> DerivationOutput [Char] Text
-> DerivationOutput [Char] Text
-> Maybe OutputDiff
diffOutput Text
outputName DerivationOutput [Char] Text
leftOutput DerivationOutput [Char] Text
rightOutput = do
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))
diffOutputs
:: Map Text (DerivationOutput FilePath Text)
-> Map Text (DerivationOutput FilePath Text)
-> 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)
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
diffText
:: Text
-> Text
-> Diff TextDiff
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
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)
diffEnv
:: Set Text
-> Set Text
-> Map Text Text
-> Map Text Text
-> 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))
diffSrcs
:: Set FilePath
-> Set FilePath
-> 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
..}