From f7c538837892dd2eb83567c9f380a11efb59b53f Mon Sep 17 00:00:00 2001 From: Finn Landweber Date: Thu, 23 May 2024 11:59:14 +0200 Subject: [PATCH] hlint refactor (#403) Was perfomed using `find -name '*.hs' -exec hlint -i "Missing NOINLINE pragma" -i "Use uncurry" -i "Use const" --refactor --refactor-options="--inplace" {} \;` --- src/Niv/Cli.hs | 53 +++++++++++++++++++----------------------- src/Niv/Git/Cmd.hs | 10 ++++---- src/Niv/GitHub.hs | 5 +--- src/Niv/GitHub/API.hs | 10 ++++---- src/Niv/GitHub/Cmd.hs | 16 ++++++------- src/Niv/Local/Cmd.hs | 5 +--- src/Niv/Logger.hs | 3 +-- src/Niv/Sources.hs | 17 +++++++------- src/Niv/Update.hs | 10 ++++---- src/Niv/Update/Test.hs | 4 ++-- 10 files changed, 61 insertions(+), 72 deletions(-) diff --git a/src/Niv/Cli.hs b/src/Niv/Cli.hs index 509e122..730416e 100644 --- a/src/Niv/Cli.hs +++ b/src/Niv/Cli.hs @@ -2,7 +2,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} @@ -56,8 +55,7 @@ li = liftIO cli :: IO () cli = do ((fsj, colors), nio) <- - execParserPure' Opts.defaultPrefs opts <$> getArgs - >>= Opts.handleParseResult + getArgs >>= Opts.handleParseResult . execParserPure' Opts.defaultPrefs opts setColors colors runReaderT (runNIO nio) fsj where @@ -115,7 +113,7 @@ parsePackageName = <$> Opts.argument Opts.str (Opts.metavar "PACKAGE") parsePackage :: Opts.Parser (PackageName, PackageSpec) -parsePackage = (,) <$> parsePackageName <*> (parsePackageSpec githubCmd) +parsePackage = (,) <$> parsePackageName <*> parsePackageSpec githubCmd ------------------------------------------------------------------------------- -- INIT @@ -158,22 +156,20 @@ parseNixpkgs = parseNixpkgsFast <|> parseNixpkgsLatest <|> parseNixpkgsCustom <| <> 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 - ) - ) + 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 @@ -285,15 +281,15 @@ parseCmdAdd :: Opts.ParserInfo (NIO ()) parseCmdAdd = Opts.info ((parseCommands <|> parseShortcuts) <**> Opts.helper) - $ (description githubCmd) + $ 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) + parseShortcut cmd = uncurry (cmdAdd cmd) <$> parseShortcutArgs cmd + parseCmd cmd = uncurry (cmdAdd cmd) <$> parseCmdArgs cmd parseCmdAddGit = Opts.info (parseCmd gitCmd <**> Opts.helper) (description gitCmd) parseCmdAddLocal = @@ -376,7 +372,7 @@ cmdAdd cmd packageName attrs = do case eFinalSpec of Left e -> li (abortUpdateFailed [(packageName, e)]) Right finalSpec -> do - say $ "Writing new sources file" + say "Writing new sources file" li $ setSources fsj $ Sources $ @@ -404,7 +400,7 @@ cmdShow = \case Nothing -> do fsj <- getFindSourcesJson sources <- unSources <$> li (getSources fsj) - forWithKeyM_ sources $ showPackage + forWithKeyM_ sources showPackage showPackage :: (MonadIO io) => PackageName -> PackageSpec -> io () showPackage (PackageName pname) (PackageSpec spec) = do @@ -483,8 +479,7 @@ cmdUpdate = \case Just "git" -> gitCmd Just "local" -> localCmd _ -> githubCmd - finalSpec <- fmap attrsToSpec <$> li (doUpdate initialSpec cmd) - pure finalSpec + fmap attrsToSpec <$> li (doUpdate initialSpec cmd) let (failed, sources') = partitionEithersHMS esources' unless (HMS.null failed) $ li $ @@ -494,7 +489,7 @@ cmdUpdate = \case -- | 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 + forM_ (extraLogs cmd attrs) tsay tryEvalUpdate attrs (updateCmd cmd) partitionEithersHMS :: @@ -590,7 +585,7 @@ cmdDrop packageName = \case tsay $ "Dropping package: " <> unPackageName packageName fsj <- getFindSourcesJson sources <- unSources <$> li (getSources fsj) - when (not $ HMS.member packageName sources) $ + unless (HMS.member packageName sources) $ li $ abortCannotDropNoSuchPackage packageName li $ diff --git a/src/Niv/Git/Cmd.hs b/src/Niv/Git/Cmd.hs index fc8b233..23369c6 100644 --- a/src/Niv/Git/Cmd.hs +++ b/src/Niv/Git/Cmd.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} @@ -13,6 +12,7 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import qualified Data.ByteString.Char8 as B8 +import Data.Char (isDigit) import qualified Data.HashMap.Strict as HMS import Data.Maybe import qualified Data.Text as T @@ -53,7 +53,7 @@ gitExtraLogs attrs = noteRef <> warnRefBranch <> warnRefTag mkWarn "Your source contains both a `ref` and a `tag`. The `ref` will be used by Nix to fetch the repo." member x = HMS.member x attrs - textIf cond txt = if cond then [txt] else [] + textIf cond txt = [txt | cond] parseGitShortcut :: T.Text -> Maybe (PackageName, Aeson.Object) parseGitShortcut txt'@(T.dropWhileEnd (== '/') -> txt) = @@ -76,7 +76,7 @@ parseGitShortcut txt'@(T.dropWhileEnd (== '/') -> txt) = parseGitPackageSpec :: Opts.Parser PackageSpec parseGitPackageSpec = - (PackageSpec . KM.fromList) + PackageSpec . KM.fromList <$> many (parseRepo <|> parseBranch <|> parseRev <|> parseAttr <|> parseSAttr) where parseRepo = @@ -180,7 +180,7 @@ latestRev repo branch = do sout <- runGit gitArgs case sout of ls@(_ : _ : _) -> abortTooMuchOutput gitArgs ls - (l1 : []) -> parseRev gitArgs l1 + [l1] -> parseRev gitArgs l1 [] -> abortNoOutput gitArgs where parseRev args l = maybe (abortNoRev args l) pure $ do @@ -242,7 +242,7 @@ runGit args = do isRev :: T.Text -> Bool isRev t = -- commit hashes are comprised of abcdef0123456789 - T.all (\c -> (c >= 'a' && c <= 'f') || (c >= '0' && c <= '9')) t + T.all (\c -> (c >= 'a' && c <= 'f') || isDigit c) t && -- commit _should_ be 40 chars long, but to be sure we pick 7 T.length t >= 7 diff --git a/src/Niv/GitHub.hs b/src/Niv/GitHub.hs index 0c01f26..fdb2918 100644 --- a/src/Niv/GitHub.hs +++ b/src/Niv/GitHub.hs @@ -1,9 +1,6 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE ViewPatterns #-} module Niv.GitHub where @@ -31,7 +28,7 @@ githubUpdate :: githubUpdate prefetch latestRev ghRepo = proc () -> do urlTemplate <- template - <<< (useOrSet "url_template" <<< completeSpec) <+> (load "url_template") + <<< (useOrSet "url_template" <<< completeSpec) <+> load "url_template" -< () url <- update "url" -< urlTemplate diff --git a/src/Niv/GitHub/API.hs b/src/Niv/GitHub/API.hs index 0700789..c586097 100644 --- a/src/Niv/GitHub/API.hs +++ b/src/Niv/GitHub/API.hs @@ -78,19 +78,21 @@ Make sure the repository exists. defaultRequest :: [T.Text] -> IO HTTP.Request defaultRequest (map T.encodeUtf8 -> parts) = do - let path = T.encodeUtf8 githubPath <> BS8.intercalate "/" (parts) + let path = T.encodeUtf8 githubPath <> BS8.intercalate "/" parts mtoken <- lookupEnv' "GITHUB_TOKEN" pure - $ ( flip (maybe id) mtoken $ \token -> + $ maybe + id + ( \token -> HTTP.addRequestHeader "authorization" ("token " <> BS8.pack token) ) + mtoken $ HTTP.setRequestPath path $ HTTP.addRequestHeader "user-agent" "niv" $ HTTP.addRequestHeader "accept" "application/vnd.github.v3+json" $ HTTP.setRequestSecure githubSecure $ HTTP.setRequestHost (T.encodeUtf8 githubApiHost) - $ HTTP.setRequestPort githubApiPort - $ HTTP.defaultRequest + $ HTTP.setRequestPort githubApiPort HTTP.defaultRequest -- | Get the latest revision for owner, repo and branch. -- TODO: explain no error handling diff --git a/src/Niv/GitHub/Cmd.hs b/src/Niv/GitHub/Cmd.hs index a9e32eb..7dfde16 100644 --- a/src/Niv/GitHub/Cmd.hs +++ b/src/Niv/GitHub/Cmd.hs @@ -46,7 +46,7 @@ githubCmd = parseGitHubPackageSpec :: Opts.Parser PackageSpec parseGitHubPackageSpec = - (PackageSpec . KM.fromList) + PackageSpec . KM.fromList <$> many parseAttribute where parseAttribute :: Opts.Parser (K.Key, Aeson.Value) @@ -66,7 +66,7 @@ parseGitHubPackageSpec = <> Opts.help "Set the package spec attribute to ." ) <|> shortcutAttributes - <|> ( (("url_template",) . Aeson.String) + <|> ( ("url_template",) . Aeson.String <$> Opts.strOption ( Opts.long "template" <> Opts.short 't' @@ -74,7 +74,7 @@ parseGitHubPackageSpec = <> Opts.help "Used during 'update' when building URL. Occurrences of are replaced with attribute 'foo'." ) ) - <|> ( (("type",) . Aeson.String) + <|> ( ("type",) . Aeson.String <$> Opts.strOption ( Opts.long "type" <> Opts.short 'T' @@ -96,9 +96,7 @@ parseGitHubPackageSpec = -- Shortcuts for common attributes shortcutAttributes :: Opts.Parser (K.Key, Aeson.Value) shortcutAttributes = - foldr (<|>) empty $ - mkShortcutAttribute - <$> ["branch", "owner", "rev", "version"] + foldr ((<|>) . mkShortcutAttribute) empty ["branch", "owner", "rev", "version"] -- TODO: infer those shortcuts from 'Update' keys mkShortcutAttribute :: T.Text -> Opts.Parser (K.Key, Aeson.Value) mkShortcutAttribute = \case @@ -114,7 +112,7 @@ parseGitHubPackageSpec = "Equivalent to --attribute " <> attr <> "=<" - <> (T.toUpper attr) + <> T.toUpper attr <> ">" ) ) @@ -165,7 +163,7 @@ nixPrefetchURL unpack turl@(T.unpack -> url) = do (ExitSuccess, l : _) -> pure $ T.pack l _ -> abortNixPrefetchExpectedOutput (T.pack <$> args) (T.pack sout) (T.pack serr) where - args = (if unpack then ["--unpack"] else []) <> [url, "--name", sanitizeName basename] + args = (["--unpack" | unpack]) <> [url, "--name", sanitizeName basename] runNixPrefetch = readProcessWithExitCode "nix-prefetch-url" args "" sanitizeName = T.unpack . T.filter isOk basename = last $ T.splitOn "/" turl @@ -173,7 +171,7 @@ nixPrefetchURL unpack turl@(T.unpack -> url) = do -- Path names are alphanumeric and can include the symbols +-._?= and must -- not begin with a period. -- (note: we assume they don't begin with a period) - isOk = \c -> isAlphaNum c || T.any (c ==) "+-._?=" + isOk c = isAlphaNum c || T.any (c ==) "+-._?=" abortNixPrefetchExpectedOutput :: [T.Text] -> T.Text -> T.Text -> IO a abortNixPrefetchExpectedOutput args sout serr = diff --git a/src/Niv/Local/Cmd.hs b/src/Niv/Local/Cmd.hs index 09f8c2c..7b929ee 100644 --- a/src/Niv/Local/Cmd.hs +++ b/src/Niv/Local/Cmd.hs @@ -1,10 +1,7 @@ {-# LANGUAGE Arrows #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} module Niv.Local.Cmd where @@ -34,7 +31,7 @@ localCmd = parseLocalShortcut :: T.Text -> Maybe (PackageName, Aeson.Object) parseLocalShortcut txt = - if (T.isPrefixOf "./" txt || T.isPrefixOf "/" txt) + if T.isPrefixOf "./" txt || T.isPrefixOf "/" txt then do let n = last $ T.splitOn "/" txt Just (PackageName n, KM.fromList [("path", Aeson.String txt)]) diff --git a/src/Niv/Logger.hs b/src/Niv/Logger.hs index 0564834..7c1dfd1 100644 --- a/src/Niv/Logger.hs +++ b/src/Niv/Logger.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -56,7 +55,7 @@ setColors :: Colors -> IO () setColors = writeIORef colors useColors :: Bool -useColors = unsafePerformIO $ (\c -> c == Always) <$> readIORef colors +useColors = unsafePerformIO $ (== Always) <$> readIORef colors type S = String -> String diff --git a/src/Niv/Sources.hs b/src/Niv/Sources.hs index ac7b453..6a8aeec 100644 --- a/src/Niv/Sources.hs +++ b/src/Niv/Sources.hs @@ -62,13 +62,14 @@ getSourcesEither fsj = do valueToSources :: Aeson.Value -> Maybe Sources valueToSources = \case Aeson.Object obj -> - fmap (Sources . mapKeys PackageName . KM.toHashMapText) $ - traverse - ( \case - Aeson.Object obj' -> Just (PackageSpec obj') - _ -> Nothing - ) - obj + ( Sources . mapKeys PackageName . KM.toHashMapText + <$> traverse + ( \case + Aeson.Object obj' -> Just (PackageSpec obj') + _ -> Nothing + ) + obj + ) _ -> Nothing mapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> HMS.HashMap k1 v -> HMS.HashMap k2 v mapKeys f = HMS.fromList . map (first f) . HMS.toList @@ -86,7 +87,7 @@ getSources fsj = do pure setSources :: FindSourcesJson -> Sources -> IO () -setSources fsj sources = Aeson.encodeFilePretty (pathNixSourcesJson fsj) sources +setSources fsj = Aeson.encodeFilePretty (pathNixSourcesJson fsj) newtype PackageName = PackageName {unPackageName :: T.Text} deriving newtype (Eq, Hashable, FromJSONKey, ToJSONKey, Show) diff --git a/src/Niv/Update.hs b/src/Niv/Update.hs index eeb3ae7..2bcddbf 100644 --- a/src/Niv/Update.hs +++ b/src/Niv/Update.hs @@ -70,11 +70,11 @@ data Compose a c = forall b. Compose' (Update b c) (Update a b) -- | Run an 'Update' and return the new attributes and result. runUpdate :: Attrs -> Update () a -> IO (Attrs, a) -runUpdate (attrs) a = boxAttrs attrs >>= flip runUpdate' a >>= feed +runUpdate attrs a = boxAttrs attrs >>= flip runUpdate' a >>= feed where feed = \case UpdateReady res -> hndl res - UpdateNeedMore next -> next (()) >>= hndl + UpdateNeedMore next -> next () >>= hndl hndl = \case UpdateSuccess f v -> (,v) <$> unboxAttrs f UpdateFailed e -> error $ "Update failed: " <> T.unpack (prettyFail e) @@ -239,7 +239,7 @@ runUpdate' attrs = \case Update k -> pure $ case HMS.lookup k attrs of Just (Locked, v) -> UpdateReady $ UpdateSuccess attrs v Just (Free, v) -> UpdateNeedMore $ \gtt -> do - if (boxNew gtt) + if boxNew gtt then do v' <- boxOp v gtt' <- boxOp gtt @@ -276,7 +276,7 @@ runUpdate' attrs = \case v' <- runBox v case renderTemplate ( \k -> - ((decodeBox $ "When rendering template " <> v') . snd) + decodeBox ("When rendering template " <> v') . snd <$> HMS.lookup k attrs ) v' of @@ -302,7 +302,7 @@ renderTemplate vals tpl = case T.uncons tpl of case T.span (/= '>') str of (key, T.uncons -> Just ('>', rest)) -> do let v = vals key - (liftA2 (<>) v) (renderTemplate vals rest) + liftA2 (<>) v (renderTemplate vals rest) _ -> Nothing Just (c, str) -> fmap (T.cons c) <$> renderTemplate vals str Nothing -> Just $ pure T.empty diff --git a/src/Niv/Update/Test.hs b/src/Niv/Update/Test.hs index a618f5b..80e6f7c 100644 --- a/src/Niv/Update/Test.hs +++ b/src/Niv/Update/Test.hs @@ -68,8 +68,8 @@ isNotTooEager = do let f1 = proc () -> do run (const $ error "IO is too eager (f1)") -< pure () useOrSet "foo" -< "foo" - void $ (execUpdate attrs f :: IO (Box T.Text)) - void $ (execUpdate attrs f1 :: IO (Box T.Text)) + void (execUpdate attrs f :: IO (Box T.Text)) + void (execUpdate attrs f1 :: IO (Box T.Text)) where attrs = HMS.singleton "foo" (Locked, "right")