diff --git a/.gitignore b/.gitignore new file mode 100644 --- /dev/null +++ b/.gitignore @@ -0,0 +1,23 @@ +dist +dist-* +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +.ghc.environment.* +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +*~ +result +result-* diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,38 @@ -# Version [0.1.2.0](https://github.com/expipiplus1/update-nix-fetchgit/compare/0.1.1.0...0.1.2.0) +# Changelog +## WIP + +## [0.2.2] - 2020-11-03 + +- Require hnix version 0.11 with several important bugfixes + +## [0.2.1] - 2020-11-01 + +- Add support for `callHackageDirect` + +## [0.2] - 2020-10-28 + +- Update hashes in calls to `builtins.fetchTarball` +- Allow updating tarball urls in fetched from GitHub +- Read comments for branch/tag information +- Allow pinning revisions in tarball fetches +- Gate stderr output under `--verbose` +- Add support for `fetchSubmodules`, `leaveDotGit` and `deepClone` +- Add support for filtering update locations with `--location line:col` + +### Under the Hood + +- Use new unification method for Nix expressions, see ./src/Nix/Match.hs +- Rewrite matchers, now in ./src/Update/Nix/Updater.hs +- Use `monad-validate` for error handling + +## Version [0.1.2.0](https://github.com/expipiplus1/update-nix-fetchgit/compare/0.1.1.0...0.1.2.0) + * Additions * Support updating `fetchFromGitLab` * Support updating `fetchgit` and `fetchgitPrivate -# Version [0.1.1.0](https://github.com/expipiplus1/update-nix-fetchgit/compare/0.1.0.0...0.1.1.0) +## Version [0.1.1.0](https://github.com/expipiplus1/update-nix-fetchgit/compare/0.1.0.0...0.1.1.0) * Changelog started. Previous release was `0.1.0.0`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,67 +1,158 @@ # update-nix-fetchgit -This is a command-line utility for updating `fetchgit`, `fetchgitPrivate`, and `fetchFromGitHub` calls in [Nix](http://nixos.org/nix/) expressions. This utility is meant to be used by people maintaining Nix expressions that fetch files from Git repositories. It automates the process of keeping such expressions up-to-date with the latest upstream sources. +This is a command-line utility for updating fetcher calls in +[Nix](http://nixos.org/nix/) expressions. It has two primary purposes: -When you run `update-nix-fetchgit` on a file, it will: +- Automating the process of keeping such expressions up-to-date with the latest + sources -- Read the file and parse it as a Nix expression. -- Find all Git fetches (calls to `fetchgit`, `fetchgitPrivate`, `fetchFromGitHub` or `fetchFromGitLab`). -- Run [`nix-prefetch-git`](https://github.com/NixOS/nixpkgs/blob/master/pkgs/build-support/fetchgit/nix-prefetch-git) to get information about the latest HEAD commit of each repository. -- Update the corresponding rev, sha256, and version attributes for each repository. -- Overwrite the original input file. +- Filling hashes automatically instead of copying from the error message[1](#deny). -Any `version` attribute found in the file will be updated if it is in a set that contains (directly or inderictly) a Git fetch. The version attribute will be updated to the commit date of the latest HEAD commit in the Git repository, in the time zone of the committer, in "YYYY-MM-DD" format. If the set contains multiple Git fetches, the latest such date is used. +The following fetchers are supported: -When this program fetches information from multiple repositories, it runs multiple instances of `nix-prefetch-git` in parallel. +- `fetchgit` +- `fetchgitPrivate` +- `fetchFromGitHub` +- `fetchFromGitLab` +- `builtins.fetchGit` +- `builtins.fetchTarball` (Only updates the url when this is a archive fetch + from GitHub) +- `pkgs.haskellPackages.callHackageDirect` (Only updates the hash) +The options `deepClone`, `leaveDotGit`, `fetchSubmodules` are also supported. -# Usage +Additionally if the `rev` (for git fetches) or `url` attribute has a comment: -Pass the name of the file to be updated as the first argument: +- `pin`: the revision or URL will not be updated, only the hash will be + changed +- Anything else: the `rev` or `url` parameter will be updated to point to the + revision pointed to by the branch or tag named in the comment. - update-nix-fetchgit filename.nix +## Usage -The file will be updated in place. +### As a command line tool -## Extra arguments +Pass the name of the files to be updated in place or pass no files to read and +write to `stdin` and `stdout` (useful as a filter in an editor). -`update-nix-fetchgit` will pass any extra arguments after the filename to `nix-prefetch-git`: +`update-nix-fetchgit file1.nix file2.nix` - update-nix-fetchgit filename.nix --rev refs/heads/myBranch +`update-nix-fetchgit file1-updated.nix` +It will update fetchers anywhere in the files, note that it is a purely +syntactic match so complicated invocations of the fetchers may not be picked +up; see <./src/Update/Nix/Updater.hs> to look at the shapes of Nix expressions +which are matched. -# Example +Please open an issue if `update-nix-fetchgit` doesn't recognize a fetcher and +you think it could. -Here is an example of a Nix expression that can be updated by this program: +### From Vim -```nix -{ stdenv, fetchgit }: +This VimScript will bind `u` to update the fetcher under the cursor. -stdenv.mkDerivation rec { - name = "foo-${version}"; - version = "2016-07-13"; - src = fetchgit { - url = "git://midipix.org/slibtool"; - rev = "4f56fd184ef6020626492a6f954a486d54f8b7ba"; - sha256 = "0nmyp5yrzl9dbq85wyiimsj9fklb8637a1936nw7zzvlnzkgh28n"; - }; -} +The mnemonic is `u` for "it's un*U*sual to update things in this way" + +```viml +" A helper to preserve the cursor location with filters +function! Preserve(command) + let w = winsaveview() + execute a:command + call winrestview(w) +endfunction + +" Update fetcher under cursor, note that this might take a little while if the +" fetched path is large. +autocmd FileType nix map u :call Preserve("%!update-nix-fetchgit --location=" . line(".") . ":" . col(".")) ``` -The `rev`, `sha256`, and `version` attributes will all be updated. +[![asciicast](https://asciinema.org/a/fJesaOF7jGKjYcLtUCsOqrZX6.svg)](https://asciinema.org/a/fJesaOF7jGKjYcLtUCsOqrZX6) +## Examples -# Building from source +Here are some examples of nix expressions which can be updated: -The recommended way to build this program from source for development purposes is to download and run `nix-shell` in the top-level source directory and then run `cabal build`. +- Updating `src` and `version` + ```nix + { stdenv, fetchgit }: -# More documentation + stdenv.mkDerivation rec { + name = "foo-${version}"; + version = "2016-07-13"; + # ^ version will be updated to the date of the new revision + src = fetchgit { + url = "git://midipix.org/slibtool"; + rev = "4f56fd184ef6020626492a6f954a486d54f8b7ba"; + # ^ rev will be updated to the revision of HEAD + sha256 = "0nmyp5yrzl9dbq85wyiimsj9fklb8637a1936nw7zzvlnzkgh28n"; + # ^ sha256 will be updated to the correct hash + }; + } + ``` -You can run `update-nix-fetchgit --help` or `man update-nix-fetchgit` for more documentation. +- Following a branch fetched with `builtins.fetchTarball` + ```nix + { pkgs ? import (builtins.fetchTarball { + url = + "https://github.com/NixOS/nixpkgs/archive/foobar.tar.gz"; # nixos-unstable + # ^ 'foobar' will be replaced with the revision pointed to by 'refs/heads/nixos-unstable' + sha256 = ""; + # ^ sha256 will be updated to the correct hash + }) { } }: + myExpression + ``` + +- Updating the hash (instead of trying to build and copying the hash from the + error message) + + ```nix + { + upfind = import (pkgs.fetchFromGitHub { + owner = "expipiplus1"; + repo = "upfind"; + rev = "cb451254f5b112f839aa36e5b6fd83b60cf9b9ae"; # pin + # ^ This will not change because of the '# pin' comment + sha256 = _; + # ^ This will be updated + }) { }; + } + ``` + +## Mechanism + +When you run `update-nix-fetchgit` on a file, it will: + +- Read the file and parse it as a Nix expression. +- Find all calls to fetchers. +- Run + [`nix-prefetch-git`](https://github.com/NixOS/nixpkgs/blob/master/pkgs/build-support/fetchgit/nix-prefetch-git) + or `nix-prefetch-url` (and a call to the GitHub API to get the commit date in + the case of `builtins.fetchTarball`) to get information about the latest + version. +- Update the corresponding `rev`, `sha256`, `url`, and `version` attributes for + each repository. +- Overwrite the original input file or print to `stdout` + +Any `version` attribute found in the file will be updated if it is in a set +that contains (directly or indirectly) a Git fetch. The version attribute will +be updated to the commit date of the latest HEAD commit in the Git repository, +in the time zone of the committer, in "YYYY-MM-DD" format. If the set contains +multiple Git fetches, the latest such date is used. + +## Building from source + +The recommended way to build this program from source for development purposes +is to download and run `nix-shell` in the top-level source directory and then +run `cabal build`. + # Authors - [expipiplus1](https://github.com/expipiplus1) - I'm `jophish` on Freenode; say hi! - [DavidEGrayson](https://github.com/DavidEGrayson) + +-------- + +1: Don't deny you do it diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,20 +1,103 @@ -{-# LANGUAGE LambdaCase #-} module Main where -import qualified Data.Text -import qualified System.Environment -import qualified System.Exit -import qualified Update.Nix.FetchGit - +import Data.Foldable +import qualified Data.Text.IO as T +import Data.Version ( showVersion ) +import Options.Applicative +import Options.Generic +import Paths_update_nix_fetchgit ( version ) +import Say +import Text.ParserCombinators.ReadP ( char + , eof + , readP_to_S + , readS_to_P + , sepBy + ) +import Update.Nix.FetchGit +import Update.Nix.FetchGit.Types main :: IO () -main = - -- Super simple command line parsing at the moment, just look for one - -- filename and optionally pass extra arguments to `nix-prefetch-git`. - System.Environment.getArgs >>= \case - [filename] -> Update.Nix.FetchGit.processFile filename [] - (filename:args) -> Update.Nix.FetchGit.processFile filename (map Data.Text.pack args) - _ -> do - putStrLn "Usage: update-nix-fetchgit filename []" - System.Exit.exitFailure +main = do + (o, fs) <- parseOpts + let e = env o + let goStd = T.putStr =<< processText e =<< T.getContents + case fs of + [] -> goStd + _ -> for_ fs $ \f -> if f == "-" then goStd else processFile e f + +---------------------------------------------------------------- +-- Env +---------------------------------------------------------------- + +env :: Options Unwrapped -> Env +env Options {..} = + let sayLog + | verbose = const sayErr + | quiet = \case + Verbose -> const (pure ()) + Normal -> const (pure ()) + Quiet -> sayErr + | otherwise = \case + Verbose -> const (pure ()) + Normal -> sayErr + Quiet -> sayErr + updateLocations = [ (l, c) | Position l c <- location ] + in Env { .. } + +---------------------------------------------------------------- +-- Options +---------------------------------------------------------------- + +data Options w = Options + { verbose :: w ::: Bool "False" + , quiet :: w ::: Bool "False" + , location :: w ::: [Position] "Source location to limit updates to" + } + deriving stock Generic + +parseOpts :: IO (Options Unwrapped, [FilePath]) +parseOpts = customExecParser (prefs $ multiSuffix "...") + (info optParser (progDesc desc)) + where + desc = unlines + [ "Update fetchers in Nix expressions." + , "Without any files, stdin and stdout will be used" + ] + +optParser :: Parser (Options Unwrapped, [FilePath]) +optParser = + versionOption + <*> ( (,) + <$> (unwrap <$> parseRecordWithModifiers defaultModifiers + { shortNameModifier = firstLetter + } + ) + <*> many + (strArgument + ( help "Nix files to update" + <> Options.Applicative.metavar "FILE" + ) + ) + ) + where + versionString = "update-nix-fetchgit-" <> showVersion version + versionOption :: Parser (a -> a) + versionOption = infoOption + versionString + (long "version" <> help ("print " <> versionString)) + +instance ParseRecord (Options Wrapped) +deriving instance Show (Options Unwrapped) + +data Position = Position Int Int + deriving Show + +instance Read Position where + readsPrec _ = readP_to_S $ do + [line, col] <- sepBy (readS_to_P reads) (char ':') + eof + pure $ Position line col + +instance ParseField Position where + metavar _ = "LINE:COL" diff --git a/default.nix b/default.nix new file mode 100644 --- /dev/null +++ b/default.nix @@ -0,0 +1,36 @@ +{ pkgs ? import ./nixpkgs.nix, compiler ? null, hoogle ? true +, forShell ? pkgs.lib.inNixShell }: + +let + src = pkgs.nix-gitignore.gitignoreSource [ ] ./.; + + compiler' = if compiler != null then + compiler + else + "ghc" + pkgs.lib.concatStrings + (pkgs.lib.splitVersion pkgs.haskellPackages.ghc.version); + + # Any overrides we require to the specified haskell package set + haskellPackages = with pkgs.haskell.lib; + pkgs.haskell.packages.${compiler'}.override { + overrides = self: super: + { + data-fix = self.data-fix_0_3_0; + optparse-generic = self.optparse-generic_1_4_4; + optparse-applicative = self.optparse-applicative_0_16_0_0; + } // pkgs.lib.optionalAttrs hoogle { + ghc = super.ghc // { withPackages = super.ghc.withHoogle; }; + ghcWithPackages = self.ghc.withPackages; + }; + }; + + # Any packages to appear in the environment provisioned by nix-shell + extraPackages = [ pkgs.git pkgs.nix pkgs.nix-prefetch-git ]; + withExtras = drv: + drv.overrideAttrs + (attrs: { buildInputs = attrs.buildInputs ++ extraPackages; }); + + # Generate a haskell derivation using the cabal2nix tool on `update-nix-fetchgit.cabal` + drv = haskellPackages.callCabal2nix "update-nix-fetchgit" src { }; + +in withExtras (if forShell then drv.env else drv) diff --git a/package.yaml b/package.yaml new file mode 100644 --- /dev/null +++ b/package.yaml @@ -0,0 +1,99 @@ +name: update-nix-fetchgit +version: "0.2.2" +synopsis: A program to update fetchgit values in Nix expressions +description: | + This command-line utility is meant to be used by people maintaining Nix + expressions that fetch files from Git repositories. It automates the process + of keeping such expressions up-to-date with the latest upstream sources. +author: Joe Hermaszewski +maintainer: Joe Hermaszewski +copyright: 2020 Joe Hermaszewski +github: expipiplus1/update-nix-fetchgit +extra-source-files: +- package.yaml +- .gitignore +- default.nix +- CHANGELOG.md +- LICENSE +- README.md +- tests/fakeRepo.sh +- tests/test_*.in.nix +- tests/test_*.expected.nix +- tests/networked/test_*.in.nix +- tests/networked/test_*.expected.nix + +executables: + update-nix-fetchgit: + main: Main.hs + source-dirs: app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + dependencies: + - base + - optparse-applicative + - optparse-generic >= 1.4.2 + - say + - text >= 1.2 + - update-nix-fetchgit + +library: + source-dirs: src + dependencies: + - base >= 4.7 && < 5 + - aeson >= 0.9 + - async >= 2.1 + - bytestring >= 0.10 + - data-fix + - github-rest + - hnix >= 0.11 + - monad-validate + - mtl + - process >= 1.2 + - syb + - template-haskell + - text >= 1.2 + - time >= 1.5 + - utf8-string >= 1.0 + - vector + +tests: + update-nix-fetchgit-samples: + source-dirs: tests + main: Driver.hs + dependencies: + - base >= 4.7 && < 5 + - directory + - filepath + - process + - tasty + - tasty-discover + - tasty-golden >= 2.3 + - temporary + - text + - update-nix-fetchgit + +ghc-options: -Wall + +default-extensions: +- DataKinds +- DefaultSignatures +- DeriveAnyClass +- DeriveDataTypeable +- DeriveGeneric +- DerivingStrategies +- FlexibleContexts +- FlexibleInstances +- GADTs +- LambdaCase +- MultiParamTypeClasses +- OverloadedStrings +- PolyKinds +- RankNTypes +- RecordWildCards +- ScopedTypeVariables +- StandaloneDeriving +- TemplateHaskellQuotes +- TupleSections +- TypeApplications +- TypeFamilies +- TypeOperators +- ViewPatterns diff --git a/src/Nix/Comments.hs b/src/Nix/Comments.hs new file mode 100644 --- /dev/null +++ b/src/Nix/Comments.hs @@ -0,0 +1,63 @@ +module Nix.Comments + ( annotateWithComments + , Comment + , NExprCommentsF + , NExprComments + ) where + +import Data.Text ( Text ) +import Data.Vector ( (!?) + , Vector + ) +import Data.Fix +import Nix.Expr +import qualified Data.Text as T +import Data.Char ( isSpace ) + +type Comment = Text + +type NExprCommentsF = AnnF (Maybe Comment) NExprLocF + +type NExprComments = Fix NExprCommentsF + +-- | A comment will be added to an expression if it occurs immediately after +-- the expression in the source, i.e. on the same line with only space and ';' +-- in between. +-- +-- >>> import Nix.Parser +-- >>> import Nix.Pretty +-- >>> import Data.Vector +-- >>> import Data.Foldable +-- >>> lines = T.pack <$> ["1 # foo", "+ {a=2; # bar","} # baz"] +-- >>> str = T.unlines $ lines +-- >>> Success nix = parseNixTextLoc str +-- >>> ann = annotateWithComments (fromList lines) nix +-- >>> fixUniverse e = e : (fixUniverse =<< Data.Foldable.toList (unFix e)) +-- >>> pretty e@(Fix (Compose (Ann comment _)))= (prettyNix (stripAnnotation (stripAnnotation e)), comment) +-- >>> pretty <$> fixUniverse ann +-- [(1 + { a = 2; },Just "baz"),(1,Just "foo"),({ a = 2; },Just "baz"),(2,Just "bar")] +annotateWithComments :: Vector Text -> NExprLoc -> NExprComments +annotateWithComments sourceLines = go + where + go :: NExprLoc -> NExprComments + go = Fix . go' . fmap go . unFix + + go' :: NExprLocF f -> NExprCommentsF f + go' e = + let + comment = case spanEnd . annotation . getCompose $ e of + SourcePos _ line col -> do + theLine <- sourceLines !? (unPos line - 1) + theLineAfterExpression <- dropMaybe (unPos col - 1) theLine + let theLineAfterCruft = T.dropWhile (\c -> isSpace c || (c == ';')) + theLineAfterExpression + ('#', theComment) <- T.uncons theLineAfterCruft + pure (T.strip theComment) + in Compose (Ann comment e) + +---------------------------------------------------------------- +-- Utils +---------------------------------------------------------------- + +dropMaybe :: Int -> Text -> Maybe Text +dropMaybe i t = if T.length t >= i then Just $ T.drop i t else Nothing diff --git a/src/Nix/Match.hs b/src/Nix/Match.hs new file mode 100644 --- /dev/null +++ b/src/Nix/Match.hs @@ -0,0 +1,296 @@ +{-# LANGUAGE UndecidableInstances #-} +-- | A set of functions for matching on Nix expression trees and extracting the +-- values of sub-trees. +module Nix.Match + ( match + , findMatches + , Matchable(..) + , GMatchable(..) + , WithHoles(..) + , addHoles + , addHolesLoc + , isOptionalPath + ) where + +import Control.Category ( (>>>) ) +import Control.Monad ( void ) +import Data.Data +import Data.Fix +import Data.Foldable +import Data.List.NonEmpty ( NonEmpty ) +import Data.Maybe +import Data.Monoid hiding ( All ) +import Data.Text ( Text ) +import qualified Data.Text as T +import GHC.Base ( NonEmpty((:|)) ) +import GHC.Generics +import Nix + +-- | Like 'Fix' but each layer could instead be a 'Hole' +data WithHoles t v + = Hole !v + | Term !(t (WithHoles t v)) + +deriving instance (Typeable t, Data (t (WithHoles t v)), Data v) => Data (WithHoles t v) + +-- | Match a tree with holes against a tree without holes, returning the values +-- of the holes if it matches. +-- +-- 'NExprF' and 'NExprLocF' are both instances of 'Matchable'. 'NExprLocF' does +-- not require the annotations to match. Please see the 'Matchable' instance +-- documentation for 'NExprF' for more details. +-- +-- >>> import Nix.TH +-- >>> match (addHoles [nix|{foo = x: ^foo; bar = ^bar;}|]) [nix|{foo = x: "hello"; bar = "world"; baz = "!";}|] +-- Just [("bar",Fix (NStr (DoubleQuoted [Plain "world"]))),("foo",Fix (NStr (DoubleQuoted [Plain "hello"])))] +match :: Matchable t => WithHoles t v -> Fix t -> Maybe [(v, Fix t)] +match = fmap (`appEndo` []) .: go + where + go = \case + Hole v -> \t -> Just (Endo ((v, t) :)) + Term s -> \(Fix t) -> do + m <- zipMatchLeft s t + fmap fold . traverse (uncurry go) . toList $ m + +-- | Find all the needles in a haystack, returning the matched expression as +-- well as their filled holes. Results are returned productively in preorder. +-- +-- >>> import Nix.TH +-- >>> import Control.Arrow +-- >>> pretty = prettyNix *** (fmap @[] (fmap @((,) Text) prettyNix)) +-- >>> pretty <$> findMatches (addHoles [nix|{x=^x;}|]) [nix|{x=1;a={x=2;};}|] +-- [({ x = 1; a = { x = 2; }; },[("x",1)]),({ x = 2; },[("x",2)])] +findMatches + :: Matchable t + => WithHoles t v + -- ^ Needle + -> Fix t + -- ^ Haystack + -> [(Fix t, [(v, Fix t)])] +findMatches needle haystack = + [ (s, r) | s <- fixUniverse haystack, Just r <- pure $ match needle s ] + +-- | Get every @f@ in a @Fix f@ in preorder. +fixUniverse :: Foldable f => Fix f -> [Fix f] +fixUniverse e = e : (fixUniverse =<< toList (unFix e)) + +-- | Make syntactic holes into 'Hole's +addHoles :: NExpr -> WithHoles NExprF Text +addHoles = unFix >>> \case + NSynHole n -> Hole n + e -> Term . fmap addHoles $ e + +-- | Make syntactic holes into 'Hole's +addHolesLoc :: NExprLoc -> WithHoles NExprLocF Text +addHolesLoc = unFix >>> \case + Compose (Ann _ (NSynHole n)) -> Hole n + e -> Term . fmap addHolesLoc $ e + +---------------------------------------------------------------- +-- Matchable +---------------------------------------------------------------- + +-- | Instances for this class can be derived for any type with a 'Generic1' +-- instance. +class Traversable t => Matchable t where + -- | Match one level of structure, returning the matched structure with sub + -- structures to match. Needle is the first argument, matchee is the second. + -- + -- Unlike the @Unifiable@ class in the "unification-fd" package, this doesn't + -- have to be a commutative operation, the needle will always be the first + -- parameter and instances are free to treat if differently if appropriate. + zipMatchLeft :: t a -> t b -> Maybe (t (a,b)) + default zipMatchLeft + :: (Generic1 t, GMatchable (Rep1 t)) + => t a + -> t b + -> Maybe (t (a, b)) + zipMatchLeft l r = to1 <$> gZipMatchLeft (from1 l) (from1 r) + +-- | Match a composition of 'Matchable' things +zipMatchLeft2 + :: (Matchable f, Matchable t) => t (f a) -> t (f b) -> Maybe (t (f (a, b))) +zipMatchLeft2 a b = zipMatchLeft a b >>= traverse (uncurry zipMatchLeft) + +---------------------------------------------------------------- +-- Matchable instance for NExprF and NExprLocF +---------------------------------------------------------------- + +-- | There are a few special cases when matching expressions to make writing +-- matchers nicer: +-- +-- - For attrsets and let bindings, the matching is done on the needle's keys +-- only. i.e. the matchee may have extra keys which are ignored. +-- +-- - For attrsets and let bindings, bindings which have a LHS beginning with +-- @_@ are treated as optional. If they are not present then any holes on +-- their RHS will not be filled. +-- +-- - Attrsets match ignoring recursiveness +-- +-- - If a function in the needle has @_@ as its parameter, it matches +-- everything, so @_@ acts as a wildcard pattern. +instance Matchable NExprF where + + zipMatchLeft (NSet _ bs1) (NSet _ bs2) = do + (bs1', bs2') <- unzip <$> reduceBindings bs1 bs2 + to1 <$> gZipMatchLeft (from1 (NSet NNonRecursive bs1')) + (from1 (NSet NNonRecursive bs2')) + + zipMatchLeft (NLet bs1 e1) (NLet bs2 e2) = do + (bs1', bs2') <- unzip <$> reduceBindings bs1 bs2 + to1 <$> gZipMatchLeft (from1 (NLet bs1' e1)) (from1 (NLet bs2' e2)) + + zipMatchLeft (NAbs (Param "_") e1) (NAbs _ e2) = do + pure $ NAbs (Param "_") (e1, e2) + + zipMatchLeft l r = to1 <$> gZipMatchLeft (from1 l) (from1 r) + +-- | Bindings are compared on top level structure only. +-- +-- Doesn't filter bindings in the needle, as they must all be present +-- +-- Bindings are returned according to their order in the needle. +-- +-- Any optional (name begins with @_@) bindings may be removed from the needle. +-- +-- Left hand sides are matched purely on the top level structure, this means +-- that "${a}" and "${b}" appear the same to this function, and it may not +-- match them up correctly. +reduceBindings :: [Binding q] -> [Binding r] -> Maybe [(Binding q, Binding r)] +reduceBindings needle matchee = + let + -- A binding is optional if the lhs starts with a '_', return the same + -- binding but without the '_' + isOptional = \case + NamedVar p e l | Just p' <- isOptionalPath p -> Just (NamedVar p' e l) + _ -> Nothing + + -- Get a representation of the left hand side which has an Eq instance + -- This will represent some things the samelike "${a}" and "${b}" + getLHS = \case + NamedVar p _ _ -> Left (fmap void p) + Inherit r ps _ -> Right (void r, fmap void ps) + in sequence + [ (n', ) <$> m + | -- For each binding in the needle + n <- needle + , let opt = isOptional n + -- | Use the optional demangled version if present + n' = fromMaybe n opt + lhs = getLHS n' + -- Find the first matching binding in the matchee + m = find ((lhs ==) . getLHS) matchee + , -- Skip this element if it is not present in the matchee and is optional in the needle + isNothing opt || isJust m + ] + +-- | Basically: does the path begin with an underscore, if so return it removed +-- without the underscore. +isOptionalPath :: NAttrPath r -> Maybe (NAttrPath r) +isOptionalPath = \case + StaticKey n :| [] | Just ('_', t) <- T.uncons n -> Just (StaticKey t :| []) + DynamicKey (Plain (DoubleQuoted [Plain n])) :| rs + | Just ('_', t) <- T.uncons n -> Just + (DynamicKey (Plain (DoubleQuoted [Plain t])) :| rs) + _ -> Nothing + +-- +-- hnix types +-- + +instance Matchable NString where + +instance Matchable (Antiquoted Text) where + +-- | The matched pair uses the source location of the first argument +instance Matchable Binding where + zipMatchLeft (NamedVar p1 v1 _) (NamedVar p2 v2 l) = do + p <- zipMatchLeft2 p1 p2 + pure (NamedVar p (v1, v2) l) + + zipMatchLeft (Inherit x1 ys1 l) (Inherit x2 ys2 _) = do + x <- zipMatchLeft x1 x2 + ys <- zipMatchLeft2 ys1 ys2 + pure (Inherit x ys l) + + zipMatchLeft _ _ = Nothing + +-- | No Generic1 instance +instance Matchable NKeyName where + zipMatchLeft (StaticKey k1) (StaticKey k2) | k1 == k2 = Just (StaticKey k1) + zipMatchLeft (DynamicKey EscapedNewline) (DynamicKey EscapedNewline) = + Just (DynamicKey EscapedNewline) + zipMatchLeft (DynamicKey (Plain k1)) (DynamicKey (Plain k2)) = do + k <- zipMatchLeft k1 k2 + pure $ DynamicKey (Plain k) + zipMatchLeft (DynamicKey (Antiquoted k1)) (DynamicKey (Antiquoted k2)) = + pure $ DynamicKey (Antiquoted (k1, k2)) + zipMatchLeft _ _ = Nothing + +instance Matchable Params where + +-- | Doesn't require the annotations to match, returns the second annotation. +instance Matchable (Ann ann) where + zipMatchLeft (Ann _ a1) (Ann ann2 a2) = Just $ Ann ann2 (a1, a2) + +-- +-- base types +-- + +instance Matchable [] where + +instance Matchable NonEmpty where + +instance Matchable Maybe where + +instance Eq a => Matchable ((,) a) where + +instance (Matchable f, Matchable g)=> Matchable (Compose f g) where + + +---------------------------------------------------------------- +-- Generic Instance for Matchable +---------------------------------------------------------------- + +-- | A class used in the @default@ definition for 'zipMatchLeft' +class (Traversable t, Generic1 t) => GMatchable t where + gZipMatchLeft :: t a -> t b -> Maybe (t (a,b)) + +instance GMatchable t => GMatchable (M1 m i t) where + gZipMatchLeft (M1 l) (M1 r) = M1 <$> gZipMatchLeft l r + +instance GMatchable U1 where + gZipMatchLeft _ _ = Just U1 + +instance Eq c => GMatchable (K1 m c) where + gZipMatchLeft (K1 l) (K1 r) | l == r = Just (K1 l) + | otherwise = Nothing + +instance GMatchable Par1 where + gZipMatchLeft (Par1 l) (Par1 r) = Just . Par1 $ (l, r) + +instance Matchable x => GMatchable (Rec1 x) where + gZipMatchLeft (Rec1 l) (Rec1 r) = Rec1 <$> zipMatchLeft l r + +instance (GMatchable l, GMatchable r) => GMatchable (l :+: r) where + gZipMatchLeft (L1 l) (L1 r) = L1 <$> gZipMatchLeft l r + gZipMatchLeft (R1 l) (R1 r) = R1 <$> gZipMatchLeft l r + gZipMatchLeft _ _ = Nothing + +instance (GMatchable l, GMatchable r) => GMatchable (l :*: r) where + gZipMatchLeft (l1 :*: l2) (r1 :*: r2) = + (:*:) <$> gZipMatchLeft l1 r1 <*> gZipMatchLeft l2 r2 + +instance (Matchable a, GMatchable b) => GMatchable (a :.: b) where + gZipMatchLeft (Comp1 l) (Comp1 r) = do + x <- zipMatchLeft l r >>= traverse (uncurry gZipMatchLeft) + pure (Comp1 x) + + +---------------------------------------------------------------- +-- Utils +---------------------------------------------------------------- + +(.:) :: (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c +(.:) = (.) . (.) diff --git a/src/Nix/Match/Typed.hs b/src/Nix/Match/Typed.hs new file mode 100644 --- /dev/null +++ b/src/Nix/Match/Typed.hs @@ -0,0 +1,263 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TemplateHaskell #-} +-- | A more strongly typed alternative to 'Nix.Match' +module Nix.Match.Typed + ( matchNix + , matchNixLoc + , TypedMatcher(..) + , TypedMatch(..) + , get + , getOptional + , matchTyped + , findMatchesTyped + ) where + +import Control.Category ( (>>>) ) +import Data.Coerce ( coerce ) +import Data.Data +import Data.Fix +import Data.Generics.Aliases +import Data.Kind ( Constraint ) +import Data.Maybe +import qualified Data.Text as T +import Data.Type.Equality ( type (==) ) +import GHC.TypeLits ( ErrorMessage(..) + , KnownSymbol + , Symbol + , TypeError + , symbolVal + ) +import Language.Haskell.TH ( Exp(AppE, VarE) + , ExpQ + , Pat(..) + , PatQ + , Q + , TyLit(StrTyLit) + , Type(..) + , appTypeE + , litT + , mkName + , newName + , strTyLit + , tupE + , tupP + , varE + , varP + ) +import Language.Haskell.TH.Lib ( appE + , conE + ) +import Language.Haskell.TH.Quote ( QuasiQuoter(..) ) +import Language.Haskell.TH.Syntax ( dataToExpQ + , liftString + ) +import Nix hiding ( TypeError ) +import Nix.Match +import Nix.TH + +---------------------------------------------------------------- +-- Typed matching +---------------------------------------------------------------- + +-- | A QuasiQuoter for safely generating 'TypedMatcher's from nix source +-- +-- The expression has the type @'TypedMatcher' opts reqs 'NExprF'@ where @opts@ +-- and @reqs@ are the optional and required holes from the source expression. +-- +-- The pattern, if matched, will bring into scope variables named according to +-- the holes present in the expression. These will have type 'NExpr' if they +-- are required, and @Maybe 'NExpr'@ if they are optional. +-- +-- This requires ViewPatterns, TypeApplications and DataKinds +-- +-- >>> case [nix|{a="hello";}|] of [matchNix|{a=^a;}|] -> a +-- Fix (NStr (DoubleQuoted [Plain "hello"])) +-- +-- >>> :t [matchNix|{a = ^a; b = {c = ^c; _d = ^d;};}|] +-- [matchNix|{a = ^a; b = {c = ^c; _d = ^d;};}|] :: TypedMatcher '["d"] '["a", "c"] NExprF +-- +-- >>> [matchNix|let a = ^a; _b = ^b; in x|] = undefined +-- >>> :t (a, b) +-- (a, b) :: (Fix NExprF, Maybe (Fix NExprF)) +matchNix :: QuasiQuoter +matchNix = QuasiQuoter { quoteExp = typedMatcherExp + , quotePat = typedMatcherPat + , quoteDec = error "No dec quoter for typedMatcher" + , quoteType = error "No type quoter for typedMatcher" + } + +-- | A QuasiQuoter for safely generating 'TypedMatcher's from nix source along +-- with source location annotations +-- +-- The expression has the type @'TypedMatcher' opts reqs 'NExprLocF'@ where +-- @opts@ and @reqs@ are the optional and required holes from the source +-- expression. +-- +-- This requires ViewPatterns, TypeApplications and DataKinds +-- +-- The pattern, if matched, will bring into scope variables named according to +-- the holes present in the expression. These will have type 'NExprLoc' if they +-- are required, and @Maybe 'NExprLoc'@ if they are optional. +matchNixLoc :: QuasiQuoter +matchNixLoc = QuasiQuoter + { quoteExp = typedMatcherLocExp + , quotePat = typedMatcherLocPat + , quoteDec = error "No dec quoter for typedMatcherLoc" + , quoteType = error "No type quoter for typedMatcherLoc" + } + +-- | A matcher with the names of the required and optional holes encoded at the +-- type level. +newtype TypedMatcher (opts :: [Symbol]) (reqs :: [Symbol]) t + = TypedMatcher {unTypedMatcher :: WithHoles t T.Text} + +-- | The results of matching with a 'TypedMatcher'. The values in the required +-- list are guaranteed to be present. The values in the optional list may be +-- present. Use 'get' and 'getOptional' to extract them safely. +newtype TypedMatch (opts :: [Symbol]) (reqs :: [Symbol]) a + = TypedMatch [(T.Text, a)] + +-- | Extract a required key from a match +get + :: forall x opts reqs a + . (Elem "Required" x reqs, KnownSymbol x) + => TypedMatch opts reqs a + -> a +get (TypedMatch ms) = + fromMaybe (error "Required key not present in TypedMatch") + $ lookup (T.pack (symbolVal (Proxy @x))) ms + +-- | Maybe extract an optional key from a match +getOptional + :: forall x opts reqs a + . (Elem "Optional" x opts, KnownSymbol x) + => TypedMatch opts reqs a + -> Maybe a +getOptional (TypedMatch ms) = lookup (T.pack (symbolVal (Proxy @x))) ms + +-- | A typed version of 'match' +matchTyped + :: Matchable t + => TypedMatcher opts reqs t + -> Fix t + -> Maybe (TypedMatch opts reqs (Fix t)) +matchTyped = coerce match + +-- | A typed version of 'findMatches' +findMatchesTyped + :: Matchable t + => TypedMatcher opts reqs t + -> Fix t + -> [(Fix t, TypedMatch opts reqs (Fix t))] +findMatchesTyped = coerce findMatches + +typedMatcherExp :: String -> ExpQ +typedMatcherExp = + fmap snd . typedMatcherGen parseNixText collectHoles addHoles id + +typedMatcherLocExp :: String -> ExpQ +typedMatcherLocExp = + fmap snd + . typedMatcherGen parseNixTextLoc + collectHolesLoc + addHolesLoc + stripAnnotation + +typedMatcherPat :: String -> PatQ +typedMatcherPat = typedMatcherPatGen parseNixText collectHoles addHoles id + +typedMatcherLocPat :: String -> PatQ +typedMatcherLocPat = + typedMatcherPatGen parseNixTextLoc collectHolesLoc addHolesLoc stripAnnotation + +typedMatcherPatGen + :: Data a + => (T.Text -> Result t) + -> (t -> ([T.Text], [T.Text])) + -> (t -> a) + -> (t -> NExpr) + -> String + -> Q Pat +typedMatcherPatGen parseNix collect add strip s = do + ((opt, req), matcher) <- typedMatcherGen parseNix collect add strip s + -- e' <- [|fmap (\x -> $()) . matchTyped $(pure matcher)|] + x <- newName "x" + let pat = tupP (varP . mkName . T.unpack <$> (req <> opt)) + textSymbol = litT . strTyLit . T.unpack + getters = tupE + ( ((\r -> [|get @($r) $(varE x)|]) . textSymbol <$> req) + <> ((\o -> [|getOptional @($o) $(varE x)|]) . textSymbol <$> opt) + ) + [p|(fmap (\ $(varP x) -> $getters) . matchTyped $(pure matcher) -> Just $pat)|] + +typedMatcherGen + :: Data a + => (T.Text -> Result t) + -> (t -> ([T.Text], [T.Text])) + -> (t -> a) + -> (t -> NExpr) + -> String + -> Q (([T.Text], [T.Text]), Exp) +typedMatcherGen parseNix collect add strip s = do + expr <- case parseNix (T.pack s) of + Failure err -> fail $ show err + Success e -> pure e + let (opt, req) = collect expr + optT = symbolList opt + reqT = symbolList req + holed = add expr + exprExp = dataToExpQ + ( const Nothing + `extQ` metaExp (freeVars (strip expr)) + `extQ` (Just . liftText) + ) + holed + e <- + conE 'TypedMatcher `appTypeE` pure optT `appTypeE` pure reqT `appE` exprExp + pure ((opt, req), e) + +liftText :: T.Text -> Q Exp +liftText txt = AppE (VarE 'T.pack) <$> liftString (T.unpack txt) + +-- | Make a list of promoted strings +symbolList :: [T.Text] -> Type +symbolList = foldr + (\n -> (PromotedConsT `AppT` LitT (StrTyLit (T.unpack n)) `AppT`)) + PromotedNilT + +-- | Collect optional and required holes +collectHoles :: NExpr -> ([T.Text], [T.Text]) +collectHoles = unFix >>> \case + NSynHole n -> ([], [n]) + NSet _ bs -> foldMap (bindingHoles collectHoles) bs + NLet bs e -> collectHoles e <> foldMap (bindingHoles collectHoles) bs + e -> foldMap collectHoles e + +-- | Collect optional and required holes +collectHolesLoc :: NExprLoc -> ([T.Text], [T.Text]) +collectHolesLoc = unFix >>> \case + Compose (Ann _ (NSynHole n)) -> ([], [n]) + Compose (Ann _ (NSet _ bs )) -> foldMap (bindingHoles collectHolesLoc) bs + Compose (Ann _ (NLet bs e)) -> + collectHolesLoc e <> foldMap (bindingHoles collectHolesLoc) bs + e -> foldMap collectHolesLoc e + +-- | Find the optional and required holees in a binding +bindingHoles :: (r -> ([a], [a])) -> Binding r -> ([a], [a]) +bindingHoles f = \case + b@(NamedVar p _ _) | isJust (isOptionalPath p) -> + let (opt, req) = foldMap f b in (opt <> req, []) + b -> foldMap f b + +---------------------------------------------------------------- +-- Helpers +---------------------------------------------------------------- + +type family Bool' (f :: k) (t :: k) (x :: Bool) :: k where + Bool' f _ 'False = f + Bool' _ t 'True = t + +type family Elem n x ys :: Constraint where + Elem n x '[] = TypeError ('Text n ':<>: 'Text " key \"" ':<>: 'Text x ':<>: 'Text "\" not found in TypedMatch") + Elem n x (y:ys) = Bool' (Elem n x ys) (() :: Constraint) (x == y) diff --git a/src/Update/Nix/FetchGit.hs b/src/Update/Nix/FetchGit.hs --- a/src/Update/Nix/FetchGit.hs +++ b/src/Update/Nix/FetchGit.hs @@ -1,163 +1,114 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} module Update.Nix.FetchGit - ( updatesFromFile - , processFile + ( processFile + , processText + , updatesFromText ) where -import Control.Concurrent.Async (mapConcurrently) -import Control.Error -import Data.Foldable (toList) -import Data.Generics.Uniplate.Data (para) -import Data.Text (Text, pack) +import Control.Monad ( when ) +import Data.Fix +import Data.Foldable +import Data.Maybe +import Data.Text ( Text + , pack + ) +import qualified Data.Text as T +import qualified Data.Text.IO +import Data.Time ( Day ) +import qualified Data.Vector as V +import Nix.Comments import Nix.Expr -import Update.Nix.FetchGit.Prefetch +import Nix.Match.Typed +import System.Exit import Update.Nix.FetchGit.Types import Update.Nix.FetchGit.Utils -import Update.Nix.FetchGit.Warning +import Update.Nix.Updater import Update.Span - -import qualified Data.Text.IO -import qualified System.IO -import qualified System.Exit +import Control.Monad.Validate ( MonadValidate(tolerate) ) +import Data.Functor +import Control.Monad.Reader ( MonadReader(ask) ) -------------------------------------------------------------------------------- -- Tying it all together -------------------------------------------------------------------------------- -- | Provided FilePath, update Nix file in-place -processFile :: FilePath -> [Text] -> IO () -processFile filename args = do - t <- Data.Text.IO.readFile filename - -- Get the updates from this file. - updatesFromFile filename args >>= \case - -- If we have any errors, print them and finish. - Left ws -> printErrorAndExit ws - Right us -> - -- Update the text of the file in memory. - case updateSpans us t of - -- If updates are needed, write to the file. - t' | t' /= t -> do - Data.Text.IO.writeFile filename t' - putStrLn $ "Made " ++ (show $ length us) ++ " changes" +processFile :: Env -> FilePath -> IO () +processFile env filename = do + t <- Data.Text.IO.readFile filename + t' <- processText env t + -- If updates are needed, write to the file. + when (t /= t') $ Data.Text.IO.writeFile filename t' - _ -> putStrLn "No updates" - where - printErrorAndExit :: Warning -> IO () - printErrorAndExit e = do - System.IO.hPutStrLn System.IO.stderr (formatWarning e) - System.Exit.exitFailure +processText :: Env -> Text -> IO Text +processText env t = do + (es, t') <- runM env (updatesFromText t <&> (`updateSpans` t)) + traverse_ (sayLog env Normal . formatWarning) es + maybe exitFailure pure t' -- | Given the path to a Nix file, returns the SpanUpdates -- all the parts of the file we want to update. -updatesFromFile :: FilePath -> [Text] -> IO (Either Warning [SpanUpdate]) -updatesFromFile f extraArgs = runExceptT $ do - expr <- ExceptT $ ourParseNixFile f - treeWithArgs <- hoistEither $ exprToFetchTree expr - treeWithLatest <- ExceptT $ - sequenceA <$> mapConcurrently (getFetchGitLatestInfo extraArgs) treeWithArgs - pure (fetchTreeToSpanUpdates treeWithLatest) - --------------------------------------------------------------------------------- --- Extracting information about fetches from the AST --------------------------------------------------------------------------------- - --- Get a FetchTree from a nix expression. -exprToFetchTree :: NExprLoc -> Either Warning (FetchTree FetchGitArgs) -exprToFetchTree = para $ \e subs -> case e of - -- If it is a call (application) of fetchgit, record the - -- arguments since we will need to update them. - AnnE _ (NBinary NApp function (AnnE _ (NSet _rec bindings))) - | extractFuncName function == Just "fetchgit" - || extractFuncName function == Just "fetchgitPrivate" - -> FetchNode <$> extractFetchGitArgs bindings - - -- Similarly for builtins.fetchGit which needs special handling. - AnnE _ (NBinary NApp function (AnnE _ (NSet _rec bindings))) - | extractFuncName function == Just "fetchGit" - -> FetchNode <$> extractFetchGitBuiltinArgs bindings - - -- Also record calls to fetchFromGitHub. - AnnE _ (NBinary NApp function (AnnE _ (NSet _rec bindings))) - | extractFuncName function == Just "fetchFromGitHub" - -> FetchNode <$> extractFetchFromGitHubArgs bindings - - -- And to fetchFromGitLab. - AnnE _ (NBinary NApp function (AnnE _ (NSet _rec bindings))) - | extractFuncName function == Just "fetchFromGitLab" - -> FetchNode <$> extractFetchFromGitLabArgs bindings - - -- If it is an attribute set, find any attributes in it that we - -- might want to update. - AnnE _ (NSet _rec bindings) - -> Node <$> findAttr "version" bindings <*> sequenceA subs - - -- If this is something uninteresting, just wrap the sub-trees. - _ -> Node Nothing <$> sequenceA subs - --- | Extract a 'FetchGitArgs' from the attrset being passed to fetchgit. -extractFetchGitArgs :: [Binding NExprLoc] -> Either Warning FetchGitArgs -extractFetchGitArgs bindings = - FetchGitArgs <$> (URL <$> (exprText =<< extractAttr "url" bindings)) - <*> extractAttr "rev" bindings - <*> (Just <$> extractAttr "sha256" bindings) - --- | Extract a 'FetchGitArgs' from the attrset being passed to builtins.fetchGit, --- unlike all the other functions it does not include a sha256 field. -extractFetchGitBuiltinArgs :: [Binding NExprLoc] -> Either Warning FetchGitArgs -extractFetchGitBuiltinArgs bindings = - FetchGitArgs <$> (URL <$> (exprText =<< extractAttr "url" bindings)) - <*> extractAttr "rev" bindings - <*> pure Nothing - --- | Extract a 'FetchGitArgs' from the attrset being passed to fetchFromGitHub. -extractFetchFromGitHubArgs :: [Binding NExprLoc] -> Either Warning FetchGitArgs -extractFetchFromGitHubArgs bindings = - FetchGitArgs <$> (GitHub <$> (exprText =<< extractAttr "owner" bindings) - <*> (exprText =<< extractAttr "repo" bindings)) - <*> extractAttr "rev" bindings - <*> (Just <$> extractAttr "sha256" bindings) - --- | Extract a 'FetchGitArgs' from the attrset being passed to fetchFromGitLab. -extractFetchFromGitLabArgs :: [Binding NExprLoc] -> Either Warning FetchGitArgs -extractFetchFromGitLabArgs bindings = - FetchGitArgs <$> (GitLab <$> (exprText =<< extractAttr "owner" bindings) - <*> (exprText =<< extractAttr "repo" bindings)) - <*> extractAttr "rev" bindings - <*> (Just <$> extractAttr "sha256" bindings) +updatesFromText :: Text -> M [SpanUpdate] +updatesFromText t = do + let nixLines = V.fromList (T.lines t) + getComment sourceLines = + annotation . getCompose . unFix . annotateWithComments sourceLines + tree <- do + expr <- fromEither $ ourParseNixText t + findUpdates (getComment nixLines) expr + us <- evalUpdates tree + case us of + [] -> logVerbose "Made no updates" + [_] -> logVerbose "Made 1 update" + _ -> logVerbose ("Made " <> T.pack (show (length us)) <> " updates") + pure us --------------------------------------------------------------------------------- --- Getting updated information from the internet. --------------------------------------------------------------------------------- +---------------------------------------------------------------- +-- Finding updates +---------------------------------------------------------------- -getFetchGitLatestInfo :: [Text] -> FetchGitArgs -> IO (Either Warning FetchGitLatestInfo) -getFetchGitLatestInfo extraArgs args = runExceptT $ do - o <- ExceptT (nixPrefetchGit extraArgs (extractUrlString $ repoLocation args)) - d <- hoistEither (parseISO8601DateToDay (date o)) - pure $ FetchGitLatestInfo args (rev o) (sha256 o) d +findUpdates :: (NExprLoc -> Maybe Comment) -> NExprLoc -> M FetchTree +findUpdates getComment e = do + Env {..} <- ask + if not (null updateLocations || any (containsPosition e) updateLocations) + then pure $ Node Nothing [] + else + let updaters = ($ e) <$> fetchers getComment + in + case asum updaters of + Just u -> UpdaterNode <$> u + Nothing -> case e of + [matchNixLoc|{ _version = ^version; }|] -> + Node version + <$> traverse (findUpdates getComment) (toList (unFix e)) + _ -> Node Nothing + <$> traverse (findUpdates getComment) (toList (unFix e)) --------------------------------------------------------------------------------- --- Deciding which parts of the Nix file should be updated and how. --------------------------------------------------------------------------------- +evalUpdates :: FetchTree -> M [SpanUpdate] +evalUpdates = fmap snd . go + where + go :: FetchTree -> M (Maybe Day, [SpanUpdate]) + go = \case + UpdaterNode (Updater u) -> u + Node versionExpr cs -> do + (ds, ss) <- unzip . catMaybes <$> traverse (tolerate . go) cs + -- Update version string with the maximum of versions in the children + let latestDate = maximumMay (catMaybes ds) + pure + ( latestDate + , [ SpanUpdate (exprSpan v) (quoteString . pack . show $ d) + | Just d <- pure latestDate + , Just v <- pure versionExpr + ] + <> concat ss + ) -fetchTreeToSpanUpdates :: FetchTree FetchGitLatestInfo -> [SpanUpdate] -fetchTreeToSpanUpdates node@(Node _ cs) = - concatMap fetchTreeToSpanUpdates cs ++ - toList (maybeUpdateVersion node) -fetchTreeToSpanUpdates (FetchNode f) = catMaybes [Just revUpdate, sha256Update] - where revUpdate = SpanUpdate (exprSpan (revExpr args)) - (quoteString (latestRev f)) - sha256Update = SpanUpdate <$> (exprSpan <$> sha256Expr args) - <*> Just (quoteString (latestSha256 f)) - args = originalInfo f +---------------------------------------------------------------- +-- Utils +---------------------------------------------------------------- --- Given a node of the fetch tree which might contain a version --- string, decides whether and how that version string should be --- updated. We basically just take the maximum latest commit date of --- all the fetches in the children. -maybeUpdateVersion :: FetchTree FetchGitLatestInfo -> Maybe SpanUpdate -maybeUpdateVersion node@(Node (Just versionExpr) _) = do - maxDay <- (maximumMay . fmap latestDate . toList) node - pure $ SpanUpdate (exprSpan versionExpr) ((quoteString . pack . show) maxDay) -maybeUpdateVersion _ = Nothing +maximumMay :: Ord a => [a] -> Maybe a +maximumMay = \case + [] -> Nothing + xs -> Just (maximum xs) diff --git a/src/Update/Nix/FetchGit/Prefetch.hs b/src/Update/Nix/FetchGit/Prefetch.hs --- a/src/Update/Nix/FetchGit/Prefetch.hs +++ b/src/Update/Nix/FetchGit/Prefetch.hs @@ -1,19 +1,32 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} module Update.Nix.FetchGit.Prefetch ( NixPrefetchGitOutput(..) , nixPrefetchGit + , nixPrefetchUrl + , getGitFullName + , getGitRevision + , getGitHubRevisionDate + , Revision(..) ) where -import Control.Error -import Control.Monad.IO.Class (liftIO) -import Data.Aeson (FromJSON, decode) -import Data.ByteString.Lazy.UTF8 (fromString) -import Data.Text (Text, pack, unpack) +import Control.Monad ( guard ) +import Control.Monad.IO.Class ( MonadIO(liftIO) ) +import Data.Aeson ( FromJSON + , decode + ) +import Data.ByteString.Lazy.UTF8 ( fromString ) +import Data.Text ( Text + , pack + , unpack + ) +import qualified Data.Text as T +import Data.Time ( Day ) import GHC.Generics -import System.Exit (ExitCode (..)) -import System.Process (readProcessWithExitCode) +import GitHub.REST +import System.Exit ( ExitCode(..) ) +import System.Process ( readProcessWithExitCode ) +import Update.Nix.FetchGit.Types +import Update.Nix.FetchGit.Utils import Update.Nix.FetchGit.Warning @@ -26,13 +39,123 @@ deriving (Show, Generic, FromJSON) -- | Run nix-prefetch-git -nixPrefetchGit :: [Text] -- ^ Extra arguments for nix-prefetch-git - -> Text -- ^ The URL to prefetch - -> IO (Either Warning NixPrefetchGitOutput) -nixPrefetchGit extraArgs prefetchURL = runExceptT $ do - (exitCode, nsStdout, nsStderr) <- liftIO $ - readProcessWithExitCode "nix-prefetch-git" (map unpack extraArgs ++ [unpack prefetchURL]) "" - hoistEither $ case exitCode of - ExitFailure e -> Left (NixPrefetchGitFailed e (pack nsStderr)) - ExitSuccess -> pure () - decode (fromString nsStdout) ?? InvalidPrefetchGitOutput (pack nsStdout) +nixPrefetchGit + :: [Text] -- ^ Extra arguments for nix-prefetch-git + -> Text -- ^ The URL to prefetch + -> M NixPrefetchGitOutput +nixPrefetchGit extraArgs prefetchURL = do + (exitCode, nsStdout, nsStderr) <- liftIO $ readProcessWithExitCode + "nix-prefetch-git" + (map unpack extraArgs ++ [unpack prefetchURL]) + "" + case exitCode of + ExitFailure e -> refute1 (NixPrefetchGitFailed e (pack nsStderr)) + ExitSuccess -> pure () + note (InvalidPrefetchGitOutput (pack nsStdout)) (decode (fromString nsStdout)) + +-- | Run nix-prefetch-url --unpack +nixPrefetchUrl + :: [Text] -- ^ Extra arguments for nix-prefetch-url + -> Text -- ^ The URL to prefetch + -> M Text -- The sha256 output +nixPrefetchUrl extraArgs prefetchURL = do + (exitCode, nsStdout, nsStderr) <- liftIO $ readProcessWithExitCode + "nix-prefetch-url" + ("--unpack" : map unpack extraArgs ++ [unpack prefetchURL]) + "" + case exitCode of + ExitFailure e -> refute1 (NixPrefetchUrlFailed e (pack nsStderr)) + ExitSuccess -> pure () + note (InvalidPrefetchUrlOutput (pack nsStdout)) + (parseSHA256 (T.strip . T.pack $ nsStdout)) + +newtype Revision = Revision { unRevision :: Text } + +-- | Discover if this ref is a branch or a tag +-- +-- >>> runM _ $ getGitFullName "https://github.com/expipiplus1/update-nix-fetchgit" (Revision "0.1.0.0") +-- Right "refs/tags/0.1.0.0" +-- +-- >>> runM _ $ getGitFullName "https://github.com/expipiplus1/update-nix-fetchgit" (Revision "joe-fetchTarball") +-- Right "refs/heads/joe-fetchTarball" +getGitFullName + :: Text + -- ^ git repo location + -> Revision + -- ^ branch or tag name + -> M Text + -- ^ Full name, i.e. with refs/heads/ or refs/tags/ +getGitFullName repo revision = do + (stdoutText, rs) <- gitLsRemotes repo revision + case rs of + [_hash, name] : _ -> pure name + _ -> refute1 $ InvalidGitLsRemoteOutput stdoutText + +-- | Return a tag or a hash +getGitRevision + :: Text + -- ^ git repo location + -> Revision + -- ^ branch or tag name + -> M Text + -- ^ Full name, i.e. with refs/heads/ or refs/tags/ +getGitRevision repo revision = do + (stdoutText, rs) <- gitLsRemotes repo revision + case rs of + [hash, name] : _ | Just tag <- stripPrefix "refs/tags/" name -> pure tag + | otherwise -> pure hash + _ -> refute1 $ InvalidGitLsRemoteOutput stdoutText + +gitLsRemotes :: Text -> Revision -> M (Text, [[Text]]) +gitLsRemotes repo revision = do + (exitCode, nsStdout, nsStderr) <- liftIO $ readProcessWithExitCode + "git" + ["ls-remote", T.unpack repo, T.unpack (unRevision revision)] + "" + case exitCode of + ExitFailure e -> refute1 (NixPrefetchGitFailed e (pack nsStderr)) + ExitSuccess -> pure () + let stdoutText = T.pack nsStdout + case fmap T.words . T.lines $ stdoutText of + [] -> refute1 (NoSuchRef (unRevision revision)) + rs -> pure (stdoutText, rs) + +getGitHubRevisionDate :: Text -> Text -> Revision -> M Day +getGitHubRevisionDate owner repo revision = do + dateString <- runGitHubT ghState $ do + ref <- queryGitHub GHEndpoint + { method = GET + , endpoint = "/repos/:owner/:repo/commits/:ref" + , endpointVals = [ "owner" := owner + , "repo" := repo + , "ref" := unRevision revision + ] + , ghData = [] + } + pure $ ref .: "commit" .: "committer" .: "date" + fromEither $ parseISO8601DateToDay dateString + +ghState :: GitHubState +ghState = GitHubState { token = Nothing + , userAgent = "expipiplus1/update-nix-fetchgit" + , apiVersion = "v3" + } + +---------------------------------------------------------------- +-- Utils +---------------------------------------------------------------- + +parseSHA256 :: Text -> Maybe Text +parseSHA256 t = do + guard (base32Length == T.length t) + guard (T.all (`elem` base32Chars) t) + pure t + where + base32Chars = "0123456789abcdfghijklmnpqrsvwxyz" :: String + sha256HashSize = 32 + base32Length = (sha256HashSize * 8 - 1) `quot` 5 + 1 + +stripPrefix :: Text -> Text -> Maybe Text +stripPrefix p t = if p `T.isPrefixOf` t + then Just $ T.drop (T.length p) t + else Nothing diff --git a/src/Update/Nix/FetchGit/Types.hs b/src/Update/Nix/FetchGit/Types.hs --- a/src/Update/Nix/FetchGit/Types.hs +++ b/src/Update/Nix/FetchGit/Types.hs @@ -1,53 +1,61 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Update.Nix.FetchGit.Types where -import Data.Data (Data) -import Data.Text (Text) -import qualified Data.Time (Day) -import Nix.Expr (NExprLoc) +import Control.Monad.Reader +import Control.Monad.Validate +import Control.Monad.Validate.Internal +import Data.Bifunctor ( Bifunctor(first) ) +import Data.Functor +import Data.Monoid +import Data.Text ( Text ) +import Data.Time ( Day ) +import Nix.Expr ( NExprLoc ) +import Update.Nix.FetchGit.Warning +import Update.Span --- | The day portion of a date, with no timezone information. -type Day = Data.Time.Day +type M = ReaderT Env (ValidateT (Dual [Warning]) IO) --- | A tree with a structure similar to the AST of the Nix file we are --- parsing, but which only contains the information we care about. --- The fetchInfo type parameter allows this tree to be used at --- different stages in the program where we know different amounts of --- information about a fetch expression. -data FetchTree fetchInfo = Node { nodeVersionExpr :: Maybe NExprLoc - , nodeChildren :: [FetchTree fetchInfo] - } - | FetchNode fetchInfo - deriving (Show, Data, Functor, Foldable, Traversable) +runM :: Env -> M a -> IO ([Warning], Maybe a) +runM env = fmap (first (reverse . getDual)) . asWarnings . flip runReaderT env --- | Represents the arguments to a call to fetchgit, fetchFromGitHub --- or fetchFromGitLab as parsed from a .nix file. --- sha256Expr will be empty on calls to builtins.fetchGit. -data FetchGitArgs = FetchGitArgs { repoLocation :: RepoLocation - , revExpr :: NExprLoc - , sha256Expr :: Maybe NExprLoc - } - deriving (Show, Data) +-- | Runs a 'ValidateT' computation returning the errors raised by 'refute' or +-- 'dispute' if any, as well as returning the computation’s result if possible. +asWarnings :: (Functor m, Monoid e) => ValidateT e m a -> m (e, Maybe a) +asWarnings m = unValidateT MNothing m <&> \case + Left e -> (e, Nothing) + Right (MJust e , a) -> (e, Just a) + Right (MNothing, a) -> (mempty, Just a) --- | Updated information about a fetchgit call that was retrieved from --- the internet. -data FetchGitLatestInfo = FetchGitLatestInfo { originalInfo :: FetchGitArgs - , latestRev :: Text - , latestSha256 :: Text - , latestDate :: Day - } - deriving (Show, Data) +data Env = Env + { sayLog :: Verbosity -> Text -> IO () + , updateLocations :: [(Int, Int)] + } +data Verbosity + = Verbose + | Normal + | Quiet + +newtype Updater = Updater + { unUpdater :: M (Maybe Day, [SpanUpdate]) + } + +-- | A tree with a structure similar to the AST of the Nix file we are +-- parsing, but which only contains the information we care about. +data FetchTree + = Node { nodeVersionExpr :: Maybe NExprLoc + , nodeChildren :: [FetchTree] + } + | UpdaterNode Updater + -- | A repo is either specified by URL or by Github owner/repo. data RepoLocation = URL Text - | GitHub { owner :: Text - , repo :: Text + | GitHub { repoOwner :: Text + , repoRepo :: Text } - | GitLab { owner :: Text - , repo :: Text + | GitLab { repoOwner :: Text + , repoRepo :: Text } - deriving (Show, Data) + deriving Show + diff --git a/src/Update/Nix/FetchGit/Utils.hs b/src/Update/Nix/FetchGit/Utils.hs --- a/src/Update/Nix/FetchGit/Utils.hs +++ b/src/Update/Nix/FetchGit/Utils.hs @@ -1,47 +1,60 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} module Update.Nix.FetchGit.Utils ( RepoLocation(..) + , ourParseNixText , ourParseNixFile , extractUrlString + , prettyRepoLocation , quoteString , extractFuncName - , extractAttr - , findAttr - , matchAttr , exprText + , exprBool , exprSpan + , containsPosition , parseISO8601DateToDay , formatWarning + , fromEither + , note + , refute1 + , logVerbose + , logNormal ) where -import Data.Maybe ( catMaybes ) +import Control.Monad.IO.Class ( MonadIO(liftIO) ) +import Control.Monad.Reader ( MonadReader(ask) ) +import Control.Monad.Validate +import Data.Fix import Data.List.NonEmpty as NE -import Data.Text ( Text - , unpack - , splitOn - ) -import Data.Time ( parseTimeM - , defaultTimeLocale - ) -import Nix.Parser ( parseNixFileLoc - , Result(..) - ) -import Nix.Reduce -import Nix.Expr hiding ( SourcePos ) +import Data.Monoid +import Data.Text ( Text + , splitOn + , unpack + ) +import qualified Data.Text as T +import Data.Time ( Day + , defaultTimeLocale + , parseTimeM + ) +import Nix.Atoms ( NAtom(NBool) ) +import Nix.Expr hiding ( SourcePos ) +import Nix.Parser ( Result(..) + , parseNixFileLoc + , parseNixTextLoc + ) import Update.Nix.FetchGit.Types import Update.Nix.FetchGit.Warning import Update.Span -ourParseNixFile :: FilePath -> IO (Either Warning NExprLoc) -ourParseNixFile f = - parseNixFileLoc f >>= \case - Failure parseError -> pure $ Left (CouldNotParseInput parseError) - Success expr -> pure <$> reduceExpr Nothing expr +ourParseNixText :: Text -> Either Warning NExprLoc +ourParseNixText t = case parseNixTextLoc t of + Failure parseError -> Left (CouldNotParseInput (tShow parseError)) + Success expr -> pure expr +ourParseNixFile :: FilePath -> M NExprLoc +ourParseNixFile f = liftIO (parseNixFileLoc f) >>= \case + Failure parseError -> refute1 (CouldNotParseInput (tShow parseError)) + Success expr -> pure expr + -- | Get the url from either a nix expression for the url or a repo and owner -- expression. extractUrlString :: RepoLocation -> Text @@ -50,6 +63,12 @@ GitHub o r -> "https://github.com/" <> o <> "/" <> r <> ".git" GitLab o r -> "https://gitlab.com/" <> o <> "/" <> r <> ".git" +prettyRepoLocation :: RepoLocation -> Text +prettyRepoLocation = \case + URL u -> u + GitHub o r -> o <> "/" <> r + GitLab o r -> o <> "/" <> r + -- Add double quotes around a string so it can be inserted into a Nix -- file as a string literal. quoteString :: Text -> Text @@ -64,6 +83,11 @@ (AnnE _ (NStr (DoubleQuoted [Plain t]))) -> pure t e -> Left (NotAString e) +exprBool :: NExprLoc -> Either Warning Bool +exprBool = \case + (AnnE _ (NConstant (NBool b))) -> pure b + e -> Left (NotABool e) + -- | Get the 'SrcSpan' covering a particular expression. exprSpan :: NExprLoc -> SrcSpan exprSpan (AnnE s _) = s @@ -77,51 +101,92 @@ extractFuncName (AnnE _ (NSelect _ (NE.last -> StaticKey name) _)) = Just name extractFuncName _ = Nothing --- | Extract a named attribute from an attrset. -extractAttr :: Text -> [Binding a] -> Either Warning a -extractAttr name bs = case catMaybes (matchAttr name <$> bs) of - [x] -> pure x - [] -> Left (MissingAttr name) - _ -> Left (DuplicateAttrs name) - --- | Find a named attribute in an attrset. This is appropriate for --- the case when a missing attribute is not an error. -findAttr :: Text -> [Binding a] -> Either Warning (Maybe a) -findAttr name bs = case catMaybes (matchAttr name <$> bs) of - [x] -> pure (Just x) - [] -> pure Nothing - _ -> Left (DuplicateAttrs name) - --- | Returns 'Just value' if this attribute's key matches the text, otherwise --- Nothing. -matchAttr :: Text -> Binding a -> Maybe a -matchAttr t = \case - NamedVar (StaticKey t' :|[]) x _ | t == t' -> Just x - NamedVar _ _ _ -> Nothing - Inherit _ _ _ -> Nothing - -- Takes an ISO 8601 date and returns just the day portion. parseISO8601DateToDay :: Text -> Either Warning Day parseISO8601DateToDay t = - let justDate = (unpack . Prelude.head . splitOn "T") t in - case parseTimeM False defaultTimeLocale "%Y-%m-%d" justDate of - Nothing -> Left $ InvalidDateString t - Just day -> pure day + let justDate = (unpack . Prelude.head . splitOn "T") t + in maybe (Left $ InvalidDateString t) + Right + (parseTimeM False defaultTimeLocale "%Y-%m-%d" justDate) -formatWarning :: Warning -> String -formatWarning (CouldNotParseInput doc) = show doc +formatWarning :: Warning -> Text +formatWarning (CouldNotParseInput doc) = tShow doc formatWarning (MissingAttr attrName) = - "Error: The \"" <> unpack attrName <> "\" attribute is missing." + "Error: The \"" <> attrName <> "\" attribute is missing." formatWarning (DuplicateAttrs attrName) = - "Error: The \"" <> unpack attrName <> "\" attribute appears twice in a set." + "Error: The \"" <> attrName <> "\" attribute appears twice in a set." formatWarning (NotAString expr) = "Error: The expression at " - <> (prettyPrintSourcePos . spanBegin . exprSpan) expr - <> " is not a string literal." + <> (T.pack . prettyPrintSourcePos . spanBegin . exprSpan) expr + <> " is not a string literal." +formatWarning (NotABool expr) = + "Error: The expression at " + <> (T.pack . prettyPrintSourcePos . spanBegin . exprSpan) expr + <> " is not a boolean literal." formatWarning (NixPrefetchGitFailed exitCode errorOutput) = - "Error: nix-prefetch-git failed with exit code " <> show exitCode - <> " and error output:\n" <> unpack errorOutput + "Error: nix-prefetch-git failed with exit code " + <> tShow exitCode + <> " and error output:\n" + <> errorOutput formatWarning (InvalidPrefetchGitOutput output) = - "Error: Output from nix-prefetch-git is invalid:\n" <> show output + "Error: Output from nix-prefetch-git is invalid:\n" <> tShow output +formatWarning (NixPrefetchUrlFailed exitCode errorOutput) = + "Error: nix-prefetch-url failed with exit code " + <> tShow exitCode + <> " and error output:\n" + <> errorOutput +formatWarning (InvalidPrefetchUrlOutput output) = + "Error: Output from nix-prefetch-url is invalid:\n" <> tShow output formatWarning (InvalidDateString text) = - "Error: Date string is invalid: " <> show text + "Error: Date string is invalid: " <> tShow text +formatWarning (GitLsRemoteFailed exitCode errorOutput) = + "Error: git ls-remote failed with exit code " + <> tShow exitCode + <> " and error output:\n" + <> errorOutput +formatWarning (NoSuchRef text) = "Error: No such ref: " <> tShow text +formatWarning (InvalidGitLsRemoteOutput output) = + "Error: Output from git ls-remote is invalid:\n" <> tShow output + +tShow :: Show a => a -> Text +tShow = T.pack . show + +---------------------------------------------------------------- +-- Locations +---------------------------------------------------------------- + +containsPosition :: NExprLoc -> (Int, Int) -> Bool +containsPosition (Fix (Compose (Ann (SrcSpan begin end) _))) p = + let unSourcePos (SourcePos _ l c) = (unPos l, unPos c) + in p >= unSourcePos begin && p < unSourcePos end + +---------------------------------------------------------------- +-- Errors +---------------------------------------------------------------- + +fromEither :: Either Warning a -> M a +fromEither = \case + Left e -> refute1 e + Right a -> pure a + +note :: Warning -> Maybe a -> M a +note e = \case + Nothing -> refute1 e + Just a -> pure a + +refute1 :: Warning -> M a +refute1 = refute . Dual . pure + +---------------------------------------------------------------- +-- Logging +---------------------------------------------------------------- + +logVerbose :: Text -> M () +logVerbose t = do + Env{..} <- ask + liftIO $ sayLog Verbose t + +logNormal :: Text -> M () +logNormal t = do + Env {..} <- ask + liftIO $ sayLog Normal t diff --git a/src/Update/Nix/FetchGit/Warning.hs b/src/Update/Nix/FetchGit/Warning.hs --- a/src/Update/Nix/FetchGit/Warning.hs +++ b/src/Update/Nix/FetchGit/Warning.hs @@ -4,13 +4,19 @@ import Data.Text import Nix.Expr -import Data.Text.Prettyprint.Doc import Data.Void -data Warning = CouldNotParseInput (Doc Void) +data Warning = CouldNotParseInput Text | MissingAttr Text | DuplicateAttrs Text | NotAString NExprLoc + | NotABool NExprLoc | NixPrefetchGitFailed Int Text | InvalidPrefetchGitOutput Text + | NixPrefetchUrlFailed Int Text + | InvalidPrefetchUrlOutput Text | InvalidDateString Text + | GitLsRemoteFailed Int Text + | NoSuchRef Text + | InvalidGitLsRemoteOutput Text + deriving Show diff --git a/src/Update/Nix/Updater.hs b/src/Update/Nix/Updater.hs new file mode 100644 --- /dev/null +++ b/src/Update/Nix/Updater.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE QuasiQuotes #-} +-- | This module exports a list of 'Fetcher's, programs which match on nix +-- fetching expressions and return programs to update them +module Update.Nix.Updater + ( fetchers + ) where + +import Data.Maybe +import Data.Text ( Text + , splitOn + ) +import Nix ( NExprLoc ) +import Nix.Comments +import Nix.Match.Typed +import qualified Update.Nix.FetchGit.Prefetch as P +import Update.Nix.FetchGit.Prefetch ( Revision(..) + , getGitFullName + , getGitHubRevisionDate + , getGitRevision + , nixPrefetchGit + , nixPrefetchUrl + ) +import Update.Nix.FetchGit.Types +import Update.Nix.FetchGit.Utils +import Update.Span + +type Fetcher = (NExprLoc -> Maybe Comment) -> NExprLoc -> Maybe (M Updater) + +fetchers :: (NExprLoc -> Maybe Comment) -> [NExprLoc -> Maybe (M Updater)] +fetchers getComment = + ($ getComment) + <$> [ fetchgitUpdater + , builtinsFetchGitUpdater + , fetchTarballGithubUpdater + , builtinsFetchTarballUpdater + , fetchGitHubUpdater + , hackageDirectUpdater + ] + +fetchgitUpdater :: Fetcher +fetchgitUpdater getComment = \case + [matchNixLoc| + ^fetcher { + url = ^url; + rev = ^rev; # rev + sha256 = ^sha256; + _deepClone = ^deepClone; + _leaveDotGit = ^leaveDotGit; + _fetchSubmodules = ^fetchSubmodules; + }|] | extractFuncName fetcher `elem` [Just "fetchgit", Just "fetchgitPrivate"] + -> Just $ do + url' <- fromEither $ URL <$> exprText url + let desiredRev = commentToRequest (getComment rev) + deepClone' <- fmap (fromMaybe False) . fromEither . traverse exprBool $ deepClone + leaveDotGit' <- fmap (fromMaybe deepClone') . fromEither . traverse exprBool $ leaveDotGit + fetchSubmodules' <- fmap (fromMaybe True) . fromEither . traverse exprBool $ fetchSubmodules + pure $ gitUpdater url' desiredRev deepClone' leaveDotGit' fetchSubmodules' rev (Just sha256) + _ -> Nothing + +builtinsFetchGitUpdater :: Fetcher +builtinsFetchGitUpdater getComment = \case + [matchNixLoc| + ^fetcher { + url = ^url; + rev = ^rev; # rev + _submodules = ^submodules; + }|] | Just "fetchGit" <- extractFuncName fetcher + -> Just $ do + url' <- fromEither $ URL <$> exprText url + let desiredRev = commentToRequest (getComment rev) + submodules' <- fmap (fromMaybe False) . fromEither . traverse exprBool $ submodules + pure $ gitUpdater url' desiredRev False False submodules' rev Nothing + _ -> Nothing + +fetchTarballGithubUpdater :: Fetcher +fetchTarballGithubUpdater getComment = \case + [matchNixLoc| + ^fetcher { + url = ^url; # rev + sha256 = ^sha256; + }|] + | Just "fetchTarball" <- extractFuncName fetcher + , Right url' <- exprText url + , "https:" : "" : "github.com" : owner : repo : "archive" : _ <- splitOn + "/" + url' + , comment <- getComment url + , comment /= Just "pin" -- Fall back to the regular tarball updater if we've been instructed to not change this URL + -> Just $ do + let rev = Revision $ fromMaybe "HEAD" comment + repoUrl = "https://github.com/" <> owner <> "/" <> repo + pure . Updater $ do + revision <- getGitRevision repoUrl rev + let newUrl = repoUrl <> "/archive/" <> revision <> ".tar.gz" + let Updater u = tarballUpdater newUrl sha256 + date <- getGitHubRevisionDate owner repo (Revision revision) + (_, urlUpdate) <- u + pure (Just date, SpanUpdate (exprSpan url) (quoteString newUrl) : urlUpdate) + _ -> Nothing + +builtinsFetchTarballUpdater :: Fetcher +builtinsFetchTarballUpdater _ = \case + [matchNixLoc| + ^fetcher { + url = ^url; + sha256 = ^sha256; + }|] | Just "fetchTarball" <- extractFuncName fetcher + -> Just $ do + url' <- fromEither $ exprText url + pure $ tarballUpdater url' sha256 + _ -> Nothing + +fetchGitHubUpdater :: Fetcher +fetchGitHubUpdater getComment = \case + [matchNixLoc| + ^fetcher { + owner = ^owner; + repo = ^repo; + rev = ^rev; + sha256 = ^sha256; + _fetchSubmodules = ^fetchSubmodules; + }|] | Just fun <- extractFuncName fetcher >>= \case + "fetchFromGitHub" -> Just GitHub + "fetchFromGitLab" -> Just GitLab + _ -> Nothing + -> Just $ do + owner' <- fromEither $ exprText owner + repo' <- fromEither $ exprText repo + let desiredRev = commentToRequest (getComment rev) + fetchSubmodules' <- fmap (fromMaybe False) . fromEither . traverse exprBool $ fetchSubmodules + pure $ gitUpdater (fun owner' repo') desiredRev False False fetchSubmodules' rev (Just sha256) + _ -> Nothing + +-- | +-- @ +-- callHackageDirect = {pkg, ver, sha256}: +-- let pkgver = "${pkg}-${ver}"; +-- in self.callCabal2nix pkg (pkgs.fetchzip { +-- url = "mirror://hackage/${pkgver}/${pkgver}.tar.gz"; +-- inherit sha256; +-- }); +-- @ +hackageDirectUpdater :: Fetcher +hackageDirectUpdater _ = \case + [matchNixLoc| + ^fetcher { + pkg = ^pkg; + ver = ^ver; + sha256 = ^sha256; + } + |] | Just "callHackageDirect" <- extractFuncName fetcher + -> Just $ do + pkg' <- fromEither $ exprText pkg + ver' <- fromEither $ exprText ver + let pkgver = pkg' <> "-" <> ver' + url = "mirror://hackage/" <> pkgver <> "/" <> pkgver <> ".tar.gz" + pure $ tarballUpdater url sha256 + _ -> Nothing + +---------------------------------------------------------------- +-- Helpers +---------------------------------------------------------------- + +data RevisionRequest + = Pin + | DoNotPin Revision + +commentToRequest :: Maybe Text -> Maybe RevisionRequest +commentToRequest = \case + Nothing -> Nothing + Just "pin" -> Just Pin + Just r -> Just (DoNotPin (Revision r)) + +gitUpdater + :: RepoLocation + -- ^ Repo URL + -> Maybe RevisionRequest + -- ^ Desired revision + -> Bool + -- ^ Deep Clone + -> Bool + -- ^ Leave .git + -> Bool + -- ^ Fetch submodules + -> NExprLoc + -- ^ rev + -> Maybe NExprLoc + -- ^ sha256, not present for some fetchers + -> Updater +gitUpdater repoLocation revisionRequest deepClone leaveDotGit fetchSubmodules revExpr sha256Expr + = Updater $ do + let repoUrl = extractUrlString repoLocation + logVerbose $ "Updating " <> prettyRepoLocation repoLocation + revArgs <- case revisionRequest of + Nothing -> pure [] + Just req -> do + rev <- case req of + Pin -> fromEither (exprText revExpr) + DoNotPin r -> getGitFullName repoUrl r + pure ["--rev", rev] + let args = + revArgs + <> [ "--deepClone" | deepClone ] + <> [ "--leave-dotGit" | leaveDotGit ] + <> [ "--fetch-submodules" | fetchSubmodules ] + o <- nixPrefetchGit args repoUrl + d <- fromEither $ parseISO8601DateToDay (P.date o) + pure + ( Just d + , [ SpanUpdate (exprSpan e) (quoteString (P.sha256 o)) + | Just e <- pure sha256Expr + ] + <> [SpanUpdate (exprSpan revExpr) (quoteString $ P.rev o)] + ) + +tarballUpdater + :: Text + -- ^ URL + -> NExprLoc + -- ^ sha256 + -> Updater +tarballUpdater url sha256Expr = Updater $ do + logVerbose $ "Updating " <> url + sha256 <- nixPrefetchUrl [] url + pure (Nothing, [SpanUpdate (exprSpan sha256Expr) (quoteString sha256)]) diff --git a/src/Update/Span.hs b/src/Update/Span.hs --- a/src/Update/Span.hs +++ b/src/Update/Span.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -- | This module deals with updating spans of characters in values of type Text. -- diff --git a/tests/Driver.hs b/tests/Driver.hs new file mode 100644 --- /dev/null +++ b/tests/Driver.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF tasty-discover #-} diff --git a/tests/Samples.hs b/tests/Samples.hs new file mode 100644 --- /dev/null +++ b/tests/Samples.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Samples where + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Golden (goldenVsFile) +import System.FilePath (()) +import Data.Bool (bool) +import Data.Maybe (mapMaybe) + +import qualified Data.List +import qualified Data.Text +import qualified Data.Text.IO +import qualified System.Environment +import qualified System.FilePath +import qualified System.Directory +import qualified System.IO +import qualified System.IO.Temp +import qualified System.Process + +import qualified Update.Nix.FetchGit +import Update.Nix.FetchGit.Types (Env(Env)) +import Data.Text.IO (hPutStrLn) + +-- | Provided output file @f@ pointing to e.g. @tests/test_rec_sets.out.nix@ +-- * turn this into @tests/test_rec_sets.in.nix@ +-- * copy to temporary directory +-- * create fake git repositories using @tests/fakeRepo.sh@ +-- * adjust @url@ to point to the faked git repositories in the temporary directory +-- * perform update +-- * adjust @url@ to point to the expected one +-- * copy file back to @tests/test_rec_sets.out.nix@ so it be compared to @expected.nix@ +runTest f = + System.IO.Temp.withSystemTempDirectory "test-update-nix-fetchgit" $ \dir -> + System.IO.Temp.withSystemTempDirectory "test-update-nix-fetchgit-store" $ \storeDir -> do + let + inFile = Data.Text.unpack + $ Data.Text.replace ".out.nix" ".in.nix" + $ Data.Text.pack f + inBase = System.FilePath.takeBaseName inFile + + System.Directory.copyFile inFile (dir inBase) + + System.Directory.copyFile "tests/fakeRepo.sh" (dir "fakeRepo.sh") + + _ <- System.Process.readCreateProcess + ((System.Process.shell (dir "fakeRepo.sh")) { System.Process.cwd = Just dir }) + mempty + + replaceFile (dir inBase) "/tmp/nix-update-fetchgit-test" (Data.Text.pack dir) + + System.Environment.setEnv "NIX_STATE_DIR" $ storeDir "state" + System.Environment.setEnv "NIX_STORE_DIR" $ storeDir + + -- work around race condition https://github.com/NixOS/nix/issues/2706 + System.Directory.createDirectoryIfMissing True $ storeDir "state/gcroots" + + -- and another - error: SQLite database storeDir 'state/db/db.sqlite' is busy + _ <- System.Process.readCreateProcess + (System.Process.shell ("nix-store --init")) + mempty + + let env = Env (const (Data.Text.IO.hPutStrLn System.IO.stderr)) [] + Update.Nix.FetchGit.processFile env (dir inBase) + + replaceFile (dir inBase) (Data.Text.pack dir) "/tmp/nix-update-fetchgit-test" + + System.Directory.copyFile (dir inBase) f + where + replaceFile f what with = + Data.Text.IO.readFile f >>= Data.Text.IO.writeFile f . Data.Text.replace what with + +test_derivation :: IO TestTree +test_derivation = do + localSamples <- findSamples "tests" + networkedSamples <- findSamples "tests/networked" + samples <- inNixBuild >>= \case + False -> pure $ localSamples <> networkedSamples + True -> do + hPutStrLn System.IO.stderr "Skipping networked tests inside Nix build" + pure localSamples + pure $ testGroup "golden" $ map mk samples + where + mk n = + let tEx = (n ++ ".expected.nix") + tOut = (n ++ ".out.nix") + in goldenVsFile ("update of " ++ tOut) tEx tOut (runTest tOut) + +findSamples :: FilePath -> IO [String] +findSamples dir = + fmap (dir ) + . mapMaybe (dropSuffix ".in.nix") + <$> System.Directory.listDirectory dir + +dropSuffix :: String -> String -> Maybe String +dropSuffix s t = if s `Data.List.isSuffixOf` t + then Just $ take (length t - length s) t + else Nothing + +-- From https://github.com/input-output-hk/ouroboros-network +-- | Infer from environment variables whether we are running within a Nix build +-- (and not just a nix-shell). +inNixBuild :: IO Bool +inNixBuild = do + let testEnv = fmap (maybe False (not . null)) . System.Environment.lookupEnv + haveNixBuildDir <- testEnv "NIX_BUILD_TOP" + inNixShell <- testEnv "IN_NIX_SHELL" + pure (haveNixBuildDir && not inNixShell) diff --git a/tests/fakeRepo.sh b/tests/fakeRepo.sh new file mode 100644 --- /dev/null +++ b/tests/fakeRepo.sh @@ -0,0 +1,40 @@ +#!/bin/sh + +# Prepares git repositories on the local machine that we will use for +# testing. + +set -ex + +# Make sure the commit hashes are predictable. +export GIT_AUTHOR_DATE='1466974421 +0200' +export GIT_COMMITTER_DATE='1466974421 +0200' +export GIT_COMMITTER_NAME='joe' +export GIT_AUTHOR_NAME='joe' +export GIT_COMMITTER_EMAIL='joe@example.com' +export GIT_AUTHOR_EMAIL='joe@example.com' + +git init repo1 +cd repo1 + echo hi > test.txt + git add test.txt + git commit -m "initial commit" + echo 1.0.0 > test.txt + git commit -m "version 1.0.0" test.txt + git tag 1.0.0 + echo '1.0.0+stuff' > test.txt + git commit -m "added stuff" test.txt + # Create a branch with this name + git branch nixos-unstable +cd .. + +export GIT_AUTHOR_DATE='1468031426 -0700' +export GIT_COMMITTER_DATE='1468031426 -0700' +git init repo2 +cd repo2 + echo hi > test.txt + git add test.txt + git commit -m "initial commit" +cd .. + +echo hi > test.txt +tar czvf archive.tar.gz test.txt diff --git a/tests/networked/test_builtins_fetchtarball_github.expected.nix b/tests/networked/test_builtins_fetchtarball_github.expected.nix new file mode 100644 --- /dev/null +++ b/tests/networked/test_builtins_fetchtarball_github.expected.nix @@ -0,0 +1,17 @@ +{ + # Pinning a specific revision + # Hash will be updated + src1 = builtins.fetchTarball { + url = + "https://github.com/expipiplus1/update-nix-fetchgit/archive/4ac47efd681f530baca71f1d27d43c50ba19bb72.tar.gz"; # pin + sha256 = "1pr0r2vc0fnpk3fm17d4gnd659nkqnih1ik3bqarr3lykgg3pci6"; + }; + + # Updating URL to use a tag + # Hash will be updated + src2 = builtins.fetchTarball { + url = + "https://github.com/expipiplus1/update-nix-fetchgit/archive/0.1.0.0.tar.gz"; # 0.1.0.0 + sha256 = "0zhng69b6lr8dbdwrw09glbyavw7cfqvm3gb4xqxx973iajifmv7"; + }; +} diff --git a/tests/networked/test_builtins_fetchtarball_github.in.nix b/tests/networked/test_builtins_fetchtarball_github.in.nix new file mode 100644 --- /dev/null +++ b/tests/networked/test_builtins_fetchtarball_github.in.nix @@ -0,0 +1,17 @@ +{ + # Pinning a specific revision + # Hash will be updated + src1 = builtins.fetchTarball { + url = + "https://github.com/expipiplus1/update-nix-fetchgit/archive/4ac47efd681f530baca71f1d27d43c50ba19bb72.tar.gz"; # pin + sha256 = "123"; + }; + + # Updating URL to use a tag + # Hash will be updated + src2 = builtins.fetchTarball { + url = + "https://github.com/expipiplus1/update-nix-fetchgit/archive/gone.tar.gz"; # 0.1.0.0 + sha256 = "123"; + }; +} diff --git a/tests/networked/test_github_submodules.expected.nix b/tests/networked/test_github_submodules.expected.nix new file mode 100644 --- /dev/null +++ b/tests/networked/test_github_submodules.expected.nix @@ -0,0 +1,21 @@ +{ pkgs ? import { } }: + +with pkgs; + +let + regular = fetchFromGitHub { + owner = "expipiplus1"; + repo = "has-submodule"; + rev = "101c71e91ec95e0dcd724b0122cf55e52aee7361"; # a-tag + sha256 = "0km9m9krsi0pmx10qy1s5z0w4dp4h0v9xj2fgm255bdpdhm4rq55"; + }; + + submodules = fetchFromGitHub { + owner = "expipiplus1"; + repo = "has-submodule"; + rev = "101c71e91ec95e0dcd724b0122cf55e52aee7361"; # a-tag + sha256 = "1w386008njxfwnwm4xrb3fip5wmm3nwhrfl4mb96ahhj0mcg493g"; + fetchSubmodules = true; + }; + +in { inherit regular submodules;} diff --git a/tests/networked/test_github_submodules.in.nix b/tests/networked/test_github_submodules.in.nix new file mode 100644 --- /dev/null +++ b/tests/networked/test_github_submodules.in.nix @@ -0,0 +1,21 @@ +{ pkgs ? import { } }: + +with pkgs; + +let + regular = fetchFromGitHub { + owner = "expipiplus1"; + repo = "has-submodule"; + rev = "a-tag"; # a-tag + sha256 = ""; + }; + + submodules = fetchFromGitHub { + owner = "expipiplus1"; + repo = "has-submodule"; + rev = "a-tag"; # a-tag + sha256 = ""; + fetchSubmodules = true; + }; + +in { inherit regular submodules;} diff --git a/tests/networked/test_readme_examples.expected.nix b/tests/networked/test_readme_examples.expected.nix new file mode 100644 --- /dev/null +++ b/tests/networked/test_readme_examples.expected.nix @@ -0,0 +1,35 @@ +{ + a = { stdenv, fetchgit }: + stdenv.mkDerivation rec { + name = "foo-${version}"; + version = "2016-06-26"; + # ^ version will be updated to the date of the new revision + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + # ^ rev will be updated to the revision of HEAD + sha256 = "008xwkjfsv3rj50x9fqj0vvggl1zwrbqh7bkvnga94krmij63hib"; + # ^ sha256 will be updated to the correct hash + }; + }; + + b = { pkgs ? import (builtins.fetchTarball { + url = + "https://github.com/expipiplus1/update-nix-fetchgit/archive/0.1.0.0.tar.gz"; # 0.1.0.0 + # ^ 'foobar' will be replaced with the revision pointed to by 'refs/tags/0.1.0.0' + sha256 = "0zhng69b6lr8dbdwrw09glbyavw7cfqvm3gb4xqxx973iajifmv7"; + # ^ sha256 will be updated to the correct hash + }) { } }: + myExpression; + + c = { + upfind = import (pkgs.fetchFromGitHub { + owner = "expipiplus1"; + repo = "upfind"; + rev = "cb451254f5b112f839aa36e5b6fd83b60cf9b9ae"; # pin + # ^ This will not change because of the '# pin' comment + sha256 = "15g5nvs6azgb2fkdna1dxbyiabx9n63if0wcbdvs91hjafhzjaqa"; + # ^ This will be updated + }) { }; + }; +} diff --git a/tests/networked/test_readme_examples.in.nix b/tests/networked/test_readme_examples.in.nix new file mode 100644 --- /dev/null +++ b/tests/networked/test_readme_examples.in.nix @@ -0,0 +1,35 @@ +{ + a = { stdenv, fetchgit }: + stdenv.mkDerivation rec { + name = "foo-${version}"; + version = "2016-07-13"; + # ^ version will be updated to the date of the new revision + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "4f56fd184ef6020626492a6f954a486d54f8b7ba"; + # ^ rev will be updated to the revision of HEAD + sha256 = "0nmyp5yrzl9dbq85wyiimsj9fklb8637a1936nw7zzvlnzkgh28n"; + # ^ sha256 will be updated to the correct hash + }; + }; + + b = { pkgs ? import (builtins.fetchTarball { + url = + "https://github.com/expipiplus1/update-nix-fetchgit/archive/foobar.tar.gz"; # 0.1.0.0 + # ^ 'foobar' will be replaced with the revision pointed to by 'refs/tags/0.1.0.0' + sha256 = ""; + # ^ sha256 will be updated to the correct hash + }) { } }: + myExpression; + + c = { + upfind = import (pkgs.fetchFromGitHub { + owner = "expipiplus1"; + repo = "upfind"; + rev = "cb451254f5b112f839aa36e5b6fd83b60cf9b9ae"; # pin + # ^ This will not change because of the '# pin' comment + sha256 = _; + # ^ This will be updated + }) { }; + }; +} diff --git a/tests/test_builtins_fetchgit.expected.nix b/tests/test_builtins_fetchgit.expected.nix new file mode 100644 --- /dev/null +++ b/tests/test_builtins_fetchgit.expected.nix @@ -0,0 +1,6 @@ +{ + src = builtins.fetchGit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + }; +} diff --git a/tests/test_builtins_fetchgit.in.nix b/tests/test_builtins_fetchgit.in.nix new file mode 100644 --- /dev/null +++ b/tests/test_builtins_fetchgit.in.nix @@ -0,0 +1,6 @@ +{ + src = builtins.fetchGit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + }; +} diff --git a/tests/test_builtins_fetchgit_update_ignores_sha256.expected.nix b/tests/test_builtins_fetchgit_update_ignores_sha256.expected.nix new file mode 100644 --- /dev/null +++ b/tests/test_builtins_fetchgit_update_ignores_sha256.expected.nix @@ -0,0 +1,10 @@ +{ + src = builtins.fetchGit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + # this is an invalid definition since fetchGit doesn't take a sha256 + # parameter, but the point of this test is to make sure the fields gets + # ignored regardless. + sha256 = "IGNORED"; + }; +} diff --git a/tests/test_builtins_fetchgit_update_ignores_sha256.in.nix b/tests/test_builtins_fetchgit_update_ignores_sha256.in.nix new file mode 100644 --- /dev/null +++ b/tests/test_builtins_fetchgit_update_ignores_sha256.in.nix @@ -0,0 +1,10 @@ +{ + src = builtins.fetchGit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + # this is an invalid definition since fetchGit doesn't take a sha256 + # parameter, but the point of this test is to make sure the fields gets + # ignored regardless. + sha256 = "IGNORED"; + }; +} diff --git a/tests/test_builtins_fetchtarball.expected.nix b/tests/test_builtins_fetchtarball.expected.nix new file mode 100644 --- /dev/null +++ b/tests/test_builtins_fetchtarball.expected.nix @@ -0,0 +1,6 @@ +{ + src = builtins.fetchTarball { + url = "file:///tmp/nix-update-fetchgit-test/archive.tar.gz"; + sha256 = "1xmr8jicvzszfzpz46g37mlpvbzjl2wpwvl2b05psipssyp1sm8h"; + }; +} diff --git a/tests/test_builtins_fetchtarball.in.nix b/tests/test_builtins_fetchtarball.in.nix new file mode 100644 --- /dev/null +++ b/tests/test_builtins_fetchtarball.in.nix @@ -0,0 +1,6 @@ +{ + src = builtins.fetchTarball { + url = "file:///tmp/nix-update-fetchgit-test/archive.tar.gz"; + sha256 = "123"; + }; +} diff --git a/tests/test_dotgit.expected.nix b/tests/test_dotgit.expected.nix new file mode 100644 --- /dev/null +++ b/tests/test_dotgit.expected.nix @@ -0,0 +1,25 @@ +{ pkgs ? import { } }: + +with pkgs; + +{ + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + sha256 = "008xwkjfsv3rj50x9fqj0vvggl1zwrbqh7bkvnga94krmij63hib"; + }; + + srcDotGit = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + sha256 = "1ywf4ysn3fcr4dw24idz48i36ghvxbvi72icglp4nqhdj2s6bzj1"; + leaveDotGit = true; + }; + + srcDeep = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + sha256 = "0xnazgn7p7xspda2wsfk1v1xrw9z5vvban0nhwd7xd3f70223gzz"; + deepClone = true; + }; +} diff --git a/tests/test_dotgit.in.nix b/tests/test_dotgit.in.nix new file mode 100644 --- /dev/null +++ b/tests/test_dotgit.in.nix @@ -0,0 +1,25 @@ +{ pkgs ? import { } }: + +with pkgs; + +{ + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + sha256 = "beef"; + }; + + srcDotGit = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + sha256 = "beef"; + leaveDotGit = true; + }; + + srcDeep = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + sha256 = "beef"; + deepClone = true; + }; +} diff --git a/tests/test_max_version.expected.nix b/tests/test_max_version.expected.nix new file mode 100644 --- /dev/null +++ b/tests/test_max_version.expected.nix @@ -0,0 +1,22 @@ +{ + version = "2016-07-08"; + repos = { + version = "2016-07-08"; + repo1 = { + version = "2016-06-26"; + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + sha256 = "008xwkjfsv3rj50x9fqj0vvggl1zwrbqh7bkvnga94krmij63hib"; + }; + }; + repo2 = { + version = "2016-07-08"; + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo2"; + rev = "1ac598e1fd0ec3556f1349bb5fd8d08d89580c8a"; + sha256 = "0fbv29f0qi6kjvjd9ancw80qhvj4ylv8jmr726mj001q4vacjs18"; + }; + }; + }; +} diff --git a/tests/test_max_version.in.nix b/tests/test_max_version.in.nix new file mode 100644 --- /dev/null +++ b/tests/test_max_version.in.nix @@ -0,0 +1,22 @@ +{ + version = "2016-01-01"; + repos = { + version = "2016-01-01"; + repo1 = { + version = "2016-01-01"; + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + sha256 = "beef"; + }; + }; + repo2 = { + version = "2016-01-01"; + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo2"; + rev = "456"; + sha256 = "feeb"; + }; + }; + }; +} diff --git a/tests/test_rec_sets.expected.nix b/tests/test_rec_sets.expected.nix new file mode 100644 --- /dev/null +++ b/tests/test_rec_sets.expected.nix @@ -0,0 +1,9 @@ +rec { + name = "foobar-${version}"; + version = "2016-06-26"; + src = fetchgit rec { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + sha256 = "008xwkjfsv3rj50x9fqj0vvggl1zwrbqh7bkvnga94krmij63hib"; + }; +} diff --git a/tests/test_rec_sets.in.nix b/tests/test_rec_sets.in.nix new file mode 100644 --- /dev/null +++ b/tests/test_rec_sets.in.nix @@ -0,0 +1,9 @@ +rec { + name = "foobar-${version}"; + version = "2016-01-01"; + src = fetchgit rec { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + sha256 = "beef"; + }; +} diff --git a/tests/test_scoped.expected.nix b/tests/test_scoped.expected.nix new file mode 100644 --- /dev/null +++ b/tests/test_scoped.expected.nix @@ -0,0 +1,12 @@ +{ + src = pkgs.fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + sha256 = "008xwkjfsv3rj50x9fqj0vvggl1zwrbqh7bkvnga94krmij63hib"; + }; + src = foo.bar.pkgs.fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + sha256 = "008xwkjfsv3rj50x9fqj0vvggl1zwrbqh7bkvnga94krmij63hib"; + }; +} diff --git a/tests/test_scoped.in.nix b/tests/test_scoped.in.nix new file mode 100644 --- /dev/null +++ b/tests/test_scoped.in.nix @@ -0,0 +1,12 @@ +{ + src = pkgs.fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + sha256 = "beef"; + }; + src = foo.bar.pkgs.fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + sha256 = "beef"; + }; +} diff --git a/tests/test_simple_update.expected.nix b/tests/test_simple_update.expected.nix new file mode 100644 --- /dev/null +++ b/tests/test_simple_update.expected.nix @@ -0,0 +1,7 @@ +{ + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + sha256 = "008xwkjfsv3rj50x9fqj0vvggl1zwrbqh7bkvnga94krmij63hib"; + }; +} diff --git a/tests/test_simple_update.in.nix b/tests/test_simple_update.in.nix new file mode 100644 --- /dev/null +++ b/tests/test_simple_update.in.nix @@ -0,0 +1,7 @@ +{ + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + sha256 = "beef"; + }; +} diff --git a/tests/test_updates_with_other_errors.expected.nix b/tests/test_updates_with_other_errors.expected.nix new file mode 100644 --- /dev/null +++ b/tests/test_updates_with_other_errors.expected.nix @@ -0,0 +1,15 @@ +{ + version = "2016-06-26"; + + should-error = fetchgit rec { + url = "/tmp/nix-update-fetchgit-test/missingRepo"; + rev = "123"; + sha256 = "beef"; + }; + + should-update = fetchgit rec { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + sha256 = "008xwkjfsv3rj50x9fqj0vvggl1zwrbqh7bkvnga94krmij63hib"; + }; +} diff --git a/tests/test_updates_with_other_errors.in.nix b/tests/test_updates_with_other_errors.in.nix new file mode 100644 --- /dev/null +++ b/tests/test_updates_with_other_errors.in.nix @@ -0,0 +1,15 @@ +{ + version = _; + + should-error = fetchgit rec { + url = "/tmp/nix-update-fetchgit-test/missingRepo"; + rev = "123"; + sha256 = "beef"; + }; + + should-update = fetchgit rec { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + sha256 = "beef"; + }; +} diff --git a/tests/test_version_update.expected.nix b/tests/test_version_update.expected.nix new file mode 100644 --- /dev/null +++ b/tests/test_version_update.expected.nix @@ -0,0 +1,8 @@ +{ + version = "2016-06-26"; + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "1c60ae07b5740aab02e32b4f64600f002112e6fd"; + sha256 = "008xwkjfsv3rj50x9fqj0vvggl1zwrbqh7bkvnga94krmij63hib"; + }; +} diff --git a/tests/test_version_update.in.nix b/tests/test_version_update.in.nix new file mode 100644 --- /dev/null +++ b/tests/test_version_update.in.nix @@ -0,0 +1,8 @@ +{ + version = "2016-01-01"; + src = fetchgit { + url = "/tmp/nix-update-fetchgit-test/repo1"; + rev = "123"; + sha256 = "beef"; + }; +} diff --git a/update-nix-fetchgit.cabal b/update-nix-fetchgit.cabal --- a/update-nix-fetchgit.cabal +++ b/update-nix-fetchgit.cabal @@ -1,55 +1,135 @@ -name: update-nix-fetchgit -version: 0.1.2.0 -synopsis: A program to update fetchgit values in Nix expressions -description: This command-line utility is meant to be used by people maintaining Nix expressions that fetch files from Git repositories. - It automates the process of keeping such expressions up-to-date with the latest upstream sources. -homepage: https://github.com/expipiplus1/update-nix-fetchgit#readme -license: BSD3 -license-file: LICENSE -author: Joe Hermaszewski -maintainer: haskell@monoid.al -copyright: 2015 Joe Hermaszewski -category: Nix -build-type: Simple -cabal-version: >=1.10 +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.2. +-- +-- see: https://github.com/sol/hpack + +name: update-nix-fetchgit +version: 0.2.2 +synopsis: A program to update fetchgit values in Nix expressions +description: This command-line utility is meant to be used by people maintaining Nix + expressions that fetch files from Git repositories. It automates the process + of keeping such expressions up-to-date with the latest upstream sources. +homepage: https://github.com/expipiplus1/update-nix-fetchgit#readme +bug-reports: https://github.com/expipiplus1/update-nix-fetchgit/issues +author: Joe Hermaszewski +maintainer: Joe Hermaszewski +copyright: 2020 Joe Hermaszewski +license: BSD3 +license-file: LICENSE +build-type: Simple extra-source-files: - CHANGELOG.md - LICENSE - README.md + package.yaml + .gitignore + default.nix + CHANGELOG.md + LICENSE + README.md + tests/fakeRepo.sh + tests/test_builtins_fetchgit.in.nix + tests/test_builtins_fetchgit_update_ignores_sha256.in.nix + tests/test_builtins_fetchtarball.in.nix + tests/test_dotgit.in.nix + tests/test_max_version.in.nix + tests/test_rec_sets.in.nix + tests/test_scoped.in.nix + tests/test_simple_update.in.nix + tests/test_updates_with_other_errors.in.nix + tests/test_version_update.in.nix + tests/test_builtins_fetchgit.expected.nix + tests/test_builtins_fetchgit_update_ignores_sha256.expected.nix + tests/test_builtins_fetchtarball.expected.nix + tests/test_dotgit.expected.nix + tests/test_max_version.expected.nix + tests/test_rec_sets.expected.nix + tests/test_scoped.expected.nix + tests/test_simple_update.expected.nix + tests/test_updates_with_other_errors.expected.nix + tests/test_version_update.expected.nix + tests/networked/test_builtins_fetchtarball_github.in.nix + tests/networked/test_github_submodules.in.nix + tests/networked/test_readme_examples.in.nix + tests/networked/test_builtins_fetchtarball_github.expected.nix + tests/networked/test_github_submodules.expected.nix + tests/networked/test_readme_examples.expected.nix +source-repository head + type: git + location: https://github.com/expipiplus1/update-nix-fetchgit + library - hs-source-dirs: src - exposed-modules: Update.Nix.FetchGit - , Update.Span - , Update.Nix.FetchGit.Prefetch - , Update.Nix.FetchGit.Warning - , Update.Nix.FetchGit.Utils - other-modules: Update.Nix.FetchGit.Types - build-depends: base >= 4.7 && < 5 - , aeson >= 0.9 - , async >= 2.1 - , bytestring >= 0.10 - , errors >= 2.1 - , hnix >= 0.8 - , prettyprinter - , process >= 1.2 - , text >= 1.2 - , time >= 1.5 - , transformers >= 0.4 - , uniplate >= 1.6 - , utf8-string >= 1.0 - default-language: Haskell2010 + exposed-modules: + Nix.Comments + Nix.Match + Nix.Match.Typed + Update.Nix.FetchGit + Update.Nix.FetchGit.Prefetch + Update.Nix.FetchGit.Types + Update.Nix.FetchGit.Utils + Update.Nix.FetchGit.Warning + Update.Nix.Updater + Update.Span + other-modules: + Paths_update_nix_fetchgit + hs-source-dirs: + src + default-extensions: DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances GADTs LambdaCase MultiParamTypeClasses OverloadedStrings PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskellQuotes TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns ghc-options: -Wall + build-depends: + aeson >=0.9 + , async >=2.1 + , base >=4.7 && <5 + , bytestring >=0.10 + , data-fix + , github-rest + , hnix >=0.11 + , monad-validate + , mtl + , process >=1.2 + , syb + , template-haskell + , text >=1.2 + , time >=1.5 + , utf8-string >=1.0 + , vector + default-language: Haskell2010 executable update-nix-fetchgit - hs-source-dirs: app - main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall - build-depends: base - , text >= 1.2 - , update-nix-fetchgit - default-language: Haskell2010 + main-is: Main.hs + other-modules: + Paths_update_nix_fetchgit + hs-source-dirs: + app + default-extensions: DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances GADTs LambdaCase MultiParamTypeClasses OverloadedStrings PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskellQuotes TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + base + , optparse-applicative + , optparse-generic >=1.4.2 + , say + , text >=1.2 + , update-nix-fetchgit + default-language: Haskell2010 -source-repository head - type: git - location: https://github.com/expipiplus1/update-nix-fetchgit +test-suite update-nix-fetchgit-samples + type: exitcode-stdio-1.0 + main-is: Driver.hs + other-modules: + Samples + Paths_update_nix_fetchgit + hs-source-dirs: + tests + default-extensions: DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances GADTs LambdaCase MultiParamTypeClasses OverloadedStrings PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskellQuotes TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns + ghc-options: -Wall + build-depends: + base >=4.7 && <5 + , directory + , filepath + , process + , tasty + , tasty-discover + , tasty-golden >=2.3 + , temporary + , text + , update-nix-fetchgit + default-language: Haskell2010