niv 0.2.3 → 0.2.4

raw patch · 16 files changed

+726/−323 lines, 16 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +8/−4
• niv.cabal +8/−2
• nix/sources.nix +5/−1
• src/Data/Text/Extended.hs +16/−0
• src/Niv/Cli.hs +77/−134
• src/Niv/Cmd.hs +18/−0
• src/Niv/Git/Cmd.hs +195/−0
• src/Niv/Git/Test.hs +30/−0
• src/Niv/GitHub.hs +1/−160
• src/Niv/GitHub/API.hs +160/−0
• src/Niv/GitHub/Cmd.hs +153/−0
• src/Niv/GitHub/Test.hs +1/−0
• src/Niv/Logger.hs +46/−15
• src/Niv/Sources.hs +4/−1
• src/Niv/Test.hs +2/−0
• src/Niv/Update.hs +2/−6

@@ -199,7 +199,7 @@ ``` niv - dependency manager for Nix projects -version: 0.2.3+version: 0.2.4  Usage: niv COMMAND @@ -209,7 +209,7 @@ Available commands:   init                     Initialize a Nix project. Existing files won't be                            modified.-  add                      Add dependency+  add                      Add a GitHub dependency   show                        update                   Update dependencies   modify                   Modify dependency@@ -226,11 +226,11 @@   niv add NixOS/nixpkgs-channels -n nixpkgs -b nixos-19.03   niv add my-package -v alpha-0.1 -t http://example.com/archive/<version>.zip -Usage: niv add [-n|--name NAME] PACKAGE ([-a|--attribute KEY=VAL] |+Usage: niv add PACKAGE [-n|--name NAME] ([-a|--attribute KEY=VAL] |                [-s|--string-attribute KEY=VAL] | [-b|--branch BRANCH] |                [-o|--owner OWNER] | [-r|--repo REPO] | [-v|--version VERSION] |                [-t|--template URL] | [-T|--type TYPE])-  Add dependency+  Add a GitHub dependency  Available options:   -n,--name NAME           Set the package name to <NAME>@@ -248,6 +248,10 @@                            '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  ``` 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 340462761c19c599af0d4d6847a470a4487bdb15dabd5a38b9ce07d90a114c8d+-- hash: e29016efb58986c56321e138b2844711e1b8c29646afe6e03cc371d0f05003df  name:           niv-version:        0.2.3+version:        0.2.4 synopsis:       Easy dependency management for Nix projects description:    Easy dependency management for Nix projects. category:       Development@@ -32,8 +32,14 @@   exposed-modules:       Data.Aeson.Extended       Data.HashMap.Strict.Extended+      Data.Text.Extended       Niv.Cli+      Niv.Cmd+      Niv.Git.Cmd+      Niv.Git.Test       Niv.GitHub+      Niv.GitHub.API+      Niv.GitHub.Cmd       Niv.GitHub.Test       Niv.Logger       Niv.Sources

@@ -18,6 +18,9 @@     else       pkgs.fetchzip { inherit (spec) url sha256; }; +  fetch_git = spec:+      builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; };+   fetch_builtin-tarball = spec:     builtins.trace       ''@@ -80,10 +83,11 @@       abort "ERROR: niv spec ${name} does not have a 'type' attribute"     else if spec.type == "file" then fetch_file spec     else if spec.type == "tarball" then fetch_tarball spec+    else if spec.type == "git" then fetch_git spec     else if spec.type == "builtin-tarball" then fetch_builtin-tarball spec     else if spec.type == "builtin-url" then fetch_builtin-url spec     else-      abort "ERROR: niv spec ${name} has unknown type ${builtins.fromJSON spec.type}";+      abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}";    # Ports of functions for older nix versions 

@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Text.Extended where++import Niv.Logger+import System.Exit (exitFailure)+import qualified Data.Text as T++tshow :: Show a => a -> T.Text+tshow = T.pack . show++-- not quite the perfect place for this+abort :: T.Text -> IO a+abort msg = do+    tsay $ T.unwords [ tbold $ tred "FATAL:", msg ]+    exitFailure

