Cleanup and prettify
This commit is contained in:
parent
5f9159aaf4
commit
89e3d420e5
28
app/Main.hs
28
app/Main.hs
@ -8,6 +8,7 @@ import GHup
|
||||
import GitHub.Auth
|
||||
import HPath
|
||||
import Options.Applicative
|
||||
import System.Console.Pretty
|
||||
import System.Exit
|
||||
|
||||
|
||||
@ -29,7 +30,8 @@ data ForkOptions = ForkOptions
|
||||
}
|
||||
|
||||
data ConfigOptions = ConfigOptions {
|
||||
oAuth :: ByteString
|
||||
oAuth :: ByteString
|
||||
, bPath :: Maybe ByteString
|
||||
}
|
||||
|
||||
|
||||
@ -45,8 +47,18 @@ opts = subparser
|
||||
)
|
||||
|
||||
configOpts :: Parser ConfigOptions
|
||||
configOpts = ConfigOptions <$> strOption
|
||||
(short 'o' <> long "oauth" <> metavar "OAUTH" <> help "The OAUTH token")
|
||||
configOpts =
|
||||
ConfigOptions
|
||||
<$> strOption
|
||||
(short 'o' <> long "oauth" <> metavar "OAUTH" <> help
|
||||
"The OAUTH token"
|
||||
)
|
||||
<*> optional
|
||||
(strOption
|
||||
((short 'p') <> long "base-path" <> metavar "BASE_PATH" <> help
|
||||
"The base path to clone into"
|
||||
)
|
||||
)
|
||||
|
||||
forkOpts :: Parser ForkOptions
|
||||
forkOpts =
|
||||
@ -82,8 +94,10 @@ main = do
|
||||
Just p -> prepareRepoForPR' repo (Just p) newBranch
|
||||
Nothing -> fail "Repo path must be absolute"
|
||||
Nothing -> prepareRepoForPR' repo Nothing newBranch
|
||||
Config (ConfigOptions {..}) -> writeSettings (OAuth oAuth) <&> Right
|
||||
Del (DelOptions {..} ) -> deleteFork' del
|
||||
Config (ConfigOptions {..}) -> do
|
||||
p <- maybe (pure Nothing) (fmap Just . parseAbs) bPath
|
||||
writeSettings (Settings (OAuth oAuth) p) <&> Right
|
||||
Del (DelOptions {..}) -> deleteFork' del
|
||||
case e of
|
||||
Right () -> putStrLn "success!"
|
||||
Left t -> die t
|
||||
Right () -> _info "success!"
|
||||
Left t -> die (color Red $ t)
|
||||
|
||||
@ -26,6 +26,7 @@ library
|
||||
, hpath-io ^>= 0.13.1
|
||||
, http-client ^>= 0.6.4
|
||||
, mtl ^>= 2.2
|
||||
, pretty-terminal ^>= 0.1
|
||||
, safe-exceptions ^>= 0.1
|
||||
, streamly ^>= 0.7
|
||||
, text ^>= 1.2
|
||||
@ -35,7 +36,7 @@ library
|
||||
hs-source-dirs: lib
|
||||
ghc-options: -Wall
|
||||
default-language: Haskell2010
|
||||
default-extensions: LambdaCase, MultiWayIf, RecordWildCards
|
||||
default-extensions: LambdaCase, MultiWayIf, RecordWildCards, TupleSections
|
||||
|
||||
executable ghup
|
||||
main-is: Main.hs
|
||||
@ -47,9 +48,10 @@ executable ghup
|
||||
, github ^>= 0.24
|
||||
, hpath ^>= 0.11
|
||||
, optparse-applicative ^>= 0.15
|
||||
, pretty-terminal ^>= 0.1
|
||||
hs-source-dirs: app
|
||||
default-language: Haskell2010
|
||||
default-extensions: LambdaCase, MultiWayIf, RecordWildCards
|
||||
default-extensions: LambdaCase, MultiWayIf, RecordWildCards, TupleSections
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
|
||||
57
lib/GHup.hs
57
lib/GHup.hs
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
@ -9,6 +10,7 @@ module GHup
|
||||
ForkResult(..)
|
||||
, CloneMethod(..)
|
||||
, ProcessError(..)
|
||||
, Settings(..)
|
||||
-- * Settings
|
||||
, getSettings
|
||||
, writeSettings
|
||||
@ -24,6 +26,10 @@ module GHup
|
||||
-- * Parsers
|
||||
, parseURL
|
||||
, ghURLParser
|
||||
-- * Utils
|
||||
, _info
|
||||
, _warn
|
||||
, _err
|
||||
)
|
||||
where
|
||||
|
||||
@ -48,6 +54,10 @@ import HPath.IO
|
||||
import Prelude hiding ( readFile
|
||||
, writeFile
|
||||
)
|
||||
import System.Console.Pretty
|
||||
import System.IO ( hPutStrLn
|
||||
, stderr
|
||||
)
|
||||
import System.Posix.ByteString ( getEnv
|
||||
, RawFilePath
|
||||
)
|
||||
@ -88,12 +98,23 @@ data UrlParseResult = UrlParseResult {
|
||||
|
||||
|
||||
data Settings = Settings {
|
||||
auth :: Auth
|
||||
auth :: Auth
|
||||
, basePath :: Maybe (Path Abs)
|
||||
} deriving (Eq, Read, Show)
|
||||
|
||||
|
||||
deriving instance Read Auth
|
||||
|
||||
instance Read (Path Abs) where
|
||||
readsPrec p input =
|
||||
let str = readsPrec p input :: [(String, String)]
|
||||
in case str of
|
||||
[(s, n)] -> case parseAbs (UTF8.fromString s) of
|
||||
Just p' -> [(p', n)]
|
||||
Nothing -> []
|
||||
_ -> []
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -103,17 +124,16 @@ deriving instance Read Auth
|
||||
|
||||
|
||||
|
||||
writeSettings :: Auth -> IO ()
|
||||
writeSettings auth = do
|
||||
writeSettings :: Settings -> IO ()
|
||||
writeSettings settings = do
|
||||
sf <- getSettingsFile
|
||||
let settings = Settings auth
|
||||
let fileperms =
|
||||
ownerWriteMode
|
||||
`unionFileModes` ownerReadMode
|
||||
`unionFileModes` groupWriteMode
|
||||
`unionFileModes` groupReadMode
|
||||
writeFile sf (Just fileperms) (u8 . show $ settings)
|
||||
putStrLn ("Written config to file " <> (UTF8.toString $ toFilePath sf))
|
||||
_info ("Written config to file " <> (UTF8.toString $ toFilePath sf))
|
||||
|
||||
|
||||
getSettingsFile :: IO (Path Abs)
|
||||
@ -136,7 +156,7 @@ getSettings = runExceptT (fromEnv <|> fromFile)
|
||||
fromEnv :: ExceptT String IO Settings
|
||||
fromEnv = do
|
||||
(lift $ getEnv (u8 "GITHUB_TOKEN")) >>= \case
|
||||
Just t -> pure $ Settings (OAuth t)
|
||||
Just t -> pure $ Settings (OAuth t) Nothing
|
||||
Nothing -> throwError "Not found"
|
||||
fromFile :: ExceptT String IO Settings
|
||||
fromFile = do
|
||||
@ -163,9 +183,12 @@ prepareRepoForPR' :: ByteString -- ^ string that contains repo url
|
||||
-> Maybe (Path b) -- ^ base path where the repo should be cloned
|
||||
-> Maybe ByteString -- ^ PR branch name to switch to
|
||||
-> IO (Either String ())
|
||||
prepareRepoForPR' repoString repobase branch = runExceptT $ do
|
||||
prepareRepoForPR' repoString mRepobase branch = runExceptT $ do
|
||||
UrlParseResult {..} <- liftEither $ parseURL repoString
|
||||
Settings {..} <- ExceptT getSettings
|
||||
repobase <- case mRepobase of
|
||||
Just r -> fmap Just $ lift $ toAbs r
|
||||
Nothing -> pure basePath
|
||||
ExceptT $ prepareRepoForPR auth owner repo repobase branch
|
||||
|
||||
|
||||
@ -190,6 +213,10 @@ prepareRepoForPR am owner repo repobase branch = runExceptT $ do
|
||||
case branch of
|
||||
Just b -> withExceptT show $ ExceptT $ createBranch b repodest
|
||||
Nothing -> pure ()
|
||||
lift $ _info
|
||||
( "To change to the repo dir, run:\n\tcd "
|
||||
<> (UTF8.toString $ toFilePath repodest)
|
||||
)
|
||||
|
||||
|
||||
forkRepository :: AuthMethod am
|
||||
@ -238,8 +265,7 @@ createBranch branch repodir =
|
||||
|
||||
-- | Same as deleteFork, but gets the auth from the config file
|
||||
-- and parses the owner/repo from the given repo url string.
|
||||
deleteFork' :: ByteString
|
||||
-> IO (Either String ())
|
||||
deleteFork' :: ByteString -> IO (Either String ())
|
||||
deleteFork' repoString = runExceptT $ do
|
||||
UrlParseResult {..} <- liftEither $ parseURL repoString
|
||||
Settings {..} <- ExceptT getSettings
|
||||
@ -326,3 +352,16 @@ getHomeDirectory = do
|
||||
Nothing -> do
|
||||
h <- PU.homeDirectory <$> (PU.getEffectiveUserID >>= PU.getUserEntryForID)
|
||||
pure $ u8 h -- this is a guess
|
||||
|
||||
|
||||
_info :: String -> IO ()
|
||||
_info = putStrLn . color Green
|
||||
|
||||
_warn :: String -> IO ()
|
||||
_warn = _stderr . color Yellow
|
||||
|
||||
_err :: String -> IO ()
|
||||
_err = _stderr . color Red
|
||||
|
||||
_stderr :: String -> IO ()
|
||||
_stderr = hPutStrLn stderr
|
||||
|
||||
Loading…
Reference in New Issue
Block a user