diff options
Diffstat (limited to 'Biz/Bild/Deps.hs')
| -rw-r--r-- | Biz/Bild/Deps.hs | 687 |
1 files changed, 680 insertions, 7 deletions
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 |