@@ -11,22 +11,20 @@ import Control.Applicative import Control.Monad import Data.Aeson ((.=))-import Data.Bifunctor-import Data.Maybe import Data.Char (isSpace)-import Data.Functor import Data.HashMap.Strict.Extended import Data.Hashable (Hashable) import Data.String.QQ (s)+import Data.Text.Extended import Data.Version (showVersion)-import Niv.GitHub+import Niv.Cmd+import Niv.Git.Cmd+import Niv.GitHub.Cmd import Niv.Logger import Niv.Sources import Niv.Update import System.Environment (getArgs)-import System.Exit (ExitCode(ExitSuccess)) import System.FilePath (takeDirectory)-import System.Process (readProcessWithExitCode) import UnliftIO import qualified Data.Aeson as Aeson import qualified Data.ByteString as B@@ -70,72 +68,8 @@ parsePackageName = PackageName <$>     Opts.argument Opts.str (Opts.metavar "PACKAGE") -parsePackageSpec :: Opts.Parser PackageSpec-parsePackageSpec =-    (PackageSpec . HMS.fromList) <$>-      many parseAttribute-  where-    parseAttribute :: Opts.Parser (T.Text, 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 <KEY> to <VAL>, where <VAL> 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 <KEY> to <VAL>."-        ) <|>-      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 <foo> 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-      :: (String -> Aeson.Value)  -- ^ how to convert to JSON-      -> String -> Maybe (T.Text, Aeson.Value)-    parseKeyVal toJSON str = case span (/= '=') str of-      (key, '=':val) -> Just (T.pack key, toJSON val)-      _ -> Nothing--    -- Shortcuts for common attributes-    shortcutAttributes :: Opts.Parser (T.Text, Aeson.Value)-    shortcutAttributes = foldr (<|>) empty $ mkShortcutAttribute <$>-      [ "branch", "owner", "repo", "version" ]--    -- TODO: infer those shortcuts from 'Update' keys-    mkShortcutAttribute :: T.Text -> Opts.Parser (T.Text, Aeson.Value)-    mkShortcutAttribute = \case-      attr@(T.uncons -> Just (c,_)) -> fmap (second Aeson.String) $ (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- parsePackage :: Opts.Parser (PackageName, PackageSpec)-parsePackage = (,) <$> parsePackageName <*> parsePackageSpec+parsePackage = (,) <$> parsePackageName <*> (parsePackageSpec githubCmd)  ------------------------------------------------------------------------------- -- INIT@@ -171,14 +105,14 @@               createFile path initNixSourcesJsonContent               -- Imports @niv@ and @nixpkgs@ (19.03)               say "Importing 'niv' ..."-              cmdAdd githubUpdate' (PackageName "niv")+              cmdAdd (updateCmd githubCmd) (PackageName "niv")                 (specToFreeAttrs $ PackageSpec $ HMS.fromList                   [ "owner" .= ("nmattia" :: T.Text)                   , "repo" .= ("niv" :: T.Text)                   ]                 )               say "Importing 'nixpkgs' ..."-              cmdAdd githubUpdate' (PackageName "nixpkgs")+              cmdAdd (updateCmd githubCmd) (PackageName "nixpkgs")                 (specToFreeAttrs $ PackageSpec $ HMS.fromList                   [ "owner" .= ("NixOS" :: T.Text)                   , "repo" .= ("nixpkgs-channels" :: T.Text)@@ -206,18 +140,43 @@ parseCmdAdd :: Opts.ParserInfo (IO ()) parseCmdAdd =     Opts.info-      ((uncurry (cmdAdd githubUpdate') <$> parseArgs) <**> Opts.helper) $-      mconcat desc+      ((parseCommands <|> parseShortcuts) <**> Opts.helper) $+      (description githubCmd)   where-    parseArgs :: Opts.Parser (PackageName, Attrs)-    parseArgs = collapse <$> parseNameAndGHShortcut <*> parsePackageSpec-    parseNameAndGHShortcut = (,) <$> optName <*> parseGitHubShortcut-    -- collaspe a "name or shortcut" with package spec-    collapse nameAndSpec pspec = (pname, specToLockedAttrs $ pspec <> repoAndOwner)+    -- 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 (updateCmd cmd)) <$> (parseShortcutArgs cmd)+    parseCmd cmd = uncurry (cmdAdd (updateCmd cmd)) <$> (parseCmdArgs cmd)+    parseCmdAddGit =+      Opts.info (parseCmd gitCmd <**> Opts.helper) (description gitCmd)+    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+        )++-- | 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, repoAndOwner) = case nameAndSpec of-          (Just pname', (_, spec)) -> (pname', PackageSpec spec)-          (Nothing, (pname', spec)) -> (pname', PackageSpec spec)+        (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' <>@@ -225,27 +184,29 @@         Opts.help "Set the package name to <NAME>"       ) -    -- parse a github shortcut of the form "owner/repo"-    parseGitHubShortcut = Opts.strArgument (Opts.metavar "PACKAGE") <&>-          -- parses a string "owner/repo" into package name (repo) and spec (owner +-          -- repo)-          \(T.pack -> str) ->-            case T.span (/= '/') str of-              (owner@(T.null -> False)-                , T.uncons -> Just ('/', repo@(T.null -> False))) ->-                  ( PackageName repo-                  , HMS.fromList [ "owner" .= owner, "repo" .= repo ])-              _ -> (PackageName str, HMS.empty)-    desc =-      [ Opts.fullDesc-      , Opts.progDesc "Add dependency"-      , Opts.headerDoc $ Just $-          "Examples:" Opts.<$$>-          "" Opts.<$$>-          "  niv add stedolan/jq" Opts.<$$>-          "  niv add NixOS/nixpkgs-channels -n nixpkgs -b nixos-19.03" Opts.<$$>-          "  niv add my-package -v alpha-0.1 -t http://example.com/archive/<version>.zip"-      ]+-- | only used in command (niv add <cmd> ...) 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 HMS.empty)+          (Nothing, Nothing) -> (PackageName "unnamed", PackageSpec HMS.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 <NAME>"+      )  cmdAdd :: Update () a -> PackageName -> Attrs -> IO () cmdAdd updateFunc packageName attrs = do@@ -297,7 +258,6 @@             _ -> tfaint "<barabajagal>"       tsay $ "  " <> attrName <> ": " <> attrValue - ------------------------------------------------------------------------------- -- UPDATE -------------------------------------------------------------------------------@@ -335,9 +295,14 @@          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 HMS.lookup "type" (unPackageSpec defaultSpec) of+                  Just "git" -> gitCmd+                  _ -> githubCmd             fmap attrsToSpec <$> tryEvalUpdate               (specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec)-              (githubUpdate nixPrefetchURL githubLatestRev githubRepo)+              (updateCmd cmd)            Nothing -> abortCannotUpdateNoSuchPackage packageName @@ -354,9 +319,14 @@         \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 HMS.lookup "type" (unPackageSpec defaultSpec) of+                Just "git" -> gitCmd+                _ -> githubCmd           finalSpec <- fmap attrsToSpec <$> tryEvalUpdate             initialSpec-            (githubUpdate nixPrefetchURL githubLatestRev githubRepo)+            (updateCmd cmd)           pure finalSpec        let (failed, sources') = partitionEithersHMS esources'@@ -456,20 +426,6 @@         HMS.insert packageName packageSpec sources  ---------------------------------------------------------------------------------- Aux----------------------------------------------------------------------------------nixPrefetchURL :: Bool -> T.Text -> IO T.Text-nixPrefetchURL unpack (T.unpack -> url) = do-    (exitCode, sout, serr) <- runNixPrefetch-    case (exitCode, lines sout) of-      (ExitSuccess, l:_)  -> pure $ T.pack l-      _ -> abortNixPrefetchExpectedOutput (T.pack sout) (T.pack serr)-  where-    args = if unpack then ["--unpack", url] else [url]-    runNixPrefetch = readProcessWithExitCode "nix-prefetch-url" args ""--------------------------------------------------------------------------------- -- Files and their content ------------------------------------------------------------------------------- @@ -490,10 +446,6 @@           _ -> False         _ -> False --- | The IO (real) github update-githubUpdate' :: Update () ()-githubUpdate' = githubUpdate nixPrefetchURL githubLatestRev githubRepo- ------------------------------------------------------------------------------- -- Abort -------------------------------------------------------------------------------@@ -559,12 +511,3 @@       pname <> ": " <> tshow e     ) errs -abortNixPrefetchExpectedOutput :: T.Text -> T.Text -> IO a-abortNixPrefetchExpectedOutput sout serr = abort $ [s|-Could not read the output of 'nix-prefetch-url'. This is a bug. Please create a-ticket:--  https://github.com/nmattia/niv/issues/new--Thanks! I'll buy you a beer.-|] <> T.unlines ["stdout: ", sout, "stderr: ", serr]

@@ -0,0 +1,18 @@+{-# LANGUAGE RankNTypes #-}++module Niv.Cmd where++import Niv.Sources+import Niv.Update+import qualified Data.Aeson as Aeson+import qualified Data.Text as T+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+  , updateCmd :: Update () ()+  , name :: T.Text+  }

@@ -0,0 +1,195 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Arrows #-}+{-# LANGUAGE QuasiQuotes #-}++module Niv.Git.Cmd where++import Control.Applicative+import Control.Arrow+import Data.Maybe+import Data.Text.Extended as T+import Niv.Cmd+import Niv.Logger+import Niv.Sources+import Niv.Update+import System.Exit (ExitCode(ExitSuccess))+import System.Process (readProcessWithExitCode)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Char8 as B8+import qualified Data.HashMap.Strict as HMS+import qualified Data.Text as T+import qualified Options.Applicative as Opts+import qualified Options.Applicative.Help.Pretty as Opts++gitCmd :: Cmd+gitCmd = Cmd+  { description = describeGit+  , parseCmdShortcut = parseGitShortcut+  , parsePackageSpec = parseGitPackageSpec+  , updateCmd = gitUpdate+  , name = "git"+  }++parseGitShortcut :: T.Text -> Maybe (PackageName, Aeson.Object)+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, HMS.singleton "repo" (Aeson.String txt'))+        Just w' -> Just (PackageName w', HMS.singleton "repo" (Aeson.String txt'))+    else Nothing+  where+    isGitURL =+        ".git" `T.isSuffixOf` txt ||+        "git@" `T.isPrefixOf` txt ||+        "ssh://" `T.isPrefixOf` txt++parseGitPackageSpec :: Opts.Parser PackageSpec+parseGitPackageSpec =+    (PackageSpec . HMS.fromList) <$>+      many (parseRepo <|> parseRef <|> 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"+        )+    parseRef =+      ("ref", ) . Aeson.String <$> Opts.strOption+        ( Opts.long "ref" <>+          Opts.metavar "REF"+        )+    parseAttr =+      Opts.option (Opts.maybeReader parseKeyValJSON)+        ( Opts.long "attribute" <>+          Opts.short 'a' <>+          Opts.metavar "KEY=VAL" <>+          Opts.help "Set the package spec attribute <KEY> to <VAL>, where <VAL> 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 <KEY> to <VAL>."+        )++    parseKeyValJSON = parseKeyVal $ \x ->+      fromMaybe (Aeson.toJSON x) (Aeson.decodeStrict (B8.pack x))++    -- Parse "key=val" into ("key", val)+    parseKeyVal+      :: (String -> Aeson.Value)  -- ^ how to convert to JSON+      -> String -> Maybe (T.Text, Aeson.Value)+    parseKeyVal toJSON str = case span (/= '=') str of+      (key, '=':val) -> Just (T.pack 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 --ref foobar"+  ]++gitUpdate :: Update () ()+gitUpdate = proc () -> do+    useOrSet "type" -< ("git" :: Box T.Text)+    repository <- load "repo" -< ()+    refAndRev <- (discoverRev <+> discoverRefAndRev) -< repository+    update "ref" -< fst <$> refAndRev+    update "rev" -< snd <$> refAndRev+    returnA -< ()+  where+    discoverRefAndRev = proc repository -> do+      run defaultRefAndHEAD -< repository+    discoverRev = proc repository -> do+      ref <- load "ref" -< ()+      rev <- run (\(r1,r2) -> latestRev r1 r2)-< (,) <$> repository <*> ref+      returnA -< (,) <$> ref <*> rev++latestRev+    :: T.Text -- ^ the repository+    -> T.Text -- ^ the ref/branch+    -> IO T.Text+latestRev repo ref = do+    let gitArgs = [ "ls-remote", repo, "refs/heads/" <> ref ]+    sout <- runGit gitArgs+    case sout of+      ls@(_:_:_) -> abortTooMuchOutput gitArgs ls+      (l1:[]) -> parseRev gitArgs l1+      [] -> abortNoOutput gitArgs+  where+    parseRev args l = maybe (abortNoRev args l) pure $ do+      checkRev $ T.takeWhile (/= '\t') l+    checkRev t = if isRev t then Just t else Nothing+    abortNoOutput args = abortGitFailure args+      "Git didn't produce any output."+    abortTooMuchOutput args ls = abortGitFailure args $ T.unlines $+      [ "Git produced too much output:" ] <> map ("  " <>) ls++defaultRefAndHEAD+    :: T.Text -- ^ the repository+    -> IO (T.Text, T.Text)+defaultRefAndHEAD repo = do+    sout <- runGit args+    case sout of+      (l1:l2:_) -> (,) <$> parseRef l1 <*> parseRev l2+      _ -> abortGitFailure args $ T.unlines $+        [ "Could not read reference and revision from stdout:"+        ] <> sout+  where+    args = [ "ls-remote", "--symref", repo, "HEAD" ]+    parseRef l = maybe (abortNoRef args l) pure $ do+      -- ref: refs/head/master\tHEAD -> master\tHEAD+      refAndSym <- T.stripPrefix "ref: refs/heads/" l+      let ref = T.takeWhile (/= '\t') refAndSym+      if T.null ref then Nothing else Just ref+    parseRev l = maybe (abortNoRev args l) pure $ do+      checkRev $ T.takeWhile (/= '\t') l+    checkRev t = if isRev t then Just t else Nothing++abortNoRev :: [T.Text] -> T.Text -> IO a+abortNoRev args l = abortGitFailure args $ "Could not read revision from: " <> l+abortNoRef :: [T.Text] -> T.Text -> IO a+abortNoRef args l = abortGitFailure args $ "Could not read reference from: " <> l++-- | Run the "git" executable+runGit :: [T.Text] -> IO [T.Text]+runGit args = do+    (exitCode, sout, serr) <- readProcessWithExitCode "git" (T.unpack <$> args) ""+    case (exitCode, lines sout) of+      (ExitSuccess, ls)  -> pure $ T.pack <$> ls+      _ -> abortGitFailure args $ T.unlines+        [ T.unwords [ "stdout:" , T.pack sout ]+        , T.unwords [ "stderr:" , T.pack serr ]+        ]++isRev :: T.Text -> Bool+isRev t =+  -- commit hashes are comprised of abcdef0123456789+  T.all (\c -> (c >= 'a' && c <= 'f') || (c >= '0' && c <= '9')) t &&+  -- commit _should_ be 40 chars long, but to be sure we pick 7+  T.length t >= 7++abortGitFailure :: [T.Text] -> T.Text -> IO a+abortGitFailure args msg = abort $ bug $ T.unlines+  [ "Could not read the output of 'git'."+  , T.unwords ("command:":"git":args)+  , msg ]

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Niv.Git.Test (tests) where++import Niv.Git.Cmd+import Niv.Sources+import Test.Tasty.HUnit ((@=?))+import qualified Data.HashMap.Strict as HMS+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.HUnit as Tasty++tests :: [Tasty.TestTree]+tests = pure $ Tasty.testGroup "repository parse"+  [ Tasty.testCase "goo" $+      parseGitShortcut "goo" @=? Nothing+  , Tasty.testCase "git@github.com:nmattia/niv" $+      parseGitShortcut "git@github.com:nmattia/niv" @=? Just+        (PackageName "niv", HMS.singleton "repo" "git@github.com:nmattia/niv")+  , Tasty.testCase "ssh://git@github.com/stedolan/jq" $+      parseGitShortcut "ssh://git@github.com/stedolan/jq" @=? Just+        (PackageName "jq", HMS.singleton "repo" "ssh://git@github.com/stedolan/jq")+  , Tasty.testCase "https://github.com/stedolan/jq.git" $+      parseGitShortcut "https://github.com/stedolan/jq.git" @=? Just+        (PackageName "jq", HMS.singleton "repo" "https://github.com/stedolan/jq.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", HMS.singleton "repo" "~/path/to/repo.git")+  ]

@@ -3,28 +3,16 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-}  module Niv.GitHub where  import Control.Arrow import Data.Bool-import Data.Functor import Data.Maybe-import Data.String.QQ (s)+import Niv.GitHub.API import Niv.Update-import System.Environment (lookupEnv)-import System.Exit (exitFailure)-import System.IO.Unsafe (unsafePerformIO)-import Text.Read (readMaybe)-import qualified Data.Aeson as Aeson-import qualified Data.ByteString.Char8 as BS8-import qualified Data.HashMap.Strict as HMS import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T-import qualified Network.HTTP.Simple as HTTP  -- | The GitHub update function -- TODO: fetchers for:@@ -68,150 +56,3 @@ githubURLTemplate =   (if githubSecure then "https://" else "http://") <>   githubHost <> githubPath <> "<owner>/<repo>/archive/<rev>.tar.gz"---- Bunch of GitHub helpers--data GithubRepo = GithubRepo-  { repoDescription :: Maybe T.Text-  , repoHomepage :: Maybe T.Text-  , repoDefaultBranch :: Maybe T.Text-  }--githubRepo :: T.Text -> T.Text -> IO GithubRepo-githubRepo owner repo = do-    request <- defaultRequest ["repos", owner, repo]-    -- we don't use httpJSONEither because it adds an "Accept:-    -- application/json" header that GitHub chokes on-    resp0 <- HTTP.httpBS request-    let resp = fmap Aeson.eitherDecodeStrict resp0-    case (HTTP.getResponseStatusCode resp, HTTP.getResponseBody resp) of-      (200, Right (Aeson.Object m)) -> do-        let lookupText k = case HMS.lookup k m of-              Just (Aeson.String t) -> Just t-              _ -> Nothing-        pure GithubRepo-          { repoDescription = lookupText "description"-          , repoHomepage = lookupText "homepage"-          , repoDefaultBranch = lookupText "default_branch"-          }-      (200, Right v) -> do-        error $ "expected object, got " <> show v-      (200, Left e) -> do-        error $ "github didn't return JSON: " <> show e-      _ -> abortCouldNotFetchGitHubRepo (tshow (request,resp0)) (owner, repo)---- | 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-  where-    line1 = "WARNING: Could not read from GitHub repo: " <> owner <> "/" <> repo-    line2 = [s|-I assumed that your package was a GitHub repository. An error occurred while-gathering information from the repository. Check whether your package was added-correctly:--  niv show--If not, try re-adding it:--  niv drop <package>-  niv add <package-without-typo>--Make sure the repository exists.-|]-    line3 = T.unwords [ "(Error was:", e, ")" ]--defaultRequest :: [T.Text] -> IO HTTP.Request-defaultRequest (map T.encodeUtf8 -> parts) = do-    let path = T.encodeUtf8 githubPath <> BS8.intercalate "/" (parts)-    mtoken <- lookupEnv "GITHUB_TOKEN"-    pure $-      (flip (maybe id) mtoken $ \token ->-        HTTP.addRequestHeader "authorization" ("token " <> BS8.pack token)-      ) $-      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---- | Get the latest revision for owner, repo and branch.--- TODO: explain no error handling-githubLatestRev-  :: T.Text-  -- ^ owner-  -> T.Text-  -- ^ repo-  -> T.Text-  -- ^ branch-  -> IO T.Text-githubLatestRev owner repo branch = do-    request <- defaultRequest [ "repos", owner, repo, "commits", branch ] <&>-          HTTP.addRequestHeader "accept" "application/vnd.github.v3.sha"-    resp <- HTTP.httpBS request-    case HTTP.getResponseStatusCode resp of-      200 -> pure $ T.decodeUtf8 $ HTTP.getResponseBody resp-      _ -> abortCouldNotGetRev owner repo branch resp--abortCouldNotGetRev :: T.Text -> T.Text -> T.Text -> HTTP.Response BS8.ByteString -> IO a-abortCouldNotGetRev owner repo branch resp = abort $ T.unlines [ line1, line2, line3 ]-  where-    line1 = T.unwords-      [ "Cannot get latest revision for branch"-      , "'" <> branch <> "'"-      , "(" <> owner <> "/" <> repo <> ")"-      ]-    line2 = "The request failed: " <> tshow resp-    line3 =  [s|-NOTE: You may want to retry with an authentication token:--    GITHUB_TOKEN=... niv <cmd>--For more information on rate-limiting, see--    https://developer.github.com/v3/#rate-limiting--|]--githubHost :: T.Text-githubHost = unsafePerformIO $ do-    lookupEnv "GITHUB_HOST" >>= \case-      Just (T.pack -> x) -> pure x-      Nothing -> pure "github.com"--githubApiPort :: Int-githubApiPort = unsafePerformIO $ do-    lookupEnv "GITHUB_API_PORT" >>= \case-      Just (readMaybe -> Just x) -> pure x-      _ -> pure $ if githubSecure then 443 else 80--githubApiHost :: T.Text-githubApiHost = unsafePerformIO $ do-    lookupEnv "GITHUB_API_HOST" >>= \case-      Just (T.pack -> x) -> pure x-      Nothing -> pure "api.github.com"--githubSecure :: Bool-githubSecure = unsafePerformIO $ do-    lookupEnv "GITHUB_INSECURE" >>= \case-      Just "" -> pure True-      Just _ -> pure False-      Nothing -> pure True--githubPath :: T.Text-githubPath = unsafePerformIO $ do-    lookupEnv "GITHUB_PATH" >>= \case-      Just (T.pack -> x) -> pure $ fromMaybe x (T.stripSuffix "/" x) <> "/"-      Nothing -> pure "/"--abort :: T.Text -> IO a-abort msg = do-    T.putStrLn msg-    exitFailure--tshow :: Show a => a -> T.Text-tshow = T.pack . show

@@ -0,0 +1,160 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ViewPatterns #-}++module Niv.GitHub.API where++import Data.Functor+import Data.Maybe+import Data.String.QQ (s)+import Data.Text.Extended+import System.Environment (lookupEnv)+import System.Exit (exitFailure)+import System.IO.Unsafe (unsafePerformIO)+import Text.Read (readMaybe)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Char8 as BS8+import qualified Data.HashMap.Strict as HMS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Simple as HTTP++-- Bunch of GitHub helpers++data GithubRepo = GithubRepo+  { repoDescription :: Maybe T.Text+  , repoHomepage :: Maybe T.Text+  , repoDefaultBranch :: Maybe T.Text+  }++githubRepo :: T.Text -> T.Text -> IO GithubRepo+githubRepo owner repo = do+    request <- defaultRequest ["repos", owner, repo]+    -- we don't use httpJSONEither because it adds an "Accept:+    -- application/json" header that GitHub chokes on+    resp0 <- HTTP.httpBS request+    let resp = fmap Aeson.eitherDecodeStrict resp0+    case (HTTP.getResponseStatusCode resp, HTTP.getResponseBody resp) of+      (200, Right (Aeson.Object m)) -> do+        let lookupText k = case HMS.lookup k m of+              Just (Aeson.String t) -> Just t+              _ -> Nothing+        pure GithubRepo+          { repoDescription = lookupText "description"+          , repoHomepage = lookupText "homepage"+          , repoDefaultBranch = lookupText "default_branch"+          }+      (200, Right v) -> do+        error $ "expected object, got " <> show v+      (200, Left e) -> do+        error $ "github didn't return JSON: " <> show e+      _ -> abortCouldNotFetchGitHubRepo (tshow (request,resp0)) (owner, repo)++-- | 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+  where+    line1 = "WARNING: Could not read from GitHub repo: " <> owner <> "/" <> repo+    line2 = [s|+I assumed that your package was a GitHub repository. An error occurred while+gathering information from the repository. Check whether your package was added+correctly:++  niv show++If not, try re-adding it:++  niv drop <package>+  niv add <package-without-typo>++Make sure the repository exists.+|]+    line3 = T.unwords [ "(Error was:", e, ")" ]++defaultRequest :: [T.Text] -> IO HTTP.Request+defaultRequest (map T.encodeUtf8 -> parts) = do+    let path = T.encodeUtf8 githubPath <> BS8.intercalate "/" (parts)+    mtoken <- lookupEnv "GITHUB_TOKEN"+    pure $+      (flip (maybe id) mtoken $ \token ->+        HTTP.addRequestHeader "authorization" ("token " <> BS8.pack token)+      ) $+      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++-- | Get the latest revision for owner, repo and branch.+-- TODO: explain no error handling+githubLatestRev+  :: T.Text+  -- ^ owner+  -> T.Text+  -- ^ repo+  -> T.Text+  -- ^ branch+  -> IO T.Text+githubLatestRev owner repo branch = do+    request <- defaultRequest [ "repos", owner, repo, "commits", branch ] <&>+          HTTP.addRequestHeader "accept" "application/vnd.github.v3.sha"+    resp <- HTTP.httpBS request+    case HTTP.getResponseStatusCode resp of+      200 -> pure $ T.decodeUtf8 $ HTTP.getResponseBody resp+      _ -> abortCouldNotGetRev owner repo branch resp++abortCouldNotGetRev :: T.Text -> T.Text -> T.Text -> HTTP.Response BS8.ByteString -> IO a+abortCouldNotGetRev owner repo branch resp = abort $ T.unlines [ line1, line2, line3 ]+  where+    line1 = T.unwords+      [ "Cannot get latest revision for branch"+      , "'" <> branch <> "'"+      , "(" <> owner <> "/" <> repo <> ")"+      ]+    line2 = "The request failed: " <> tshow resp+    line3 =  [s|+NOTE: You may want to retry with an authentication token:++    GITHUB_TOKEN=... niv <cmd>++For more information on rate-limiting, see++    https://developer.github.com/v3/#rate-limiting++|]++githubHost :: T.Text+githubHost = unsafePerformIO $ do+    lookupEnv "GITHUB_HOST" >>= \case+      Just (T.pack -> x) -> pure x+      Nothing -> pure "github.com"++githubApiPort :: Int+githubApiPort = unsafePerformIO $ do+    lookupEnv "GITHUB_API_PORT" >>= \case+      Just (readMaybe -> Just x) -> pure x+      _ -> pure $ if githubSecure then 443 else 80++githubApiHost :: T.Text+githubApiHost = unsafePerformIO $ do+    lookupEnv "GITHUB_API_HOST" >>= \case+      Just (T.pack -> x) -> pure x+      Nothing -> pure "api.github.com"++githubSecure :: Bool+githubSecure = unsafePerformIO $ do+    lookupEnv "GITHUB_INSECURE" >>= \case+      Just "" -> pure True+      Just _ -> pure False+      Nothing -> pure True++githubPath :: T.Text+githubPath = unsafePerformIO $ do+    lookupEnv "GITHUB_PATH" >>= \case+      Just (T.pack -> x) -> pure $ fromMaybe x (T.stripSuffix "/" x) <> "/"+      Nothing -> pure "/"

@@ -0,0 +1,153 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++module Niv.GitHub.Cmd (githubCmd) where++import Control.Applicative+import Data.Aeson ((.=))+import Data.Bifunctor+import Data.Maybe+import Data.String.QQ (s)+import Data.Text.Extended+import Niv.Cmd+import Niv.GitHub+import Niv.GitHub.API+import Niv.Sources+import Niv.Update+import System.Exit (ExitCode(ExitSuccess))+import System.Process (readProcessWithExitCode)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Char8 as B8+import qualified Data.HashMap.Strict as HMS+import qualified Data.Text as T+import qualified Options.Applicative as Opts+import qualified Options.Applicative.Help.Pretty as Opts++githubCmd :: Cmd+githubCmd = Cmd+  { description = describeGitHub+  , parseCmdShortcut = parseAddShortcutGitHub+  , parsePackageSpec = parseGitHubPackageSpec+  , updateCmd = githubUpdate'+  , name = "github"+  -- TODO: here filter by type == tarball or file or builtin-+  }++parseGitHubPackageSpec :: Opts.Parser PackageSpec+parseGitHubPackageSpec =+    (PackageSpec . HMS.fromList) <$>+      many parseAttribute+  where+    parseAttribute :: Opts.Parser (T.Text, 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 <KEY> to <VAL>, where <VAL> 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 <KEY> to <VAL>."+        ) <|>+      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 <foo> 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+      :: (String -> Aeson.Value)  -- ^ how to convert to JSON+      -> String -> Maybe (T.Text, Aeson.Value)+    parseKeyVal toJSON str = case span (/= '=') str of+      (key, '=':val) -> Just (T.pack key, toJSON val)+      _ -> Nothing++    -- Shortcuts for common attributes+    shortcutAttributes :: Opts.Parser (T.Text, Aeson.Value)+    shortcutAttributes = foldr (<|>) empty $ mkShortcutAttribute <$>+      [ "branch", "owner", "repo", "version" ]++    -- TODO: infer those shortcuts from 'Update' keys+    mkShortcutAttribute :: T.Text -> Opts.Parser (T.Text, Aeson.Value)+    mkShortcutAttribute = \case+      attr@(T.uncons -> Just (c,_)) -> fmap (second Aeson.String) $ (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-channels -n nixpkgs -b nixos-19.03" Opts.<$$>+      "  niv add my-package -v alpha-0.1 -t http://example.com/archive/<version>.zip"+  ]++-- parse a github shortcut of the form "owner/repo"+parseAddShortcutGitHub :: T.Text -> Maybe (PackageName, Aeson.Object)+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+              , HMS.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, HMS.empty)++-- | The IO (real) github update+githubUpdate' :: Update () ()+githubUpdate' = githubUpdate nixPrefetchURL githubLatestRev githubRepo++nixPrefetchURL :: Bool -> T.Text -> IO T.Text+nixPrefetchURL unpack (T.unpack -> url) = do+    (exitCode, sout, serr) <- runNixPrefetch+    case (exitCode, lines sout) of+      (ExitSuccess, l:_)  -> pure $ T.pack l+      _ -> abortNixPrefetchExpectedOutput (T.pack sout) (T.pack serr)+  where+    args = if unpack then ["--unpack", url] else [url]+    runNixPrefetch = readProcessWithExitCode "nix-prefetch-url" args ""++abortNixPrefetchExpectedOutput :: T.Text -> T.Text -> IO a+abortNixPrefetchExpectedOutput sout serr = abort $ [s|+Could not read the output of 'nix-prefetch-url'. This is a bug. Please create a+ticket:++  https://github.com/nmattia/niv/issues/new++Thanks! I'll buy you a beer.+|] <> T.unlines ["stdout: ", sout, "stderr: ", serr]

@@ -8,6 +8,7 @@ import Data.IORef import Data.Bifunctor import Niv.GitHub+import Niv.GitHub.API import Niv.Update import qualified Data.HashMap.Strict as HMS 

@@ -3,7 +3,18 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Niv.Logger where+module Niv.Logger+  ( job+  , bug+  , tsay+  , say+  , green, tgreen+  , red, tred+  , blue, tblue+  , yellow, tyellow+  , bold, tbold+  , faint, tfaint+  ) where  import Control.Monad import Data.Profunctor@@ -13,6 +24,9 @@ import UnliftIO import qualified System.Console.ANSI as ANSI +type S = String -> String+type T = T.Text -> T.Text+ -- XXX: this assumes as single thread job :: String -> IO () -> IO () job str act = do@@ -45,51 +59,68 @@ say msg = do     stackSize <- jobStackSize     let indent = replicate (stackSize * 2) ' '-    putStrLn $ indent <> msg+    putStrLn $ unlines $ (indent <>) <$> lines msg -green :: String -> String+green :: S green str =     ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>     ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Green] <>     str <> ANSI.setSGRCode [ANSI.Reset] -yellow :: String -> String+tgreen :: T+tgreen = t green++yellow :: S yellow str =     ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>     ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Yellow] <>     str <> ANSI.setSGRCode [ANSI.Reset] -tyellow :: T.Text -> T.Text-tyellow = dimap T.unpack T.pack yellow+tyellow :: T+tyellow = t yellow -blue :: String -> String+blue :: S blue str =     ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>     ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Blue] <>     str <> ANSI.setSGRCode [ANSI.Reset] -tblue :: T.Text -> T.Text-tblue = dimap T.unpack T.pack blue+tblue :: T+tblue = t blue -red :: String -> String+red :: S red str =     ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red] <>     str <> ANSI.setSGRCode [ANSI.Reset] -tbold :: T.Text -> T.Text-tbold = dimap T.unpack T.pack bold+tred :: T+tred = t red -bold :: String -> String+bold :: S bold str =     ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>     ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White] <>     str <> ANSI.setSGRCode [ANSI.Reset] -tfaint :: T.Text -> T.Text-tfaint = dimap T.unpack T.pack faint+tbold :: T+tbold = t bold  faint :: String -> String faint str =     ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.FaintIntensity] <>     ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White] <>     str <> ANSI.setSGRCode [ANSI.Reset]++tfaint :: T+tfaint = t faint++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."+  ]

