mirror of
https://github.com/nmattia/niv.git
synced 2024-10-06 12:27:35 +03:00
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" {} \;`
This commit is contained in:
parent
84fed676e4
commit
f7c5388378
@ -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 $
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 <KEY> to <VAL>."
|
||||
)
|
||||
<|> 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 <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,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 =
|
||||
|
@ -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)])
|
||||
|
@ -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
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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")
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user