diff --git a/nix-diff.cabal b/nix-diff.cabal --- a/nix-diff.cabal +++ b/nix-diff.cabal @@ -1,5 +1,5 @@ name: nix-diff -version: 1.0.10 +version: 1.0.11 synopsis: Explain why two Nix derivations differ description: This package provides a @nix-diff@ executable which explains why two Nix derivations (i.e. @*.drv@ files) @@ -21,6 +21,7 @@ build-depends: base >= 4.9 && < 5 , attoparsec >= 0.13 && < 0.14 , containers >= 0.5 && < 0.7 + , directory < 1.4 , Diff >= 0.3 && < 0.5 , text >= 1.2 && < 1.3 , optparse-applicative >= 0.14.0.0 && < 0.16 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} @@ -22,9 +23,10 @@ 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.Algorithm.Diff as Diff +import qualified Data.Algorithm.Diff as Diff import qualified Data.Attoparsec.Text import qualified Data.Map import qualified Data.Set @@ -34,6 +36,7 @@ import qualified GHC.IO.Encoding import qualified Nix.Derivation import qualified Options.Applicative +import qualified System.Directory as Directory import qualified System.Posix.IO import qualified System.Posix.Terminal @@ -166,8 +169,8 @@ derivationName :: FilePath -> Text derivationName = Data.Text.dropEnd 4 . Data.Text.drop 44 . pathToText --- | Group input derivations by their name -groupByName :: Map FilePath (Set Text) -> Map Text (Map FilePath (Set Text)) +-- | 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) @@ -176,6 +179,23 @@ 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 = Data.Text.drop 44 . pathToText + +-- | 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 and parse a derivation from a file readDerivation :: FilePath -> Diff (Derivation FilePath Text) readDerivation path = do @@ -278,7 +298,7 @@ else do echo (explain ("{" <> outputName <> "}:")) echo (explain " Hash algorithm:") - diffWith leftHashAlgo rightHashAlgo $ \(sign, hashAlgo) -> do + diffWith leftHashAlgo rightHashAlgo \(sign, hashAlgo) -> do echo (" " <> sign hashAlgo) -- | Diff two sets of outputs @@ -298,10 +318,10 @@ 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 + 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 + forM_ (Data.Map.toList bothOutputs) \(key, (leftOutput, rightOutput)) -> do if leftOutput == rightOutput then return () else diffOutput key leftOutput rightOutput @@ -388,14 +408,14 @@ 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 + 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 + forM_ (Data.Map.toList bothEnv) \(key, (leftValue, rightValue)) -> do if predicate key (leftValue, rightValue) then return () else do - text <- indented 4 (diffText leftValue rightValue) + text <- diffText leftValue rightValue echo (" " <> key <> "=" <> text) -- | Diff input sources @@ -406,24 +426,53 @@ -- ^ 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 + let leftExtraSrcs = Data.Set.difference leftSrcs rightSrcs let rightExtraSrcs = Data.Set.difference rightSrcs leftSrcs - if Data.Set.null leftExtraSrcs && Data.Set.null rightExtraSrcs - then return () - else do - echo (explain "The set of input sources do not match:") - diffWith leftExtraSrcs rightExtraSrcs $ \(sign, extraSrcs) -> do - forM_ extraSrcs $ \extraSrc -> do - echo (" " <> sign (pathToText extraSrc)) + 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 (Data.Text.IO.readFile leftPath) + rightText <- liftIO (Data.Text.IO.readFile rightPath) + + text <- diffText leftText rightText + echo (" " <> text) + else do + return () + return () + 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 + diffWith leftPlatform rightPlatform \(sign, platform) -> do echo (" " <> sign platform) diffBuilder :: Text -> Text -> Diff () @@ -432,7 +481,7 @@ then return () else do echo (explain "The builders do not match") - diffWith leftBuilder rightBuilder $ \(sign, builder) -> do + diffWith leftBuilder rightBuilder \(sign, builder) -> do echo (" " <> sign builder) diffArgs :: Vector Text -> Vector Text -> Diff () @@ -464,7 +513,7 @@ 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 + diffWith (leftPath, leftOutputs) (rightPath, rightOutputs) \(sign, (path, outputs)) -> do echo (sign (pathToText path <> renderOutputs outputs)) if derivationName leftPath /= derivationName rightPath && not topLevel @@ -505,14 +554,14 @@ let leftExtraNames = Data.Set.difference leftNames rightNames let rightExtraNames = Data.Set.difference rightNames leftNames - Control.Monad.State.when (leftNames /= rightNames) $ do - echo (explain "The set of input names do not match:") - diffWith leftExtraNames rightExtraNames $ \(sign, names) -> do - forM_ names $ \name -> do + 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 + descended <- forM assocs \(inputName, (leftPaths, rightPaths)) -> do let leftExtraPaths = Data.Map.difference leftPaths rightPaths let rightExtraPaths = @@ -522,13 +571,13 @@ return False ([(leftPath', leftOutputs')], [(rightPath', rightOutputs')]) | leftOutputs' == rightOutputs' -> do - echo (explain ("The input named `" <> inputName <> "` differs")) + echo (explain ("The input derivation named `" <> inputName <> "` differs")) indented 2 (diff False leftPath' leftOutputs' rightPath' rightOutputs') return True _ -> do - echo (explain ("The set of inputs named `" <> inputName <> "` do not match")) - diffWith leftExtraPaths rightExtraPaths $ \(sign, extraPaths) -> do - forM_ (Data.Map.toList extraPaths) $ \(extraPath, outputs) -> 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 (pathToText extraPath <> renderOutputs outputs)) return False