mirror of
https://github.com/nmattia/niv.git
synced 2024-11-07 22:36:53 +03:00
Pre merge cleanup
This commit is contained in:
parent
43d7884eb4
commit
567bdb256e
@ -31,7 +31,6 @@ import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.HashMap.Strict as HMS
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import qualified GitHub as GH
|
||||
import qualified Options.Applicative as Opts
|
||||
import qualified Options.Applicative.Help.Pretty as Opts
|
||||
import qualified System.Directory as Dir
|
||||
@ -546,31 +545,6 @@ pathNixSourcesJson = "nix" </> "sources.json"
|
||||
initNixSourcesJsonContent :: B.ByteString
|
||||
initNixSourcesJsonContent = "{}"
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Warn
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
warnCouldNotFetchGitHubRepo :: GH.Error -> (String, String) -> IO ()
|
||||
warnCouldNotFetchGitHubRepo e (owner, repo) =
|
||||
putStrLn $ unlines [ line1, line2, line3 ]
|
||||
where
|
||||
line1 = "WARNING: Could not read from GitHub repo: " <> owner <> "/" <> repo
|
||||
line2 = [s|
|
||||
I assumed that your package was a GitHub repository. An error occurred while
|
||||
gathering information from the repository. Check whether your package was added
|
||||
correctly:
|
||||
|
||||
niv show
|
||||
|
||||
If not, try re-adding it:
|
||||
|
||||
niv drop <package>
|
||||
niv add <package-without-typo>
|
||||
|
||||
Make sure the repository exists.
|
||||
|]
|
||||
line3 = unwords [ "(Error was:", show e, ")" ]
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Abort
|
||||
-------------------------------------------------------------------------------
|
||||
|
@ -1,6 +1,8 @@
|
||||
{-# LANGUAGE Arrows #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Niv.GitHub where
|
||||
@ -8,6 +10,7 @@ module Niv.GitHub where
|
||||
import Control.Arrow
|
||||
import Data.Bool
|
||||
import Data.Maybe
|
||||
import Data.String.QQ (s)
|
||||
import GHC.Exts (toList)
|
||||
import Niv.Update
|
||||
import qualified Data.Text as T
|
||||
@ -23,7 +26,9 @@ data GithubRepo = GithubRepo
|
||||
githubRepo :: T.Text -> T.Text -> IO GithubRepo
|
||||
githubRepo owner repo = fmap translate <$>
|
||||
GH.executeRequest' (GH.repositoryR (GH.N owner) (GH.N repo)) >>= \case
|
||||
Left e -> error (show e)
|
||||
Left e -> do
|
||||
warnCouldNotFetchGitHubRepo e (owner, repo)
|
||||
error (show e)
|
||||
Right x -> pure x
|
||||
where
|
||||
translate r = GithubRepo
|
||||
@ -32,6 +37,27 @@ githubRepo owner repo = fmap translate <$>
|
||||
, repoDefaultBranch = GH.repoDefaultBranch r
|
||||
}
|
||||
|
||||
warnCouldNotFetchGitHubRepo :: GH.Error -> (T.Text, T.Text) -> IO ()
|
||||
warnCouldNotFetchGitHubRepo e (T.unpack -> owner, T.unpack -> repo) =
|
||||
putStrLn $ unlines [ line1, line2, line3 ]
|
||||
where
|
||||
line1 = "WARNING: Could not read from GitHub repo: " <> owner <> "/" <> repo
|
||||
line2 = [s|
|
||||
I assumed that your package was a GitHub repository. An error occurred while
|
||||
gathering information from the repository. Check whether your package was added
|
||||
correctly:
|
||||
|
||||
niv show
|
||||
|
||||
If not, try re-adding it:
|
||||
|
||||
niv drop <package>
|
||||
niv add <package-without-typo>
|
||||
|
||||
Make sure the repository exists.
|
||||
|]
|
||||
line3 = unwords [ "(Error was:", show e, ")" ]
|
||||
|
||||
-- TODO: fetchers for:
|
||||
-- * npm
|
||||
-- * hackage
|
||||
|
@ -76,7 +76,6 @@ runUpdate (boxAttrs -> attrs) a = runUpdate' attrs a >>= feed
|
||||
UpdateNeedMore next -> next (()) >>= hndl
|
||||
hndl = \case
|
||||
UpdateSuccess f v -> (,v) <$> unboxAttrs f
|
||||
-- TODO: fix this
|
||||
UpdateFailed e -> error $ "Update failed: " <> T.unpack (prettyFail e)
|
||||
prettyFail :: UpdateFailed -> T.Text
|
||||
prettyFail = \case
|
||||
|
Loading…
Reference in New Issue
Block a user