From 0fac3a83c72fe99941dcb4703e6cd321f3274daf Mon Sep 17 00:00:00 2001 From: Andrei Borzenkov Date: Thu, 13 Oct 2022 16:35:31 +0400 Subject: [PATCH 1/2] [#58] Add intermediate representation Problem: There is no way to reuse result of diff alghorithm because program print it into stdout in human readable format in-place. Solution: divide steps of finding diff between two derivations and printing it out. Now result of `diff` is tree with result of derivation comparison, that you can print than in stdout as was before, or use in your program. --- nix-diff.cabal | 3 + src/Diff.hs | 606 +++++++++++++++++++++++++++++++++ src/Main.hs | 644 +----------------------------------- src/Render/HumanReadable.hs | 274 +++++++++++++++ 4 files changed, 896 insertions(+), 631 deletions(-) create mode 100644 src/Diff.hs create mode 100644 src/Render/HumanReadable.hs diff --git a/nix-diff.cabal b/nix-diff.cabal index 13dcab1..3f48317 100644 --- a/nix-diff.cabal +++ b/nix-diff.cabal @@ -19,6 +19,9 @@ extra-source-files: README.md executable nix-diff main-is: Main.hs + other-modules: + Diff + Render.HumanReadable build-depends: base >= 4.9 && < 5 , attoparsec >= 0.13 && < 0.15 , bytestring >= 0.9 && < 0.12 diff --git a/src/Diff.hs b/src/Diff.hs new file mode 100644 index 0000000..41d1609 --- /dev/null +++ b/src/Diff.hs @@ -0,0 +1,606 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module 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.Monoid ((<>)) +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.Char as Char +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.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,9,0) +import Control.Monad.Fail (MonadFail) +import qualified Data.ByteString +import qualified Data.Text.Encoding +import qualified Data.Text.Encoding.Error +#endif + + +newtype Status = Status { visited :: Set Diffed } + +data Diffed = Diffed + { leftDerivation :: FilePath + , leftOutput :: Set Text + , rightDerivation :: FilePath + , rightOutput :: Set Text + } deriving (Eq, Ord) + +newtype Diff a = Diff { unDiff :: ReaderT DiffContext (StateT Status IO) a } + deriving + ( Functor + , Applicative + , Monad + , MonadReader DiffContext + , MonadState Status + , MonadIO +#if MIN_VERSION_base(4,9,0) + , MonadFail +#endif + ) + +data DiffContext = DiffContext + { orientation :: Orientation + , environment :: Bool + } + +data Orientation = Character | Word | Line + +data Changed a = Changed { before :: a, now :: a } + +type OutputHash = Text + +type Platform = Text + +type Builder = Text + +type Argument = Text + +data DerivationDiff + = DerivationsAreTheSame + | AlreadyCompared + | NamesDontMatch { outputStructure :: Changed (FilePath, Set Text)} + | OutputsDontMatch { outputStructure :: Changed (FilePath, Set Text)} + | DerivationDiff + { outputStructure :: Changed (FilePath, Set Text) + , outputsDiff :: OutputsDiff + , platformDiff :: Maybe (Changed Platform) + -- ^ Will be Nothing, if Platform does not change + , builderDiff :: Maybe (Changed Builder) + -- ^ Will be Nothing, if Builder does not change + , argumentsDiff :: Maybe (NonEmpty (Patience.Item Argument)) + -- ^ Will be Nothing, if arguments are equal + , sourcesDiff :: SourcesDiff + , inputsDiff :: InputsDiff + , envDiff :: Maybe EnvironmentDiff + -- ^ Will be Nothing, if environment comparison is skipped + } + + +data OutputsDiff = OutputsDiff + { extraOutputs :: Maybe (Changed (Map Text (DerivationOutput FilePath Text))) + -- ^ Map from derivation name to it's outputs. + -- Will be Nothing, if `Data.Map.difference` gives + -- empty Maps for both new and old outputs + , outputHashDiff :: [OutputDiff] + -- ^ Difference of outputs with the same name. + -- Will be empty, if all outputs are equal. + } + +data OutputDiff = OutputDiff + { outputName :: Text + , hashDifference :: Changed OutputHash + } + +data SourcesDiff = SourcesDiff + { extraSrcNames :: Maybe (Changed (Set Text)) + -- ^ Will be Nothing, if there is no extra source names + , srcFilesDiff :: [SourceFileDiff] + } + +data SourceFileDiff + = OneSourceFileDiff + { srcName :: Text + , srcContentDiff :: Maybe [Patience.Item Text] + -- ^ Will be Nothing, if any of source files not exists + } + | SomeSourceFileDiff + { srcName :: Text + , srcFilesDiff :: Changed [FilePath] + } + +data InputsDiff = InputsDiff + { inputExtraNames :: Maybe (Changed (Set Text)) + -- ^ Will be Nothing, if there is no extra input names + , inputDerivationDiffs :: [InputDerivationsDiff] + } + +data InputDerivationsDiff + = OneDerivationDiff + { drvName :: Text + , drvDiff :: DerivationDiff + } + | SomeDerivationsDiff + { drvName :: Text + , extraPartsDiff :: Changed (Map FilePath (Set Text)) + } + +data EnvVarDiff = EnvVarDiff + { envKey :: Text + , envValueDiff :: [Patience.Item Text] + } + +data EnvironmentDiff + = EnvironmentsAreEqual + | EnvironmentDiff + { extraEnvDiff :: Changed (Map Text Text) + , envContentDiff :: [EnvVarDiff] + } + +{-| 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 = Text.dropEnd 4 . Text.drop 44 . Text.pack + +-- | Group paths by their name +groupByName :: Map FilePath a -> Map Text (Map FilePath a) +groupByName m = Data.Map.fromList assocs + where + toAssoc key = (derivationName key, Data.Map.filterWithKey predicate m) + where + predicate key' _ = derivationName key == derivationName key' + + assocs = fmap toAssoc (Data.Map.keys 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 = Text.drop 44 . Text.pack + +-- | Like `groupByName`, but for `Set`s +groupSetsByName :: Set FilePath -> Map Text (Set FilePath) +groupSetsByName s = Data.Map.fromList (fmap toAssoc (Data.Set.toList s)) + where + toAssoc key = (buildProductName key, Data.Set.filter predicate s) + where + predicate key' = buildProductName key == buildProductName 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 file = + Data.Text.Encoding.decodeUtf8With Data.Text.Encoding.Error.lenientDecode + <$> Data.ByteString.readFile file + +-- | Read and parse a derivation from a file +readDerivation :: FilePath -> Diff (Derivation FilePath Text) +readDerivation path = do + let string = path + text <- liftIO (readFileUtf8Lenient string) + case Data.Attoparsec.Text.parse Nix.Derivation.parseDerivation text of + Done _ derivation -> do + return derivation + _ -> do + fail ("Could not parse a derivation from this file: " ++ 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 path = + if FilePath.isExtensionOf ".drv" path + then readDerivation path + else do + let string = path + result <- liftIO (Process.readProcess "nix-store" [ "--query", "--deriver", string ] []) + case String.lines result of + [] -> fail ("Could not obtain the derivation of " ++ string) + l : ls -> do + let drv_path = Data.List.NonEmpty.last (l :| ls) + readDerivation 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 = Data.Map.mergeWithKey both left right + where + both _ a b = Just (a, b) + + left _ = Data.Map.empty + + right _ = Data.Map.empty + +-- `getGroupedDiff` from `Diff` library, adapted for `patience` +getGroupedDiff :: Ord a => [a] -> [a] -> [Patience.Item [a]] +getGroupedDiff oldList newList = go $ Patience.diff oldList newList + where + go = \case + Patience.Old x : xs -> + let (fs, rest) = goOlds xs + in Patience.Old (x : fs) : go rest + Patience.New x : xs -> + let (fs, rest) = goNews xs + in Patience.New (x : fs) : go rest + Patience.Both x y : xs -> + let (fs, rest) = goBoth xs + (fxs, fys) = unzip fs + in Patience.Both (x : fxs) (y : fys) : go rest + [] -> [] + + goOlds = \case + Patience.Old x : xs -> + let (fs, rest) = goOlds xs + in (x : fs, rest) + xs -> ([], xs) + + goNews = \case + Patience.New x : xs -> + let (fs, rest) = goNews xs + in (x : fs, rest) + xs -> ([], xs) + + goBoth = \case + Patience.Both x y : xs -> + let (fs, rest) = goBoth xs + in ((x, y) : fs, rest) + xs -> ([], xs) + +-- | Diff two outputs +diffOutput + :: Text + -- ^ Output name + -> (DerivationOutput FilePath Text) + -- ^ Left derivation outputs + -> (DerivationOutput FilePath Text) + -- ^ Right derivation outputs + -> (Maybe OutputDiff) +diffOutput outputName leftOutput 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 = Nix.Derivation.hashAlgo leftOutput + let rightHashAlgo = Nix.Derivation.hashAlgo rightOutput + if leftHashAlgo == rightHashAlgo + then Nothing + else Just (OutputDiff outputName (Changed leftHashAlgo 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 leftOutputs rightOutputs = do + let leftExtraOutputs = Data.Map.difference leftOutputs rightOutputs + let rightExtraOutputs = Data.Map.difference rightOutputs leftOutputs + + let bothOutputs = innerJoin leftOutputs rightOutputs + + let + extraOutputs = + if Data.Map.null leftExtraOutputs && Data.Map.null rightExtraOutputs + then Nothing + else Just (Changed leftExtraOutputs rightExtraOutputs) + let + outputDifference = flip map (Data.Map.toList bothOutputs) \(key, (leftOutput, rightOutput)) -> do + if leftOutput == rightOutput + then Nothing + else Just (diffOutput key leftOutput rightOutput) + + OutputsDiff extraOutputs (catMaybes . catMaybes $ 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 predicate = unsatisfy + where + unsatisfy text + | Text.null text = [] + | otherwise = prefix : satisfy suffix + where + (prefix, suffix) = Text.break predicate text + + satisfy text + | Text.null text = [] + | otherwise = prefix : unsatisfy suffix + where + (prefix, suffix) = Text.span predicate text + +lineBoundary :: Char -> Bool +lineBoundary = ('\n' ==) + +wordBoundary :: Char -> Bool +wordBoundary = Char.isSpace + +-- | Diff two `Text` values +diffText + :: Text + -- ^ Left value to compare + -> Text + -- ^ Right value to compare + -> Diff [Patience.Item Text] + -- ^ List of blocks of diffed text +diffText left right = do + DiffContext{ orientation } <- ask + + let leftString = Text.unpack left + let rightString = Text.unpack right + + let decomposeWords = decomposeOn wordBoundary + + let decomposeLines text = loop (decomposeOn lineBoundary text) + where + -- Groups each newline character with the preceding line + loop (x : y : zs) = (x <> y) : loop zs + loop zs = zs + + let leftWords = decomposeWords left + let rightWords = decomposeWords right + + let leftLines = decomposeLines left + let rightLines = decomposeLines right + + let chunks = + case orientation of + Character -> + fmap (fmap Text.pack) (getGroupedDiff leftString rightString) + Word -> + Patience.diff leftWords rightWords + Line -> + Patience.diff leftLines rightLines + + return 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 leftOutputs rightOutputs leftEnv rightEnv = do + let leftExtraEnv = Data.Map.difference leftEnv rightEnv + let rightExtraEnv = Data.Map.difference rightEnv leftEnv + + let bothEnv = innerJoin leftEnv rightEnv + + let predicate key (left, right) = + left == right + || ( Data.Set.member key leftOutputs + && Data.Set.member key rightOutputs + ) + || key == "builder" + || key == "system" + + if Data.Map.null leftExtraEnv + && Data.Map.null rightExtraEnv + && Data.Map.null + (Data.Map.filterWithKey (\k v -> not (predicate k v)) bothEnv) + then return EnvironmentsAreEqual + else do + let extraEnvDiff = Changed leftExtraEnv rightExtraEnv + envDiff <- forM (Data.Map.toList bothEnv) \(key, (leftValue, rightValue)) -> do + if predicate key (leftValue, rightValue) + then return Nothing + else do + valueDiff <- diffText leftValue rightValue + pure (Just (EnvVarDiff key valueDiff)) + pure (EnvironmentDiff extraEnvDiff (catMaybes envDiff)) + + +-- | Diff input sources +diffSrcs + :: Set FilePath + -- ^ Left input sources + -> Set FilePath + -- ^ Right inputSources + -> Diff SourcesDiff +diffSrcs leftSrcs rightSrcs = do + let groupedLeftSrcs = groupSetsByName leftSrcs + let groupedRightSrcs = groupSetsByName rightSrcs + + let leftNames = Data.Map.keysSet groupedLeftSrcs + let rightNames = Data.Map.keysSet groupedRightSrcs + + let leftExtraNames = Data.Set.difference leftNames rightNames + let rightExtraNames = Data.Set.difference rightNames leftNames + + let extraSrcNames = if (leftNames /= rightNames) + then Just (Changed leftExtraNames rightExtraNames) + else Nothing + + let assocs = Data.Map.toList (innerJoin groupedLeftSrcs groupedRightSrcs) + + srcFilesDiff <- forM assocs \(inputName, (leftPaths, rightPaths)) -> do + let leftExtraPaths = Data.Set.difference leftPaths rightPaths + let rightExtraPaths = Data.Set.difference rightPaths leftPaths + case (Data.Set.toList leftExtraPaths, Data.Set.toList rightExtraPaths) of + ([], []) -> return Nothing + ([leftPath], [rightPath]) -> do + leftExists <- liftIO (Directory.doesFileExist leftPath) + rightExists <- liftIO (Directory.doesFileExist rightPath) + srcContentDiff <- if leftExists && rightExists + then do + leftText <- liftIO (readFileUtf8Lenient leftPath) + rightText <- liftIO (readFileUtf8Lenient rightPath) + + text <- diffText leftText rightText + return (Just text) + else do + return Nothing + return (Just (OneSourceFileDiff inputName srcContentDiff)) + (leftExtraPathsList, rightExtraPathsList) -> do + return (Just (SomeSourceFileDiff inputName (Changed leftExtraPathsList rightExtraPathsList))) + return (SourcesDiff extraSrcNames (catMaybes srcFilesDiff)) + +diffPlatform :: Text -> Text -> Maybe (Changed Platform) +diffPlatform leftPlatform rightPlatform = do + if leftPlatform == rightPlatform + then Nothing + else Just (Changed leftPlatform rightPlatform) + +diffBuilder :: Text -> Text -> Maybe (Changed Builder) +diffBuilder leftBuilder rightBuilder = do + if leftBuilder == rightBuilder + then Nothing + else Just (Changed leftBuilder rightBuilder) + +diffArgs :: Vector Text -> Vector Text -> Maybe (NonEmpty (Patience.Item Argument)) +diffArgs leftArgs rightArgs = do + if leftArgs == rightArgs + then Nothing + else do + let leftList = Data.Vector.toList leftArgs + let rightList = Data.Vector.toList rightArgs + Data.List.NonEmpty.nonEmpty (Patience.diff leftList rightList) + +diff :: Bool -> FilePath -> Set Text -> FilePath -> Set Text -> Diff DerivationDiff +diff topLevel leftPath leftOutputs rightPath rightOutputs = do + Status { visited } <- get + let diffed = Diffed leftPath leftOutputs rightPath rightOutputs + if leftPath == rightPath + then return DerivationsAreTheSame + else if Data.Set.member diffed visited + then do + pure AlreadyCompared + else do + put (Status (Data.Set.insert diffed visited)) + let + outputStructure = Changed (leftPath, leftOutputs) (rightPath, rightOutputs) + + if derivationName leftPath /= derivationName rightPath && not topLevel + then do + pure (NamesDontMatch outputStructure) + else if leftOutputs /= rightOutputs + then do + pure (OutputsDontMatch outputStructure) + else do + leftDerivation <- readInput leftPath + rightDerivation <- readInput rightPath + + let leftOuts = Nix.Derivation.outputs leftDerivation + let rightOuts = Nix.Derivation.outputs rightDerivation + let outputsDiff = diffOutputs leftOuts rightOuts + + let leftPlatform = Nix.Derivation.platform leftDerivation + let rightPlatform = Nix.Derivation.platform rightDerivation + let platformDiff = diffPlatform leftPlatform rightPlatform + + let leftBuilder = Nix.Derivation.builder leftDerivation + let rightBuilder = Nix.Derivation.builder rightDerivation + let builderDiff = diffBuilder leftBuilder rightBuilder + + let leftArgs = Nix.Derivation.args leftDerivation + let rightArgs = Nix.Derivation.args rightDerivation + let argumentsDiff = diffArgs leftArgs rightArgs + + let leftSrcs = Nix.Derivation.inputSrcs leftDerivation + let rightSrcs = Nix.Derivation.inputSrcs rightDerivation + sourcesDiff <- diffSrcs leftSrcs rightSrcs + + let leftInputs = groupByName (Nix.Derivation.inputDrvs leftDerivation) + let rightInputs = groupByName (Nix.Derivation.inputDrvs rightDerivation) + + let leftNames = Data.Map.keysSet leftInputs + let rightNames = Data.Map.keysSet rightInputs + let leftExtraNames = Data.Set.difference leftNames rightNames + let rightExtraNames = Data.Set.difference rightNames leftNames + + let inputExtraNames = if (leftNames /= rightNames) + then Just (Changed leftExtraNames rightExtraNames) + else Nothing + + let assocs = Data.Map.toList (innerJoin leftInputs rightInputs) + (descended, mInputsDiff) <- unzip <$> forM assocs \(inputName, (leftPaths, rightPaths)) -> do + let leftExtraPaths = + Data.Map.difference leftPaths rightPaths + let rightExtraPaths = + Data.Map.difference rightPaths leftPaths + case (Data.Map.toList leftExtraPaths, Data.Map.toList rightExtraPaths) of + _ | leftPaths == rightPaths -> do + return (False, Nothing) + ([(leftPath', leftOutputs')], [(rightPath', rightOutputs')]) + | leftOutputs' == rightOutputs' -> do + drvDiff <- diff False leftPath' leftOutputs' rightPath' rightOutputs' + return (True, Just (OneDerivationDiff inputName drvDiff)) + _ -> do + let extraPartsDiff = Changed leftExtraPaths rightExtraPaths + return (False, Just (SomeDerivationsDiff inputName extraPartsDiff)) + + let inputDerivationDiffs = catMaybes mInputsDiff + let inputsDiff = InputsDiff {..} + + DiffContext { environment } <- ask + + envDiff <- if or descended && not environment + then return Nothing + else do + let leftEnv = Nix.Derivation.env leftDerivation + let rightEnv = Nix.Derivation.env rightDerivation + let leftOutNames = Data.Map.keysSet leftOuts + let rightOutNames = Data.Map.keysSet rightOuts + Just <$> diffEnv leftOutNames rightOutNames leftEnv rightEnv + pure DerivationDiff{..} diff --git a/src/Main.hs b/src/Main.hs index a3f785b..f906655 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,56 +6,30 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Main where import Control.Applicative ((<|>)) -import Control.Monad (forM, forM_) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Reader (MonadReader, ReaderT, ask, local) -import Control.Monad.State (MonadState, StateT, get, put) -import Data.Attoparsec.Text (IResult(..)) -import Data.List.NonEmpty (NonEmpty(..)) -import Data.Map (Map) import Data.Monoid ((<>)) -import Data.Set (Set) import Data.Text (Text) -import Data.Vector (Vector) -import Nix.Derivation (Derivation, DerivationOutput) -import Numeric.Natural (Natural) import Options.Applicative (Parser, ParserInfo) -import qualified Control.Monad as Monad import qualified Control.Monad.Reader import qualified Control.Monad.State -import qualified Data.Attoparsec.Text -import qualified Data.Char as Char -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.IO as Text.IO -import qualified Data.Vector import qualified GHC.IO.Encoding -import qualified Nix.Derivation import qualified Options.Applicative -import qualified Patience -import qualified System.Directory as Directory -import qualified System.FilePath as FilePath import qualified System.Posix.IO import qualified System.Posix.Terminal -import qualified System.Process as Process -#if MIN_VERSION_base(4,9,0) -import Control.Monad.Fail (MonadFail) -import qualified Data.ByteString -import qualified Data.Text.Encoding -import qualified Data.Text.Encoding.Error -#endif +import Diff +import Render.HumanReadable data Color = Always | Auto | Never +data RenderRunner = HumanReadable + parseColor :: Parser Color parseColor = Options.Applicative.option @@ -102,8 +76,6 @@ data Options = Options , environment :: Bool } -data Orientation = Character | Word | Line - parseOptions :: Parser Options parseOptions = do left <- parseLeft @@ -130,602 +102,9 @@ parserInfo = <> Options.Applicative.header "Explain why two derivations differ" ) -data Context = Context - { tty :: TTY - , indent :: Natural - , orientation :: Orientation - , environment :: Bool - } - -newtype Status = Status { visited :: Set Diffed } - -data Diffed = Diffed - { leftDerivation :: FilePath - , leftOutput :: Set Text - , rightDerivation :: FilePath - , rightOutput :: Set Text - } deriving (Eq, Ord) - -newtype Diff a = Diff { unDiff :: ReaderT Context (StateT Status IO) a } - deriving - ( Functor - , Applicative - , Monad - , MonadReader Context - , MonadState Status - , MonadIO -#if MIN_VERSION_base(4,9,0) - , MonadFail -#endif - ) - -echo :: Text -> Diff () -echo text = do - Context { indent } <- ask - let n = fromIntegral indent - liftIO (Text.IO.putStrLn (Text.replicate n " " <> text)) - -indented :: Natural -> Diff a -> Diff a -indented n = local adapt - where - adapt context = context { indent = indent context + n } - -{-| 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 = Text.dropEnd 4 . Text.drop 44 . Text.pack - --- | Group paths by their name -groupByName :: Map FilePath a -> Map Text (Map FilePath a) -groupByName m = Data.Map.fromList assocs - where - toAssoc key = (derivationName key, Data.Map.filterWithKey predicate m) - where - predicate key' _ = derivationName key == derivationName key' - - assocs = fmap toAssoc (Data.Map.keys 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 = Text.drop 44 . Text.pack - --- | Like `groupByName`, but for `Set`s -groupSetsByName :: Set FilePath -> Map Text (Set FilePath) -groupSetsByName s = Data.Map.fromList (fmap toAssoc (Data.Set.toList s)) - where - toAssoc key = (buildProductName key, Data.Set.filter predicate s) - where - predicate key' = buildProductName key == buildProductName 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 file = - Data.Text.Encoding.decodeUtf8With Data.Text.Encoding.Error.lenientDecode - <$> Data.ByteString.readFile file - --- | Read and parse a derivation from a file -readDerivation :: FilePath -> Diff (Derivation FilePath Text) -readDerivation path = do - let string = path - text <- liftIO (readFileUtf8Lenient string) - case Data.Attoparsec.Text.parse Nix.Derivation.parseDerivation text of - Done _ derivation -> do - return derivation - _ -> do - fail ("Could not parse a derivation from this file: " ++ 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 path = - if FilePath.isExtensionOf ".drv" path - then readDerivation path - else do - let string = path - result <- liftIO (Process.readProcess "nix-store" [ "--query", "--deriver", string ] []) - case String.lines result of - [] -> fail ("Could not obtain the derivation of " ++ string) - l : ls -> do - let drv_path = Data.List.NonEmpty.last (l :| ls) - readDerivation 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 = Data.Map.mergeWithKey both left right - where - both _ a b = Just (a, b) - - left _ = Data.Map.empty - - right _ = Data.Map.empty - -data TTY = IsTTY | NotTTY - --- | Color text red -red :: TTY -> Text -> Text -red IsTTY text = "\ESC[1;31m" <> text <> "\ESC[0m" -red NotTTY text = text - --- | Color text background red -redBackground :: Orientation -> TTY -> Text -> Text -redBackground Line IsTTY text = "\ESC[41m" <> prefix <> "\ESC[0m" <> suffix - where - (prefix, suffix) = Text.break lineBoundary text -redBackground Word IsTTY text = "\ESC[41m" <> prefix <> "\ESC[0m" <> suffix - where - (prefix, suffix) = Text.break wordBoundary text -redBackground Character IsTTY text = "\ESC[41m" <> text <> "\ESC[0m" -redBackground Line NotTTY text = "- " <> text -redBackground _ NotTTY text = "←" <> text <> "←" - --- | Color text green -green :: TTY -> Text -> Text -green IsTTY text = "\ESC[1;32m" <> text <> "\ESC[0m" -green NotTTY text = text - --- | Color text background green -greenBackground :: Orientation -> TTY -> Text -> Text -greenBackground Line IsTTY text = "\ESC[42m" <> prefix <> "\ESC[0m" <> suffix - where - (prefix, suffix) = Text.break lineBoundary text -greenBackground Word IsTTY text = "\ESC[42m" <> prefix <> "\ESC[0m" <> suffix - where - (prefix, suffix) = Text.break wordBoundary text -greenBackground Character IsTTY text = "\ESC[42m" <> text <> "\ESC[0m" -greenBackground Line NotTTY text = "+ " <> text -greenBackground _ NotTTY text = "→" <> text <> "→" - --- | Color text grey -grey :: Orientation -> TTY -> Text -> Text -grey _ IsTTY text = "\ESC[1;2m" <> text <> "\ESC[0m" -grey Line NotTTY text = " " <> text -grey _ NotTTY text = text - --- | Format the left half of a diff -minus :: TTY -> Text -> Text -minus tty text = red tty ("- " <> text) - --- | Format the right half of a diff -plus :: TTY -> Text -> Text -plus tty text = green tty ("+ " <> text) - --- | Format text explaining a diff -explain :: Text -> Text -explain text = "• " <> text - --- `getGroupedDiff` from `Diff` library, adapted for `patience` -getGroupedDiff :: Ord a => [a] -> [a] -> [Patience.Item [a]] -getGroupedDiff oldList newList = go $ Patience.diff oldList newList - where - go = \case - Patience.Old x : xs -> - let (fs, rest) = goOlds xs - in Patience.Old (x : fs) : go rest - Patience.New x : xs -> - let (fs, rest) = goNews xs - in Patience.New (x : fs) : go rest - Patience.Both x y : xs -> - let (fs, rest) = goBoth xs - (fxs, fys) = unzip fs - in Patience.Both (x : fxs) (y : fys) : go rest - [] -> [] - - goOlds = \case - Patience.Old x : xs -> - let (fs, rest) = goOlds xs - in (x : fs, rest) - xs -> ([], xs) - - goNews = \case - Patience.New x : xs -> - let (fs, rest) = goNews xs - in (x : fs, rest) - xs -> ([], xs) - - goBoth = \case - Patience.Both x y : xs -> - let (fs, rest) = goBoth xs - in ((x, y) : fs, rest) - xs -> ([], xs) - -{-| Utility to automate a common pattern of printing the two halves of a diff. - This passes the correct formatting function to each half --} -diffWith :: a -> a -> ((Text -> Text, a) -> Diff ()) -> Diff () -diffWith l r k = do - Context { tty } <- ask - k (minus tty, l) - k (plus tty, r) - --- | Format the derivation outputs -renderOutputs :: Set Text -> Text -renderOutputs outputs = - ":{" <> Text.intercalate "," (Data.Set.toList outputs) <> "}" - --- | Diff two outputs -diffOutput - :: Text - -- ^ Output name - -> (DerivationOutput FilePath Text) - -- ^ Left derivation outputs - -> (DerivationOutput FilePath Text) - -- ^ Right derivation outputs - -> Diff () -diffOutput outputName leftOutput 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 = Nix.Derivation.hashAlgo leftOutput - let rightHashAlgo = Nix.Derivation.hashAlgo rightOutput - if leftHashAlgo == rightHashAlgo - then return () - else do - echo (explain ("{" <> outputName <> "}:")) - echo (explain " Hash algorithm:") - diffWith leftHashAlgo rightHashAlgo \(sign, hashAlgo) -> do - echo (" " <> sign hashAlgo) - --- | Diff two sets of outputs -diffOutputs - :: Map Text (DerivationOutput FilePath Text) - -- ^ Left derivation outputs - -> Map Text (DerivationOutput FilePath Text) - -- ^ Right derivation outputs - -> Diff () -diffOutputs leftOutputs rightOutputs = do - let leftExtraOutputs = Data.Map.difference leftOutputs rightOutputs - let rightExtraOutputs = Data.Map.difference rightOutputs leftOutputs - - let bothOutputs = innerJoin leftOutputs rightOutputs - - if Data.Map.null leftExtraOutputs && Data.Map.null rightExtraOutputs - then return () - else do - echo (explain "The set of outputs do not match:") - diffWith leftExtraOutputs rightExtraOutputs \(sign, extraOutputs) -> do - forM_ (Data.Map.toList extraOutputs) \(key, _value) -> do - echo (" " <> sign ("{" <> key <> "}")) - forM_ (Data.Map.toList bothOutputs) \(key, (leftOutput, rightOutput)) -> do - if leftOutput == rightOutput - then return () - else diffOutput key leftOutput rightOutput - -mapDiff :: (a -> b) -> Patience.Item a -> Patience.Item b -mapDiff f (Patience.Old l ) = Patience.Old (f l) -mapDiff f (Patience.New r) = Patience.New (f r) -mapDiff f (Patience.Both l r) = Patience.Both (f l) (f r) - -{-| 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 predicate = unsatisfy - where - unsatisfy text - | Text.null text = [] - | otherwise = prefix : satisfy suffix - where - (prefix, suffix) = Text.break predicate text - - satisfy text - | Text.null text = [] - | otherwise = prefix : unsatisfy suffix - where - (prefix, suffix) = Text.span predicate text - -lineBoundary :: Char -> Bool -lineBoundary = ('\n' ==) - -wordBoundary :: Char -> Bool -wordBoundary = Char.isSpace - --- | Diff two `Text` values -diffText - :: Text - -- ^ Left value to compare - -> Text - -- ^ Right value to compare - -> Diff Text -diffText left right = do - Context{ indent, orientation, tty } <- ask - - let n = fromIntegral indent - - let leftString = Text.unpack left - let rightString = Text.unpack right - - let decomposeWords = decomposeOn wordBoundary - - let decomposeLines text = loop (decomposeOn lineBoundary text) - where - -- Groups each newline character with the preceding line - loop (x : y : zs) = (x <> y) : loop zs - loop zs = zs - - let leftWords = decomposeWords left - let rightWords = decomposeWords right - - let leftLines = decomposeLines left - let rightLines = decomposeLines right - - let chunks = - case orientation of - Character -> - fmap (mapDiff Text.pack) (getGroupedDiff leftString rightString) - Word -> - Patience.diff leftWords rightWords - Line -> - Patience.diff leftLines rightLines - let prefix = Text.replicate n " " - - let format text = - if 80 <= n + Text.length text - then "''\n" <> indentedText <> prefix <> "''" - else text - where - indentedText = - (Text.unlines . fmap indentLine . Text.lines) text - where - indentLine line = prefix <> " " <> line - - let renderChunk (Patience.Old l ) = - redBackground orientation tty l - renderChunk (Patience.New r) = - greenBackground orientation tty r - renderChunk (Patience.Both l _) = - grey orientation tty l - - return (format (Text.concat (fmap renderChunk 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 () -diffEnv leftOutputs rightOutputs leftEnv rightEnv = do - let leftExtraEnv = Data.Map.difference leftEnv rightEnv - let rightExtraEnv = Data.Map.difference rightEnv leftEnv - - let bothEnv = innerJoin leftEnv rightEnv - - let predicate key (left, right) = - left == right - || ( Data.Set.member key leftOutputs - && Data.Set.member key rightOutputs - ) - || key == "builder" - || key == "system" - - if Data.Map.null leftExtraEnv - && Data.Map.null rightExtraEnv - && Data.Map.null - (Data.Map.filterWithKey (\k v -> not (predicate k v)) bothEnv) - then return () - else do - echo (explain "The environments do not match:") - diffWith leftExtraEnv rightExtraEnv \(sign, extraEnv) -> do - forM_ (Data.Map.toList extraEnv) \(key, value) -> do - echo (" " <> sign (key <> "=" <> value)) - forM_ (Data.Map.toList bothEnv) \(key, (leftValue, rightValue)) -> do - if predicate key (leftValue, rightValue) - then return () - else do - text <- diffText leftValue rightValue - echo (" " <> key <> "=" <> text) - --- | Diff input sources -diffSrcs - :: Set FilePath - -- ^ Left input sources - -> Set FilePath - -- ^ Right inputSources - -> Diff () -diffSrcs leftSrcs rightSrcs = do - let groupedLeftSrcs = groupSetsByName leftSrcs - let groupedRightSrcs = groupSetsByName rightSrcs - - let leftNames = Data.Map.keysSet groupedLeftSrcs - let rightNames = Data.Map.keysSet groupedRightSrcs - - let leftExtraNames = Data.Set.difference leftNames rightNames - let rightExtraNames = Data.Set.difference rightNames leftNames - - Monad.when (leftNames /= rightNames) do - echo (explain "The set of input source names do not match:") - diffWith leftExtraNames rightExtraNames \(sign, names) -> do - forM_ names \name -> do - echo (" " <> sign name) - - let assocs = Data.Map.toList (innerJoin groupedLeftSrcs groupedRightSrcs) - - forM_ assocs \(inputName, (leftPaths, rightPaths)) -> do - let leftExtraPaths = Data.Set.difference leftPaths rightPaths - let rightExtraPaths = Data.Set.difference rightPaths leftPaths - case (Data.Set.toList leftExtraPaths, Data.Set.toList rightExtraPaths) of - ([], []) -> return () - ([leftPath], [rightPath]) -> do - echo (explain ("The input source named `" <> inputName <> "` differs")) - leftExists <- liftIO (Directory.doesFileExist leftPath) - rightExists <- liftIO (Directory.doesFileExist rightPath) - if leftExists && rightExists - then do - leftText <- liftIO (readFileUtf8Lenient leftPath) - rightText <- liftIO (readFileUtf8Lenient rightPath) - - text <- diffText leftText rightText - echo (" " <> text) - else do - return () - return () - (leftExtraPathsList, rightExtraPathsList) -> do - echo (explain ("The input sources named `" <> inputName <> "` differ")) - diffWith leftExtraPathsList rightExtraPathsList \(sign, paths) -> do - forM_ paths \path -> do - echo (" " <> sign (Text.pack path)) - -diffPlatform :: Text -> Text -> Diff () -diffPlatform leftPlatform rightPlatform = do - if leftPlatform == rightPlatform - then return () - else do - echo (explain "The platforms do not match") - diffWith leftPlatform rightPlatform \(sign, platform) -> do - echo (" " <> sign platform) - -diffBuilder :: Text -> Text -> Diff () -diffBuilder leftBuilder rightBuilder = do - if leftBuilder == rightBuilder - then return () - else do - echo (explain "The builders do not match") - diffWith leftBuilder rightBuilder \(sign, builder) -> do - echo (" " <> sign builder) - -diffArgs :: Vector Text -> Vector Text -> Diff () -diffArgs leftArgs rightArgs = do - Context { tty } <- ask - if leftArgs == rightArgs - then return () - else do - echo (explain "The arguments do not match") - let leftList = Data.Vector.toList leftArgs - let rightList = Data.Vector.toList rightArgs - let diffs = Patience.diff leftList rightList - let renderDiff (Patience.Old arg) = - echo (" " <> minus tty arg) - renderDiff (Patience.New arg) = - echo (" " <> plus tty arg) - renderDiff (Patience.Both arg _) = - echo (" " <> explain arg) - mapM_ renderDiff diffs - -diff :: Bool -> FilePath -> Set Text -> FilePath -> Set Text -> Diff () -diff topLevel leftPath leftOutputs rightPath rightOutputs = do - Status { visited } <- get - let diffed = Diffed leftPath leftOutputs rightPath rightOutputs - if leftPath == rightPath - then return () - else if Data.Set.member diffed visited - then do - echo (explain "These two derivations have already been compared") - else do - put (Status (Data.Set.insert diffed visited)) - diffWith (leftPath, leftOutputs) (rightPath, rightOutputs) \(sign, (path, outputs)) -> do - echo (sign (Text.pack path <> renderOutputs outputs)) - - if derivationName leftPath /= derivationName rightPath && not topLevel - then do - echo (explain "The derivation names do not match") - else if leftOutputs /= rightOutputs - then do - echo (explain "The requested outputs do not match") - else do - leftDerivation <- readInput leftPath - rightDerivation <- readInput rightPath - - let leftOuts = Nix.Derivation.outputs leftDerivation - let rightOuts = Nix.Derivation.outputs rightDerivation - diffOutputs leftOuts rightOuts - - let leftPlatform = Nix.Derivation.platform leftDerivation - let rightPlatform = Nix.Derivation.platform rightDerivation - diffPlatform leftPlatform rightPlatform - - let leftBuilder = Nix.Derivation.builder leftDerivation - let rightBuilder = Nix.Derivation.builder rightDerivation - diffBuilder leftBuilder rightBuilder - - let leftArgs = Nix.Derivation.args leftDerivation - let rightArgs = Nix.Derivation.args rightDerivation - diffArgs leftArgs rightArgs - - let leftSrcs = Nix.Derivation.inputSrcs leftDerivation - let rightSrcs = Nix.Derivation.inputSrcs rightDerivation - diffSrcs leftSrcs rightSrcs - - let leftInputs = groupByName (Nix.Derivation.inputDrvs leftDerivation) - let rightInputs = groupByName (Nix.Derivation.inputDrvs rightDerivation) - - let leftNames = Data.Map.keysSet leftInputs - let rightNames = Data.Map.keysSet rightInputs - let leftExtraNames = Data.Set.difference leftNames rightNames - let rightExtraNames = Data.Set.difference rightNames leftNames - - Monad.when (leftNames /= rightNames) do - echo (explain "The set of input derivation names do not match:") - diffWith leftExtraNames rightExtraNames \(sign, names) -> do - forM_ names \name -> do - echo (" " <> sign name) - - let assocs = Data.Map.toList (innerJoin leftInputs rightInputs) - descended <- forM assocs \(inputName, (leftPaths, rightPaths)) -> do - let leftExtraPaths = - Data.Map.difference leftPaths rightPaths - let rightExtraPaths = - Data.Map.difference rightPaths leftPaths - case (Data.Map.toList leftExtraPaths, Data.Map.toList rightExtraPaths) of - _ | leftPaths == rightPaths -> do - return False - ([(leftPath', leftOutputs')], [(rightPath', rightOutputs')]) - | leftOutputs' == rightOutputs' -> do - echo (explain ("The input derivation named `" <> inputName <> "` differs")) - indented 2 (diff False leftPath' leftOutputs' rightPath' rightOutputs') - return True - _ -> do - echo (explain ("The set of input derivations named `" <> inputName <> "` do not match")) - diffWith leftExtraPaths rightExtraPaths \(sign, extraPaths) -> do - forM_ (Data.Map.toList extraPaths) \(extraPath, outputs) -> do - echo (" " <> sign (Text.pack extraPath <> renderOutputs outputs)) - return False - - Context { environment } <- ask - - if or descended && not environment - then do - echo (explain "Skipping environment comparison") - else do - let leftEnv = Nix.Derivation.env leftDerivation - let rightEnv = Nix.Derivation.env rightDerivation - let leftOutNames = Data.Map.keysSet leftOuts - let rightOutNames = Data.Map.keysSet rightOuts - diffEnv leftOutNames rightOutNames leftEnv rightEnv +renderDiff :: RenderRunner -> RenderContext -> DerivationDiff -> IO () +renderDiff HumanReadable context derivation + = Control.Monad.Reader.runReaderT (unRender (renderDiffHumanReadable derivation)) context main :: IO () main = do @@ -743,7 +122,10 @@ main = do return (if b then IsTTY else NotTTY) let indent = 0 - let context = Context { tty, indent, orientation, environment } + let diffContext = DiffContext {..} + let renderContext = RenderContext {..} + let renderRunner = HumanReadable let status = Status Data.Set.empty let action = diff True left (Data.Set.singleton "out") right (Data.Set.singleton "out") - Control.Monad.State.evalStateT (Control.Monad.Reader.runReaderT (unDiff action) context) status + diffTree <- Control.Monad.State.evalStateT (Control.Monad.Reader.runReaderT (unDiff action) diffContext) status + renderDiff renderRunner renderContext diffTree diff --git a/src/Render/HumanReadable.hs b/src/Render/HumanReadable.hs new file mode 100644 index 0000000..bde41c8 --- /dev/null +++ b/src/Render/HumanReadable.hs @@ -0,0 +1,274 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Render.HumanReadable where + +import Control.Monad (forM_) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Reader (MonadReader, ReaderT, ask, local) +import Data.Monoid ((<>)) +import Data.Set (Set) +import Data.Text (Text) +import Numeric.Natural (Natural) + +import qualified Control.Monad.Reader +import qualified Data.Map +import qualified Data.Set +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified Patience + +#if MIN_VERSION_base(4,9,0) +import Control.Monad.Fail (MonadFail) +#endif + +import Diff + + +data RenderContext = RenderContext + { orientation :: Orientation + , tty :: TTY + , indent :: Natural + } + +newtype Render a = Render { unRender :: ReaderT RenderContext IO a} + deriving + ( Functor + , Applicative + , Monad + , MonadReader RenderContext + , MonadIO +#if MIN_VERSION_base(4,9,0) + , MonadFail +#endif + ) + +echo :: Text -> Render () +echo text = do + RenderContext { indent } <- ask + let n = fromIntegral indent + liftIO (Text.IO.putStrLn (Text.replicate n " " <> text)) + +indented :: Natural -> Render a -> Render a +indented n = local adapt + where + adapt context = context { indent = indent context + n } + +data TTY = IsTTY | NotTTY + +-- | Color text red +red :: TTY -> Text -> Text +red IsTTY text = "\ESC[1;31m" <> text <> "\ESC[0m" +red NotTTY text = text + +-- | Color text background red +redBackground :: Orientation -> TTY -> Text -> Text +redBackground Line IsTTY text = "\ESC[41m" <> prefix <> "\ESC[0m" <> suffix + where + (prefix, suffix) = Text.break lineBoundary text +redBackground Word IsTTY text = "\ESC[41m" <> prefix <> "\ESC[0m" <> suffix + where + (prefix, suffix) = Text.break wordBoundary text +redBackground Character IsTTY text = "\ESC[41m" <> text <> "\ESC[0m" +redBackground Line NotTTY text = "- " <> text +redBackground _ NotTTY text = "←" <> text <> "←" + +-- | Color text green +green :: TTY -> Text -> Text +green IsTTY text = "\ESC[1;32m" <> text <> "\ESC[0m" +green NotTTY text = text + +-- | Color text background green +greenBackground :: Orientation -> TTY -> Text -> Text +greenBackground Line IsTTY text = "\ESC[42m" <> prefix <> "\ESC[0m" <> suffix + where + (prefix, suffix) = Text.break lineBoundary text +greenBackground Word IsTTY text = "\ESC[42m" <> prefix <> "\ESC[0m" <> suffix + where + (prefix, suffix) = Text.break wordBoundary text +greenBackground Character IsTTY text = "\ESC[42m" <> text <> "\ESC[0m" +greenBackground Line NotTTY text = "+ " <> text +greenBackground _ NotTTY text = "→" <> text <> "→" + +-- | Color text grey +grey :: Orientation -> TTY -> Text -> Text +grey _ IsTTY text = "\ESC[1;2m" <> text <> "\ESC[0m" +grey Line NotTTY text = " " <> text +grey _ NotTTY text = text + +-- | Format the left half of a diff +minus :: TTY -> Text -> Text +minus tty text = red tty ("- " <> text) + +-- | Format the right half of a diff +plus :: TTY -> Text -> Text +plus tty text = green tty ("+ " <> text) + +-- | Format text explaining a diff +explain :: Text -> Text +explain text = "• " <> text + +{-| Utility to automate a common pattern of printing the two halves of a diff. + This passes the correct formatting function to each half +-} +renderWith :: Changed a -> ((Text -> Text, a) -> Render ()) -> Render () +renderWith Changed{..} k = do + RenderContext { tty } <- ask + k (minus tty, before) + k (plus tty, now) + +-- | Format the derivation outputs +renderOutputs :: Set Text -> Text +renderOutputs outputs = + ":{" <> Text.intercalate "," (Data.Set.toList outputs) <> "}" + +renderDiffHumanReadable :: DerivationDiff -> Render () +renderDiffHumanReadable = \case + DerivationsAreTheSame -> pure () + AlreadyCompared -> echo (explain "These two derivations have already been compared") + NamesDontMatch {..} -> do + renderOutputStructure outputStructure + echo (explain "The derivation names do not match") + OutputsDontMatch {..} -> do + renderOutputStructure outputStructure + echo (explain "The requested outputs do not match") + DerivationDiff {..} -> do + renderOutputStructure outputStructure + renderOutputsDiff outputsDiff + renderPlatformDiff platformDiff + renderBuilderDiff builderDiff + renderArgsDiff argumentsDiff + renderSrcDiff sourcesDiff + renderInputsDiff inputsDiff + renderEnvDiff envDiff + + where + renderOutputStructure os = + renderWith os \(sign, (path, outputs)) -> do + echo (sign (Text.pack path <> renderOutputs outputs)) + + renderOutputsDiff OutputsDiff{..} = do + ifExist extraOutputs \eo -> do + echo (explain "The set of outputs do not match:") + renderWith eo \(sign, extraOutputs') -> do + forM_ (Data.Map.toList extraOutputs') \(key, _value) -> do + echo (" " <> sign ("{" <> key <> "}")) + mapM_ renderOutputHashDiff outputHashDiff + + renderOutputHashDiff OutputDiff{..} = do + echo (explain ("{" <> outputName <> "}:")) + echo (explain " Hash algorithm:") + renderWith hashDifference \(sign, hashAlgo) -> do + echo (" " <> sign hashAlgo) + + renderPlatformDiff mpd = + ifExist mpd \pd -> do + echo (explain "The platforms do not match") + renderWith pd \(sign, platform) -> do + echo (" " <> sign platform) + + renderBuilderDiff mbd = + ifExist mbd \bd -> do + echo (explain "The builders do not match") + renderWith bd \(sign, builder) -> do + echo (" " <> sign builder) + + renderArgsDiff mad = + ifExist mad \ad -> do + RenderContext { tty } <- ask + echo (explain "The arguments do not match") + let renderDiff (Patience.Old arg) = + echo (" " <> minus tty arg) + renderDiff (Patience.New arg) = + echo (" " <> plus tty arg) + renderDiff (Patience.Both arg _) = + echo (" " <> explain arg) + mapM_ renderDiff ad + + renderSrcDiff SourcesDiff{..} = do + ifExist extraSrcNames \esn -> do + echo (explain "The set of input source names do not match:") + renderWith esn \(sign, names) -> do + forM_ names \name -> do + echo (" " <> sign name) + + mapM_ renderSrcFileDiff srcFilesDiff + + renderSrcFileDiff OneSourceFileDiff{..} = do + echo (explain ("The input source named `" <> srcName <> "` differs")) + ifExist srcContentDiff \scd -> do + text <- renderText scd + echo (" " <> text) + renderSrcFileDiff SomeSourceFileDiff{..} = do + echo (explain ("The input sources named `" <> srcName <> "` differ")) + renderWith srcFilesDiff \(sign, paths) -> do + forM_ paths \path -> do + echo (" " <> sign (Text.pack path)) + + renderInputsDiff InputsDiff{..} = do + renderInputExtraNames inputExtraNames + mapM_ renderInputDerivationsDiff inputDerivationDiffs + + renderInputExtraNames mien = + ifExist mien \ien -> do + echo (explain "The set of input derivation names do not match:") + renderWith ien \(sign, names) -> do + forM_ names \name -> do + echo (" " <> sign name) + + renderInputDerivationsDiff OneDerivationDiff{..} = do + echo (explain ("The input derivation named `" <> drvName <> "` differs")) + indented 2 (renderDiffHumanReadable drvDiff) + renderInputDerivationsDiff SomeDerivationsDiff{..} = do + echo (explain ("The set of input derivations named `" <> drvName <> "` do not match")) + renderWith extraPartsDiff \(sign, extraPaths) -> do + forM_ (Data.Map.toList extraPaths) \(extraPath, outputs) -> do + echo (" " <> sign (Text.pack extraPath <> renderOutputs outputs)) + + renderEnvDiff Nothing = + echo (explain "Skipping environment comparison") + renderEnvDiff (Just EnvironmentsAreEqual) = pure () + renderEnvDiff (Just EnvironmentDiff{..}) = do + echo (explain "The environments do not match:") + renderWith extraEnvDiff \(sign, extraEnv) -> do + forM_ (Data.Map.toList extraEnv) \(key, value) -> do + echo (" " <> sign (key <> "=" <> value)) + forM_ envContentDiff \EnvVarDiff{..} -> do + text <- renderText envValueDiff + echo (" " <> envKey <> "=" <> text) + + renderText :: [Patience.Item Text] -> Render Text + renderText chunks = do + RenderContext{ indent, orientation, tty } <- ask + + let n = fromIntegral indent + + let prefix = Text.replicate n " " + + let format text = + if 80 <= n + Text.length text + then "''\n" <> indentedText <> prefix <> "''" + else text + where + indentedText = + (Text.unlines . fmap indentLine . Text.lines) text + where + indentLine line = prefix <> " " <> line + + let renderChunk (Patience.Old l ) = + redBackground orientation tty l + renderChunk (Patience.New r) = + greenBackground orientation tty r + renderChunk (Patience.Both l _) = + grey orientation tty l + + return (format (Text.concat (fmap renderChunk chunks))) + + ifExist m l = maybe (pure ()) l m From f5c009b415d346701056fa0ba050fe25f7c1c70e Mon Sep 17 00:00:00 2001 From: Andrei Borzenkov Date: Tue, 18 Oct 2022 17:45:31 +0400 Subject: [PATCH 2/2] Add golden tests for this repo Problem: we need to check if code changes will also change the behavior Solution: add test, that will make two derivations and check if output of program will be different of saved one. --- README.md | 12 +- golden-tests/expected-output | 174 +++++++++++++++++++++++ golden-tests/new-derivation/changed-file | 120 ++++++++++++++++ golden-tests/new-derivation/drv.nix | 39 +++++ golden-tests/new-derivation/new-file | 1 + golden-tests/old-derivation/changed-file | 120 ++++++++++++++++ golden-tests/old-derivation/drv.nix | 39 +++++ golden-tests/old-derivation/missing-file | 1 + golden-tests/run-test.sh | 9 ++ 9 files changed, 512 insertions(+), 3 deletions(-) create mode 100644 golden-tests/expected-output create mode 100644 golden-tests/new-derivation/changed-file create mode 100644 golden-tests/new-derivation/drv.nix create mode 100644 golden-tests/new-derivation/new-file create mode 100644 golden-tests/old-derivation/changed-file create mode 100644 golden-tests/old-derivation/drv.nix create mode 100644 golden-tests/old-derivation/missing-file create mode 100755 golden-tests/run-test.sh diff --git a/README.md b/README.md index 70756e7..b7d338b 100644 --- a/README.md +++ b/README.md @@ -70,7 +70,7 @@ We can use `nix-diff` to compare the two computed derivations to determine what changed about our system: ```bash -$ nix-diff /nix/store/6z9nr5pzs4j1v9mld517dmlcz61zy78z-nixos-system-nixos-18.03pre119245.5cfd049a03.drv /nix/store/k05ibijg0kknvwrgfyb7dxwjrs8qrlbj-nixos-system-nixos-18.03pre119245.5cfd049a03.drv +$ nix-diff /nix/store/6z9nr5pzs4j1v9mld517dmlcz61zy78z-nixos-system-nixos-18.03pre119245.5cfd049a03.drv /nix/store/k05ibijg0kknvwrgfyb7dxwjrs8qrlbj-nixos-system-nixos-18.03pre119245.5cfd049a03.drv ``` ... which produces the following output: @@ -83,6 +83,12 @@ It's also possible to pass store paths or links to store paths, for example: $ nix-build example.nix $ nix-diff /run/current-system ./result ``` +## Testing + +You have to have `nix-diff` in PATH to run test from `golden-tests` folder. +You also have to be in that folder and to have nix in your system. + +Basically, you can run test, using `cabal exec bash -- -c "cd golden-tests; ./run-test.sh"` command. ## Development status @@ -96,7 +102,7 @@ an improvement. Copyright (c) 2017 Gabriella Gonzalez All rights reserved. - + Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, @@ -107,7 +113,7 @@ an improvement. * Neither the name of Gabriella Gonzalez nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. - + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE diff --git a/golden-tests/expected-output b/golden-tests/expected-output new file mode 100644 index 0000000..d88b40a --- /dev/null +++ b/golden-tests/expected-output @@ -0,0 +1,174 @@ +- /nix/store/2bwmj0qp4m6fiah2b39qwpf1lw0l1a4v-drv.drv:{out} ++ /nix/store/bg0lxf2d20a3sif8vpfmxcl6hch8ls8h-drv.drv:{out} +• The arguments do not match + • one + - two + • three + + four +• The set of input source names do not match: + - missing-file + + new-file +• The input source named `changed-file` differs + '' + When in the Course of human events it becomes necessary for one people to + dissolve the political bands which have connected them with another and to + assume among the powers of the earth, the separate and equal station to which + the Laws of Nature and of Nature's ←God←→Dog→ entitle them, a decent respect to the + opinions of mankind requires that they should declare the causes which impel + them to the separation. + We hold these truths to be self-evident, that all men are created equal, that + they are endowed by their Creator with certain unalienable Rights, that among + these are Life, Liberty and the pursuit of Happiness. — That to secure these + rights, Governments are instituted among Men, deriving their just powers from + the consent of the governed, — That whenever any Form of Government becomes + destructive of these ends, it is the Right of the People to alter or to + abolish it, and to institute new Government, laying its foundation on such + principles and organizing its powers in such form, as to them shall seem most + likely to effect their Safety and Happiness. Prudence, indeed, will dictate + that Governments long established should not be changed for light and + transient causes; and accordingly all experience hath shewn that mankind are + more disposed to suffer, while evils are sufferable than to right themselves + by abolishing the forms to which they are accustomed. But when a long train of + abuses and usurpations, pursuing invariably the same Object evinces a design + to reduce them under absolute Despotism, it is their right, it is their duty, + to throw off such Government, and to provide new Guards for their future + security. — Such has been the patient sufferance of these Colonies; and such + is now the necessity which constrains them to alter their former Systems of + Government. The history of the present King of Great Britain is a history of + repeated injuries and usurpations, all having in direct object the + establishment of an absolute Tyranny over these States. To prove this, let + Facts be submitted to a candid world. + He has refused his Assent to Laws, the most wholesome and necessary for the + public good. + He has forbidden his Governors to pass Laws of immediate and pressing + importance, unless suspended in their operation till his Assent should be + obtained; and when so suspended, he has utterly neglected to attend to them. + He has refused to pass other Laws for the accommodation of large districts of + people, unless those people would relinquish the right of Representation in + the Legislature, a right inestimable to them and formidable to tyrants only. + He has called together legislative bodies at places unusual, uncomfortable, + and distant from the depository of their Public Records, for the sole purpose + of fatiguing them into compliance with his measures. + He has dissolved Representative Houses repeatedly, for opposing with manly + firmness his invasions on the rights of the people. + He has refused for a long time, after such dissolutions, to cause others to be + elected, whereby the Legislative Powers, incapable of Annihilation, have + returned to the People at large for their exercise; the State remaining in the + mean time exposed to all the dangers of invasion from without, and convulsions + within. + He has endeavoured to prevent the population of these States; for that purpose + obstructing the Laws for Naturalization of Foreigners; refusing to pass others + to encourage their migrations hither, and raising the conditions of new + Appropriations of Lands. + He has obstructed the Administration of Justice by refusing his Assent to Laws + for establishing Judiciary Powers. + He has made Judges dependent on his Will alone for the tenure of their + offices, and the amount and payment of their salaries. + He has erected a multitude of New Offices, and sent hither swarms of Officers + to harass our people and eat out their substance. + He has kept among us, in times of peace, Standing Armies without the Consent + of our legislatures. + He has affected to render the Military independent of and superior to the + Civil Power. + He has combined with others to subject us to a jurisdiction foreign to our + constitution, and unacknowledged by our laws; giving his Assent to their Acts + of pretended Legislation: + For quartering large bodies of armed troops among us: + For protecting them, by a mock Trial from punishment for any Murders which + they should commit on the Inhabitants of these States: + For cutting off our Trade with all parts of the world: + For imposing Taxes on us without our Consent: + For depriving us in many cases, of the benefit of Trial by Jury: + For transporting us beyond Seas to be tried for pretended offences: + For abolishing the free System of English Laws in a neighbouring Province, + establishing therein an Arbitrary government, and enlarging its Boundaries so + as to render it at once an example and fit instrument for introducing the same + absolute rule into these Colonies + For taking away our Charters, abolishing our most valuable Laws and altering + fundamentally the Forms of our Governments: + For suspending our own Legislatures, and declaring themselves invested with + power to legislate for us in all cases whatsoever. + He has abdicated Government here, by declaring us out of his Protection and + waging War against us. + He has plundered our seas, ravaged our coasts, burnt our towns, and destroyed + the lives of our people. + He is at this time transporting large Armies of foreign Mercenaries to + compleat the works of death, desolation, and tyranny, already begun with + circumstances of Cruelty & Perfidy scarcely paralleled in the most barbarous + ages, and totally unworthy the Head of a civilized nation. + He has constrained our fellow Citizens taken Captive on the high Seas to bear + Arms against their Country, to become the executioners of their friends and + Brethren, or to fall themselves by their Hands. + He has excited domestic insurrections amongst us, and has endeavoured to bring + on the inhabitants of our frontiers, the merciless Indian Savages whose known + rule of warfare, is an undistinguished destruction of all ages, sexes and + conditions. + In every stage of these Oppressions We have Petitioned for Redress in the most + humble terms: Our repeated Petitions have been answered only by repeated + injury. A Prince, whose character is thus marked by every act which may + define a Tyrant, is unfit to be the ruler of a free people. + Nor have We been wanting in attentions to our British brethren. We have warned + them from time to time of attempts by their legislature to extend an + unwarrantable jurisdiction over us. We have reminded them of the circumstances + of our emigration and settlement here. We have appealed to their native + justice and magnanimity, and we have conjured them by the ties of our common + kindred to disavow these usurpations, which would inevitably interrupt our + connections and correspondence. They too have been deaf to the voice of + justice and of consanguinity. We must, therefore, acquiesce in the necessity, + which denounces our Separation, and hold them, as we hold the rest of mankind, + Enemies in War, in Peace Friends. + We, therefore, the Representatives of the united States of America, in General + Congress, Assembled, appealing to the Supreme Judge of the world for the + rectitude of our intentions, do, in the Name, and by Authority of the good + People of these Colonies, solemnly publish and declare, That these united + Colonies are, and of Right ought to be Free and Independent States, that they + are Absolved from all Allegiance to the British Crown, and that all political + connection between them and the State of Great Britain, is and ought to be + totally dissolved; and that as Free and Independent States, they have full + Power to levy War, conclude Peace, contract Alliances, establish Commerce, and + to do all other Acts and Things which Independent States may of right do. — + And for the support of this Declaration, with a firm reliance on the + protection of Divine Providence, we mutually pledge to each other our Lives, + our Fortunes, and our sacred Honor. +'' +• The set of input derivation names do not match: + - old + + new +• The set of input derivations named `outputs` do not match + - /nix/store/sapk625xl072bdh8w7w7l3m1ii9lcc65-outputs.drv:{out} + + /nix/store/vsfl2bqr1banhcpwf0f3aja5320ijiln-outputs.drv:{lib} +• The input derivation named `second_derivation` differs + - /nix/store/gq9mz7fsvxanbpw6m4qlriyxzj6j7id8-second_derivation.drv:{out} + + /nix/store/0ijwj4k5vdyawhk12yghx3cdsic6w8ly-second_derivation.drv:{out} + • The input derivation named `soft_from_SW` differs + - /nix/store/f62l132ax7syr3l9y7y2413lmynq7wnh-soft_from_SW.drv:{out} + + /nix/store/vyks8xqgrydzay393gjz4bkah9c75892-soft_from_SW.drv:{out} + • The platforms do not match + - R2D2_astrodroid + + C3PO + • The builders do not match + - Anakin Skywalker + + Luke Skywalker + • The environments do not match: + - missingEnvVaribale=value + + newEnvVaribale=value + • The environments do not match: + derivations='' + ←/nix/store/6hhm9alara3lijwww2sbm8bmf81x5j94-soft_from_SW←→/nix/store/qrn9pa2j5swdqld8h0rhlvpj5mjcbn5z-soft_from_SW→ + '' +• The input derivation named `third_derivation` differs + - /nix/store/j1jmbxd74kzianaywml2nw1ja31a00r5-third_derivation.drv:{out} + + /nix/store/ww51c2dha7m5l5qjzh2rblicsamkrh62-third_derivation.drv:{out} + • The input derivation named `soft_from_SW` differs + • These two derivations have already been compared + • The environments do not match: + derivations='' + ←/nix/store/6hhm9alara3lijwww2sbm8bmf81x5j94-soft_from_SW←→/nix/store/qrn9pa2j5swdqld8h0rhlvpj5mjcbn5z-soft_from_SW→ + '' +• The environments do not match: + derivations='' + ←/nix/store/9dmp71si62hsgf2bi5g1ibkqdbwsv0zv-second_derivation←← ←←/nix/store/gvvxj52wd0s986ybx06gzrj8r2623fi9-third_derivation←← ←←/nix/store/5agf2p8f84fijdnlqy5mvwza3s2lic8l-old←← ←←/nix/store/10gqfacshzjzz0aayx29w5wrbcsbsa83-outputs←→/nix/store/1zy94ghyzk4f1r3alk4yhk2yvrm6x4ch-second_derivation→→ →→/nix/store/0xq8xmcxshwkai4rn55zb780pq8qdrbx-third_derivation→→ →→/nix/store/gz8x5pzvn6wpzk74m5nr7758iz8cvbsr-new→→ →→/nix/store/kqgpkfil6919d95c2vfyvdpb0fcfam30-outputs-lib→ +'' + srcs='' + ←/nix/store/271h6y1jg7qizbqav8a34bhdaa6lvd64-changed-file←→/nix/store/7xawqkhd7p3d0brazmrv5zi8ki9w64wk-changed-file→ ←/nix/store/w1cqaspljnya9vxwyv25m6ak2crqjy7i-missing-file←→/nix/store/h9jy4njbp943nffs7sc9ycndmxmvgwwa-new-file→ +'' diff --git a/golden-tests/new-derivation/changed-file b/golden-tests/new-derivation/changed-file new file mode 100644 index 0000000..c50c694 --- /dev/null +++ b/golden-tests/new-derivation/changed-file @@ -0,0 +1,120 @@ + When in the Course of human events it becomes necessary for one people to + dissolve the political bands which have connected them with another and to + assume among the powers of the earth, the separate and equal station to which + the Laws of Nature and of Nature's Dog entitle them, a decent respect to the + opinions of mankind requires that they should declare the causes which impel + them to the separation. + We hold these truths to be self-evident, that all men are created equal, that + they are endowed by their Creator with certain unalienable Rights, that among + these are Life, Liberty and the pursuit of Happiness. — That to secure these + rights, Governments are instituted among Men, deriving their just powers from + the consent of the governed, — That whenever any Form of Government becomes + destructive of these ends, it is the Right of the People to alter or to + abolish it, and to institute new Government, laying its foundation on such + principles and organizing its powers in such form, as to them shall seem most + likely to effect their Safety and Happiness. Prudence, indeed, will dictate + that Governments long established should not be changed for light and + transient causes; and accordingly all experience hath shewn that mankind are + more disposed to suffer, while evils are sufferable than to right themselves + by abolishing the forms to which they are accustomed. But when a long train of + abuses and usurpations, pursuing invariably the same Object evinces a design + to reduce them under absolute Despotism, it is their right, it is their duty, + to throw off such Government, and to provide new Guards for their future + security. — Such has been the patient sufferance of these Colonies; and such + is now the necessity which constrains them to alter their former Systems of + Government. The history of the present King of Great Britain is a history of + repeated injuries and usurpations, all having in direct object the + establishment of an absolute Tyranny over these States. To prove this, let + Facts be submitted to a candid world. + He has refused his Assent to Laws, the most wholesome and necessary for the + public good. + He has forbidden his Governors to pass Laws of immediate and pressing + importance, unless suspended in their operation till his Assent should be + obtained; and when so suspended, he has utterly neglected to attend to them. + He has refused to pass other Laws for the accommodation of large districts of + people, unless those people would relinquish the right of Representation in + the Legislature, a right inestimable to them and formidable to tyrants only. + He has called together legislative bodies at places unusual, uncomfortable, + and distant from the depository of their Public Records, for the sole purpose + of fatiguing them into compliance with his measures. + He has dissolved Representative Houses repeatedly, for opposing with manly + firmness his invasions on the rights of the people. + He has refused for a long time, after such dissolutions, to cause others to be + elected, whereby the Legislative Powers, incapable of Annihilation, have + returned to the People at large for their exercise; the State remaining in the + mean time exposed to all the dangers of invasion from without, and convulsions + within. + He has endeavoured to prevent the population of these States; for that purpose + obstructing the Laws for Naturalization of Foreigners; refusing to pass others + to encourage their migrations hither, and raising the conditions of new + Appropriations of Lands. + He has obstructed the Administration of Justice by refusing his Assent to Laws + for establishing Judiciary Powers. + He has made Judges dependent on his Will alone for the tenure of their + offices, and the amount and payment of their salaries. + He has erected a multitude of New Offices, and sent hither swarms of Officers + to harass our people and eat out their substance. + He has kept among us, in times of peace, Standing Armies without the Consent + of our legislatures. + He has affected to render the Military independent of and superior to the + Civil Power. + He has combined with others to subject us to a jurisdiction foreign to our + constitution, and unacknowledged by our laws; giving his Assent to their Acts + of pretended Legislation: + For quartering large bodies of armed troops among us: + For protecting them, by a mock Trial from punishment for any Murders which + they should commit on the Inhabitants of these States: + For cutting off our Trade with all parts of the world: + For imposing Taxes on us without our Consent: + For depriving us in many cases, of the benefit of Trial by Jury: + For transporting us beyond Seas to be tried for pretended offences: + For abolishing the free System of English Laws in a neighbouring Province, + establishing therein an Arbitrary government, and enlarging its Boundaries so + as to render it at once an example and fit instrument for introducing the same + absolute rule into these Colonies + For taking away our Charters, abolishing our most valuable Laws and altering + fundamentally the Forms of our Governments: + For suspending our own Legislatures, and declaring themselves invested with + power to legislate for us in all cases whatsoever. + He has abdicated Government here, by declaring us out of his Protection and + waging War against us. + He has plundered our seas, ravaged our coasts, burnt our towns, and destroyed + the lives of our people. + He is at this time transporting large Armies of foreign Mercenaries to + compleat the works of death, desolation, and tyranny, already begun with + circumstances of Cruelty & Perfidy scarcely paralleled in the most barbarous + ages, and totally unworthy the Head of a civilized nation. + He has constrained our fellow Citizens taken Captive on the high Seas to bear + Arms against their Country, to become the executioners of their friends and + Brethren, or to fall themselves by their Hands. + He has excited domestic insurrections amongst us, and has endeavoured to bring + on the inhabitants of our frontiers, the merciless Indian Savages whose known + rule of warfare, is an undistinguished destruction of all ages, sexes and + conditions. + In every stage of these Oppressions We have Petitioned for Redress in the most + humble terms: Our repeated Petitions have been answered only by repeated + injury. A Prince, whose character is thus marked by every act which may + define a Tyrant, is unfit to be the ruler of a free people. + Nor have We been wanting in attentions to our British brethren. We have warned + them from time to time of attempts by their legislature to extend an + unwarrantable jurisdiction over us. We have reminded them of the circumstances + of our emigration and settlement here. We have appealed to their native + justice and magnanimity, and we have conjured them by the ties of our common + kindred to disavow these usurpations, which would inevitably interrupt our + connections and correspondence. They too have been deaf to the voice of + justice and of consanguinity. We must, therefore, acquiesce in the necessity, + which denounces our Separation, and hold them, as we hold the rest of mankind, + Enemies in War, in Peace Friends. + We, therefore, the Representatives of the united States of America, in General + Congress, Assembled, appealing to the Supreme Judge of the world for the + rectitude of our intentions, do, in the Name, and by Authority of the good + People of these Colonies, solemnly publish and declare, That these united + Colonies are, and of Right ought to be Free and Independent States, that they + are Absolved from all Allegiance to the British Crown, and that all political + connection between them and the State of Great Britain, is and ought to be + totally dissolved; and that as Free and Independent States, they have full + Power to levy War, conclude Peace, contract Alliances, establish Commerce, and + to do all other Acts and Things which Independent States may of right do. — + And for the support of this Declaration, with a firm reliance on the + protection of Divine Providence, we mutually pledge to each other our Lives, + our Fortunes, and our sacred Honor. diff --git a/golden-tests/new-derivation/drv.nix b/golden-tests/new-derivation/drv.nix new file mode 100644 index 0000000..d8fdde2 --- /dev/null +++ b/golden-tests/new-derivation/drv.nix @@ -0,0 +1,39 @@ +let + one = derivation { + name = "soft_from_SW"; + builder = "Luke Skywalker"; + system = "C3PO"; + newEnvVaribale = "value"; + }; + two = derivation { + name = "second_derivation"; + derivations = [ one ]; + builder = "builder"; + system = builtins.currentSystem; + }; + three = derivation { + name = "third_derivation"; + derivations = [ one ]; + builder = "builder"; + system = builtins.currentSystem; + }; + namesMissmatch = derivation { + name = "new"; + builder = "builder"; + system = builtins.currentSystem; + }; + outputsMissmatch = derivation { + name = "outputs"; + outputs = [ "lib" "headers" "doc" ]; + builder = "builder"; + system = builtins.currentSystem; + }; +in +derivation { + name = "drv"; + builder = "handmade"; + srcs = [ ./changed-file ./new-file ]; + derivations = [ two three namesMissmatch outputsMissmatch ]; + args = [ "one" "three" "four" ]; + system = builtins.currentSystem; +} diff --git a/golden-tests/new-derivation/new-file b/golden-tests/new-derivation/new-file new file mode 100644 index 0000000..fc1f92f --- /dev/null +++ b/golden-tests/new-derivation/new-file @@ -0,0 +1 @@ +content of new file diff --git a/golden-tests/old-derivation/changed-file b/golden-tests/old-derivation/changed-file new file mode 100644 index 0000000..ca439c4 --- /dev/null +++ b/golden-tests/old-derivation/changed-file @@ -0,0 +1,120 @@ + When in the Course of human events it becomes necessary for one people to + dissolve the political bands which have connected them with another and to + assume among the powers of the earth, the separate and equal station to which + the Laws of Nature and of Nature's God entitle them, a decent respect to the + opinions of mankind requires that they should declare the causes which impel + them to the separation. + We hold these truths to be self-evident, that all men are created equal, that + they are endowed by their Creator with certain unalienable Rights, that among + these are Life, Liberty and the pursuit of Happiness. — That to secure these + rights, Governments are instituted among Men, deriving their just powers from + the consent of the governed, — That whenever any Form of Government becomes + destructive of these ends, it is the Right of the People to alter or to + abolish it, and to institute new Government, laying its foundation on such + principles and organizing its powers in such form, as to them shall seem most + likely to effect their Safety and Happiness. Prudence, indeed, will dictate + that Governments long established should not be changed for light and + transient causes; and accordingly all experience hath shewn that mankind are + more disposed to suffer, while evils are sufferable than to right themselves + by abolishing the forms to which they are accustomed. But when a long train of + abuses and usurpations, pursuing invariably the same Object evinces a design + to reduce them under absolute Despotism, it is their right, it is their duty, + to throw off such Government, and to provide new Guards for their future + security. — Such has been the patient sufferance of these Colonies; and such + is now the necessity which constrains them to alter their former Systems of + Government. The history of the present King of Great Britain is a history of + repeated injuries and usurpations, all having in direct object the + establishment of an absolute Tyranny over these States. To prove this, let + Facts be submitted to a candid world. + He has refused his Assent to Laws, the most wholesome and necessary for the + public good. + He has forbidden his Governors to pass Laws of immediate and pressing + importance, unless suspended in their operation till his Assent should be + obtained; and when so suspended, he has utterly neglected to attend to them. + He has refused to pass other Laws for the accommodation of large districts of + people, unless those people would relinquish the right of Representation in + the Legislature, a right inestimable to them and formidable to tyrants only. + He has called together legislative bodies at places unusual, uncomfortable, + and distant from the depository of their Public Records, for the sole purpose + of fatiguing them into compliance with his measures. + He has dissolved Representative Houses repeatedly, for opposing with manly + firmness his invasions on the rights of the people. + He has refused for a long time, after such dissolutions, to cause others to be + elected, whereby the Legislative Powers, incapable of Annihilation, have + returned to the People at large for their exercise; the State remaining in the + mean time exposed to all the dangers of invasion from without, and convulsions + within. + He has endeavoured to prevent the population of these States; for that purpose + obstructing the Laws for Naturalization of Foreigners; refusing to pass others + to encourage their migrations hither, and raising the conditions of new + Appropriations of Lands. + He has obstructed the Administration of Justice by refusing his Assent to Laws + for establishing Judiciary Powers. + He has made Judges dependent on his Will alone for the tenure of their + offices, and the amount and payment of their salaries. + He has erected a multitude of New Offices, and sent hither swarms of Officers + to harass our people and eat out their substance. + He has kept among us, in times of peace, Standing Armies without the Consent + of our legislatures. + He has affected to render the Military independent of and superior to the + Civil Power. + He has combined with others to subject us to a jurisdiction foreign to our + constitution, and unacknowledged by our laws; giving his Assent to their Acts + of pretended Legislation: + For quartering large bodies of armed troops among us: + For protecting them, by a mock Trial from punishment for any Murders which + they should commit on the Inhabitants of these States: + For cutting off our Trade with all parts of the world: + For imposing Taxes on us without our Consent: + For depriving us in many cases, of the benefit of Trial by Jury: + For transporting us beyond Seas to be tried for pretended offences: + For abolishing the free System of English Laws in a neighbouring Province, + establishing therein an Arbitrary government, and enlarging its Boundaries so + as to render it at once an example and fit instrument for introducing the same + absolute rule into these Colonies + For taking away our Charters, abolishing our most valuable Laws and altering + fundamentally the Forms of our Governments: + For suspending our own Legislatures, and declaring themselves invested with + power to legislate for us in all cases whatsoever. + He has abdicated Government here, by declaring us out of his Protection and + waging War against us. + He has plundered our seas, ravaged our coasts, burnt our towns, and destroyed + the lives of our people. + He is at this time transporting large Armies of foreign Mercenaries to + compleat the works of death, desolation, and tyranny, already begun with + circumstances of Cruelty & Perfidy scarcely paralleled in the most barbarous + ages, and totally unworthy the Head of a civilized nation. + He has constrained our fellow Citizens taken Captive on the high Seas to bear + Arms against their Country, to become the executioners of their friends and + Brethren, or to fall themselves by their Hands. + He has excited domestic insurrections amongst us, and has endeavoured to bring + on the inhabitants of our frontiers, the merciless Indian Savages whose known + rule of warfare, is an undistinguished destruction of all ages, sexes and + conditions. + In every stage of these Oppressions We have Petitioned for Redress in the most + humble terms: Our repeated Petitions have been answered only by repeated + injury. A Prince, whose character is thus marked by every act which may + define a Tyrant, is unfit to be the ruler of a free people. + Nor have We been wanting in attentions to our British brethren. We have warned + them from time to time of attempts by their legislature to extend an + unwarrantable jurisdiction over us. We have reminded them of the circumstances + of our emigration and settlement here. We have appealed to their native + justice and magnanimity, and we have conjured them by the ties of our common + kindred to disavow these usurpations, which would inevitably interrupt our + connections and correspondence. They too have been deaf to the voice of + justice and of consanguinity. We must, therefore, acquiesce in the necessity, + which denounces our Separation, and hold them, as we hold the rest of mankind, + Enemies in War, in Peace Friends. + We, therefore, the Representatives of the united States of America, in General + Congress, Assembled, appealing to the Supreme Judge of the world for the + rectitude of our intentions, do, in the Name, and by Authority of the good + People of these Colonies, solemnly publish and declare, That these united + Colonies are, and of Right ought to be Free and Independent States, that they + are Absolved from all Allegiance to the British Crown, and that all political + connection between them and the State of Great Britain, is and ought to be + totally dissolved; and that as Free and Independent States, they have full + Power to levy War, conclude Peace, contract Alliances, establish Commerce, and + to do all other Acts and Things which Independent States may of right do. — + And for the support of this Declaration, with a firm reliance on the + protection of Divine Providence, we mutually pledge to each other our Lives, + our Fortunes, and our sacred Honor. diff --git a/golden-tests/old-derivation/drv.nix b/golden-tests/old-derivation/drv.nix new file mode 100644 index 0000000..df4ef6d --- /dev/null +++ b/golden-tests/old-derivation/drv.nix @@ -0,0 +1,39 @@ +let + one = derivation { + name = "soft_from_SW"; + builder = "Anakin Skywalker"; + system = "R2D2_astrodroid"; + missingEnvVaribale = "value"; + }; + two = derivation { + name = "second_derivation"; + derivations = [ one ]; + builder = "builder"; + system = builtins.currentSystem; + }; + three = derivation { + name = "third_derivation"; + derivations = [ one ]; + builder = "builder"; + system = builtins.currentSystem; + }; + namesMissmatch = derivation { + name = "old"; + builder = "builder"; + system = builtins.currentSystem; + }; + outputsMissmatch = derivation { + name = "outputs"; + outputs = [ "out" "bin" ]; + builder = "builder"; + system = builtins.currentSystem; + }; +in +derivation { + name = "drv"; + builder = "handmade"; + srcs = [ ./changed-file ./missing-file ]; + derivations = [ two three namesMissmatch outputsMissmatch ]; + args = [ "one" "two" "three" ]; + system = builtins.currentSystem; +} diff --git a/golden-tests/old-derivation/missing-file b/golden-tests/old-derivation/missing-file new file mode 100644 index 0000000..8ae13a8 --- /dev/null +++ b/golden-tests/old-derivation/missing-file @@ -0,0 +1 @@ +content of missing file diff --git a/golden-tests/run-test.sh b/golden-tests/run-test.sh new file mode 100755 index 0000000..0cb69ee --- /dev/null +++ b/golden-tests/run-test.sh @@ -0,0 +1,9 @@ +#!/usr/bin/env bash + +old_drv="$(nix-instantiate ./old-derivation/drv.nix)" +new_drv="$(nix-instantiate ./new-derivation/drv.nix)" +nix-diff $old_drv $new_drv --environment > /tmp/nix-diff-output +diff ./expected-output /tmp/nix-diff-output +code="$?" +rm /tmp/nix-diff-output +exit "$code"