From 2d753c6120ccf47734fba8fb1588408df1fdf5c0 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Tue, 26 Jul 2022 09:22:58 -0400
Subject: Port Niv.Cli to Biz.Bild.Deps
---
Biz/Bild/Deps.hs | 687 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
Biz/Ide/deps | 4 -
2 files changed, 680 insertions(+), 11 deletions(-)
delete mode 100755 Biz/Ide/deps
(limited to 'Biz')
diff --git a/Biz/Bild/Deps.hs b/Biz/Bild/Deps.hs
index 908f188..582899c 100644
--- a/Biz/Bild/Deps.hs
+++ b/Biz/Bild/Deps.hs
@@ -1,16 +1,689 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ViewPatterns #-}
-- | A specific-purpose dependency manager.
--
-- : out deps
module Biz.Bild.Deps where
-import Alpha
-import qualified Niv.Cli
-import qualified System.Environment as Env
+import Alpha hiding (map, packageName, str, tshow)
+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 as B
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.HashMap.Strict as HMS
+import Data.HashMap.Strict.Extended
+import qualified Data.Text as T
+import Data.Text.Extended
+import GHC.Show
+import qualified Network.HTTP.Simple as HTTP
+import Niv.Cmd (Cmd, description, extraLogs, parseCmdShortcut, parsePackageSpec, updateCmd)
+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
+import qualified System.Directory as Dir
+import System.Environment (getEnv)
+import System.FilePath (takeDirectory, (</>))
+import UnliftIO
+import Prelude
+
+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
+getFindSourcesJson = do
+ root <- li <| getEnv "BIZ_ROOT"
+ pure <| AtPath <| root </> "Biz/Bild/Sources.json"
+
+li :: MonadIO io => IO a -> io a
+li = liftIO
main :: IO ()
-main =
- Env.getArgs +> \case
- ["test"] -> pure ()
- _ -> Niv.Cli.cli
+main = cli
+
+cli :: IO ()
+cli = do
+ ((fsj, colors), nio) <-
+ getArgs +> Opts.handleParseResult <. execParserPure' Opts.defaultPrefs opts
+ 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)) <| mconcat desc
+ desc =
+ [ Opts.fullDesc,
+ Opts.headerDoc
+ <| Just
+ <| "deps - specific-purpose dependency manager"
+ ]
+ parseFindSourcesJson =
+ AtPath
+ </ Opts.strOption
+ ( Opts.long "sources-file"
+ <> Opts.short 's'
+ <> Opts.metavar "FILE"
+ <> Opts.help "Use FILE instead of Biz/Bild/Sources.json"
+ )
+ <|> pure Auto
+ parseColors =
+ (\case True -> Never; False -> Always)
+ </ Opts.switch
+ ( Opts.long "no-colors"
+ <> Opts.help "Don't use colors in output"
+ )
+
+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 <NAME>"
+ )
+
+-- | 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 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 <NAME>"
+ )
+
+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.progDesc "Show information about a dependency in human-readable format"
+
+-- 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 "<barabajagal>"
+ 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 "deps update" Opts.<+> "# update all packages",
+ Opts.fill 30 "deps update nixpkgs" Opts.<+> "# update nixpkgs",
+ Opts.fill 30 "deps 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
+ fmap attrsToSpec </ li (doUpdate initialSpec cmd)
+ 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 <NAME>"
+ )
+
+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
diff --git a/Biz/Ide/deps b/Biz/Ide/deps
deleted file mode 100755
index 1dc7ff3..0000000
--- a/Biz/Ide/deps
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/usr/bin/env bash
-#
-# this really needs to be its own Biz/Bild/Deps.hs thing
-niv --sources-file "$BIZ_ROOT/Biz/Bild/Sources.json" "$@"
--
cgit v1.2.3