diff --git a/LICENSE b/LICENSE deleted file mode 100644 --- a/LICENSE +++ /dev/null @@ -1,7 +0,0 @@ -Copyright 2019 Nicolas Mattia - -Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,14 +1,14 @@ # niv [![Test](https://github.com/nmattia/niv/actions/workflows/test.yml/badge.svg)](https://github.com/nmattia/niv/actions/workflows/test.yml) -[![Netlify Status](https://api.netlify.com/api/v1/badges/48532eaa-259f-4ca2-aadf-67f7c6b957fd/deploy-status)](https://niv.nmattia.com) -Painless dependencies for [Nix] projects. Read more in the [Getting started](#getting-started) section below. +Track and pin any external dependency in your Nix project (Nix or not).

- +

+Track and pin any external dependency in your Nix project, Nix or not. * [Install](#install) * [Build](#build) @@ -23,12 +23,12 @@ $ nix-env -iA nixpkgs.niv ``` -Alternatively, run the following command to install the development version: +Alternatively, you can run the development version with this command: ``` bash -$ nix-env -iA niv -f https://github.com/nmattia/niv/tarball/master \ - --substituters https://niv.cachix.org \ - --trusted-public-keys niv.cachix.org-1:X32PCg2e/zAm3/uD1ScqW2z/K0LtDyNV7RdaxIuLgQM= +$ nix run github:nmattia/niv#niv \ + --substituters https://niv.cachix.org --trusted-public-keys niv.cachix.org-1:X32PCg2e/zAm3/uD1ScqW2z/K0LtDyNV7RdaxIuLgQM= \ + -- --help ``` ## Build @@ -81,7 +81,7 @@ ### Getting started -Nix is a very powerful tool for building code and setting up environments. `niv` complements it by making it easy to describe and update remote dependencies (URLs, GitHub repos, etc). It is a simple, practical alternative to [Nix flakes](https://nixos.wiki/wiki/Flakes). +Nix is a very powerful tool for building code and setting up environments. `niv` complements it by making it easy to describe and update remote dependencies (URLs, GitHub repos, etc). It is a simple, practical alternative to [Nix flakes](https://wiki.nixos.org/wiki/Flakes). This section covers common use cases: @@ -113,15 +113,15 @@ ``` json { "nixpkgs": { - "branch": "release-21.05", + "branch": "nixos-unstable", "description": "Nix Packages collection", - "homepage": "", + "homepage": null, "owner": "NixOS", "repo": "nixpkgs", - "rev": "5f244caea76105b63d826911b2a1563d33ff1cdc", - "sha256": "1xlgynfw9svy7nvh9nkxsxdzncv9hg99gbvbwv3gmrhmzc3sar75", + "rev": "6c43a3495a11e261e5f41e5d7eda2d71dae1b2fe", + "sha256": "16f329z831bq7l3wn1dfvbkh95l2gcggdwn6rk3cisdmv2aa3189", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/5f244caea76105b63d826911b2a1563d33ff1cdc.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/6c43a3495a11e261e5f41e5d7eda2d71dae1b2fe.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } } @@ -142,7 +142,7 @@ The `init` command sets the `nix/sources.json` to the content of the file [data/nixpkgs.json](data/nixpkgs.json). Currently, you would be tracking the -`release-21.05` branch. +`nixos-unstable` branch. Run the following command to update it to the last commit of the configured branch: @@ -212,7 +212,7 @@ ``` niv - dependency manager for Nix projects -version: 0.2.22 +version: 0.3.0 Usage: niv [-s|--sources-file FILE] [--no-colors] COMMAND @@ -225,12 +225,14 @@ Available commands: init Initialize a Nix project. Existing files won't be modified. - add Add a GitHub dependency + add Add a package show update Update dependencies + rename Rename a package modify Modify dependency attributes without performing an update drop Drop dependency + version Print version ``` #### Add @@ -238,73 +240,82 @@ ``` Examples: - niv add stedolan/jq - niv add NixOS/nixpkgs -n nixpkgs -b nixpkgs-unstable - niv add my-package -v alpha-0.1 -t http://example.com/archive/.zip + niv add stedolan/jq # add a GitHub repo + niv add NixOS/nixpkgs -b nixpkgs-unstable # use non-default branch + niv add neovim/neovim --name vim # override inferred name + niv add https://gcc.gnu.org/git/gcc.git # add an arbitrary Git repo -Usage: niv add PACKAGE [-n|--name NAME] - [(-a|--attribute KEY=VAL) | (-s|--string-attribute KEY=VAL) | - (-b|--branch BRANCH) | (-o|--owner OWNER) | (-r|--rev REV) | - (-v|--version VERSION) | (-t|--template URL) | - (-T|--type TYPE)] +Usage: niv add PACKAGE [-n|--name NAME] [ATTRIBUTES] - Add a GitHub dependency + Add a package -Available options: - -n,--name NAME Set the package name to +ATTRIBUTES -a,--attribute KEY=VAL Set the package spec attribute to , where may be JSON. -s,--string-attribute KEY=VAL Set the package spec attribute to . - -b,--branch BRANCH Equivalent to --attribute branch= - -o,--owner OWNER Equivalent to --attribute owner= - -r,--rev REV Equivalent to --attribute rev= - -v,--version VERSION Equivalent to --attribute version= + -o,--owner OWNER Set the repository owner (for github) + --repo REPO Set the repository name (for github) + -b,--branch BRANCH Set the branch (for git/github) + -r,--rev REV Set the revision/commit (for git/github) + -v,--version VERSION Set the version -t,--template URL Used during 'update' when building URL. Occurrences of are replaced with attribute 'foo'. -T,--type TYPE The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL. - -h,--help Show this help text -Experimental commands: - git Add a git dependency. Experimental. - github Add a GitHub dependency - local Add a local dependency. Experimental. +Available options: + -h,--help Show this help text ``` #### Update ``` Examples: - + niv update # update all packages niv update nixpkgs # update nixpkgs niv update my-package -v beta-0.2 # update my-package to version "beta-0.2" -Usage: niv update [PACKAGE - [(-a|--attribute KEY=VAL) | - (-s|--string-attribute KEY=VAL) | (-b|--branch BRANCH) | - (-o|--owner OWNER) | (-r|--rev REV) | - (-v|--version VERSION) | (-t|--template URL) | - (-T|--type TYPE)]] +Usage: niv update [PACKAGE] [ATTRIBUTES] Update dependencies Available options: + PACKAGE Matches a single package by exact name; otherwise + matches all packages names starting with this prefix. + -h,--help Show this help text + +ATTRIBUTES -a,--attribute KEY=VAL Set the package spec attribute to , where may be JSON. -s,--string-attribute KEY=VAL Set the package spec attribute to . - -b,--branch BRANCH Equivalent to --attribute branch= - -o,--owner OWNER Equivalent to --attribute owner= - -r,--rev REV Equivalent to --attribute rev= - -v,--version VERSION Equivalent to --attribute version= + -o,--owner OWNER Set the repository owner (for github) + --repo REPO Set the repository name (for github) + -b,--branch BRANCH Set the branch (for git/github) + -r,--rev REV Set the revision/commit (for git/github) + -v,--version VERSION Set the version -t,--template URL Used during 'update' when building URL. Occurrences of are replaced with attribute 'foo'. -T,--type TYPE The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL. +``` + +#### Rename + +``` +Examples: + + niv rename nixpkgs nixpkgs-unstable + +Usage: niv rename OLD NEW + + Rename a package + +Available options: -h,--help Show this help text ``` @@ -316,29 +327,27 @@ niv modify nixpkgs -v beta-0.2 niv modify nixpkgs -a branch=nixpkgs-unstable -Usage: niv modify PACKAGE [-n|--name NAME] - [(-a|--attribute KEY=VAL) | (-s|--string-attribute KEY=VAL) | - (-b|--branch BRANCH) | (-o|--owner OWNER) | (-r|--rev REV) | - (-v|--version VERSION) | (-t|--template URL) | - (-T|--type TYPE)] +Usage: niv modify PACKAGE ATTRIBUTES Modify dependency attributes without performing an update -Available options: - -n,--name NAME Set the package name to +ATTRIBUTES -a,--attribute KEY=VAL Set the package spec attribute to , where may be JSON. -s,--string-attribute KEY=VAL Set the package spec attribute to . - -b,--branch BRANCH Equivalent to --attribute branch= - -o,--owner OWNER Equivalent to --attribute owner= - -r,--rev REV Equivalent to --attribute rev= - -v,--version VERSION Equivalent to --attribute version= + -o,--owner OWNER Set the repository owner (for github) + --repo REPO Set the repository name (for github) + -b,--branch BRANCH Set the branch (for git/github) + -r,--rev REV Set the revision/commit (for git/github) + -v,--version VERSION Set the version -t,--template URL Used during 'update' when building URL. Occurrences of are replaced with attribute 'foo'. -T,--type TYPE The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL. + +Available options: -h,--help Show this help text ``` @@ -384,6 +393,8 @@ Usage: niv show [PACKAGE] Available options: + PACKAGE Matches a single package by exact name; otherwise + matches all packages names starting with this prefix. -h,--help Show this help text ``` @@ -399,6 +410,7 @@ * [How do I import a subpath of a source?](#how-do-i-import-a-subpath-of-a-source) * [How do I import NixOS modules](#how-do-i-import-nixos-modules) * [Can I use local packages?](#can-i-use-local-packages) +* [Can I use git submodules?](#can-i-use-git-submodules) ### Can I use private GitHub repositories? @@ -542,3 +554,25 @@ characters in the source name are escaped to the character `_`; i.e. to override the package `my package-foo` you need to set the environment variable `NIV_OVERRIDE_my_package_foo`. + +### Can I use a git dependency with submodules? + +Yes, however you need to follow some steps. + +Add your dependency as git dependency to your `sources.json`: +``` +niv add git git@github.com:user/repo -n name +``` + +Add `"submodules": true,` to your dependecy in the source.json: +``` +{ + "name": { + "branch": "main", + "repo": "git@github.com:user/repo", + "rev": "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX", + "submodules": true, + "type": "git" + } +} +``` diff --git a/app/Niv.hs b/app/Niv.hs --- a/app/Niv.hs +++ b/app/Niv.hs @@ -1,6 +1,7 @@ -module Niv where +module Main where import Niv.Cli +import System.Environment (getArgs) main :: IO () -main = Niv.Cli.cli +main = getArgs >>= Niv.Cli.cli diff --git a/app/NivTest.hs b/app/NivTest.hs --- a/app/NivTest.hs +++ b/app/NivTest.hs @@ -1,4 +1,4 @@ -module NivTest where +module Main where import Niv.Test diff --git a/niv.cabal b/niv.cabal --- a/niv.cabal +++ b/niv.cabal @@ -1,29 +1,24 @@ -cabal-version: 1.12 - --- This file has been generated from package.yaml by hpack version 0.35.2. --- --- see: https://github.com/sol/hpack +cabal-version: 2.2 -name: niv -version: 0.2.22 -synopsis: Easy dependency management for Nix projects -description: Easy dependency management for Nix projects. -category: Development -homepage: https://github.com/nmattia/niv#readme -bug-reports: https://github.com/nmattia/niv/issues -author: Nicolas Mattia -maintainer: Nicolas Mattia -copyright: (c) 2019 Nicolas Mattia -license: MIT -license-file: LICENSE -build-type: Simple -extra-source-files: - README.md +name: niv +version: 0.3.0 +synopsis: Easy dependency management for Nix projects +description: Easy dependency management for Nix projects. +category: Development +homepage: https://github.com/nmattia/niv#readme +bug-reports: https://github.com/nmattia/niv/issues +author: Nicolas Mattia +maintainer: Nicolas Mattia +copyright: (c) 2019 Nicolas Mattia +license: MIT +build-type: Simple data-files: nix/sources.nix +extra-source-files: + README.md source-repository head - type: git + type: git location: https://github.com/nmattia/niv library @@ -31,6 +26,7 @@ Data.Aeson.Extended Data.HashMap.Strict.Extended Data.Text.Extended + Niv.Cli Niv.Cmd Niv.Git.Cmd @@ -46,13 +42,17 @@ Niv.Test Niv.Update Niv.Update.Test + other-modules: Paths_niv + autogen-modules: + Paths_niv hs-source-dirs: src - ghc-options: -Wall -optP-Wno-nonportable-include-path + ghc-options: + -Wall build-depends: - aeson + aeson >=2 , aeson-pretty , ansi-terminal , base <5 @@ -63,7 +63,7 @@ , hashable , http-conduit , mtl - , optparse-applicative + , optparse-applicative >= 0.19.0.0 , process , profunctors , pureMD5 @@ -76,65 +76,22 @@ default-language: Haskell2010 executable niv - main-is: Niv.hs - other-modules: - NivTest - Paths_niv - hs-source-dirs: - app - ghc-options: -Wall -optP-Wno-nonportable-include-path -main-is Niv.main - build-depends: - aeson >=2 - , aeson-pretty - , ansi-terminal - , base <5 - , bytestring - , directory - , file-embed - , filepath - , hashable - , http-conduit - , mtl - , niv - , optparse-applicative - , process - , profunctors - , pureMD5 - , string-qq - , text - , unliftio - , unordered-containers - default-language: Haskell2010 + main-is: app/Niv.hs + build-depends: + base <5 + , niv + ghc-options: + -Wall + default-language: Haskell2010 test-suite unit - type: exitcode-stdio-1.0 - main-is: NivTest.hs - other-modules: - Niv - Paths_niv - hs-source-dirs: - app - ghc-options: -Wall -optP-Wno-nonportable-include-path -main-is NivTest.main - build-depends: - aeson >=2 - , aeson-pretty - , ansi-terminal - , base <5 - , bytestring - , directory - , file-embed - , filepath - , hashable - , http-conduit - , mtl - , niv - , optparse-applicative - , process - , profunctors - , pureMD5 - , string-qq - , tasty - , text - , unliftio - , unordered-containers - default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: app/NivTest.hs + build-depends: + base <5 + , niv + , tasty + , tasty-hunit + default-language: Haskell2010 + ghc-options: + -Wall diff --git a/nix/sources.nix b/nix/sources.nix --- a/nix/sources.nix +++ b/nix/sources.nix @@ -186,7 +186,7 @@ , sources ? if sourcesFile == null then { } else builtins.fromJSON (builtins.readFile sourcesFile) , system ? builtins.currentSystem , pkgs ? mkPkgs sources system - }: rec { + }: { # The sources, i.e. the attribute set of spec name to spec inherit sources; diff --git a/src/Data/Text/Extended.hs b/src/Data/Text/Extended.hs --- a/src/Data/Text/Extended.hs +++ b/src/Data/Text/Extended.hs @@ -3,15 +3,6 @@ module Data.Text.Extended where import qualified Data.Text as T -import Niv.Logger -import System.Exit (exitFailure) -import UnliftIO -tshow :: Show a => a -> T.Text +tshow :: (Show a) => a -> T.Text tshow = T.pack . show - --- not quite the perfect place for this -abort :: MonadIO io => T.Text -> io a -abort msg = do - tsay $ T.unwords [tbold $ tred "FATAL:", msg] - liftIO exitFailure diff --git a/src/Niv/Cli.hs b/src/Niv/Cli.hs --- a/src/Niv/Cli.hs +++ b/src/Niv/Cli.hs @@ -17,677 +17,932 @@ import qualified Data.Aeson.KeyMap as KM import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 -import Data.Char (isSpace) -import qualified Data.HashMap.Strict as HMS -import Data.HashMap.Strict.Extended -import Data.Hashable (Hashable) -import qualified Data.Text as T -import Data.Text.Extended -import Data.Version (showVersion) -import qualified Network.HTTP.Simple as HTTP -import Niv.Cmd -import Niv.Git.Cmd -import Niv.GitHub.Cmd -import Niv.Local.Cmd -import Niv.Logger -import Niv.Sources -import Niv.Update -import qualified Options.Applicative as Opts -import qualified Options.Applicative.Help.Pretty as Opts --- I died a little -import Paths_niv (version) -import qualified System.Directory as Dir -import System.Environment (getArgs) -import System.FilePath (takeDirectory) -import UnliftIO - -newtype NIO a = NIO {runNIO :: ReaderT FindSourcesJson IO a} - deriving (Functor, Applicative, Monad, MonadIO, MonadReader FindSourcesJson) - -instance MonadUnliftIO NIO where - withRunInIO = wrappedWithRunInIO NIO runNIO - -getFindSourcesJson :: NIO FindSourcesJson -getFindSourcesJson = ask - -li :: MonadIO io => IO a -> io a -li = liftIO - -cli :: IO () -cli = do - ((fsj, colors), nio) <- - execParserPure' Opts.defaultPrefs opts <$> getArgs - >>= Opts.handleParseResult - setColors colors - runReaderT (runNIO nio) fsj - where - execParserPure' pprefs pinfo [] = - Opts.Failure $ - Opts.parserFailure pprefs pinfo (Opts.ShowHelpText Nothing) mempty - execParserPure' pprefs pinfo args = Opts.execParserPure pprefs pinfo args - opts = Opts.info ((,) <$> ((,) <$> parseFindSourcesJson <*> parseColors) <*> (parseCommand <**> Opts.helper <**> versionflag)) $ mconcat desc - desc = - [ Opts.fullDesc, - Opts.headerDoc $ - Just $ - "niv - dependency manager for Nix projects" - Opts.<$$> "" - Opts.<$$> "version:" Opts.<+> Opts.text (showVersion version) - ] - parseFindSourcesJson = - AtPath - <$> Opts.strOption - ( Opts.long "sources-file" - <> Opts.short 's' - <> Opts.metavar "FILE" - <> Opts.help "Use FILE instead of nix/sources.json" - ) - <|> pure Auto - parseColors = - (\case True -> Never; False -> Always) - <$> Opts.switch - ( Opts.long "no-colors" - <> Opts.help "Don't use colors in output" - ) - versionflag :: Opts.Parser (a -> a) - versionflag = - Opts.abortOption (Opts.InfoMsg (showVersion version)) $ - mconcat - [Opts.long "version", Opts.hidden, Opts.help "Print version"] - -parseCommand :: Opts.Parser (NIO ()) -parseCommand = - Opts.subparser - ( Opts.command "init" parseCmdInit - <> Opts.command "add" parseCmdAdd - <> Opts.command "show" parseCmdShow - <> Opts.command "update" parseCmdUpdate - <> Opts.command "modify" parseCmdModify - <> Opts.command "drop" parseCmdDrop - ) - -parsePackageName :: Opts.Parser PackageName -parsePackageName = - PackageName - <$> Opts.argument Opts.str (Opts.metavar "PACKAGE") - -parsePackage :: Opts.Parser (PackageName, PackageSpec) -parsePackage = (,) <$> parsePackageName <*> (parsePackageSpec githubCmd) - -------------------------------------------------------------------------------- --- INIT -------------------------------------------------------------------------------- - --- | Whether or not to fetch nixpkgs -data FetchNixpkgs - = NoNixpkgs - | NixpkgsFast -- Pull latest known nixpkgs - | NixpkgsCustom T.Text Nixpkgs -- branch, nixpkgs - deriving (Show) - -data Nixpkgs = Nixpkgs T.Text T.Text -- owner, repo - -instance Show Nixpkgs where - show (Nixpkgs o r) = T.unpack o <> "/" <> T.unpack r - -parseCmdInit :: Opts.ParserInfo (NIO ()) -parseCmdInit = Opts.info (cmdInit <$> parseNixpkgs <**> Opts.helper) $ mconcat desc - where - desc = - [ Opts.fullDesc, - Opts.progDesc - "Initialize a Nix project. Existing files won't be modified." - ] - -parseNixpkgs :: Opts.Parser FetchNixpkgs -parseNixpkgs = parseNixpkgsFast <|> parseNixpkgsLatest <|> parseNixpkgsCustom <|> parseNoNixpkgs <|> pure NixpkgsFast - where - parseNixpkgsFast = - Opts.flag' - NixpkgsFast - ( Opts.long "fast" - <> Opts.help "Use the latest nixpkgs cached at 'https://github.com/nmattia/niv/blob/master/data/nixpkgs.json'. This is the default." - ) - parseNixpkgsLatest = - Opts.flag' - (NixpkgsCustom "master" (Nixpkgs "NixOS" "nixpkgs")) - ( Opts.long "latest" - <> Opts.help "Pull the latest unstable nixpkgs from NixOS/nixpkgs." - ) - parseNixpkgsCustom = - (flip NixpkgsCustom) - <$> ( Opts.option - customNixpkgsReader - ( Opts.long "nixpkgs" - <> Opts.showDefault - <> Opts.help "Use a custom nixpkgs repository from GitHub." - <> Opts.metavar "OWNER/REPO" - ) - ) - <*> ( Opts.strOption - ( Opts.long "nixpkgs-branch" - <> Opts.short 'b' - <> Opts.help "The nixpkgs branch when using --nixpkgs ...." - <> Opts.showDefault - ) - ) - parseNoNixpkgs = - Opts.flag' - NoNixpkgs - ( Opts.long "no-nixpkgs" - <> Opts.help "Don't add a nixpkgs entry to sources.json." - ) - customNixpkgsReader = Opts.maybeReader $ \(T.pack -> repo) -> case T.splitOn "/" repo of - [owner, reponame] -> Just (Nixpkgs owner reponame) - _ -> Nothing - -cmdInit :: FetchNixpkgs -> NIO () -cmdInit nixpkgs = do - job "Initializing" $ do - fsj <- getFindSourcesJson - -- Writes all the default files - -- a path, a "create" function and an update function for each file. - forM_ - [ ( pathNixSourcesNix, - (`createFile` initNixSourcesNixContent), - \path content -> do - if shouldUpdateNixSourcesNix content - then do - say "Updating sources.nix" - li $ B.writeFile path initNixSourcesNixContent - else say "Not updating sources.nix" - ), - ( pathNixSourcesJson fsj, - \path -> do - createFile path initNixSourcesJsonContent - - -- Import nixpkgs, if necessary - initNixpkgs nixpkgs, - \path _content -> dontCreateFile path - ) - ] - $ \(path, onCreate, onUpdate) -> do - exists <- li $ Dir.doesFileExist path - if exists then li (B.readFile path) >>= onUpdate path else onCreate path - case fsj of - Auto -> pure () - AtPath fp -> - tsay $ - T.unlines - [ T.unwords - [ tbold $ tblue "INFO:", - "You are using a custom path for sources.json." - ], - " You need to configure the sources.nix to use " <> tbold (T.pack fp) <> ":", - tbold " import sources.nix { sourcesFile = PATH ; }; ", - T.unwords - [ " where", - tbold "PATH", - "is the relative path from sources.nix to", - tbold (T.pack fp) <> "." - ] - ] - where - createFile :: FilePath -> B.ByteString -> NIO () - createFile path content = li $ do - let dir = takeDirectory path - Dir.createDirectoryIfMissing True dir - say $ "Creating " <> path - B.writeFile path content - dontCreateFile :: FilePath -> NIO () - dontCreateFile path = say $ "Not creating " <> path - -initNixpkgs :: FetchNixpkgs -> NIO () -initNixpkgs nixpkgs = - case nixpkgs of - NoNixpkgs -> say "Not importing 'nixpkgs'." - NixpkgsFast -> do - say "Using known 'nixpkgs' ..." - packageSpec <- HTTP.getResponseBody <$> HTTP.httpJSON "https://raw.githubusercontent.com/nmattia/niv/master/data/nixpkgs.json" - cmdAdd - githubCmd - (PackageName "nixpkgs") - (specToLockedAttrs packageSpec) - pure () - NixpkgsCustom branch nixpkgs' -> do - say "Importing 'nixpkgs' ..." - let (owner, repo) = case nixpkgs' of - Nixpkgs o r -> (o, r) - cmdAdd - githubCmd - (PackageName "nixpkgs") - ( specToFreeAttrs $ - PackageSpec $ - KM.fromList - [ "owner" .= owner, - "repo" .= repo, - "branch" .= branch - ] - ) - -------------------------------------------------------------------------------- --- ADD -------------------------------------------------------------------------------- - -parseCmdAdd :: Opts.ParserInfo (NIO ()) -parseCmdAdd = - Opts.info - ((parseCommands <|> parseShortcuts) <**> Opts.helper) - $ (description githubCmd) - where - -- XXX: this should parse many shortcuts (github, git). Right now we only - -- parse GitHub because the git interface is still experimental. note to - -- implementer: it'll be tricky to have the correct arguments show up - -- without repeating "PACKAGE PACKAGE PACKAGE" for every package type. - parseShortcuts = parseShortcut githubCmd - parseShortcut cmd = uncurry (cmdAdd cmd) <$> (parseShortcutArgs cmd) - parseCmd cmd = uncurry (cmdAdd cmd) <$> (parseCmdArgs cmd) - parseCmdAddGit = - Opts.info (parseCmd gitCmd <**> Opts.helper) (description gitCmd) - parseCmdAddLocal = - Opts.info (parseCmd localCmd <**> Opts.helper) (description localCmd) - parseCmdAddGitHub = - Opts.info (parseCmd githubCmd <**> Opts.helper) (description githubCmd) - parseCommands = - Opts.subparser - ( Opts.hidden - <> Opts.commandGroup "Experimental commands:" - <> Opts.command "git" parseCmdAddGit - <> Opts.command "github" parseCmdAddGitHub - <> Opts.command "local" parseCmdAddLocal - ) - --- | only used in shortcuts (niv add foo/bar ...) because PACKAGE is NOT --- optional -parseShortcutArgs :: Cmd -> Opts.Parser (PackageName, Attrs) -parseShortcutArgs cmd = collapse <$> parseNameAndShortcut <*> parsePackageSpec cmd - where - collapse specAndName pspec = (pname, specToLockedAttrs $ pspec <> baseSpec) - where - (pname, baseSpec) = case specAndName of - ((_, spec), Just pname') -> (pname', PackageSpec spec) - ((pname', spec), Nothing) -> (pname', PackageSpec spec) - parseNameAndShortcut = - (,) - <$> Opts.argument - (Opts.maybeReader (parseCmdShortcut cmd . T.pack)) - (Opts.metavar "PACKAGE") - <*> optName - optName = - Opts.optional $ - PackageName - <$> Opts.strOption - ( Opts.long "name" - <> Opts.short 'n' - <> Opts.metavar "NAME" - <> Opts.help "Set the package name to " - ) - --- | only used in command (niv add ...) because PACKAGE is optional -parseCmdArgs :: Cmd -> Opts.Parser (PackageName, Attrs) -parseCmdArgs cmd = collapse <$> parseNameAndShortcut <*> parsePackageSpec cmd - where - collapse specAndName pspec = (pname, specToLockedAttrs $ pspec <> baseSpec) - where - (pname, baseSpec) = case specAndName of - (Just (_, spec), Just pname') -> (pname', PackageSpec spec) - (Just (pname', spec), Nothing) -> (pname', PackageSpec spec) - (Nothing, Just pname') -> (pname', PackageSpec KM.empty) - (Nothing, Nothing) -> (PackageName "unnamed", PackageSpec KM.empty) - parseNameAndShortcut = - (,) - <$> Opts.optional - ( Opts.argument - (Opts.maybeReader (parseCmdShortcut cmd . T.pack)) - (Opts.metavar "PACKAGE") - ) - <*> optName - optName = - Opts.optional $ - PackageName - <$> Opts.strOption - ( Opts.long "name" - <> Opts.short 'n' - <> Opts.metavar "NAME" - <> Opts.help "Set the package name to " - ) - -cmdAdd :: Cmd -> PackageName -> Attrs -> NIO () -cmdAdd cmd packageName attrs = do - job ("Adding package " <> T.unpack (unPackageName packageName)) $ do - fsj <- getFindSourcesJson - sources <- unSources <$> li (getSources fsj) - when (HMS.member packageName sources) $ - li $ - abortCannotAddPackageExists packageName - eFinalSpec <- fmap attrsToSpec <$> li (doUpdate attrs cmd) - case eFinalSpec of - Left e -> li (abortUpdateFailed [(packageName, e)]) - Right finalSpec -> do - say $ "Writing new sources file" - li $ - setSources fsj $ - Sources $ - HMS.insert packageName finalSpec sources - -------------------------------------------------------------------------------- --- SHOW -------------------------------------------------------------------------------- - -parseCmdShow :: Opts.ParserInfo (NIO ()) -parseCmdShow = - Opts.info - ((cmdShow <$> Opts.optional parsePackageName) <**> Opts.helper) - Opts.fullDesc - --- TODO: nicer output -cmdShow :: Maybe PackageName -> NIO () -cmdShow = \case - Just packageName -> do - fsj <- getFindSourcesJson - sources <- unSources <$> li (getSources fsj) - case HMS.lookup packageName sources of - Just pspec -> showPackage packageName pspec - Nothing -> li $ abortCannotShowNoSuchPackage packageName - Nothing -> do - fsj <- getFindSourcesJson - sources <- unSources <$> li (getSources fsj) - forWithKeyM_ sources $ showPackage - -showPackage :: MonadIO io => PackageName -> PackageSpec -> io () -showPackage (PackageName pname) (PackageSpec spec) = do - tsay $ tbold pname - forM_ (KM.toList spec) $ \(attrName, attrValValue) -> do - let attrValue = case attrValValue of - Aeson.String str -> str - _ -> tfaint "" - tsay $ " " <> K.toText attrName <> ": " <> attrValue - -------------------------------------------------------------------------------- --- UPDATE -------------------------------------------------------------------------------- - -parseCmdUpdate :: Opts.ParserInfo (NIO ()) -parseCmdUpdate = - Opts.info - ((cmdUpdate <$> Opts.optional parsePackage) <**> Opts.helper) - $ mconcat desc - where - desc = - [ Opts.fullDesc, - Opts.progDesc "Update dependencies", - Opts.headerDoc $ - Just $ - Opts.nest 2 $ - "Examples:" - Opts.<$$> "" - Opts.<$$> Opts.vcat - [ Opts.fill 30 "niv update" Opts.<+> "# update all packages", - Opts.fill 30 "niv update nixpkgs" Opts.<+> "# update nixpkgs", - Opts.fill 30 "niv update my-package -v beta-0.2" Opts.<+> "# update my-package to version \"beta-0.2\"" - ] - ] - -specToFreeAttrs :: PackageSpec -> Attrs -specToFreeAttrs = KM.toHashMapText . fmap (Free,) . unPackageSpec - -specToLockedAttrs :: PackageSpec -> Attrs -specToLockedAttrs = KM.toHashMapText . fmap (Locked,) . unPackageSpec - -cmdUpdate :: Maybe (PackageName, PackageSpec) -> NIO () -cmdUpdate = \case - Just (packageName, cliSpec) -> - job ("Update " <> T.unpack (unPackageName packageName)) $ do - fsj <- getFindSourcesJson - sources <- unSources <$> li (getSources fsj) - eFinalSpec <- case HMS.lookup packageName sources of - Just defaultSpec -> do - -- lookup the "type" to find a Cmd to run, defaulting to legacy - -- github - let cmd = case KM.lookup "type" (unPackageSpec defaultSpec) of - Just "git" -> gitCmd - Just "local" -> localCmd - _ -> githubCmd - spec = specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec - fmap attrsToSpec <$> li (doUpdate spec cmd) - Nothing -> li $ abortCannotUpdateNoSuchPackage packageName - case eFinalSpec of - Left e -> li $ abortUpdateFailed [(packageName, e)] - Right finalSpec -> - li $ - setSources fsj $ - Sources $ - HMS.insert packageName finalSpec sources - Nothing -> job "Updating all packages" $ do - fsj <- getFindSourcesJson - sources <- unSources <$> li (getSources fsj) - esources' <- forWithKeyM sources $ - \packageName defaultSpec -> do - tsay $ "Package: " <> unPackageName packageName - let initialSpec = specToFreeAttrs defaultSpec - -- lookup the "type" to find a Cmd to run, defaulting to legacy - -- github - let cmd = case KM.lookup "type" (unPackageSpec defaultSpec) of - Just "git" -> gitCmd - Just "local" -> localCmd - _ -> githubCmd - finalSpec <- fmap attrsToSpec <$> li (doUpdate initialSpec cmd) - pure finalSpec - let (failed, sources') = partitionEithersHMS esources' - unless (HMS.null failed) $ - li $ - abortUpdateFailed (HMS.toList failed) - li $ setSources fsj $ Sources sources' - --- | pretty much tryEvalUpdate but we might issue some warnings first -doUpdate :: Attrs -> Cmd -> IO (Either SomeException Attrs) -doUpdate attrs cmd = do - forM_ (extraLogs cmd attrs) $ tsay - tryEvalUpdate attrs (updateCmd cmd) - -partitionEithersHMS :: - (Eq k, Hashable k) => - HMS.HashMap k (Either a b) -> - (HMS.HashMap k a, HMS.HashMap k b) -partitionEithersHMS = - flip HMS.foldlWithKey' (HMS.empty, HMS.empty) $ \(ls, rs) k -> \case - Left l -> (HMS.insert k l ls, rs) - Right r -> (ls, HMS.insert k r rs) - -------------------------------------------------------------------------------- --- MODIFY -------------------------------------------------------------------------------- - -parseCmdModify :: Opts.ParserInfo (NIO ()) -parseCmdModify = - Opts.info - ((cmdModify <$> parsePackageName <*> optName <*> parsePackageSpec githubCmd) <**> Opts.helper) - $ mconcat desc - where - desc = - [ Opts.fullDesc, - Opts.progDesc "Modify dependency attributes without performing an update", - Opts.headerDoc $ - Just $ - "Examples:" - Opts.<$$> "" - Opts.<$$> " niv modify nixpkgs -v beta-0.2" - Opts.<$$> " niv modify nixpkgs -a branch=nixpkgs-unstable" - ] - optName = - Opts.optional $ - PackageName - <$> Opts.strOption - ( Opts.long "name" - <> Opts.short 'n' - <> Opts.metavar "NAME" - <> Opts.help "Set the package name to " - ) - -cmdModify :: PackageName -> Maybe PackageName -> PackageSpec -> NIO () -cmdModify packageName mNewName cliSpec = do - tsay $ "Modifying package: " <> unPackageName packageName - fsj <- getFindSourcesJson - sources <- unSources <$> li (getSources fsj) - finalSpec <- case HMS.lookup packageName sources of - Just defaultSpec -> pure $ attrsToSpec (specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec) - Nothing -> li $ abortCannotModifyNoSuchPackage packageName - case mNewName of - Just newName -> do - when (HMS.member newName sources) $ - li $ - abortCannotAddPackageExists newName - li $ setSources fsj $ Sources $ HMS.insert newName finalSpec $ HMS.delete packageName sources - Nothing -> - li $ setSources fsj $ Sources $ HMS.insert packageName finalSpec sources - -------------------------------------------------------------------------------- --- DROP -------------------------------------------------------------------------------- - -parseCmdDrop :: Opts.ParserInfo (NIO ()) -parseCmdDrop = - Opts.info - ( (cmdDrop <$> parsePackageName <*> parseDropAttributes) - <**> Opts.helper - ) - $ mconcat desc - where - desc = - [ Opts.fullDesc, - Opts.progDesc "Drop dependency", - Opts.headerDoc $ - Just $ - "Examples:" - Opts.<$$> "" - Opts.<$$> " niv drop jq" - Opts.<$$> " niv drop my-package version" - ] - parseDropAttributes :: Opts.Parser [T.Text] - parseDropAttributes = - many $ - Opts.argument Opts.str (Opts.metavar "ATTRIBUTE") - -cmdDrop :: PackageName -> [T.Text] -> NIO () -cmdDrop packageName = \case - [] -> do - tsay $ "Dropping package: " <> unPackageName packageName - fsj <- getFindSourcesJson - sources <- unSources <$> li (getSources fsj) - when (not $ HMS.member packageName sources) $ - li $ - abortCannotDropNoSuchPackage packageName - li $ - setSources fsj $ - Sources $ - HMS.delete packageName sources - attrs -> do - tsay $ "Dropping attributes: " <> T.intercalate " " attrs - tsay $ "In package: " <> unPackageName packageName - fsj <- getFindSourcesJson - sources <- unSources <$> li (getSources fsj) - packageSpec <- case HMS.lookup packageName sources of - Nothing -> - li $ abortCannotAttributesDropNoSuchPackage packageName - Just (PackageSpec packageSpec) -> - pure $ - PackageSpec $ - KM.mapMaybeWithKey - (\k v -> if K.toText k `elem` attrs then Nothing else Just v) - packageSpec - li $ - setSources fsj $ - Sources $ - HMS.insert packageName packageSpec sources - -------------------------------------------------------------------------------- --- Files and their content -------------------------------------------------------------------------------- - --- | Checks if content is different than default and if it does /not/ contain --- a comment line with @niv: no_update@ -shouldUpdateNixSourcesNix :: B.ByteString -> Bool -shouldUpdateNixSourcesNix content = - content /= initNixSourcesNixContent - && not (any lineForbids (B8.lines content)) - where - lineForbids :: B8.ByteString -> Bool - lineForbids str = - case B8.uncons (B8.dropWhile isSpace str) of - Just ('#', rest) -> case B8.stripPrefix "niv:" (B8.dropWhile isSpace rest) of - Just rest' -> case B8.stripPrefix "no_update" (B8.dropWhile isSpace rest') of - Just {} -> True - _ -> False - _ -> False - _ -> False - -------------------------------------------------------------------------------- --- Abort -------------------------------------------------------------------------------- - -abortCannotAddPackageExists :: PackageName -> IO a -abortCannotAddPackageExists (PackageName n) = - abort $ - T.unlines - [ "Cannot add package " <> n <> ".", - "The package already exists. Use", - " niv drop " <> n, - "and then re-add the package. Alternatively use", - " niv update " <> n <> " --attribute foo=bar", - "to update the package's attributes." - ] - -abortCannotUpdateNoSuchPackage :: PackageName -> IO a -abortCannotUpdateNoSuchPackage (PackageName n) = - abort $ - T.unlines - [ "Cannot update package " <> n <> ".", - "The package doesn't exist. Use", - " niv add " <> n, - "to add the package." - ] - -abortCannotModifyNoSuchPackage :: PackageName -> IO a -abortCannotModifyNoSuchPackage (PackageName n) = - abort $ - T.unlines - [ "Cannot modify package " <> n <> ".", - "The package doesn't exist. Use", - " niv add " <> n, - "to add the package." - ] - -abortCannotDropNoSuchPackage :: PackageName -> IO a -abortCannotDropNoSuchPackage (PackageName n) = - abort $ - T.unlines - [ "Cannot drop package " <> n <> ".", - "The package doesn't exist." - ] - -abortCannotShowNoSuchPackage :: PackageName -> IO a -abortCannotShowNoSuchPackage (PackageName n) = - abort $ - T.unlines - [ "Cannot show package " <> n <> ".", - "The package doesn't exist." - ] - -abortCannotAttributesDropNoSuchPackage :: PackageName -> IO a -abortCannotAttributesDropNoSuchPackage (PackageName n) = - abort $ - T.unlines - [ "Cannot drop attributes of package " <> n <> ".", - "The package doesn't exist." - ] - -abortUpdateFailed :: [(PackageName, SomeException)] -> IO a -abortUpdateFailed errs = - abort $ - T.unlines $ - ["One or more packages failed to update:"] - <> map - ( \(PackageName pname, e) -> - pname <> ": " <> tshow e - ) - errs +import qualified Data.ByteString.Lazy as BL +import Data.Char (isSpace) +import Data.Either (partitionEithers) +import Data.Functor ((<&>)) +import qualified Data.HashMap.Strict as HMS +import Data.HashMap.Strict.Extended +import Data.List (find) +import Data.Maybe +import Data.String (fromString) +import Data.String.QQ (s) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.IO as T +import Data.Version (showVersion) +import GHC.IO.Encoding (utf8) +import qualified Network.HTTP.Simple as HTTP +import Niv.Cmd +import Niv.Git.Cmd hiding (abort) +import Niv.GitHub.Cmd +import Niv.Local.Cmd +import Niv.Logger hiding (Job) +import qualified Niv.Logger +import Niv.Sources +import Niv.Update +import qualified Options.Applicative as Opts +import qualified Options.Applicative.Help.Pretty as Opts +-- I died a little +import Paths_niv (version) +import qualified System.Directory as Dir +import System.Exit (exitFailure) +import System.FilePath (takeDirectory) +import System.IO (hSetEncoding) +import UnliftIO +import UnliftIO.Concurrent + +-- | An IO Monad with some configuration: +-- * FindSourcesJson: how to find sources.json (known path, discover, etc) +-- * [Cmd]: the update types +newtype NIO a = NIO {runNIO :: ReaderT (FindSourcesJson, [Cmd]) IO a} + deriving (Functor, Applicative, Monad, MonadIO, MonadFail, MonadReader (FindSourcesJson, [Cmd])) + +type Job = Niv.Logger.Job NIO + +instance MonadUnliftIO NIO where + withRunInIO = wrappedWithRunInIO NIO runNIO + +getFindSourcesJson :: NIO FindSourcesJson +getFindSourcesJson = fst <$> ask + +getCmds :: NIO [Cmd] +getCmds = snd <$> ask + +cli :: [String] -> IO () +cli args = do + ((fsj, colors), nio) <- + pure args >>= Opts.handleParseResult . execParserPure' Opts.defaultPrefs opts + setColors colors + hSetEncoding stdout utf8 -- required for printing out unicode on some systems + runReaderT (runNIO nio) (fsj, [gitCmd, localCmd, githubCmd]) + warnIfOutdated + where + execParserPure' pprefs pinfo [] = + Opts.Failure $ + Opts.parserFailure pprefs pinfo (Opts.ShowHelpText Nothing) mempty + execParserPure' pprefs pinfo as = Opts.execParserPure pprefs pinfo as + opts = Opts.info ((,) <$> ((,) <$> parseFindSourcesJson <*> parseColors) <*> (parseCommand <**> Opts.helper <**> versionflag)) $ mconcat desc + desc = + [ Opts.headerDoc $ + Just $ + Opts.vcat + [ "niv - dependency manager for Nix projects", + "", + "version:" + Opts.<+> Opts.pretty (showVersion version) + ] + ] + parseFindSourcesJson = + AtPath + <$> Opts.strOption + ( Opts.long "sources-file" + <> Opts.short 's' + <> Opts.metavar "FILE" + <> Opts.help "Use FILE instead of nix/sources.json" + ) + <|> pure Auto + parseColors = + (\case True -> Never; False -> Always) + <$> Opts.switch + ( Opts.long "no-colors" + <> Opts.help "Don't use colors in output" + ) + versionflag :: Opts.Parser (a -> a) + versionflag = + Opts.abortOption (Opts.InfoMsg (showVersion version)) $ + mconcat + [Opts.long "version", Opts.hidden, Opts.help "Print version"] + +parseCommand :: Opts.Parser (NIO ()) +parseCommand = + Opts.subparser + ( Opts.command "init" parseCmdInit + <> Opts.command "add" parseCmdAdd + <> Opts.command "show" parseCmdShow + <> Opts.command "update" parseCmdUpdate + <> Opts.command "rename" parseCmdRename + <> Opts.command "modify" parseCmdModify + <> Opts.command "drop" parseCmdDrop + <> Opts.command "version" parseCmdVersion + ) + <|> Opts.subparser (Opts.internal <> Opts.command "debug" parseCmdDebug) + +parsePackageName :: Opts.Parser PackageName +parsePackageName = + PackageName + <$> Opts.argument Opts.str (Opts.metavar "PACKAGE") + +------------------------------------------------------------------------------- +-- INIT +------------------------------------------------------------------------------- + +-- | Whether or not to fetch nixpkgs +data FetchNixpkgs + = NoNixpkgs + | NixpkgsFast -- Pull latest known nixpkgs + | NixpkgsCustom T.Text Nixpkgs -- branch, nixpkgs + deriving (Show) + +data Nixpkgs = Nixpkgs T.Text T.Text -- owner, repo + +instance Show Nixpkgs where + show (Nixpkgs o r) = T.unpack o <> "/" <> T.unpack r + +parseCmdInit :: Opts.ParserInfo (NIO ()) +parseCmdInit = Opts.info (cmdInit <$> parseNixpkgs <**> Opts.helper) $ mconcat desc + where + desc = + [ Opts.progDesc + "Initialize a Nix project. Existing files won't be modified." + ] + +parseNixpkgs :: Opts.Parser FetchNixpkgs +parseNixpkgs = parseNixpkgsFast <|> parseNixpkgsLatest <|> parseNixpkgsCustom <|> parseNoNixpkgs <|> pure NixpkgsFast + where + parseNixpkgsFast = + Opts.flag' + NixpkgsFast + ( Opts.long "fast" + <> Opts.help "Use the latest nixpkgs cached at 'https://github.com/nmattia/niv/blob/master/data/nixpkgs.json'. This is the default." + ) + parseNixpkgsLatest = + Opts.flag' + (NixpkgsCustom "master" (Nixpkgs "NixOS" "nixpkgs")) + ( Opts.long "latest" + <> Opts.help "Pull the latest unstable nixpkgs from NixOS/nixpkgs." + ) + parseNixpkgsCustom = + flip NixpkgsCustom + <$> Opts.option + customNixpkgsReader + ( Opts.long "nixpkgs" + <> Opts.showDefault + <> Opts.help "Use a custom nixpkgs repository from GitHub." + <> Opts.metavar "OWNER/REPO" + ) + <*> Opts.strOption + ( Opts.long "nixpkgs-branch" + <> Opts.short 'b' + <> Opts.help "The nixpkgs branch when using --nixpkgs ...." + <> Opts.showDefault + ) + parseNoNixpkgs = + Opts.flag' + NoNixpkgs + ( Opts.long "no-nixpkgs" + <> Opts.help "Don't add a nixpkgs entry to sources.json." + ) + customNixpkgsReader = Opts.maybeReader $ \(T.pack -> repo) -> case T.splitOn "/" repo of + [owner, reponame] -> Just (Nixpkgs owner reponame) + _ -> Nothing + +cmdInit :: FetchNixpkgs -> NIO () +cmdInit nixpkgs = do + fsj <- getFindSourcesJson + + -- Writes all the default files + + void $ job "sources.nix (file)" $ do + let path = pathNixSourcesNix + exists <- liftIO $ Dir.doesFileExist path + if exists + then do + content <- liftIO $ B.readFile path + when (shouldUpdateNixSourcesNix content) $ do + say "updating sources.nix" + liftIO $ B.writeFile path initNixSourcesNixContent + else + createFile path initNixSourcesNixContent + case fsj of + Auto -> pure () + AtPath fp -> noteUpdateSourcesNixForPath fp + + -- returns whether we should initialize nixpkgs + sourcesJsonResult <- job "sources.json (file)" $ do + let path = pathNixSourcesJson fsj + exists <- liftIO $ Dir.doesFileExist path + if exists + then do + say $ T.pack path <> " already exists" + pure False + else do + createFile path initNixSourcesJsonContent + pure True + + case (sourcesJsonResult, nixpkgs) of + (Left (), _) -> liftIO exitFailure + (Right False, _) -> pure () -- not initializing nixpkgs + (_, NoNixpkgs) -> pure () -- not initializing nixpkgs + (Right True, NixpkgsFast) -> do + result <- job "nixpkgs" $ do + say "Using known 'nixpkgs' ..." + spec <- HTTP.getResponseBody <$> HTTP.httpJSON "https://raw.githubusercontent.com/nmattia/niv/master/data/nixpkgs.json" + updatePackage (specToLockedAttrs spec) + + case result of + Right spec' -> writeSourcesEntry (PackageName "nixpkgs") spec' + Left () -> liftIO exitFailure + (Right True, NixpkgsCustom branch (Nixpkgs owner repo)) -> do + result <- job "nixpkgs" $ do + say "Importing 'nixpkgs' ..." + updatePackage $ + specToLockedAttrs $ + PackageSpec $ + KM.fromList + [ "owner" .= owner, + "repo" .= repo, + "branch" .= branch + ] + + case result of + Right spec' -> writeSourcesEntry (PackageName "nixpkgs") spec' + Left () -> liftIO exitFailure + +createFile :: FilePath -> B.ByteString -> Job () +createFile path content = do + let dir = takeDirectory path + liftIO $ Dir.createDirectoryIfMissing True dir + say $ "Creating " <> T.pack path + liftIO $ B.writeFile path content + +------------------------------------------------------------------------------- +-- ADD +------------------------------------------------------------------------------- + +-- | a string like 'nmattia/niv' that gets turned into a PackageName + PackageSpec +newtype PackageShortcut = PackageShortcut {unPackageShortcut :: T.Text} + +parseCmdAdd :: Opts.ParserInfo (NIO ()) +parseCmdAdd = + Opts.info + ((cmdAdd <$> parsePackageShortcut <*> Opts.optional parsePackageNameOverride <*> Opts.optional parsePackageSpec) <**> Opts.helper) + $ description + where + parsePackageShortcut = PackageShortcut <$> Opts.argument Opts.str (Opts.metavar "PACKAGE") + parsePackageNameOverride = PackageName <$> Opts.strOption (Opts.long "name" <> Opts.short 'n' <> Opts.metavar "NAME") + description = + mconcat + [ Opts.progDesc "Add a package", + Opts.headerDoc $ + Just $ + Opts.vcat + [ "Examples:", + "", + " niv add stedolan/jq" Opts.<+> "# add a GitHub repo", + " niv add NixOS/nixpkgs -b nixpkgs-unstable" Opts.<+> "# use non-default branch", + " niv add neovim/neovim --name vim" Opts.<+> "# override inferred name", + " niv add https://gcc.gnu.org/git/gcc.git" Opts.<+> "# add an arbitrary Git repo" + ] + ] + +-- Try to expand the shortcut with all commands and return successfully if exactly one matches +expandShortcut :: [Cmd] -> PackageShortcut -> NIO (PackageName, PackageSpec) +expandShortcut cmds (unPackageShortcut -> shortcut) = do + let expanded = mapMaybe (\cmd -> parseCmdShortcut cmd shortcut) cmds + + case expanded of + -- no match: create a dummy package with name and hope the user provides enough attributes + -- via `--attribute ...` + [] -> pure (PackageName shortcut, mempty) + -- exactly one match: use this + [x] -> pure x + -- 1+ match: this is a bug + _ -> abortManyCommandsForShortcut (PackageShortcut shortcut) + +cmdAdd :: PackageShortcut -> Maybe PackageName -> Maybe ParsedPackageSpec -> NIO () +cmdAdd shortcut mPackageName mParsed = do + -- fully realize the spec passed as `--attribute ...`, if any + cliSpecAttrs <- case mParsed of + Nothing -> pure $ PackageSpec KM.empty + Just parsed -> checkParsedSpec parsed + + -- try to expand the shortcut + (packageName', cliSpecShortcut) <- getCmds >>= \cmds -> expandShortcut cmds shortcut + + let packageName = case mPackageName of + Just packageName'' -> packageName'' + Nothing -> packageName' + + -- merge the specs: in case of conflict, the `--attribute ...` takes precedence + let cliSpec = cliSpecAttrs <> cliSpecShortcut -- left biased via Data.Aeson.KeyMap + sources <- unSources <$> readSources + when (HMS.member packageName sources) $ abortCannotAddPackageExists packageName + + result <- job (unPackageName packageName) $ do + say "updating new package..." + result <- updatePackage (specToLockedAttrs cliSpec) + say "package updated" + pure result + + case result of + Right spec' -> writeSourcesEntry packageName spec' + Left () -> liftIO exitFailure + +------------------------------------------------------------------------------- +-- SHOW +------------------------------------------------------------------------------- + +parseCmdShow :: Opts.ParserInfo (NIO ()) +parseCmdShow = + Opts.info + ((cmdShow <$> Opts.optional parsePackagePattern) <**> Opts.helper) + mempty + +cmdShow :: Maybe PackagePattern -> NIO () +cmdShow mPat = do + toShow <- readSources <&> \sources -> filterPackages sources mPat + + when (HMS.null $ unSources toShow) $ do + case mPat of + Just (PackagePattern pat) -> abort $ "no package matching: " <> "'" <> pat <> "'" + Nothing -> abort "nothing to show" + + forWithKeyM_ (unSources toShow) showPackage + +showPackage :: (MonadIO io) => PackageName -> PackageSpec -> io () +showPackage (PackageName pname) (PackageSpec spec) = do + liftIO $ T.putStrLn $ tbold pname + forM_ (KM.toList spec) $ \(attrName, attrValValue) -> do + let attrValue = case attrValValue of + -- if a string, show the string + Aeson.String str -> str + -- otherwise, show the raw encoding + v -> tfaint $ T.decodeUtf8Lenient $ BL.toStrict $ Aeson.encode v + liftIO $ T.putStrLn $ " " <> K.toText attrName <> ": " <> attrValue + +------------------------------------------------------------------------------- +-- UPDATE +------------------------------------------------------------------------------- + +-- | a pattern to match on package names +newtype PackagePattern = PackagePattern {unPackagePattern :: T.Text} + +parsePackagePattern :: Opts.Parser PackagePattern +parsePackagePattern = PackagePattern <$> Opts.argument Opts.str (Opts.metavar "PACKAGE" <> Opts.help "Matches a single package by exact name; otherwise matches all packages names starting with this prefix.") + +-- | filter out packages based on a pattern +filterPackages :: Sources -> Maybe PackagePattern -> Sources +filterPackages (unSources -> sources) mPat = Sources $ case mPat of + -- no pattern: return all packages + Nothing -> sources + -- pattern (filter) provided: return an exact match; if no exact match, match by prefix + Just (PackagePattern pat) -> case HMS.lookup (PackageName pat) sources of + Just exact -> HMS.singleton (PackageName pat) exact + Nothing -> + HMS.filterWithKey (\k _ -> pat `T.isPrefixOf` (unPackageName k)) sources + +parseCmdUpdate :: Opts.ParserInfo (NIO ()) +parseCmdUpdate = + Opts.info + ((cmdUpdate <$> Opts.optional parsePackagePattern <*> Opts.optional parsePackageSpec) <**> Opts.helper) + $ mconcat desc + where + desc = + [ Opts.progDesc "Update dependencies", + Opts.headerDoc $ + Just $ + Opts.nest 2 $ + Opts.vcat + [ "Examples:", + "", + Opts.fill 30 "niv update" Opts.<+> "# update all packages", + Opts.fill 30 "niv update nixpkgs" Opts.<+> "# update nixpkgs", + Opts.fill 30 "niv update my-package -v beta-0.2" Opts.<+> "# update my-package to version \"beta-0.2\"" + ] + ] + +specToFreeAttrs :: PackageSpec -> Attrs +specToFreeAttrs = KM.toHashMapText . fmap (Free,) . unPackageSpec + +specToLockedAttrs :: PackageSpec -> Attrs +specToLockedAttrs = KM.toHashMapText . fmap (Locked,) . unPackageSpec + +-- | find a matching Cmd for the PackageSpec +inferCmd :: [Cmd] -> PackageSpec -> Maybe Cmd +inferCmd cmds spec = do + find (\cmd -> acceptsCmd cmd spec) cmds + +-- update the attributes and return the updated spec +updatePackage :: Attrs -> Job PackageSpec +updatePackage attrs = do + cmds <- lift getCmds + + -- infer what command (git, github, etc) to use to update the package + cmd <- case inferCmd cmds (attrsToSpec attrs) of + Just cmd -> pure cmd + Nothing -> abortNoSuitableCommand + + say "updating..." + result <- attrsToSpec <$> doUpdate attrs cmd + say "package updated" + pure result + +-- | Update many packages. +-- For each package, the package name, attrs-to-update as well as original state are given. +-- For each package, the package name and final state are returned. +updatePackages :: [(PackageName, PackageSpec, Maybe PackageSpec)] -> NIO [Either () ()] +updatePackages packageUpdates = do + -- prepare some padding for package names so that the output is aligned + let maxNameLength = maximum $ (\(p, _, _) -> T.length $ unPackageName p) <$> packageUpdates + padName (PackageName p) = p <> T.replicate (maxNameLength - T.length p) " " + + -- update all the packages, writing the new spec after each (successful) update and + -- finally returning a list of all successes & failures statuses + forM packageUpdates $ \(packageName, spec, mCliSpec) -> do + let defAttrs = specToFreeAttrs spec + attrs = maybe defAttrs (\cliSpec -> specToLockedAttrs cliSpec <> defAttrs) mCliSpec + result <- job (padName packageName) $ updatePackage attrs + case result of + Right spec' -> do + writeSourcesEntry packageName spec' + pure $ Right () + Left _ -> pure $ Left () + +cmdUpdate :: Maybe PackagePattern -> Maybe ParsedPackageSpec -> NIO () +cmdUpdate mPat mParsed = do + cliSpec <- case mParsed of + Nothing -> pure Nothing + Just parsed -> Just <$> checkParsedSpec parsed + + toUpdate <- readSources <&> \sources -> filterPackages sources mPat + + when (HMS.null $ unSources toUpdate) $ do + case mPat of + Just (PackagePattern pat) -> abort $ "no package matching: " <> "'" <> pat <> "'" + Nothing -> abort "nothing to update" + + let packageUpdates = (\(pName, spec) -> (pName, spec, cliSpec)) <$> HMS.toList (unSources toUpdate) + + liftIO $ T.putStrLn $ T.pack (show (length packageUpdates)) <> " package(s) to update" + + -- update all packages and separate failures from successes + (errs, successes) <- partitionEithers <$> updatePackages packageUpdates + + -- print a short summary + liftIO $ T.putStrLn "" + unless (null successes) $ do + liftIO $ T.putStrLn $ T.pack (show (length successes)) <> " package(s) updated successfully" + unless (null errs) $ do + liftIO $ T.putStrLn "" + liftIO $ T.putStrLn $ T.pack (show (length errs)) <> " package(s) failed to update" + liftIO exitFailure + +-- | A package spec as parsed (may be malformed and contain the same attributes multiple times) +newtype ParsedPackageSpec = ParsedPackageSpec {unParsedPackageSpec :: [(T.Text, Aeson.Value)]} + +-- | Collapse the parsed spec into something usable, potentially erroring out +checkParsedSpec :: ParsedPackageSpec -> NIO PackageSpec +checkParsedSpec (unParsedPackageSpec -> parsed) = do + -- count how many times an attribute is seen, and then filter on the "offending" ones which have been seen + -- more than once + let counts = + foldl' + (\acc (k, _) -> HMS.alter (\case Nothing -> Just (1 :: Int); Just n -> Just (n + 1)) k acc) + HMS.empty + parsed + offending = HMS.filter (\n -> n > 1) counts + + when (not $ HMS.null offending) $ do + abortAttributeRepeated (HMS.keys offending) + + pure $ PackageSpec $ KM.fromList $ (\(k, v) -> (fromString $ T.unpack k, v)) <$> parsed + +-- Parse a package spec, where any attribute can be specified at most once. +parsePackageSpec :: Opts.Parser ParsedPackageSpec +parsePackageSpec = groupOptions "ATTRIBUTES" $ ParsedPackageSpec <$> Opts.some (jsonAttribute <|> stringAttribute <|> knownAttribute) + where + -- this (with `Opts.hidden` set on all options) groups the options below instead of showing them all with the command + -- https://github.com/pcapriotti/optparse-applicative/issues/523 + groupOptions :: String -> Opts.Parser a -> Opts.Parser a + groupOptions mv x = Opts.option empty (Opts.metavar mv) <|> Opts.parserOptionGroup mv x + + -- shortcuts for many known attributes + knownAttribute :: Opts.Parser (T.Text, Aeson.Value) + knownAttribute = + attrOption + "owner" + ( Opts.long "owner" + <> Opts.short 'o' + <> Opts.metavar "OWNER" + <> Opts.help "Set the repository owner (for github)" + ) + <|> attrOption + "repo" + ( Opts.long "repo" + <> Opts.metavar "REPO" + <> Opts.help "Set the repository name (for github)" + ) + <|> attrOption + "branch" + ( Opts.long "branch" + <> Opts.short 'b' + <> Opts.metavar "BRANCH" + <> Opts.help "Set the branch (for git/github)" + ) + <|> attrOption + "rev" + ( Opts.long "rev" + <> Opts.short 'r' + <> Opts.metavar "REV" + <> Opts.help "Set the revision/commit (for git/github)" + ) + <|> attrOption + "version" + ( Opts.long "version" + <> Opts.short 'v' + <> Opts.metavar "VERSION" + <> Opts.help "Set the version" + ) + <|> attrOption + "url_template" + ( Opts.long "template" + <> Opts.short 't' + <> Opts.metavar "URL" + <> Opts.help "Used during 'update' when building URL. Occurrences of are replaced with attribute 'foo'." + ) + <|> attrOption + "type" + ( Opts.long "type" + <> Opts.short 'T' + <> Opts.metavar "TYPE" + <> Opts.help "The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL." + ) + + attrOption key mods = (\v -> (key, v)) <$> Opts.strOption (Opts.hidden <> mods) + + -- parse any json value as `--attribute 'foo={"hello": "world"}'` + -- NOTE: if the string fails to parse as JSON we assume it's a string (a string itself like 'foo' won't + -- successfully parse as a JSON string, only '"foo"' would) + jsonAttribute :: Opts.Parser (T.Text, Aeson.Value) + jsonAttribute = + Opts.option + (kvMaybe >>= \(k, v) -> case Aeson.decodeStrict (B8.pack (T.unpack v)) of Just v' -> pure (k, v'); Nothing -> pure (k, Aeson.toJSON v)) + ( Opts.long "attribute" + <> Opts.short 'a' + <> Opts.metavar "KEY=VAL" + <> Opts.help "Set the package spec attribute to , where may be JSON." + <> Opts.hidden + ) + + -- same as above but force parsing as string + stringAttribute :: Opts.Parser (T.Text, Aeson.Value) + stringAttribute = + Opts.option + ((\(k, v) -> (k, Aeson.String v)) <$> kvMaybe) + ( Opts.long "string-attribute" + <> Opts.short 's' + <> Opts.metavar "KEY=VAL" + <> Opts.help "Set the package spec attribute to ." + <> Opts.hidden + ) + + -- try to turn "foo=bar" into ("foo", "bar") + kvMaybe :: Opts.ReadM (T.Text, T.Text) + kvMaybe = Opts.maybeReader $ \str -> case span (/= '=') str of + (k, '=' : v) -> Just (T.pack k, T.pack v) + _ -> Nothing + +-- | pretty much tryEvalUpdate but we might issue some warnings first +doUpdate :: Attrs -> Cmd -> Job Attrs +doUpdate attrs cmd = do + forM_ (extraLogs cmd attrs) say + result <- liftIO $ tryEvalUpdate attrs (updateCmd cmd) + case result of + Right attrs' -> pure attrs' + Left e -> throwError $ T.show e + +------------------------------------------------------------------------------- +-- RENAME +------------------------------------------------------------------------------- + +parseCmdRename :: Opts.ParserInfo (NIO ()) +parseCmdRename = + Opts.info + ((cmdRename <$> parsePackageNameOld <*> parsePackageNameNew) <**> Opts.helper) + $ mconcat desc + where + desc = + [ Opts.progDesc "Rename a package", + Opts.headerDoc $ + Just $ + Opts.vcat + [ "Examples:", + "", + " niv rename nixpkgs nixpkgs-unstable" + ] + ] + parsePackageNameOld = PackageName <$> Opts.argument Opts.str (Opts.metavar "OLD") + parsePackageNameNew = PackageName <$> Opts.argument Opts.str (Opts.metavar "NEW") + +cmdRename :: PackageName -> PackageName -> NIO () +cmdRename oldName newName = + modifySources $ \(unSources -> sources) -> do + spec <- case HMS.lookup oldName sources of + Nothing -> abortNoSuchPackage oldName + Just spec -> pure spec + + pure $ Sources $ HMS.insert newName spec $ HMS.delete oldName sources + +------------------------------------------------------------------------------- +-- MODIFY +------------------------------------------------------------------------------- + +parseCmdModify :: Opts.ParserInfo (NIO ()) +parseCmdModify = + Opts.info + ((cmdModify <$> parsePackageName <*> parsePackageSpec) <**> Opts.helper) + $ mconcat desc + where + desc = + [ Opts.progDesc "Modify dependency attributes without performing an update", + Opts.headerDoc $ + Just $ + Opts.vcat + [ "Examples:", + "", + " niv modify nixpkgs -v beta-0.2", + " niv modify nixpkgs -a branch=nixpkgs-unstable" + ] + ] + +cmdModify :: PackageName -> ParsedPackageSpec -> NIO () +cmdModify packageName parsed = do + cliSpec <- checkParsedSpec parsed + modifySources $ \(unSources -> sources) -> do + spec <- case HMS.lookup packageName sources of + Nothing -> abortNoSuchPackage packageName + Just spec -> pure spec + + let spec' = attrsToSpec (specToLockedAttrs cliSpec <> specToFreeAttrs spec) + pure $ Sources $ HMS.insert packageName spec' sources + +------------------------------------------------------------------------------- +-- DROP +------------------------------------------------------------------------------- + +parseCmdDrop :: Opts.ParserInfo (NIO ()) +parseCmdDrop = + Opts.info + ( (cmdDrop <$> parsePackageName <*> parseDropAttributes) + <**> Opts.helper + ) + $ mconcat desc + where + desc = + [ Opts.progDesc "Drop dependency", + Opts.headerDoc $ + Just $ + Opts.vcat + [ "Examples:", + "", + " niv drop jq", + " niv drop my-package version" + ] + ] + parseDropAttributes :: Opts.Parser [T.Text] + parseDropAttributes = + many $ + Opts.argument Opts.str (Opts.metavar "ATTRIBUTE") + +cmdDrop :: PackageName -> [T.Text] -> NIO () +cmdDrop packageName = \case + [] -> modifySources $ \(unSources -> sources) -> do + unless (HMS.member packageName sources) $ + abortNoSuchPackage packageName + pure $ Sources $ HMS.delete packageName sources + attrs -> do + liftIO $ T.putStrLn $ "Dropping attributes: " <> T.intercalate " " attrs + liftIO $ T.putStrLn $ "In package: " <> unPackageName packageName + sources <- unSources <$> readSources + spec <- case HMS.lookup packageName sources of + Nothing -> abortNoSuchPackage packageName + Just spec -> pure spec + let spec' = PackageSpec $ KM.mapMaybeWithKey (\k v -> if K.toText k `elem` attrs then Nothing else Just v) (unPackageSpec spec) + writeSourcesEntry packageName spec' + +------------------------------------------------------------------------------- +-- VERSION +------------------------------------------------------------------------------- + +parseCmdVersion :: Opts.ParserInfo (NIO ()) +parseCmdVersion = + Opts.info + ( pure (liftIO $ T.putStrLn $ T.pack $ showVersion version) + <**> Opts.helper + ) + $ mconcat desc + where + desc = + [ Opts.progDesc "Print version" + ] + +------------------------------------------------------------------------------- +-- DEBUG: some debugging helpers (internal) +------------------------------------------------------------------------------- + +-- | Collection of help, debug and test output for bug reports & tests +parseCmdDebug :: Opts.ParserInfo (NIO ()) +parseCmdDebug = + Opts.info + ( Opts.subparser + ( Opts.command "job-hello-world" (Opts.info (pure $ liftIO jobHelloWorld) mempty) + <> Opts.command "job-note" (Opts.info (pure $ liftIO jobNote) mempty) + <> Opts.command "job-note-multiline" (Opts.info (pure $ liftIO jobNoteMultiline) mempty) + <> Opts.command "job-every-admonition" (Opts.info (pure $ liftIO jobEveryAdmonition) mempty) + <> Opts.command "job-multi" (Opts.info (pure $ liftIO jobMulti) mempty) + ) + ) + mempty + +-- "hello world" inside a job. +jobHelloWorld :: IO () +jobHelloWorld = void $ job "test" $ do + threadDelay 600000 + say "hello" + threadDelay 600000 + say "world" + threadDelay 600000 + +-- simple note +jobNote :: IO () +jobNote = void $ job "test-note" $ do + threadDelay 600000 + note "hello" + threadDelay 600000 + +-- multiline notes +jobNoteMultiline :: IO () +jobNoteMultiline = void $ job "test-note-multiline" $ do + note $ "this is the first note\nwhich is a " <> tbold "multiline" <> " note" + note "this is another note" + +-- every admonition (note, warning, error) +jobEveryAdmonition :: IO () +jobEveryAdmonition = void $ job "every-admonition" $ do + warn "some warning" + note "some note" + throwError "some error" + +-- multiple jobs +jobMulti :: IO () +jobMulti = do + void $ job "a" $ say "message" + void $ job "ab" $ say "message" + void $ job "abc-def" $ say "message" + void $ job "hello" $ say "message" + void $ job "world" $ say "message" + void $ job "nothing" $ say "message" + +------------------------------------------------------------------------------- +-- Files and their content +------------------------------------------------------------------------------- + +-- Read the sources, throwing an IO error if there's an issue +getSources :: FindSourcesJson -> IO Sources +getSources fsj = do + getSourcesEither fsj + >>= either + ( \case + SourcesDoesntExist -> (abortSourcesDoesntExist fsj) + SourceIsntJSON -> (abortSourcesIsntJSON fsj) + SpecIsntAMap -> (abortSpecIsntAMap fsj) + ) + pure + +-- helper for modifying the sources file +modifySources :: (Sources -> NIO Sources) -> NIO () +modifySources upd = do + fsj <- getFindSourcesJson + sources <- liftIO $ getSources fsj + sources' <- upd sources + liftIO $ setSources fsj sources' + +-- Read the sources in NIO +readSources :: NIO Sources +readSources = do + fsj <- getFindSourcesJson + liftIO $ getSources fsj + +-- Update or insert a spec +writeSourcesEntry :: PackageName -> PackageSpec -> NIO () +writeSourcesEntry packageName spec = do + fsj <- getFindSourcesJson + sources <- liftIO $ getSources fsj + let sources' = Sources $ HMS.insert packageName spec (unSources sources) + liftIO $ setSources fsj sources' + +-- | Checks if content is different than default and if it does /not/ contain +-- a comment line with @niv: no_update@ +shouldUpdateNixSourcesNix :: B.ByteString -> Bool +shouldUpdateNixSourcesNix content = + content /= initNixSourcesNixContent + && not (any lineForbids (B8.lines content)) + where + lineForbids :: B8.ByteString -> Bool + lineForbids str = + case B8.uncons (B8.dropWhile isSpace str) of + Just ('#', rest) -> case B8.stripPrefix "niv:" (B8.dropWhile isSpace rest) of + Just rest' -> case B8.stripPrefix "no_update" (B8.dropWhile isSpace rest') of + Just {} -> True + _ -> False + _ -> False + _ -> False + +------------------------------------------------------------------------------- +-- MISC +------------------------------------------------------------------------------- + +noteUpdateSourcesNixForPath :: (MonadIO io) => FilePath -> Niv.Logger.Job io () +noteUpdateSourcesNixForPath fp = do + note $ + T.unlines + [ "You are using a custom path for sources.json.", + "You need to configure the sources.nix to use " <> tbold (T.pack fp) <> ":", + "", + tbold " import sources.nix { sourcesFile = PATH ; }; ", + "", + T.unwords + [ " where", + tbold "PATH", + "is the relative path from sources.nix to", + tbold (T.pack fp) <> "." + ] + ] + +------------------------------------------------------------------------------- +-- Abort +------------------------------------------------------------------------------- + +-- A job error if no update Cmd is suited to the package +abortNoSuitableCommand :: Job a +abortNoSuitableCommand = + throwError "don't know how to update package" + +-- proper aborts that exit niv (only used when there is no way to make +-- progress, like missing sources) + +abort :: (MonadIO io) => T.Text -> io a +abort msg = do + liftIO $ T.putStrLn $ T.unwords [tbold (tred "FATAL") <> ":", msg] + liftIO exitFailure + +-- error if the command to use is ambiguous +abortManyCommandsForShortcut :: PackageShortcut -> NIO a +abortManyCommandsForShortcut (unPackageShortcut -> shortcut) = + abort $ bug $ "shortcut matched multiple commands: " <> shortcut + +-- We don't allow attributes to be specified multiple times +abortAttributeRepeated :: [T.Text] -> NIO a +abortAttributeRepeated ks = + abort $ "some attributes were specified multiple times: " <> T.intercalate "," ks + +abortNoSuchPackage :: (MonadIO io) => PackageName -> io a +abortNoSuchPackage (unPackageName -> packageName) = + abort $ packageName <> ": no such package" + +abortSourcesDoesntExist :: FindSourcesJson -> IO a +abortSourcesDoesntExist fsj = abort $ T.unlines [line1, line2] + where + line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj) + line2 = + [s| +The sources file does not exist! You may need to run 'niv init'. +|] + +abortSourcesIsntJSON :: FindSourcesJson -> IO a +abortSourcesIsntJSON fsj = abort $ T.unlines [line1, line2] + where + line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj) + line2 = "The sources file should be JSON." + +abortSpecIsntAMap :: FindSourcesJson -> IO a +abortSpecIsntAMap fsj = abort $ T.unlines [line1, line2] + where + line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj) + line2 = + [s| +The package specifications in the sources file should be JSON maps from +attribute name to attribute value, e.g.: + { "nixpkgs": { "foo": "bar" } } +|] + +abortCannotRenamePackageExists :: PackageName -> PackageName -> NIO a +abortCannotRenamePackageExists (PackageName from) (PackageName to) = + abort $ + T.unlines + [ "Cannot rename package " <> from <> " to " <> to <> ".", + "Package " <> to <> " already exists." + ] + +abortCannotAddPackageExists :: PackageName -> NIO a +abortCannotAddPackageExists (PackageName n) = + abort $ + T.unlines + [ "Cannot add package " <> n <> ".", + "The package already exists. Use", + " niv drop " <> n, + "and then re-add the package. Alternatively use", + " niv update " <> n <> " --attribute foo=bar", + "to update the package's attributes." + ] diff --git a/src/Niv/Cmd.hs b/src/Niv/Cmd.hs --- a/src/Niv/Cmd.hs +++ b/src/Niv/Cmd.hs @@ -1,20 +1,17 @@ -{-# LANGUAGE RankNTypes #-} - module Niv.Cmd where -import qualified Data.Aeson as Aeson import qualified Data.Text as T import Niv.Sources import Niv.Update -import qualified Options.Applicative as Opts --- TODO: add filter data Cmd = Cmd - { description :: forall a. Opts.InfoMod a, - parseCmdShortcut :: T.Text -> Maybe (PackageName, Aeson.Object), - parsePackageSpec :: Opts.Parser PackageSpec, + { -- | Important: if an object is returned, then it should be accepted by 'acceptsCmd' + parseCmdShortcut :: T.Text -> Maybe (PackageName, PackageSpec), updateCmd :: Update () (), name :: T.Text, -- | Some notes to print - extraLogs :: Attrs -> [T.Text] + extraLogs :: Attrs -> [T.Text], + -- | Returns True if this Cmd knows how to handle the + -- given PackageSpec + acceptsCmd :: PackageSpec -> Bool } diff --git a/src/Niv/Git/Cmd.hs b/src/Niv/Git/Cmd.hs --- a/src/Niv/Git/Cmd.hs +++ b/src/Niv/Git/Cmd.hs @@ -1,40 +1,34 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} module Niv.Git.Cmd where -import Control.Applicative import Control.Arrow +import Control.Monad.Except (throwError) +import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM -import qualified Data.ByteString.Char8 as B8 +import Data.Char (isDigit) import qualified Data.HashMap.Strict as HMS -import Data.Maybe import qualified Data.Text as T -import Data.Text.Extended as T import Niv.Cmd -import Niv.Logger import Niv.Sources import Niv.Update -import qualified Options.Applicative as Opts -import qualified Options.Applicative.Help.Pretty as Opts import System.Exit (ExitCode (ExitSuccess)) import System.Process (readProcessWithExitCode) +import UnliftIO gitCmd :: Cmd gitCmd = Cmd - { description = describeGit, - parseCmdShortcut = parseGitShortcut, - parsePackageSpec = parseGitPackageSpec, + { parseCmdShortcut = parseGitShortcut, updateCmd = gitUpdate', name = "git", - extraLogs = gitExtraLogs + extraLogs = gitExtraLogs, + acceptsCmd = \(unPackageSpec -> spec) -> KM.lookup "type" spec == Just "git" } gitExtraLogs :: Attrs -> [T.Text] @@ -42,104 +36,36 @@ where noteRef = textIf (HMS.member "ref" attrs) $ - mkNote - "Your source contains a `ref` attribute. Make sure your sources.nix is up-to-date and consider using a `branch` or `tag` attribute." + "Your source contains a `ref` attribute. Make sure your sources.nix is up-to-date and consider using a `branch` or `tag` attribute." warnRefBranch = textIf (member "ref" && member "branch") $ - mkWarn - "Your source contains both a `ref` and a `branch`. Niv will update the `branch` but the `ref` will be used by Nix to fetch the repo." + "Your source contains both a `ref` and a `branch`. Niv will update the `branch` but the `ref` will be used by Nix to fetch the repo." warnRefTag = textIf (member "ref" && member "tag") $ - mkWarn - "Your source contains both a `ref` and a `tag`. The `ref` will be used by Nix to fetch the repo." + "Your source contains both a `ref` and a `tag`. The `ref` will be used by Nix to fetch the repo." member x = HMS.member x attrs - textIf cond txt = if cond then [txt] else [] + textIf cond txt = [txt | cond] -parseGitShortcut :: T.Text -> Maybe (PackageName, Aeson.Object) +parseGitShortcut :: T.Text -> Maybe (PackageName, PackageSpec) parseGitShortcut txt'@(T.dropWhileEnd (== '/') -> txt) = - -- basic heuristics for figuring out if something is a git repo - if isGitURL - then case T.splitOn "/" txt of - [] -> Nothing - (last -> w) -> case T.stripSuffix ".git" w of - Nothing -> Just (PackageName w, KM.singleton "repo" (Aeson.String txt')) - Just w' -> Just (PackageName w', KM.singleton "repo" (Aeson.String txt')) - else Nothing + second PackageSpec + <$> + -- basic heuristics for figuring out if something is a git repo + if isGitURL + then case T.splitOn "/" txt of + [] -> Nothing + (last -> w) -> case T.stripSuffix ".git" w of + Nothing -> Just (PackageName w, KM.fromList ["repo" .= txt', "type" .= Aeson.String "git"]) + Just w' -> Just (PackageName w', KM.fromList ["repo" .= txt', "type" .= Aeson.String "git"]) + else Nothing where isGitURL = ".git" `T.isSuffixOf` txt || "git@" - `T.isPrefixOf` txt + `T.isPrefixOf` txt || "ssh://" - `T.isPrefixOf` txt - -parseGitPackageSpec :: Opts.Parser PackageSpec -parseGitPackageSpec = - (PackageSpec . KM.fromList) - <$> many (parseRepo <|> parseBranch <|> parseRev <|> parseAttr <|> parseSAttr) - where - parseRepo = - ("repo",) . Aeson.String - <$> Opts.strOption - ( Opts.long "repo" - <> Opts.metavar "URL" - ) - parseRev = - ("rev",) . Aeson.String - <$> Opts.strOption - ( Opts.long "rev" - <> Opts.metavar "SHA" - ) - parseBranch = - ("branch",) . Aeson.String - <$> Opts.strOption - ( Opts.long "branch" - <> Opts.short 'b' - <> Opts.metavar "BRANCH" - ) - parseAttr = - Opts.option - (Opts.maybeReader parseKeyValJSON) - ( Opts.long "attribute" - <> Opts.short 'a' - <> Opts.metavar "KEY=VAL" - <> Opts.help "Set the package spec attribute to , where may be JSON." - ) - parseSAttr = - Opts.option - (Opts.maybeReader (parseKeyVal Aeson.toJSON)) - ( Opts.long "string-attribute" - <> Opts.short 's' - <> Opts.metavar "KEY=VAL" - <> Opts.help "Set the package spec attribute to ." - ) - parseKeyValJSON = parseKeyVal $ \x -> - fromMaybe (Aeson.toJSON x) (Aeson.decodeStrict (B8.pack x)) - -- Parse "key=val" into ("key", val) - parseKeyVal :: - -- how to convert to JSON - (String -> Aeson.Value) -> - String -> - Maybe (K.Key, Aeson.Value) - parseKeyVal toJSON str = case span (/= '=') str of - (key, '=' : val) -> Just (K.fromString key, toJSON val) - _ -> Nothing - -describeGit :: Opts.InfoMod a -describeGit = - mconcat - [ Opts.fullDesc, - Opts.progDesc "Add a git dependency. Experimental.", - Opts.headerDoc $ - Just $ - "Examples:" - Opts.<$$> "" - Opts.<$$> " niv add git git@github.com:stedolan/jq" - Opts.<$$> " niv add git ssh://git@github.com/stedolan/jq --rev deadb33f" - Opts.<$$> " niv add git https://github.com/stedolan/jq.git" - Opts.<$$> " niv add git --repo /my/custom/repo --name custom --branch development" - ] + `T.isPrefixOf` txt gitUpdate :: -- | latest rev @@ -178,7 +104,7 @@ sout <- runGit gitArgs case sout of ls@(_ : _ : _) -> abortTooMuchOutput gitArgs ls - (l1 : []) -> parseRev gitArgs l1 + [l1] -> parseRev gitArgs l1 [] -> abortNoOutput gitArgs where parseRev args l = maybe (abortNoRev args l) pure $ do @@ -240,7 +166,7 @@ isRev :: T.Text -> Bool isRev t = -- commit hashes are comprised of abcdef0123456789 - T.all (\c -> (c >= 'a' && c <= 'f') || (c >= '0' && c <= '9')) t + T.all (\c -> (c >= 'a' && c <= 'f') || isDigit c) t && -- commit _should_ be 40 chars long, but to be sure we pick 7 T.length t >= 7 @@ -263,3 +189,7 @@ T.unwords ("command:" : "git" : args), msg ] + +abort :: (MonadIO io) => T.Text -> io a +abort msg = + liftIO $ throwError $ userError $ T.unpack msg diff --git a/src/Niv/Git/Test.hs b/src/Niv/Git/Test.hs --- a/src/Niv/Git/Test.hs +++ b/src/Niv/Git/Test.hs @@ -7,6 +7,8 @@ where import Control.Monad +import Data.Aeson ((.=)) +import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KM import Data.Bifunctor import qualified Data.HashMap.Strict as HMS @@ -30,21 +32,21 @@ Tasty.testCase "git@github.com:nmattia/niv" $ parseGitShortcut "git@github.com:nmattia/niv" @=? Just - (PackageName "niv", KM.singleton "repo" "git@github.com:nmattia/niv"), + (PackageName "niv", PackageSpec $ KM.fromList ["repo" .= Aeson.String "git@github.com:nmattia/niv", "type" .= Aeson.String "git"]), Tasty.testCase "ssh://git@github.com/stedolan/jq" $ parseGitShortcut "ssh://git@github.com/stedolan/jq" @=? Just - (PackageName "jq", KM.singleton "repo" "ssh://git@github.com/stedolan/jq"), + (PackageName "jq", PackageSpec $ KM.fromList ["repo" .= Aeson.String "ssh://git@github.com/stedolan/jq", "type" .= Aeson.String "git"]), Tasty.testCase "https://github.com/stedolan/jq.git" $ parseGitShortcut "https://github.com/stedolan/jq.git" @=? Just - (PackageName "jq", KM.singleton "repo" "https://github.com/stedolan/jq.git"), + (PackageName "jq", PackageSpec $ KM.fromList ["repo" .= Aeson.String "https://github.com/stedolan/jq.git", "type" .= Aeson.String "git"]), Tasty.testCase "https://github.com/stedolan/jq" $ parseGitShortcut "https://github.com/stedolan/jq" @=? Nothing, Tasty.testCase "~/path/to/repo.git" $ parseGitShortcut "~/path/to/repo.git" @=? Just - (PackageName "repo", KM.singleton "repo" "~/path/to/repo.git") + (PackageName "repo", PackageSpec $ KM.fromList ["repo" .= Aeson.String "~/path/to/repo.git", "type" .= Aeson.String "git"]) ] test_gitUpdates :: Tasty.TestTree diff --git a/src/Niv/GitHub.hs b/src/Niv/GitHub.hs --- a/src/Niv/GitHub.hs +++ b/src/Niv/GitHub.hs @@ -1,9 +1,6 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE ViewPatterns #-} module Niv.GitHub where @@ -31,12 +28,21 @@ githubUpdate prefetch latestRev ghRepo = proc () -> do urlTemplate <- template - <<< (useOrSet "url_template" <<< completeSpec) <+> (load "url_template") + <<< (useOrSet "url_template" <<< completeSpec) <+> load "url_template" -< () url <- update "url" -< urlTemplate - let isTarGuess = (\u -> "tar.gz" `T.isSuffixOf` u || ".tgz" `T.isSuffixOf` u) <$> url - type' <- useOrSet "type" -< bool "file" "tarball" <$> isTarGuess :: Box T.Text + let isTarGuess u = + any + (`T.isSuffixOf` u) + [ ".tar", + ".tar.gz", + ".tgz", + ".tar.bz2", + ".tar.xz", + ".tar.zst" + ] + type' <- useOrSet "type" -< bool "file" "tarball" . isTarGuess <$> url :: Box T.Text let doUnpack = (== "tarball") <$> type' _sha256 <- update "sha256" <<< run (\(up, u) -> prefetch up u) -< (,) <$> doUnpack <*> url returnA -< () diff --git a/src/Niv/GitHub/API.hs b/src/Niv/GitHub/API.hs --- a/src/Niv/GitHub/API.hs +++ b/src/Niv/GitHub/API.hs @@ -5,6 +5,7 @@ module Niv.GitHub.API where +import Control.Monad.Except (throwError) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KM import qualified Data.ByteString.Char8 as BS8 @@ -16,9 +17,9 @@ import Data.Text.Extended import qualified Network.HTTP.Simple as HTTP import System.Environment (lookupEnv) -import System.Exit (exitFailure) import System.IO.Unsafe (unsafePerformIO) import Text.Read (readMaybe) +import UnliftIO -- Bunch of GitHub helpers @@ -55,8 +56,7 @@ -- | TODO: Error instead of T.Text? abortCouldNotFetchGitHubRepo :: T.Text -> (T.Text, T.Text) -> IO a abortCouldNotFetchGitHubRepo e (T.unpack -> owner, T.unpack -> repo) = do - putStrLn $ unlines [line1, line2, T.unpack line3] - exitFailure + abort $ T.pack $ unlines [line1, line2, T.unpack line3] where line1 = "WARNING: Could not read from GitHub repo: " <> owner <> "/" <> repo line2 = @@ -78,19 +78,21 @@ defaultRequest :: [T.Text] -> IO HTTP.Request defaultRequest (map T.encodeUtf8 -> parts) = do - let path = T.encodeUtf8 githubPath <> BS8.intercalate "/" (parts) + let path = T.encodeUtf8 githubPath <> BS8.intercalate "/" parts mtoken <- lookupEnv' "GITHUB_TOKEN" pure - $ ( flip (maybe id) mtoken $ \token -> + $ maybe + id + ( \token -> HTTP.addRequestHeader "authorization" ("token " <> BS8.pack token) ) + mtoken $ HTTP.setRequestPath path $ HTTP.addRequestHeader "user-agent" "niv" $ HTTP.addRequestHeader "accept" "application/vnd.github.v3+json" $ HTTP.setRequestSecure githubSecure $ HTTP.setRequestHost (T.encodeUtf8 githubApiHost) - $ HTTP.setRequestPort githubApiPort - $ HTTP.defaultRequest + $ HTTP.setRequestPort githubApiPort HTTP.defaultRequest -- | Get the latest revision for owner, repo and branch. -- TODO: explain no error handling @@ -174,3 +176,7 @@ lookupEnv "NIV_GITHUB_PATH" >>= \case Just (T.pack -> x) -> pure $ fromMaybe x (T.stripSuffix "/" x) <> "/" Nothing -> pure "/" + +abort :: (MonadIO io) => T.Text -> io a +abort msg = + liftIO $ throwError $ userError $ T.unpack msg diff --git a/src/Niv/GitHub/Cmd.hs b/src/Niv/GitHub/Cmd.hs --- a/src/Niv/GitHub/Cmd.hs +++ b/src/Niv/GitHub/Cmd.hs @@ -10,147 +10,50 @@ ) where -import Control.Applicative import Data.Aeson ((.=)) -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import Data.Bifunctor -import qualified Data.ByteString.Char8 as B8 import Data.Char (isAlphaNum) -import Data.Maybe import Data.String.QQ (s) import qualified Data.Text as T -import Data.Text.Extended import Niv.Cmd import Niv.GitHub import Niv.GitHub.API import Niv.Sources import Niv.Update -import qualified Options.Applicative as Opts -import qualified Options.Applicative.Help.Pretty as Opts import System.Exit (ExitCode (ExitSuccess)) import System.Process (readProcessWithExitCode) githubCmd :: Cmd githubCmd = Cmd - { description = describeGitHub, - parseCmdShortcut = parseAddShortcutGitHub, - parsePackageSpec = parseGitHubPackageSpec, + { parseCmdShortcut = parseAddShortcutGitHub, updateCmd = githubUpdate', name = "github", - extraLogs = const [] - -- TODO: here filter by type == tarball or file or builtin- + extraLogs = const [], + acceptsCmd = \(unPackageSpec -> spec) -> + (KM.member "repo" spec && KM.member "owner" spec) || KM.member "url_template" spec } -parseGitHubPackageSpec :: Opts.Parser PackageSpec -parseGitHubPackageSpec = - (PackageSpec . KM.fromList) - <$> many parseAttribute - where - parseAttribute :: Opts.Parser (K.Key, Aeson.Value) - parseAttribute = - Opts.option - (Opts.maybeReader parseKeyValJSON) - ( Opts.long "attribute" - <> Opts.short 'a' - <> Opts.metavar "KEY=VAL" - <> Opts.help "Set the package spec attribute to , where may be JSON." - ) - <|> Opts.option - (Opts.maybeReader (parseKeyVal Aeson.toJSON)) - ( Opts.long "string-attribute" - <> Opts.short 's' - <> Opts.metavar "KEY=VAL" - <> Opts.help "Set the package spec attribute to ." - ) - <|> shortcutAttributes - <|> ( (("url_template",) . Aeson.String) - <$> Opts.strOption - ( Opts.long "template" - <> Opts.short 't' - <> Opts.metavar "URL" - <> Opts.help "Used during 'update' when building URL. Occurrences of are replaced with attribute 'foo'." - ) - ) - <|> ( (("type",) . Aeson.String) - <$> Opts.strOption - ( Opts.long "type" - <> Opts.short 'T' - <> Opts.metavar "TYPE" - <> Opts.help "The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL." - ) - ) - parseKeyValJSON = parseKeyVal $ \x -> - fromMaybe (Aeson.toJSON x) (Aeson.decodeStrict (B8.pack x)) - -- Parse "key=val" into ("key", val) - parseKeyVal :: - -- how to convert to JSON - (String -> Aeson.Value) -> - String -> - Maybe (K.Key, Aeson.Value) - parseKeyVal toJSON str = case span (/= '=') str of - (key, '=' : val) -> Just (K.fromString key, toJSON val) - _ -> Nothing - -- Shortcuts for common attributes - shortcutAttributes :: Opts.Parser (K.Key, Aeson.Value) - shortcutAttributes = - foldr (<|>) empty $ - mkShortcutAttribute - <$> ["branch", "owner", "rev", "version"] - -- TODO: infer those shortcuts from 'Update' keys - mkShortcutAttribute :: T.Text -> Opts.Parser (K.Key, Aeson.Value) - mkShortcutAttribute = \case - attr@(T.uncons -> Just (c, _)) -> - fmap (second Aeson.String) $ - (K.fromText attr,) - <$> Opts.strOption - ( Opts.long (T.unpack attr) - <> Opts.short c - <> Opts.metavar (T.unpack $ T.toUpper attr) - <> Opts.help - ( T.unpack $ - "Equivalent to --attribute " - <> attr - <> "=<" - <> (T.toUpper attr) - <> ">" - ) - ) - _ -> empty - -describeGitHub :: Opts.InfoMod a -describeGitHub = - mconcat - [ Opts.fullDesc, - Opts.progDesc "Add a GitHub dependency", - Opts.headerDoc $ - Just $ - "Examples:" - Opts.<$$> "" - Opts.<$$> " niv add stedolan/jq" - Opts.<$$> " niv add NixOS/nixpkgs -n nixpkgs -b nixpkgs-unstable" - Opts.<$$> " niv add my-package -v alpha-0.1 -t http://example.com/archive/.zip" - ] - -- parse a github shortcut of the form "owner/repo" -parseAddShortcutGitHub :: T.Text -> Maybe (PackageName, Aeson.Object) +parseAddShortcutGitHub :: T.Text -> Maybe (PackageName, PackageSpec) parseAddShortcutGitHub str = - -- parses a string "owner/repo" into package name (repo) and spec (owner + - -- repo) - case T.span (/= '/') str of - ( owner@(T.null -> False), - T.uncons -> Just ('/', repo@(T.null -> False)) - ) -> - Just - ( PackageName repo, - KM.fromList ["owner" .= owner, "repo" .= repo] - ) - -- XXX: this should be "Nothing" but for the time being we keep - -- backwards compatibility with "niv add foo" adding "foo" as a - -- package name. - _ -> Just (PackageName str, KM.empty) + second PackageSpec + <$> + -- parses a string "owner/repo" into package name (repo) and spec (owner + + -- repo) + case T.span (/= '/') str of + ( owner@(T.null -> False), + T.uncons -> Just ('/', repo@(T.null -> False)) + ) -> + Just + ( PackageName repo, + KM.fromList ["owner" .= owner, "repo" .= repo] + ) + -- XXX: this should be "Nothing" but for the time being we keep + -- backwards compatibility with "niv add foo" adding "foo" as a + -- package name. + _ -> Just (PackageName str, KM.empty) -- | The IO (real) github update githubUpdate' :: Update () () @@ -163,7 +66,7 @@ (ExitSuccess, l : _) -> pure $ T.pack l _ -> abortNixPrefetchExpectedOutput (T.pack <$> args) (T.pack sout) (T.pack serr) where - args = (if unpack then ["--unpack"] else []) <> [url, "--name", sanitizeName basename] + args = (["--unpack" | unpack]) <> [url, "--name", sanitizeName basename] runNixPrefetch = readProcessWithExitCode "nix-prefetch-url" args "" sanitizeName = T.unpack . T.filter isOk basename = last $ T.splitOn "/" turl @@ -171,7 +74,7 @@ -- Path names are alphanumeric and can include the symbols +-._?= and must -- not begin with a period. -- (note: we assume they don't begin with a period) - isOk = \c -> isAlphaNum c || T.any (c ==) "+-._?=" + isOk c = isAlphaNum c || T.any (c ==) "+-._?=" abortNixPrefetchExpectedOutput :: [T.Text] -> T.Text -> T.Text -> IO a abortNixPrefetchExpectedOutput args sout serr = @@ -184,4 +87,4 @@ Thanks! I'll buy you a beer. |] - <> T.unlines ["command: ", "nix-prefetch-url" <> T.unwords args, "stdout: ", sout, "stderr: ", serr] + <> T.unlines ["command: ", T.unwords ("nix-prefetch-url" : args), "stdout: ", sout, "stderr: ", serr] diff --git a/src/Niv/Local/Cmd.hs b/src/Niv/Local/Cmd.hs --- a/src/Niv/Local/Cmd.hs +++ b/src/Niv/Local/Cmd.hs @@ -1,7 +1,5 @@ {-# LANGUAGE Arrows #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} @@ -10,56 +8,29 @@ import Control.Arrow import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import qualified Data.Text as T import Niv.Cmd import Niv.Sources import Niv.Update -import qualified Options.Applicative as Opts -import qualified Options.Applicative.Help.Pretty as Opts localCmd :: Cmd localCmd = Cmd - { description = describeLocal, - parseCmdShortcut = parseLocalShortcut, - parsePackageSpec = parseLocalPackageSpec, + { parseCmdShortcut = parseLocalShortcut, updateCmd = proc () -> do useOrSet "type" -< ("local" :: Box T.Text) returnA -< (), name = "local", - extraLogs = const [] + extraLogs = const [], + acceptsCmd = \(unPackageSpec -> spec) -> KM.lookup "type" spec == Just "local" } -parseLocalShortcut :: T.Text -> Maybe (PackageName, Aeson.Object) +parseLocalShortcut :: T.Text -> Maybe (PackageName, PackageSpec) parseLocalShortcut txt = - if (T.isPrefixOf "./" txt || T.isPrefixOf "/" txt) - then do - let n = last $ T.splitOn "/" txt - Just (PackageName n, KM.fromList [("path", Aeson.String txt)]) - else Nothing - -parseLocalPackageSpec :: Opts.Parser PackageSpec -parseLocalPackageSpec = PackageSpec . KM.fromList <$> parseParams - where - parseParams :: Opts.Parser [(K.Key, Aeson.Value)] - parseParams = maybe [] pure <$> Opts.optional parsePath - parsePath = - ("path",) . Aeson.String - <$> Opts.strOption - ( Opts.long "path" - <> Opts.metavar "PATH" - ) - -describeLocal :: Opts.InfoMod a -describeLocal = - mconcat - [ Opts.fullDesc, - Opts.progDesc "Add a local dependency. Experimental.", - Opts.headerDoc $ - Just $ - "Examples:" - Opts.<$$> "" - Opts.<$$> " niv add local ./foo/bar" - ] + second PackageSpec + <$> if T.isPrefixOf "./" txt || T.isPrefixOf "/" txt + then do + let n = last $ T.splitOn "/" txt + Just (PackageName n, KM.fromList [("path", Aeson.String txt), ("type", Aeson.String "local")]) + else Nothing diff --git a/src/Niv/Logger.hs b/src/Niv/Logger.hs --- a/src/Niv/Logger.hs +++ b/src/Niv/Logger.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -7,12 +8,10 @@ ( Colors (Always, Never), job, setColors, - bug, - tsay, say, - twarn, - mkWarn, - mkNote, + note, + warn, + throwError, green, tgreen, red, @@ -25,18 +24,134 @@ tbold, faint, tfaint, + Job, ) where import Control.Monad +import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError) +import Control.Monad.Trans (MonadTrans, lift) +import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell) import Data.List import Data.Profunctor import qualified Data.Text as T +import qualified Data.Text.IO as T import qualified System.Console.ANSI as ANSI -import System.Exit (exitFailure) import System.IO.Unsafe (unsafePerformIO) import UnliftIO +newtype Job io a = Job + -- A monad stack for use with logging functions below. Can throw a (textual) + -- error, and gathers admonitions (monad writer: (, )) + { unJob :: ExceptT T.Text (WriterT ([T.Text], [T.Text]) io) a + } + deriving newtype + ( Functor, + Applicative, + Monad, + MonadError T.Text, + MonadWriter ([T.Text], [T.Text]), + MonadIO + ) + +instance MonadTrans Job where + lift = Job . lift . lift + +warn :: (Monad io) => T.Text -> Job io () +warn w = tell ([], [w]) + +note :: (Monad io) => T.Text -> Job io () +note n = tell ([n], []) + +-- | Run a Job, getting back the result (or error) plus accumulated log. +job :: (MonadUnliftIO io, MonadIO io) => T.Text -> Job io a -> io (Either () a) +job name jb = bracket_ (liftIO ANSI.hideCursor) (liftIO ANSI.showCursor) $ do + -- the "prefixes" that are shown in front of the job name + let pending = " • " + success = tgreen " ✓ " + warning = tyellow " ✓ " + failure = tred " ⨯ " + + -- write a "prefix" and the name: + -- " • foo" + liftIO $ T.putStr $ pending <> tbold name <> " " + hFlush stdout + + -- run the job (the 'say' function expects the cursor to be positioned after + -- the name) + (res, (ns, ws)) <- runWriterT . runExceptT . unJob $ jb + + -- overwrite the default "prefix" with the result-aware one + liftIO $ ANSI.setCursorColumn 0 + let prefix = case res of + Left _ -> failure + Right _ -> + if length ws >= 1 + then + warning + else success + liftIO $ T.putStrLn prefix + + -- print admonitions logged during run + let ns' = fmap (\n -> (tblue "note", n)) ns + let ws' = fmap (\w -> (tyellow "warning", w)) ws + -- if the job errored out, add an "error" admonition + let admns = + (ns' <> ws') <> case res of + Left (err) -> [(tred "error", err)] + Right _ -> [] + + printAdmonitions admns + + res' <- case res of + Left _ -> pure (Left ()) + Right value -> pure (Right value) + pure res' + +-- prints "admonitions": +-- +-- ├ note: +-- │ │ this is the first note +-- │ └ which is a multiline note +-- └ note: +-- └ this is another note +printAdmonitions :: (MonadIO io) => [(T.Text, T.Text)] -> io () +printAdmonitions admns = case unsnoc admns of + Nothing -> pure () + Just (inits', last') -> do + mapM_ (\(admn, txt) -> printAdmonition admn False txt) inits' + let (admn, txt) = last' + printAdmonition admn True txt + where + printAdmonition admn isLast txt = + case unsnoc (T.lines txt) of + Nothing -> pure () + Just (inits', last') -> do + -- hdr: header (name), idt: indent (alongside text), cls: close (last + -- line of text). + -- all are either for the (I)nitial line or the (L)ast line. + let hdrI = " ├ " <> admn <> ": " + hdrL = " └ " <> admn <> ": " + idtI line = " │ │ " <> line + idtL line = " │ " <> line + clsI = " │ └ " <> last' + clsL = " └ " <> last' + hdr = if isLast then hdrL else hdrI + idt = if isLast then idtL else idtI + cls = if isLast then clsL else clsI + + liftIO $ do + T.putStrLn hdr + forM_ inits' $ liftIO . T.putStrLn . idt + T.putStrLn cls + +say :: (MonadIO io) => T.Text -> Job io () +say msg = do + liftIO $ ANSI.clearFromCursorToLineEnd + liftIO $ T.putStr msg + liftIO $ ANSI.cursorBackward $ T.length msg + hFlush stdout + -- A somewhat hacky way of deciding whether or not to use SGR codes, by writing -- and reading a global variable unsafely. -- This should be fine as long as the IORef is written right after argument @@ -56,64 +171,17 @@ setColors = writeIORef colors useColors :: Bool -useColors = unsafePerformIO $ (\c -> c == Always) <$> readIORef colors +useColors = unsafePerformIO $ (== Always) <$> readIORef colors type S = String -> String type T = T.Text -> T.Text --- XXX: this assumes as single thread -job :: (MonadUnliftIO io, MonadIO io) => String -> io () -> io () -job str act = do - say (bold str) - indent - tryAny act <* deindent >>= \case - Right () -> say $ green "Done" <> ": " <> str - Left e -> do - -- don't wrap if the error ain't too long - let showErr = do - let se = show e - (if length se > 40 then ":\n" else ": ") <> se - say $ red "ERROR" <> showErr - liftIO exitFailure - where - indent = void $ atomicModifyIORef jobStack (\x -> (x + 1, undefined)) - deindent = void $ atomicModifyIORef jobStack (\x -> (x - 1, undefined)) - -jobStackSize :: MonadIO io => io Int -jobStackSize = readIORef jobStack - -jobStack :: IORef Int -jobStack = unsafePerformIO $ newIORef 0 - -{-# NOINLINE jobStackSize #-} - -tsay :: MonadIO io => T.Text -> io () -tsay = say . T.unpack - -say :: MonadIO io => String -> io () -say msg = do - stackSize <- jobStackSize - let indent = replicate (stackSize * 2) ' ' - -- we use `intercalate "\n"` because `unlines` prints an extra newline at - -- the end - liftIO $ putStrLn $ intercalate "\n" $ (indent <>) <$> lines msg - -mkWarn :: T.Text -> T.Text -mkWarn w = tbold (tyellow "WARNING") <> ": " <> w - -twarn :: MonadIO io => T.Text -> io () -twarn = tsay . mkWarn - -mkNote :: T.Text -> T.Text -mkNote w = tbold (tblue "NOTE") <> ": " <> w - color :: ANSI.Color -> String -> String color c str = if useColors then - ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] - <> ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid c] + ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid c] <> str <> ANSI.setSGRCode [ANSI.Reset] else str @@ -166,12 +234,3 @@ t :: (String -> String) -> T.Text -> T.Text t = dimap T.unpack T.pack - -bug :: T.Text -> T.Text -bug txt = - T.unlines - [ txt, - "This is a bug. Please create a ticket:", - " https://github.com/nmattia/niv/issues/new", - "Thanks! I'll buy you a beer." - ] diff --git a/src/Niv/Sources.hs b/src/Niv/Sources.hs --- a/src/Niv/Sources.hs +++ b/src/Niv/Sources.hs @@ -2,7 +2,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module Niv.Sources where @@ -19,9 +18,8 @@ import qualified Data.HashMap.Strict as HMS import Data.Hashable (Hashable) import Data.List -import Data.String.QQ (s) import qualified Data.Text as T -import Data.Text.Extended +import qualified Data.Text.IO as T import Niv.Logger import Niv.Update import qualified System.Directory as Dir @@ -62,37 +60,26 @@ valueToSources :: Aeson.Value -> Maybe Sources valueToSources = \case Aeson.Object obj -> - fmap (Sources . mapKeys PackageName . KM.toHashMapText) $ - traverse - ( \case - Aeson.Object obj' -> Just (PackageSpec obj') - _ -> Nothing - ) - obj + ( Sources . mapKeys PackageName . KM.toHashMapText + <$> traverse + ( \case + Aeson.Object obj' -> Just (PackageSpec obj') + _ -> Nothing + ) + obj + ) _ -> Nothing mapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> HMS.HashMap k1 v -> HMS.HashMap k2 v mapKeys f = HMS.fromList . map (first f) . HMS.toList -getSources :: FindSourcesJson -> IO Sources -getSources fsj = do - warnIfOutdated - getSourcesEither fsj - >>= either - ( \case - SourcesDoesntExist -> (abortSourcesDoesntExist fsj) - SourceIsntJSON -> (abortSourcesIsntJSON fsj) - SpecIsntAMap -> (abortSpecIsntAMap fsj) - ) - pure - setSources :: FindSourcesJson -> Sources -> IO () -setSources fsj sources = Aeson.encodeFilePretty (pathNixSourcesJson fsj) sources +setSources fsj = Aeson.encodeFilePretty (pathNixSourcesJson fsj) newtype PackageName = PackageName {unPackageName :: T.Text} deriving newtype (Eq, Hashable, FromJSONKey, ToJSONKey, Show) newtype PackageSpec = PackageSpec {unPackageSpec :: Aeson.Object} - deriving newtype (FromJSON, ToJSON, Show, Semigroup, Monoid) + deriving newtype (FromJSON, ToJSON, Show, Semigroup, Monoid, Eq) -- | Simply discards the 'Freedom' attrsToSpec :: Attrs -> PackageSpec @@ -104,36 +91,6 @@ Auto -> "nix" "sources.json" AtPath f -> f --- --- ABORT messages --- - -abortSourcesDoesntExist :: FindSourcesJson -> IO a -abortSourcesDoesntExist fsj = abort $ T.unlines [line1, line2] - where - line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj) - line2 = - [s| -The sources file does not exist! You may need to run 'niv init'. -|] - -abortSourcesIsntJSON :: FindSourcesJson -> IO a -abortSourcesIsntJSON fsj = abort $ T.unlines [line1, line2] - where - line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj) - line2 = "The sources file should be JSON." - -abortSpecIsntAMap :: FindSourcesJson -> IO a -abortSpecIsntAMap fsj = abort $ T.unlines [line1, line2] - where - line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj) - line2 = - [s| -The package specifications in the sources file should be JSON maps from -attribute name to attribute value, e.g.: - { "nixpkgs": { "foo": "bar" } } -|] - ------------------------------------------------------------------------------- -- sources.nix related ------------------------------------------------------------------------------- @@ -181,6 +138,8 @@ | -- formatting fix -- Apply statix suggestions V28 + | -- Remove unnecessary recs + V29 deriving stock (Bounded, Enum, Eq) -- | A user friendly version @@ -214,6 +173,7 @@ V26 -> "26" V27 -> "27" V28 -> "28" + V29 -> "29" latestVersionMD5 :: T.Text latestVersionMD5 = sourcesVersionToMD5 maxBound @@ -254,6 +214,7 @@ V26 -> "937bff93370a064c9000f13cec5867f9" V27 -> "8031ba9d8fbbc7401c800d0b84278ec8" V28 -> "26ed55356db7673935329210a4f8c4a5" + V29 -> "a8751de841ac5e0a60f4c2db7e8bbade" -- | The MD5 sum of ./nix/sources.nix sourcesNixMD5 :: IO T.Text @@ -266,12 +227,7 @@ warnIfOutdated :: IO () warnIfOutdated = do tryAny (BL8.readFile pathNixSourcesNix) >>= \case - Left e -> - twarn $ - T.unlines - [ T.unwords ["Could not read", T.pack pathNixSourcesNix], - T.unwords [" ", "(", tshow e, ")"] - ] + Left _ -> pure () -- can't find it; let's not bother the user Right content -> do case md5ToSourcesVersion (T.pack $ show $ MD5.md5 content) of -- This is a custom or newer version, we don't do anything @@ -281,10 +237,10 @@ | v == maxBound -> pure () -- The file is older than than latest | otherwise -> do - tsay $ + T.putStrLn $ T.unlines [ T.unwords - [ tbold $ tblue "INFO:", + [ tblue "INFO:", "new sources.nix available:", sourcesVersionToText v, "->", diff --git a/src/Niv/Update.hs b/src/Niv/Update.hs --- a/src/Niv/Update.hs +++ b/src/Niv/Update.hs @@ -10,15 +10,14 @@ module Niv.Update where -import Control.Applicative import Control.Arrow import qualified Control.Category as Cat +import Control.Monad.Except (throwError) import Data.Aeson (FromJSON, ToJSON, Value) import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict as HMS import Data.String import qualified Data.Text as T -import Niv.Logger import UnliftIO type Attrs = HMS.HashMap T.Text (Freedom, Value) @@ -70,14 +69,14 @@ -- | Run an 'Update' and return the new attributes and result. runUpdate :: Attrs -> Update () a -> IO (Attrs, a) -runUpdate (attrs) a = boxAttrs attrs >>= flip runUpdate' a >>= feed +runUpdate attrs a = boxAttrs attrs >>= flip runUpdate' a >>= feed where feed = \case UpdateReady res -> hndl res - UpdateNeedMore next -> next (()) >>= hndl + UpdateNeedMore next -> next () >>= hndl hndl = \case UpdateSuccess f v -> (,v) <$> unboxAttrs f - UpdateFailed e -> error $ "Update failed: " <> T.unpack (prettyFail e) + UpdateFailed e -> throwError $ userError $ "Update failed: " <> T.unpack (prettyFail e) prettyFail :: UpdateFailed -> T.Text prettyFail = \case FailNoSuchKey k -> "Key could not be found: " <> k @@ -89,6 +88,15 @@ "with keys: " <> T.intercalate ", " keys ] +bug :: T.Text -> T.Text +bug txt = + T.unlines + [ txt, + "This is a bug. Please create a ticket:", + " https://github.com/nmattia/niv/issues/new", + "Thanks! I'll buy you a beer." + ] + execUpdate :: Attrs -> Update () a -> IO a execUpdate attrs a = snd <$> runUpdate attrs a @@ -149,7 +157,7 @@ boxOp = boxOp f <*> boxOp v } -instance Semigroup a => Semigroup (Box a) where +instance (Semigroup a) => Semigroup (Box a) where (<>) = liftA2 (<>) instance IsString (Box T.Text) where @@ -239,7 +247,7 @@ Update k -> pure $ case HMS.lookup k attrs of Just (Locked, v) -> UpdateReady $ UpdateSuccess attrs v Just (Free, v) -> UpdateNeedMore $ \gtt -> do - if (boxNew gtt) + if boxNew gtt then do v' <- boxOp v gtt' <- boxOp gtt @@ -276,21 +284,21 @@ v' <- runBox v case renderTemplate ( \k -> - ((decodeBox $ "When rendering template " <> v') . snd) + decodeBox ("When rendering template " <> v') . snd <$> HMS.lookup k attrs ) v' of Nothing -> pure $ UpdateFailed $ FailTemplate v' (HMS.keys attrs) Just v'' -> pure $ UpdateSuccess attrs (v'' <* v) -- carries over v's newness -decodeBox :: FromJSON a => T.Text -> Box Value -> Box a +decodeBox :: (FromJSON a) => T.Text -> Box Value -> Box a decodeBox msg v = v {boxOp = boxOp v >>= decodeValue msg} -decodeValue :: FromJSON a => T.Text -> Value -> IO a +decodeValue :: (FromJSON a) => T.Text -> Value -> IO a decodeValue msg v = case Aeson.fromJSON v of Aeson.Success x -> pure x Aeson.Error str -> - error $ T.unpack msg <> ": Could not decode: " <> show v <> ": " <> str + throwError $ userError $ T.unpack msg <> ": Could not decode: " <> show v <> ": " <> str -- | Renders the template. Returns 'Nothing' if some of the attributes are -- missing. @@ -302,7 +310,7 @@ case T.span (/= '>') str of (key, T.uncons -> Just ('>', rest)) -> do let v = vals key - (liftA2 (<>) v) (renderTemplate vals rest) + liftA2 (<>) v (renderTemplate vals rest) _ -> Nothing Just (c, str) -> fmap (T.cons c) <$> renderTemplate vals str Nothing -> Just $ pure T.empty @@ -313,17 +321,17 @@ check :: (a -> Bool) -> Update (Box a) () check = Check -load :: FromJSON a => T.Text -> Update () (Box a) +load :: (FromJSON a) => T.Text -> Update () (Box a) load k = Load k >>> arr (decodeBox $ "When loading key " <> k) -- TODO: should input really be Box? -useOrSet :: JSON a => T.Text -> Update (Box a) (Box a) +useOrSet :: (JSON a) => T.Text -> Update (Box a) (Box a) useOrSet k = arr (fmap Aeson.toJSON) >>> UseOrSet k >>> arr (decodeBox $ "When trying to use or set key " <> k) -update :: JSON a => T.Text -> Update (Box a) (Box a) +update :: (JSON a) => T.Text -> Update (Box a) (Box a) update k = arr (fmap Aeson.toJSON) >>> Update k diff --git a/src/Niv/Update/Test.hs b/src/Niv/Update/Test.hs --- a/src/Niv/Update/Test.hs +++ b/src/Niv/Update/Test.hs @@ -68,8 +68,8 @@ let f1 = proc () -> do run (const $ error "IO is too eager (f1)") -< pure () useOrSet "foo" -< "foo" - void $ (execUpdate attrs f :: IO (Box T.Text)) - void $ (execUpdate attrs f1 :: IO (Box T.Text)) + void (execUpdate attrs f :: IO (Box T.Text)) + void (execUpdate attrs f1 :: IO (Box T.Text)) where attrs = HMS.singleton "foo" (Locked, "right")