{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Niv.GitHub.Cmd
( githubCmd,
)
where
import Control.Applicative
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import Data.Bifunctor
import qualified Data.ByteString.Char8 as B8
import Data.Char (isAlphaNum)
import Data.Maybe
import Data.String.QQ (s)
import qualified Data.Text as T
import Data.Text.Extended
import Niv.Cmd
import Niv.GitHub
import Niv.GitHub.API
import Niv.Sources
import Niv.Update
import qualified Options.Applicative as Opts
import qualified Options.Applicative.Help.Pretty as Opts
import System.Exit (ExitCode (ExitSuccess))
import System.Process (readProcessWithExitCode)
githubCmd :: Cmd
githubCmd :: Cmd
githubCmd =
Cmd :: (forall a. InfoMod a)
-> (Text -> Maybe (PackageName, Object))
-> Parser PackageSpec
-> Update () ()
-> Text
-> (Attrs -> [Text])
-> Cmd
Cmd
{ description :: forall a. InfoMod a
description = forall a. InfoMod a
describeGitHub,
parseCmdShortcut :: Text -> Maybe (PackageName, Object)
parseCmdShortcut = Text -> Maybe (PackageName, Object)
parseAddShortcutGitHub,
parsePackageSpec :: Parser PackageSpec
parsePackageSpec = Parser PackageSpec
parseGitHubPackageSpec,
updateCmd :: Update () ()
updateCmd = Update () ()
githubUpdate',
name :: Text
name = Text
"github",
extraLogs :: Attrs -> [Text]
extraLogs = [Text] -> Attrs -> [Text]
forall a b. a -> b -> a
const []
}
parseGitHubPackageSpec :: Opts.Parser PackageSpec
parseGitHubPackageSpec :: Parser PackageSpec
parseGitHubPackageSpec =
(Object -> PackageSpec
PackageSpec (Object -> PackageSpec)
-> ([(Key, Value)] -> Object) -> [(Key, Value)] -> PackageSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList)
([(Key, Value)] -> PackageSpec)
-> Parser [(Key, Value)] -> Parser PackageSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Key, Value) -> Parser [(Key, Value)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Key, Value)
parseAttribute
where
parseAttribute :: Opts.Parser (K.Key, Aeson.Value)
parseAttribute :: Parser (Key, Value)
parseAttribute =
ReadM (Key, Value)
-> Mod OptionFields (Key, Value) -> Parser (Key, Value)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opts.option
((String -> Maybe (Key, Value)) -> ReadM (Key, Value)
forall a. (String -> Maybe a) -> ReadM a
Opts.maybeReader String -> Maybe (Key, Value)
parseKeyValJSON)
( String -> Mod OptionFields (Key, Value)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"attribute"
Mod OptionFields (Key, Value)
-> Mod OptionFields (Key, Value) -> Mod OptionFields (Key, Value)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (Key, Value)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opts.short Char
'a'
Mod OptionFields (Key, Value)
-> Mod OptionFields (Key, Value) -> Mod OptionFields (Key, Value)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Key, Value)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"KEY=VAL"
Mod OptionFields (Key, Value)
-> Mod OptionFields (Key, Value) -> Mod OptionFields (Key, Value)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Key, Value)
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Set the package spec attribute <KEY> to <VAL>, where <VAL> may be JSON."
)
Parser (Key, Value) -> Parser (Key, Value) -> Parser (Key, Value)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadM (Key, Value)
-> Mod OptionFields (Key, Value) -> Parser (Key, Value)
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opts.option
((String -> Maybe (Key, Value)) -> ReadM (Key, Value)
forall a. (String -> Maybe a) -> ReadM a
Opts.maybeReader ((String -> Value) -> String -> Maybe (Key, Value)
parseKeyVal String -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON))
( String -> Mod OptionFields (Key, Value)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"string-attribute"
Mod OptionFields (Key, Value)
-> Mod OptionFields (Key, Value) -> Mod OptionFields (Key, Value)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (Key, Value)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opts.short Char
's'
Mod OptionFields (Key, Value)
-> Mod OptionFields (Key, Value) -> Mod OptionFields (Key, Value)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Key, Value)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"KEY=VAL"
Mod OptionFields (Key, Value)
-> Mod OptionFields (Key, Value) -> Mod OptionFields (Key, Value)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Key, Value)
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Set the package spec attribute <KEY> to <VAL>."
)
Parser (Key, Value) -> Parser (Key, Value) -> Parser (Key, Value)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Key, Value)
shortcutAttributes
Parser (Key, Value) -> Parser (Key, Value) -> Parser (Key, Value)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( ((Key
"url_template",) (Value -> (Key, Value)) -> (Text -> Value) -> Text -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
Aeson.String)
(Text -> (Key, Value)) -> Parser Text -> Parser (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opts.strOption
( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"template"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opts.short Char
't'
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"URL"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Used during 'update' when building URL. Occurrences of <foo> are replaced with attribute 'foo'."
)
)
Parser (Key, Value) -> Parser (Key, Value) -> Parser (Key, Value)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( ((Key
"type",) (Value -> (Key, Value)) -> (Text -> Value) -> Text -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
Aeson.String)
(Text -> (Key, Value)) -> Parser Text -> Parser (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opts.strOption
( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"type"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opts.short Char
'T'
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"TYPE"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL."
)
)
parseKeyValJSON :: String -> Maybe (Key, Value)
parseKeyValJSON = (String -> Value) -> String -> Maybe (Key, Value)
parseKeyVal ((String -> Value) -> String -> Maybe (Key, Value))
-> (String -> Value) -> String -> Maybe (Key, Value)
forall a b. (a -> b) -> a -> b
$ \String
x ->
Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (String -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON String
x) (ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decodeStrict (String -> ByteString
B8.pack String
x))
parseKeyVal ::
(String -> Aeson.Value) ->
String ->
Maybe (K.Key, Aeson.Value)
parseKeyVal :: (String -> Value) -> String -> Maybe (Key, Value)
parseKeyVal String -> Value
toJSON String
str = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') String
str of
(String
key, Char
'=' : String
val) -> (Key, Value) -> Maybe (Key, Value)
forall a. a -> Maybe a
Just (String -> Key
K.fromString String
key, String -> Value
toJSON String
val)
(String, String)
_ -> Maybe (Key, Value)
forall a. Maybe a
Nothing
shortcutAttributes :: Opts.Parser (K.Key, Aeson.Value)
shortcutAttributes :: Parser (Key, Value)
shortcutAttributes =
(Parser (Key, Value) -> Parser (Key, Value) -> Parser (Key, Value))
-> Parser (Key, Value)
-> [Parser (Key, Value)]
-> Parser (Key, Value)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Parser (Key, Value) -> Parser (Key, Value) -> Parser (Key, Value)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Parser (Key, Value)
forall (f :: * -> *) a. Alternative f => f a
empty ([Parser (Key, Value)] -> Parser (Key, Value))
-> [Parser (Key, Value)] -> Parser (Key, Value)
forall a b. (a -> b) -> a -> b
$
Text -> Parser (Key, Value)
mkShortcutAttribute
(Text -> Parser (Key, Value)) -> [Text] -> [Parser (Key, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text
"branch", Text
"owner", Text
"rev", Text
"version"]
mkShortcutAttribute :: T.Text -> Opts.Parser (K.Key, Aeson.Value)
mkShortcutAttribute :: Text -> Parser (Key, Value)
mkShortcutAttribute = \case
attr :: Text
attr@(Text -> Maybe (Char, Text)
T.uncons -> Just (Char
c, Text
_)) ->
((Key, Text) -> (Key, Value))
-> Parser (Key, Text) -> Parser (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Value) -> (Key, Text) -> (Key, Value)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Text -> Value
Aeson.String) (Parser (Key, Text) -> Parser (Key, Value))
-> Parser (Key, Text) -> Parser (Key, Value)
forall a b. (a -> b) -> a -> b
$
(Text -> Key
K.fromText Text
attr,)
(Text -> (Key, Text)) -> Parser Text -> Parser (Key, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opts.strOption
( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long (Text -> String
T.unpack Text
attr)
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opts.short Char
c
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
attr)
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opts.help
( Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
"Equivalent to --attribute "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attr
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=<"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
T.toUpper Text
attr)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
)
)
Text
_ -> Parser (Key, Value)
forall (f :: * -> *) a. Alternative f => f a
empty
describeGitHub :: Opts.InfoMod a
describeGitHub :: InfoMod a
describeGitHub =
[InfoMod a] -> InfoMod a
forall a. Monoid a => [a] -> a
mconcat
[ InfoMod a
forall a. InfoMod a
Opts.fullDesc,
String -> InfoMod a
forall a. String -> InfoMod a
Opts.progDesc String
"Add a GitHub dependency",
Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
Opts.headerDoc (Maybe Doc -> InfoMod a) -> Maybe Doc -> InfoMod a
forall a b. (a -> b) -> a -> b
$
Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
Doc
"Examples:"
Doc -> Doc -> Doc
Opts.<$$> Doc
""
Doc -> Doc -> Doc
Opts.<$$> Doc
" niv add stedolan/jq"
Doc -> Doc -> Doc
Opts.<$$> Doc
" niv add NixOS/nixpkgs -n nixpkgs -b nixpkgs-unstable"
Doc -> Doc -> Doc
Opts.<$$> Doc
" niv add my-package -v alpha-0.1 -t http://example.com/archive/<version>.zip"
]
parseAddShortcutGitHub :: T.Text -> Maybe (PackageName, Aeson.Object)
parseAddShortcutGitHub :: Text -> Maybe (PackageName, Object)
parseAddShortcutGitHub Text
str =
case (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') Text
str of
( owner :: Text
owner@(Text -> Bool
T.null -> Bool
False),
Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'/', repo :: Text
repo@(Text -> Bool
T.null -> Bool
False))
) ->
(PackageName, Object) -> Maybe (PackageName, Object)
forall a. a -> Maybe a
Just
( Text -> PackageName
PackageName Text
repo,
[(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList [Key
"owner" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
owner, Key
"repo" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
repo]
)
(Text, Text)
_ -> (PackageName, Object) -> Maybe (PackageName, Object)
forall a. a -> Maybe a
Just (Text -> PackageName
PackageName Text
str, Object
forall v. KeyMap v
KM.empty)
githubUpdate' :: Update () ()
githubUpdate' :: Update () ()
githubUpdate' = (Bool -> Text -> IO Text)
-> (Text -> Text -> Text -> IO Text)
-> (Text -> Text -> IO GithubRepo)
-> Update () ()
githubUpdate Bool -> Text -> IO Text
nixPrefetchURL Text -> Text -> Text -> IO Text
githubLatestRev Text -> Text -> IO GithubRepo
githubRepo
nixPrefetchURL :: Bool -> T.Text -> IO T.Text
nixPrefetchURL :: Bool -> Text -> IO Text
nixPrefetchURL Bool
unpack turl :: Text
turl@(Text -> String
T.unpack -> String
url) = do
(ExitCode
exitCode, String
sout, String
serr) <- IO (ExitCode, String, String)
runNixPrefetch
case (ExitCode
exitCode, String -> [String]
lines String
sout) of
(ExitCode
ExitSuccess, String
l : [String]
_) -> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
l
(ExitCode, [String])
_ -> [Text] -> Text -> Text -> IO Text
forall a. [Text] -> Text -> Text -> IO a
abortNixPrefetchExpectedOutput (String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
args) (String -> Text
T.pack String
sout) (String -> Text
T.pack String
serr)
where
args :: [String]
args = (if Bool
unpack then [String
"--unpack"] else []) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
url, String
"--name", Text -> String
sanitizeName Text
basename]
runNixPrefetch :: IO (ExitCode, String, String)
runNixPrefetch = String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"nix-prefetch-url" [String]
args String
""
sanitizeName :: Text -> String
sanitizeName = Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isOk
basename :: Text
basename = [Text] -> Text
forall a. [a] -> a
last ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"/" Text
turl
isOk :: Char -> Bool
isOk = \Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
"+-._?="
abortNixPrefetchExpectedOutput :: [T.Text] -> T.Text -> T.Text -> IO a
abortNixPrefetchExpectedOutput :: [Text] -> Text -> Text -> IO a
abortNixPrefetchExpectedOutput [Text]
args Text
sout Text
serr =
Text -> IO a
forall (io :: * -> *) a. MonadIO io => Text -> io a
abort (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
[s|
Could not read the output of 'nix-prefetch-url'. This is a bug. Please create a
ticket:
https://github.com/nmattia/niv/issues/new
Thanks! I'll buy you a beer.
|]
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unlines [Text
"command: ", Text
"nix-prefetch-url" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
args, Text
"stdout: ", Text
sout, Text
"stderr: ", Text
serr]