nmattia · nmattia · May 23, 2024 · May 21, 2024
diff --git 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
@@ -276,15 +272,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 =
@@ -367,7 +363,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 $
@@ -395,7 +391,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
@@ -474,8 +470,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 $
@@ -485,7 +480,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 ::
@@ -581,7 +576,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
@@ -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
@@ -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
@@ -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
@@ -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,15 +66,15 @@ parseGitHubPackageSpec =
               <> Opts.help "Set the package spec attribute <KEY> to <VAL>."
           )
         <|> shortcutAttributes
-        <|> ( (("url_template",) . Aeson.String)
+        <|> ( ("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)
+        <|> ( ("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,15 +163,15 @@ 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
     -- From the nix-prefetch-url documentation:
     --  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
@@ -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
@@ -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
@@ -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
@@ -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