summaryrefslogtreecommitdiff
path: root/Biz/Bild/Deps.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Biz/Bild/Deps.hs')
-rw-r--r--Biz/Bild/Deps.hs694
1 files changed, 0 insertions, 694 deletions
diff --git a/Biz/Bild/Deps.hs b/Biz/Bild/Deps.hs
deleted file mode 100644
index e268a74..0000000
--- a/Biz/Bild/Deps.hs
+++ /dev/null
@@ -1,694 +0,0 @@
-{-# 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 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 "CODEROOT"
- pure <| AtPath <| root </> "Biz/Bild/Sources.json"
-
-li :: (MonadIO io) => IO a -> io a
-li = liftIO
-
-main :: IO ()
-main =
- getArgs +> \case
- ["test"] -> pure ()
- args -> cli args
-
-cli :: [String] -> IO ()
-cli args = do
- ((fsj, colors), nio) <-
- pure args +> 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"
-
-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
- <| Opts.vcat
- [ "Examples:",
- 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
- <| Opts.vcat
- [ "Examples:",
- "",
- " niv modify nixpkgs -v beta-0.2",
- " 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
- <| 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
- [] -> 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