@@ -13,7 +13,7 @@ import Data.Hashable (Hashable) import Data.List import Data.String.QQ (s)-import Niv.GitHub+import Data.Text.Extended import Niv.Logger import Niv.Update import System.FilePath ((</>))@@ -135,6 +135,7 @@   | V9   | V10   | V11+  | V12   deriving stock (Bounded, Enum, Eq)  -- | A user friendly version@@ -151,6 +152,7 @@     V9 -> "9"     V10 -> "10"     V11 -> "11"+    V12 -> "12"  latestVersionMD5 :: T.Text latestVersionMD5 = sourcesVersionToMD5 maxBound@@ -174,6 +176,7 @@     V9 -> "87149616c1b3b1e5aa73178f91c20b53"     V10 -> "d8625c0a03dd935e1c79f46407faa8d3"     V11 -> "8a95b7d93b16f7c7515d98f49b0ec741"+    V12 -> "2f9629ad9a8f181ed71d2a59b454970c"  -- | The MD5 sum of ./nix/sources.nix sourcesNixMD5 :: IO T.Text

@@ -3,6 +3,7 @@ import Niv.Sources.Test import Niv.GitHub.Test import Niv.Update.Test+import qualified Niv.Git.Test as Git import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as Tasty @@ -31,4 +32,5 @@     , Tasty.testGroup "sources.nix"         [ Tasty.testCase "has latest version" test_shippedSourcesNixIsLatest         ]+    , Tasty.testGroup "git" Git.tests     ]

@@ -14,6 +14,7 @@ import Control.Arrow import Data.Aeson (FromJSON, ToJSON, Value) import Data.String+import Niv.Logger import UnliftIO import qualified Control.Category as Cat import qualified Data.Aeson as Aeson@@ -80,12 +81,7 @@     prettyFail :: UpdateFailed -> T.Text     prettyFail = \case       FailNoSuchKey k -> "Key could not be found: " <> k-      FailZero -> T.unlines-        [ "A dead end was reached during evaluation."-        , "This is a bug. Please create a ticket:"-        , "  https://github.com/nmattia/niv/issues/new"-        , "Thanks! I'll buy you a beer."-        ]+      FailZero -> bug "A dead end was reached during evaluation."       FailCheck -> "A check failed during update"       FailTemplate tpl keys -> T.unlines         [ "Could not render template " <> tpl