diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +1.0.21 + +* [Support relocated Nix store](https://github.com/Gabriella439/nix-diff/pull/82) + * If configured through `NIX_REMOTE` environment variable. +* [Compact input derivation diffs](https://github.com/Gabriella439/nix-diff/pull/86) +* [Fix support for `less -R` when coloring multiple lines](https://github.com/Gabriella439/nix-diff/pull/96) + 1.0.20 * [Add `--context` flag](https://github.com/Gabriella439/nix-diff/pull/81) diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,12 +1,4 @@ -{-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} module Main where @@ -27,6 +19,7 @@ import qualified System.Posix.Terminal import Nix.Diff +import Nix.Diff.Store (StorePath(StorePath)) import Nix.Diff.Types import Nix.Diff.Render.HumanReadable import Nix.Diff.Transformations @@ -46,7 +39,7 @@ Options.Applicative.option reader ( Options.Applicative.long "color" - <> Options.Applicative.help ("display colors always, automatically (if terminal detected), or never") + <> Options.Applicative.help "display colors always, automatically (if terminal detected), or never" <> Options.Applicative.value Auto <> Options.Applicative.metavar "(always|auto|never)" ) @@ -160,6 +153,7 @@ transformDiff TransformOptions{..} = transformIf foldAlreadyCompared foldAlreadyComparedSubTrees . transformIf squashTextDiff squashSourcesAndEnvsDiff + . foldManyInputDerivationsAlreadyCompared renderDiff :: RenderRunner -> RenderContext -> DerivationDiff -> IO () renderDiff HumanReadable context derivation @@ -185,8 +179,8 @@ let diffContext = DiffContext {..} let renderContext = RenderContext {..} let status = Status Data.Set.empty - let action = diff True left (Data.Set.singleton "out") right (Data.Set.singleton "out") - diffTree <- Control.Monad.State.evalStateT (Control.Monad.Reader.runReaderT (unDiff action) diffContext) status + let action = diff True (StorePath left) (OutputNames (Data.Set.singleton "out")) (StorePath right) (OutputNames (Data.Set.singleton "out")) + diffTree <- Control.Monad.State.evalStateT (Control.Monad.Reader.runReaderT action.unDiff diffContext) status let diffTree' = transformDiff transformOptions diffTree renderDiff renderRunner renderContext diffTree' diff --git a/nix-diff.cabal b/nix-diff.cabal --- a/nix-diff.cabal +++ b/nix-diff.cabal @@ -1,28 +1,53 @@ +cabal-version: 3.0 name: nix-diff -version: 1.0.20 +version: 1.0.21 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) differ homepage: https://github.com/Gabriella439/nix-diff -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Gabriella Gonzalez maintainer: GenuineGabriella@gmail.com -copyright: 2017 Gabriella Gonzalez +copyright: 2024 Gabriella Gonzalez category: System build-type: Simple -tested-with: GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.5, GHC == 9.4.4 -cabal-version: >= 1.10 +tested-with: GHC == 9.2.8, + GHC == 9.4.7, + GHC == 9.6.3 extra-source-files: README.md CHANGELOG.md +common language + default-language: GHC2021 + default-extensions: + ApplicativeDo, + BlockArguments, + DeriveAnyClass, + DerivingStrategies, + DerivingVia, + DuplicateRecordFields, + LambdaCase, + MultiWayIf, + NamedFieldPuns, + NoFieldSelectors, + OverloadedRecordDot, + OverloadedStrings, + RecordWildCards, + ghc-options: -Wall + library + import: language + hs-source-dirs: src + exposed-modules: Nix.Diff + Nix.Diff.Store Nix.Diff.Types Nix.Diff.Transformations Nix.Diff.Render.HumanReadable + build-depends: base >= 4.9 && < 5 , attoparsec >= 0.13 && < 0.15 , aeson @@ -41,27 +66,27 @@ , quickcheck-instances < 3.29 , generic-arbitrary < 1.1 , uniplate < 1.17 - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall executable nix-diff + import: language + hs-source-dirs: app main-is: Main.hs build-depends: base , nix-diff , aeson , bytestring - , optparse-applicative >= 0.14.0.0 && < 0.18 + , optparse-applicative , text , unix < 2.9 , containers , mtl - hs-source-dirs: app - default-language: Haskell2010 - ghc-options: -Wall test-suite nix-diff-test + import: language + ghc-options: -Wall + + hs-source-dirs: test main-is: Main.hs other-modules: @@ -82,8 +107,3 @@ , tasty < 1.6 , tasty-quickcheck < 0.11 , tasty-silver < 3.4 - - hs-source-dirs: test - - default-language: Haskell2010 - ghc-options: -Wall diff --git a/src/Nix/Diff.hs b/src/Nix/Diff.hs --- a/src/Nix/Diff.hs +++ b/src/Nix/Diff.hs @@ -1,11 +1,4 @@ -{-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} module Nix.Diff where @@ -13,7 +6,7 @@ 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.Attoparsec.Text (IResult(..), Parser) import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map) import Data.Maybe (catMaybes) @@ -21,8 +14,8 @@ import Data.Text (Text) import Data.Vector (Vector) import Nix.Derivation (Derivation, DerivationOutput) +import Prelude hiding (unzip) -import qualified Control.Monad.Reader import qualified Data.Attoparsec.Text import qualified Data.ByteString import qualified Data.Char as Char @@ -37,7 +30,6 @@ 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 @@ -46,18 +38,27 @@ #endif import Nix.Diff.Types +import Nix.Diff.Store (StorePath (StorePath, unsafeStorePathFile)) +import qualified Nix.Diff.Store as Store +#if MIN_VERSION_base(4,19,0) +import Data.Functor (unzip) +#else +unzip :: Functor f => f (a, b) -> (f a, f b) +unzip xs = (fst <$> xs, snd <$> xs) +#endif + newtype Status = Status { visited :: Set Diffed } data Diffed = Diffed - { leftDerivation :: FilePath - , leftOutput :: Set Text - , rightDerivation :: FilePath - , rightOutput :: Set Text + { leftDerivation :: StorePath + , leftOutput :: OutputNames + , rightDerivation :: StorePath + , rightOutput :: OutputNames } deriving (Eq, Ord) newtype Diff a = Diff { unDiff :: ReaderT DiffContext (StateT Status IO) a } - deriving + deriving newtype ( Functor , Applicative , Monad @@ -88,11 +89,11 @@ 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 +derivationName :: StorePath -> Text +derivationName storePath = Text.dropEnd 4 (Text.drop 44 (Text.pack storePath.unsafeStorePathFile)) -- | Group paths by their name -groupByName :: Map FilePath a -> Map Text (Map FilePath a) +groupByName :: Map StorePath a -> Map Text (Map StorePath a) groupByName m = Data.Map.fromList assocs where toAssoc key = (derivationName key, Data.Map.filterWithKey predicate m) @@ -107,11 +108,11 @@ > /nix/store/${32_CHARACTER_HASH}-${NAME}.drv -} -buildProductName :: FilePath -> Text -buildProductName = Text.drop 44 . Text.pack +buildProductName :: StorePath -> Text +buildProductName storePath = Text.drop 44 (Text.pack storePath.unsafeStorePathFile) -- | Like `groupByName`, but for `Set`s -groupSetsByName :: Set FilePath -> Map Text (Set FilePath) +groupSetsByName :: Set StorePath -> Map Text (Set StorePath) groupSetsByName s = Data.Map.fromList (fmap toAssoc (Data.Set.toList s)) where toAssoc key = (buildProductName key, Data.Set.filter predicate s) @@ -127,12 +128,25 @@ Data.Text.Encoding.decodeUtf8With Data.Text.Encoding.Error.lenientDecode <$> Data.ByteString.readFile file +storepathParser :: Parser StorePath +storepathParser = do + text <- Nix.Derivation.textParser + let str = Text.unpack text + case (Text.uncons text, FilePath.isValid str) of + (Just ('/', _), True) -> do + return (StorePath str) + _ -> do + fail ("bad path ‘" <> Text.unpack text <> "’ in derivation") + + -- | Read and parse a derivation from a file -readDerivation :: FilePath -> Diff (Derivation FilePath Text) -readDerivation path = do +readDerivation :: StorePath -> Diff (Derivation StorePath Text) +readDerivation sp = do + path <- liftIO (Store.toPhysicalPath sp) let string = path text <- liftIO (readFileUtf8Lenient string) - case Data.Attoparsec.Text.parse Nix.Derivation.parseDerivation text of + let parser = Nix.Derivation.parseDerivationWith storepathParser Nix.Derivation.textParser + case Data.Attoparsec.Text.parse parser text of Done _ derivation -> do return derivation _ -> do @@ -141,11 +155,11 @@ -- | 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 :: StorePath -> Diff (Derivation StorePath Text) readInput pathAndMaybeOutput = do - let (path, _) = List.break (== '!') pathAndMaybeOutput + let (path, _) = List.break (== '!') pathAndMaybeOutput.unsafeStorePathFile if FilePath.isExtensionOf ".drv" path - then readDerivation path + then readDerivation (StorePath path) else do let string = path result <- liftIO (Process.readProcess "nix-store" [ "--query", "--deriver", string ] []) @@ -153,7 +167,7 @@ [] -> fail ("Could not obtain the derivation of " ++ string) l : ls -> do let drv_path = Data.List.NonEmpty.last (l :| ls) - readDerivation drv_path + readDerivation (StorePath drv_path) {-| Join two `Map`s on shared keys, discarding keys which are not present in both `Map`s @@ -198,11 +212,11 @@ diffOutput :: Text -- ^ Output name - -> (DerivationOutput FilePath Text) + -> DerivationOutput StorePath Text -- ^ Left derivation outputs - -> (DerivationOutput FilePath Text) + -> DerivationOutput StorePath Text -- ^ Right derivation outputs - -> (Maybe OutputDiff) + -> 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 @@ -215,9 +229,9 @@ -- | Diff two sets of outputs diffOutputs - :: Map Text (DerivationOutput FilePath Text) + :: Map Text (DerivationOutput StorePath Text) -- ^ Left derivation outputs - -> Map Text (DerivationOutput FilePath Text) + -> Map Text (DerivationOutput StorePath Text) -- ^ Right derivation outputs -> OutputsDiff diffOutputs leftOutputs rightOutputs = do @@ -314,16 +328,16 @@ -- | Diff two environments diffEnv - :: Set Text + :: OutputNames -- ^ Left derivation outputs - -> Set Text + -> OutputNames -- ^ 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 +diffEnv (OutputNames leftOutputs) (OutputNames rightOutputs) leftEnv rightEnv = do let leftExtraEnv = Data.Map.difference leftEnv rightEnv let rightExtraEnv = Data.Map.difference rightEnv leftEnv @@ -355,9 +369,9 @@ -- | Diff input sources diffSrcs - :: Set FilePath + :: Set StorePath -- ^ Left input sources - -> Set FilePath + -> Set StorePath -- ^ Right inputSources -> Diff SourcesDiff diffSrcs leftSrcs rightSrcs = do @@ -370,7 +384,7 @@ let leftExtraNames = Data.Set.difference leftNames rightNames let rightExtraNames = Data.Set.difference rightNames leftNames - let extraSrcNames = if (leftNames /= rightNames) + let extraSrcNames = if leftNames /= rightNames then Just (Changed leftExtraNames rightExtraNames) else Nothing @@ -382,12 +396,12 @@ 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) + leftExists <- liftIO (Store.doesFileExist leftPath) + rightExists <- liftIO (Store.doesFileExist rightPath) srcContentDiff <- if leftExists && rightExists then do - leftText <- liftIO (readFileUtf8Lenient leftPath) - rightText <- liftIO (readFileUtf8Lenient rightPath) + leftText <- liftIO (Store.readFileUtf8Lenient leftPath) + rightText <- liftIO (Store.readFileUtf8Lenient rightPath) text <- diffText leftText rightText return (Just text) @@ -419,7 +433,20 @@ 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 :: Bool + -- ^ Is this the top-level call for a comparison? + -- + -- If so, the diff will be more detailed. + -> StorePath + -- ^ Store path of left derivation. + -> OutputNames + -- ^ Output names of left derivation. + -> StorePath + -- ^ Store path of right derivation. + -> OutputNames + -- ^ Output names of right derivation. + -> Diff DerivationDiff + -- ^ Description of how the two derivations differ. diff topLevel leftPath leftOutputs rightPath rightOutputs = do Status { visited } <- get let diffed = Diffed leftPath leftOutputs rightPath rightOutputs @@ -465,15 +492,15 @@ 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 leftInputs = groupByName (Data.Map.map OutputNames (Nix.Derivation.inputDrvs leftDerivation)) + let rightInputs = groupByName (Data.Map.map OutputNames (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) + let inputExtraNames = if leftNames /= rightNames then Just (Changed leftExtraNames rightExtraNames) else Nothing @@ -504,7 +531,7 @@ 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 + let leftOutNames = OutputNames (Data.Map.keysSet leftOuts) + let rightOutNames = OutputNames (Data.Map.keysSet rightOuts) Just <$> diffEnv leftOutNames rightOutNames leftEnv rightEnv pure DerivationDiff{..} diff --git a/src/Nix/Diff/Render/HumanReadable.hs b/src/Nix/Diff/Render/HumanReadable.hs --- a/src/Nix/Diff/Render/HumanReadable.hs +++ b/src/Nix/Diff/Render/HumanReadable.hs @@ -1,19 +1,10 @@ -{-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} module Nix.Diff.Render.HumanReadable where import Control.Monad (forM_) import Control.Monad.Reader (MonadReader, ReaderT (runReaderT), ask, local) import Control.Monad.Writer(MonadWriter, Writer, tell, runWriter) -import Data.Set (Set) import Data.Text (Text) import Numeric.Natural (Natural) @@ -29,6 +20,7 @@ import Nix.Diff import Nix.Diff.Types +import qualified Nix.Diff.Store as Store data RenderContext = RenderContext @@ -39,7 +31,7 @@ } newtype Render a = Render { unRender :: ReaderT RenderContext (Writer Text) a} - deriving + deriving newtype ( Functor , Applicative , Monad @@ -48,7 +40,7 @@ ) runRender :: Render a -> RenderContext -> (a, Text) -runRender render rc = runWriter $ runReaderT (unRender render) rc +runRender render rc = runWriter $ runReaderT render.unRender rc runRender' :: Render () -> RenderContext -> Text runRender' render = snd . runRender render @@ -64,47 +56,63 @@ indented :: Natural -> Render a -> Render a indented n = local adapt where - adapt context = context { indent = indent context + n } + adapt context = context { indent = context.indent + n } data TTY = IsTTY | NotTTY +-- | This exists to improve compatibility with @less -R@. See: +-- +-- https://github.com/Gabriella439/nix-diff/issues/95 +escape + :: Text + -- ^ Beginning of escape sequence + -> Text + -- ^ Text to escape + -> Text +escape begin text = + begin <> Text.intercalate middle (Text.splitOn "\n" text) <> end + where + end = "\ESC[0m" + + middle = end <> "\n" <> begin + -- | Color text red red :: TTY -> Text -> Text -red IsTTY text = "\ESC[1;31m" <> text <> "\ESC[0m" +red IsTTY text = escape "\ESC[1;31m" text red NotTTY text = text -- | Color text background red redBackground :: Orientation -> TTY -> Text -> Text -redBackground Line IsTTY text = "\ESC[41m" <> prefix <> "\ESC[0m" <> suffix +redBackground Line IsTTY text = escape "\ESC[41m" prefix <> suffix where (prefix, suffix) = Text.break lineBoundary text -redBackground Word IsTTY text = "\ESC[41m" <> prefix <> "\ESC[0m" <> suffix +redBackground Word IsTTY text = escape "\ESC[41m" prefix <> suffix where (prefix, suffix) = Text.break wordBoundary text -redBackground Character IsTTY text = "\ESC[41m" <> text <> "\ESC[0m" +redBackground Character IsTTY text = escape "\ESC[41m" text 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 IsTTY text = escape "\ESC[1;32m" text green NotTTY text = text -- | Color text background green greenBackground :: Orientation -> TTY -> Text -> Text -greenBackground Line IsTTY text = "\ESC[42m" <> prefix <> "\ESC[0m" <> suffix +greenBackground Line IsTTY text = escape "\ESC[42m" prefix <> suffix where (prefix, suffix) = Text.break lineBoundary text -greenBackground Word IsTTY text = "\ESC[42m" <> prefix <> "\ESC[0m" <> suffix +greenBackground Word IsTTY text = escape "\ESC[42m" prefix <> suffix where (prefix, suffix) = Text.break wordBoundary text -greenBackground Character IsTTY text = "\ESC[42m" <> text <> "\ESC[0m" +greenBackground Character IsTTY text = escape "\ESC[42m" text 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 _ IsTTY text = escape "\ESC[1;2m" text grey Line NotTTY text = " " <> text grey _ NotTTY text = text @@ -130,8 +138,8 @@ k (plus tty, now) -- | Format the derivation outputs -renderOutputs :: Set Text -> Text -renderOutputs outputs = +renderOutputs :: OutputNames -> Text +renderOutputs (OutputNames outputs) = ":{" <> Text.intercalate "," (Data.Set.toList outputs) <> "}" renderDiffHumanReadable :: DerivationDiff -> Render () @@ -159,8 +167,8 @@ where renderOutputStructure os = - renderWith os \(sign, (OutputStructure path outputs)) -> do - echo (sign (Text.pack path <> renderOutputs outputs)) + renderWith os \(sign, OutputStructure path outputs) -> do + echo (sign (Store.toText path <> renderOutputs outputs)) renderOutputsDiff OutputsDiff{..} = do ifExist extraOutputs \eo -> do @@ -218,7 +226,7 @@ echo (explain ("The input sources named `" <> srcName <> "` differ")) renderWith srcFileDiff \(sign, paths) -> do forM_ paths \path -> do - echo (" " <> sign (Text.pack path)) + echo (" " <> sign (Store.toText path)) renderInputsDiff InputsDiff{..} = do renderInputExtraNames inputExtraNames @@ -238,7 +246,11 @@ 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)) + echo (" " <> sign (Store.toText extraPath <> renderOutputs outputs)) + renderInputDerivationsDiff ManyDerivationsAlreadyComparedDiff{..} = do + echo (explain "Input derivations differ but have already been compared") + forM_ (Data.Set.toList drvNames) \name -> do + echo (" " <> name) renderEnvDiff Nothing = echo (explain "Skipping environment comparison") diff --git a/src/Nix/Diff/Store.hs b/src/Nix/Diff/Store.hs new file mode 100644 --- /dev/null +++ b/src/Nix/Diff/Store.hs @@ -0,0 +1,66 @@ +-- | A crude implementation of the Nix store concept. +-- +-- For anything fancier than this, it would be best to use FFI bindings instead, +-- such as hercules-ci-cnix-store. +module Nix.Diff.Store + ( StorePath (..), + toPhysicalPath, + toText, + doesFileExist, + readFileUtf8Lenient, + ) +where + +import Control.Monad ((<=<)) +import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey) +import qualified Data.ByteString +import Data.Data (Data) +import Data.Functor ((<&>)) +import qualified Data.List as L +import Data.Text (Text) +import qualified Data.Text.Encoding +import qualified Data.Text.Encoding.Error +import qualified System.Directory as Directory +import System.Environment (lookupEnv) +import Test.QuickCheck (Arbitrary) +import qualified Data.Text as T + +-- | A file path that may not exist on the true file system; +-- needs to be looked up in a store, which may be relocated. +-- +-- Unlike the (C++) Nix StorePath type, subpaths are allowed. +newtype StorePath = StorePath + { -- | If the store is relocated, its physical location is elsewhere, and this 'FilePath' won't resolve. + -- Use 'toPhysicalPath'. + unsafeStorePathFile :: FilePath + } + deriving (Data) + deriving newtype (Show, Eq, Ord, ToJSON, FromJSON, ToJSONKey, FromJSONKey, Arbitrary) + +doesFileExist :: StorePath -> IO Bool +doesFileExist = + Directory.doesFileExist <=< toPhysicalPath + +readFileUtf8Lenient :: StorePath -> IO Text +readFileUtf8Lenient sp = do + file <- toPhysicalPath sp + Data.Text.Encoding.decodeUtf8With Data.Text.Encoding.Error.lenientDecode + <$> Data.ByteString.readFile file + +toPhysicalPath :: StorePath -> IO FilePath +toPhysicalPath (StorePath p) = do + nixStoreDir <- lookupEnv "NIX_STORE_DIR" <&> maybe "/nix/store" stripSlash + nixRemoteMaybe <- lookupEnv "NIX_REMOTE" <&> fmap stripSlash + case nixRemoteMaybe of + Just nixRemote | nixStoreDir `L.isPrefixOf` p -> do + pure $ nixRemote <> "/" <> L.dropWhile (== '/') p + _ -> pure p + +-- | Convert a 'StorePath' to a 'Text' for display purposes. The path may not exist at this physical location. +toText :: StorePath -> Text +toText (StorePath p) = T.pack p + +stripSlash :: FilePath -> FilePath +stripSlash s | not ("/" `L.isSuffixOf` s) = s +stripSlash s = doIt s + where doIt = T.unpack . T.dropWhileEnd (== '/') . T.pack diff --git a/src/Nix/Diff/Transformations.hs b/src/Nix/Diff/Transformations.hs --- a/src/Nix/Diff/Transformations.hs +++ b/src/Nix/Diff/Transformations.hs @@ -1,15 +1,11 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE FlexibleContexts #-} module Nix.Diff.Transformations where import qualified Patience import Data.Generics.Uniplate.Data ( transformBi ) import Nix.Diff.Types +import qualified Data.Set as Set +import Data.Text (Text) {-| In large diffs there may be a lot of derivations that doesn't change at all, but changed some of @@ -26,7 +22,7 @@ • These two derivations have already been compared ``` This transformation will fold all these subtrees of diff - into one OnlyAlreadComparedBelow. + into one OnlyAlreadyComparedBelow. -} foldAlreadyComparedSubTrees :: DerivationDiff -> DerivationDiff foldAlreadyComparedSubTrees dd = case dd of @@ -61,6 +57,61 @@ foldAlreadyComparedSubTrees inputsDiff +{-| If packages deep in the dependency graph have been changed, many other + derivations will also change in an uninteresting manner. This can lead to + hundreds or thousands of lines of output like this: + + ``` + • The input derivation named `bash-5.2p32` differs + • These two derivations have already been compared + • The input derivation named `ensure-newer-sources-hook` differs + • These two derivations have already been compared + • The input derivation named `pypa-install-hook` differs + • These two derivations have already been compared + ``` + + This transformation will fold sequences of `OneDerivationDiff` like this + into a single `ManyDerivationsAlreadyComparedDiff`. +-} +foldManyInputDerivationsAlreadyCompared :: DerivationDiff -> DerivationDiff +foldManyInputDerivationsAlreadyCompared dd = case dd of + DerivationsAreTheSame -> dd + AlreadyCompared -> dd + OnlyAlreadyComparedBelow{} -> dd + NamesDontMatch{} -> dd + OutputsDontMatch{} -> dd + DerivationDiff{..} -> + let inputsDiff' = transformNestedDerivationDiffs + foldManyInputDerivationsAlreadyCompared + inputsDiff + + helper :: [Text] -> [InputDerivationsDiff] -> [InputDerivationsDiff] + helper [] [] = [] + helper names [] = + [ManyDerivationsAlreadyComparedDiff + { drvNames = Set.fromList names + }] + helper names (input:inputs) = + case input of + OneDerivationDiff + { drvName + , drvDiff = AlreadyCompared + } -> helper + (drvName:names) + inputs + OneDerivationDiff{} -> input : helper names inputs + SomeDerivationsDiff{} -> input : helper names inputs + ManyDerivationsAlreadyComparedDiff{} -> error "unreachable" + + in DerivationDiff + { inputsDiff = + inputsDiff' + { inputDerivationDiffs = + helper [] inputsDiff'.inputDerivationDiffs + } + , .. + } + {-| This transformation is most useful for --json output, because it will sqash a lot of `{"content":" ","type":"Both"},{"content":"When","type":"Both"},{"content":" ","type":"Both"},{"content":"in","type":"Both"},{"content":" ","type":"Both"}` @@ -102,6 +153,7 @@ OneDerivationDiff name dd -> OneDerivationDiff name (f dd) SomeDerivationsDiff {} -> idd + ManyDerivationsAlreadyComparedDiff {} -> idd envSkippedOrUnchanged :: Maybe EnvironmentDiff -> Bool envSkippedOrUnchanged = \case diff --git a/src/Nix/Diff/Types.hs b/src/Nix/Diff/Types.hs --- a/src/Nix/Diff/Types.hs +++ b/src/Nix/Diff/Types.hs @@ -1,15 +1,7 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE FlexibleInstances #-} -{-# OPTIONS_GHC -Wno-orphans -fconstraint-solver-iterations=0 #-} +-- Needed for `deriving Arbitrary via GenericArbitrary DerivationDiff`: +{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-} +-- Needed for `deriving instance Data (DerivationOutput StorePath Text)`: +{-# OPTIONS_GHC -Wno-orphans #-} module Nix.Diff.Types where @@ -20,6 +12,7 @@ import Data.Set (Set) import Data.Text (Text) import Nix.Derivation (DerivationOutput (..)) +import Nix.Diff.Store ( StorePath ) import qualified Patience import GHC.Generics (Generic) @@ -61,12 +54,12 @@ arbitrary = TextDiff <$> listOf arbitraryItem instance ToJSON TextDiff where - toJSON = listValue itemToJSON . unTextDiff + toJSON textDiff = listValue itemToJSON textDiff.unTextDiff instance FromJSON TextDiff where parseJSON v = TextDiff <$> (traverse itemFromJSON =<< parseJSON v) --- Helpfull aliases +-- Helpful aliases type OutputHash = Text @@ -76,6 +69,12 @@ type Argument = Text +-- | A set of Nix derivation output names. +newtype OutputNames = OutputNames {unOutputNames :: Set Text} + deriving newtype (Eq, Ord, ToJSON, FromJSON) + deriving stock (Show, Generic, Data) + deriving Arbitrary via GenericArbitrary OutputNames + -- Derivation diff data DerivationDiff @@ -105,8 +104,8 @@ -- Output structure data OutputStructure = OutputStructure - { derivationPath :: FilePath - , derivationOutputs :: Set Text + { derivationPath :: StorePath + , derivationOutputs :: OutputNames } deriving stock (Eq, Show, Generic, Data) deriving anyclass (ToJSON, FromJSON) @@ -115,7 +114,7 @@ -- ** Outputs diff data OutputsDiff = OutputsDiff - { extraOutputs :: Maybe (Changed (Map Text (DerivationOutput FilePath Text))) + { extraOutputs :: Maybe (Changed (Map Text (DerivationOutput StorePath Text))) -- ^ Map from derivation name to its outputs. -- Will be Nothing, if `Data.Map.difference` gives -- empty Maps for both new and old outputs @@ -125,7 +124,7 @@ } deriving stock (Eq, Show, Data) -deriving instance Data (DerivationOutput FilePath Text) +deriving instance Data (DerivationOutput StorePath Text) instance Arbitrary OutputsDiff where arbitrary = OutputsDiff <$> arbitraryExtraOutputs <*> arbitrary @@ -145,10 +144,10 @@ , "outputHashDiff" .= outputHashDiff ] where - extraOutputsToJSON :: Map Text (DerivationOutput FilePath Text) -> Value + extraOutputsToJSON :: Map Text (DerivationOutput StorePath Text) -> Value extraOutputsToJSON = toJSON . fmap derivationOutputToJSON - derivationOutputToJSON :: DerivationOutput FilePath Text -> Value + derivationOutputToJSON :: DerivationOutput StorePath Text -> Value derivationOutputToJSON DerivationOutput{..} = object [ "path" .= path , "hashAlgo" .= hashAlgo @@ -165,7 +164,7 @@ pure $ OutputsDiff eo ohd where - derivationOutputFromJSON :: Value -> Parser (DerivationOutput FilePath Text) + derivationOutputFromJSON :: Value -> Parser (DerivationOutput StorePath Text) derivationOutputFromJSON = withObject "DerivationOutput" \o -> DerivationOutput <$> o .: "path" <*> o .: "hashAlgo" <*> o .: "hash" @@ -188,7 +187,7 @@ arbitrary = ArgumentsDiff . NonEmpty.fromList <$> listOf1 arbitraryItem instance ToJSON ArgumentsDiff where - toJSON = listValue itemToJSON . toList . unArgumetsDiff + toJSON argumentsDiff = listValue itemToJSON (toList argumentsDiff.unArgumetsDiff) instance FromJSON ArgumentsDiff where parseJSON v = ArgumentsDiff <$> (traverse itemFromJSON =<< parseJSON v) @@ -212,7 +211,7 @@ } | SomeSourceFileDiff { srcName :: Text - , srcFileDiff :: Changed [FilePath] + , srcFileDiff :: Changed [StorePath] } deriving stock (Eq, Show, Generic, Data) deriving anyclass (ToJSON, FromJSON) @@ -236,7 +235,11 @@ } | SomeDerivationsDiff { drvName :: Text - , extraPartsDiff :: Changed (Map FilePath (Set Text)) + , extraPartsDiff :: Changed (Map StorePath OutputNames) + } + | -- | Many input derivations differ, but they've all already been compared. + ManyDerivationsAlreadyComparedDiff + { drvNames :: Set Text } deriving stock (Eq, Show, Generic, Data) deriving anyclass (ToJSON, FromJSON) diff --git a/test/Golden/Tests.hs b/test/Golden/Tests.hs --- a/test/Golden/Tests.hs +++ b/test/Golden/Tests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module Golden.Tests where import qualified Data.Aeson diff --git a/test/Golden/Utils.hs b/test/Golden/Utils.hs --- a/test/Golden/Utils.hs +++ b/test/Golden/Utils.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE OverloadedStrings #-} - module Golden.Utils where import qualified Data.ByteString.Lazy.Char8 as BS @@ -12,11 +9,12 @@ import System.Process.Typed import Nix.Diff ( diff, Diff(unDiff), DiffContext, Status(Status) ) -import Nix.Diff.Types ( DerivationDiff ) +import Nix.Diff.Types ( DerivationDiff, OutputNames(OutputNames) ) +import Nix.Diff.Store ( StorePath(StorePath) ) data TestableDerivations = TestableDerivations - { oldDerivation :: FilePath - , newDerivation :: FilePath + { oldDerivation :: StorePath + , newDerivation :: StorePath } deriving Show @@ -26,9 +24,7 @@ (nExit, n) <- readProcessStdout (nixInstantiate "./golden-tests/derivations/simple/new/drv.nix") unless (oExit == ExitSuccess || nExit == ExitSuccess) (throwIO (ErrorCall "Can't instantiate simple derivations")) - pure (TestableDerivations (toFilePath o) (toFilePath n)) - where - toFilePath = BS.unpack . BS.init -- drop new-line char + pure (TestableDerivations (storePathFromCLI o) (storePathFromCLI n)) initComplexDerivations :: IO TestableDerivations initComplexDerivations = do @@ -36,9 +32,7 @@ (nExit, n) <- readProcessStdout (nixPathInfo "./golden-tests/derivations/complex/new/") unless (oExit == ExitSuccess || nExit == ExitSuccess) (throwIO (ErrorCall "Can't instantiate complex derivations")) - pure (TestableDerivations (toFilePath o) (toFilePath n)) - where - toFilePath = BS.unpack . BS.init -- drop new-line char + pure (TestableDerivations (storePathFromCLI o) (storePathFromCLI n)) nixInstantiate :: FilePath -> ProcessConfig () () () nixInstantiate fp = shell ("nix-instantiate " <> fp) @@ -49,5 +43,9 @@ makeDiffTree :: TestableDerivations -> DiffContext -> IO DerivationDiff makeDiffTree TestableDerivations{..} diffContext = do let status = Status Data.Set.empty - let action = diff True oldDerivation (Data.Set.singleton "out") newDerivation (Data.Set.singleton "out") - Control.Monad.State.evalStateT (Control.Monad.Reader.runReaderT (unDiff action) diffContext) status + let action = diff True oldDerivation (OutputNames (Data.Set.singleton "out")) newDerivation (OutputNames (Data.Set.singleton "out")) + Control.Monad.State.evalStateT (Control.Monad.Reader.runReaderT action.unDiff diffContext) status + +-- | Drop conventional stdout newline, convert to StorePath +storePathFromCLI :: BS.ByteString -> StorePath +storePathFromCLI = StorePath . BS.unpack . BS.init -- drop new-line char diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,6 +1,7 @@ module Main where import Test.Tasty +import Test.Tasty.Silver.Interactive (interactiveTests) import Golden.Utils (initSimpleDerivations, initComplexDerivations) import Golden.Tests (goldenTests) @@ -10,5 +11,7 @@ main = do simpleTd <- initSimpleDerivations complexTd <- initComplexDerivations - defaultMain $ - testGroup "Tests" [goldenTests simpleTd complexTd, properties] + defaultMainWithIngredients + [ interactiveTests (const False) + ] + $ testGroup "Tests" [goldenTests simpleTd complexTd, properties]