{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Niv.Cli where
import Control.Applicative
import Control.Monad
import Control.Monad.Reader
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.Char (isSpace)
import qualified Data.HashMap.Strict as HMS
import Data.HashMap.Strict.Extended
import Data.Hashable (Hashable)
import qualified Data.Text as T
import Data.Text.Extended
import Data.Version (showVersion)
import qualified Network.HTTP.Simple as HTTP
import Niv.Cmd
import Niv.Git.Cmd
import Niv.GitHub.Cmd
import Niv.Local.Cmd
import Niv.Logger
import Niv.Sources
import Niv.Update
import qualified Options.Applicative as Opts
import qualified Options.Applicative.Help.Pretty as Opts
import Paths_niv (version)
import qualified System.Directory as Dir
import System.Environment (getArgs)
import System.FilePath (takeDirectory)
import UnliftIO
newtype NIO a = NIO {NIO a -> ReaderT FindSourcesJson IO a
runNIO :: ReaderT FindSourcesJson IO a}
deriving (a -> NIO b -> NIO a
(a -> b) -> NIO a -> NIO b
(forall a b. (a -> b) -> NIO a -> NIO b)
-> (forall a b. a -> NIO b -> NIO a) -> Functor NIO
forall a b. a -> NIO b -> NIO a
forall a b. (a -> b) -> NIO a -> NIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NIO b -> NIO a
$c<$ :: forall a b. a -> NIO b -> NIO a
fmap :: (a -> b) -> NIO a -> NIO b
$cfmap :: forall a b. (a -> b) -> NIO a -> NIO b
Functor, Functor NIO
a -> NIO a
Functor NIO
-> (forall a. a -> NIO a)
-> (forall a b. NIO (a -> b) -> NIO a -> NIO b)
-> (forall a b c. (a -> b -> c) -> NIO a -> NIO b -> NIO c)
-> (forall a b. NIO a -> NIO b -> NIO b)
-> (forall a b. NIO a -> NIO b -> NIO a)
-> Applicative NIO
NIO a -> NIO b -> NIO b
NIO a -> NIO b -> NIO a
NIO (a -> b) -> NIO a -> NIO b
(a -> b -> c) -> NIO a -> NIO b -> NIO c
forall a. a -> NIO a
forall a b. NIO a -> NIO b -> NIO a
forall a b. NIO a -> NIO b -> NIO b
forall a b. NIO (a -> b) -> NIO a -> NIO b
forall a b c. (a -> b -> c) -> NIO a -> NIO b -> NIO c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: NIO a -> NIO b -> NIO a
$c<* :: forall a b. NIO a -> NIO b -> NIO a
*> :: NIO a -> NIO b -> NIO b
$c*> :: forall a b. NIO a -> NIO b -> NIO b
liftA2 :: (a -> b -> c) -> NIO a -> NIO b -> NIO c
$cliftA2 :: forall a b c. (a -> b -> c) -> NIO a -> NIO b -> NIO c
<*> :: NIO (a -> b) -> NIO a -> NIO b
$c<*> :: forall a b. NIO (a -> b) -> NIO a -> NIO b
pure :: a -> NIO a
$cpure :: forall a. a -> NIO a
$cp1Applicative :: Functor NIO
Applicative, Applicative NIO
a -> NIO a
Applicative NIO
-> (forall a b. NIO a -> (a -> NIO b) -> NIO b)
-> (forall a b. NIO a -> NIO b -> NIO b)
-> (forall a. a -> NIO a)
-> Monad NIO
NIO a -> (a -> NIO b) -> NIO b
NIO a -> NIO b -> NIO b
forall a. a -> NIO a
forall a b. NIO a -> NIO b -> NIO b
forall a b. NIO a -> (a -> NIO b) -> NIO b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> NIO a
$creturn :: forall a. a -> NIO a
>> :: NIO a -> NIO b -> NIO b
$c>> :: forall a b. NIO a -> NIO b -> NIO b
>>= :: NIO a -> (a -> NIO b) -> NIO b
$c>>= :: forall a b. NIO a -> (a -> NIO b) -> NIO b
$cp1Monad :: Applicative NIO
Monad, Monad NIO
Monad NIO -> (forall a. IO a -> NIO a) -> MonadIO NIO
IO a -> NIO a
forall a. IO a -> NIO a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> NIO a
$cliftIO :: forall a. IO a -> NIO a
$cp1MonadIO :: Monad NIO
MonadIO, MonadReader FindSourcesJson)
instance MonadUnliftIO NIO where
withRunInIO :: ((forall a. NIO a -> IO a) -> IO b) -> NIO b
withRunInIO = (ReaderT FindSourcesJson IO b -> NIO b)
-> (forall a. NIO a -> ReaderT FindSourcesJson IO a)
-> ((forall a. NIO a -> IO a) -> IO b)
-> NIO b
forall (n :: * -> *) b (m :: * -> *).
MonadUnliftIO n =>
(n b -> m b)
-> (forall a. m a -> n a)
-> ((forall a. m a -> IO a) -> IO b)
-> m b
wrappedWithRunInIO ReaderT FindSourcesJson IO b -> NIO b
forall a. ReaderT FindSourcesJson IO a -> NIO a
NIO forall a. NIO a -> ReaderT FindSourcesJson IO a
runNIO
getFindSourcesJson :: NIO FindSourcesJson
getFindSourcesJson :: NIO FindSourcesJson
getFindSourcesJson = NIO FindSourcesJson
forall r (m :: * -> *). MonadReader r m => m r
ask
li :: MonadIO io => IO a -> io a
li :: IO a -> io a
li = IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
cli :: IO ()
cli :: IO ()
cli = do
((FindSourcesJson
fsj, Colors
colors), NIO ()
nio) <-
ParserPrefs
-> ParserInfo ((FindSourcesJson, Colors), NIO ())
-> [String]
-> ParserResult ((FindSourcesJson, Colors), NIO ())
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure' ParserPrefs
Opts.defaultPrefs ParserInfo ((FindSourcesJson, Colors), NIO ())
opts ([String] -> ParserResult ((FindSourcesJson, Colors), NIO ()))
-> IO [String]
-> IO (ParserResult ((FindSourcesJson, Colors), NIO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getArgs
IO (ParserResult ((FindSourcesJson, Colors), NIO ()))
-> (ParserResult ((FindSourcesJson, Colors), NIO ())
-> IO ((FindSourcesJson, Colors), NIO ()))
-> IO ((FindSourcesJson, Colors), NIO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserResult ((FindSourcesJson, Colors), NIO ())
-> IO ((FindSourcesJson, Colors), NIO ())
forall a. ParserResult a -> IO a
Opts.handleParseResult
Colors -> IO ()
setColors Colors
colors
ReaderT FindSourcesJson IO () -> FindSourcesJson -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (NIO () -> ReaderT FindSourcesJson IO ()
forall a. NIO a -> ReaderT FindSourcesJson IO a
runNIO NIO ()
nio) FindSourcesJson
fsj
where
execParserPure' :: ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure' ParserPrefs
pprefs ParserInfo a
pinfo [] =
ParserFailure ParserHelp -> ParserResult a
forall a. ParserFailure ParserHelp -> ParserResult a
Opts.Failure (ParserFailure ParserHelp -> ParserResult a)
-> ParserFailure ParserHelp -> ParserResult a
forall a b. (a -> b) -> a -> b
$
ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
forall a.
ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
Opts.parserFailure ParserPrefs
pprefs ParserInfo a
pinfo (Maybe String -> ParseError
Opts.ShowHelpText Maybe String
forall a. Maybe a
Nothing) [Context]
forall a. Monoid a => a
mempty
execParserPure' ParserPrefs
pprefs ParserInfo a
pinfo [String]
args = ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
Opts.execParserPure ParserPrefs
pprefs ParserInfo a
pinfo [String]
args
opts :: ParserInfo ((FindSourcesJson, Colors), NIO ())
opts = Parser ((FindSourcesJson, Colors), NIO ())
-> InfoMod ((FindSourcesJson, Colors), NIO ())
-> ParserInfo ((FindSourcesJson, Colors), NIO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info ((,) ((FindSourcesJson, Colors)
-> NIO () -> ((FindSourcesJson, Colors), NIO ()))
-> Parser (FindSourcesJson, Colors)
-> Parser (NIO () -> ((FindSourcesJson, Colors), NIO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (FindSourcesJson -> Colors -> (FindSourcesJson, Colors))
-> Parser FindSourcesJson
-> Parser (Colors -> (FindSourcesJson, Colors))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FindSourcesJson
parseFindSourcesJson Parser (Colors -> (FindSourcesJson, Colors))
-> Parser Colors -> Parser (FindSourcesJson, Colors)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Colors
parseColors) Parser (NIO () -> ((FindSourcesJson, Colors), NIO ()))
-> Parser (NIO ()) -> Parser ((FindSourcesJson, Colors), NIO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser (NIO ())
parseCommand Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
Opts.helper Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
versionflag)) (InfoMod ((FindSourcesJson, Colors), NIO ())
-> ParserInfo ((FindSourcesJson, Colors), NIO ()))
-> InfoMod ((FindSourcesJson, Colors), NIO ())
-> ParserInfo ((FindSourcesJson, Colors), NIO ())
forall a b. (a -> b) -> a -> b
$ [InfoMod ((FindSourcesJson, Colors), NIO ())]
-> InfoMod ((FindSourcesJson, Colors), NIO ())
forall a. Monoid a => [a] -> a
mconcat [InfoMod ((FindSourcesJson, Colors), NIO ())]
forall a. [InfoMod a]
desc
desc :: [InfoMod a]
desc =
[ InfoMod a
forall a. InfoMod a
Opts.fullDesc,
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
"niv - dependency manager for Nix projects"
Doc -> Doc -> Doc
Opts.<$$> Doc
""
Doc -> Doc -> Doc
Opts.<$$> Doc
"version:" Doc -> Doc -> Doc
Opts.<+> String -> Doc
Opts.text (Version -> String
showVersion Version
version)
]
parseFindSourcesJson :: Parser FindSourcesJson
parseFindSourcesJson =
String -> FindSourcesJson
AtPath
(String -> FindSourcesJson)
-> Parser String -> Parser FindSourcesJson
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opts.strOption
( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"sources-file"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opts.short Char
's'
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"FILE"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Use FILE instead of nix/sources.json"
)
Parser FindSourcesJson
-> Parser FindSourcesJson -> Parser FindSourcesJson
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FindSourcesJson -> Parser FindSourcesJson
forall (f :: * -> *) a. Applicative f => a -> f a
pure FindSourcesJson
Auto
parseColors :: Parser Colors
parseColors =
(\case Bool
True -> Colors
Never; Bool
False -> Colors
Always)
(Bool -> Colors) -> Parser Bool -> Parser Colors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
Opts.switch
( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"no-colors"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Don't use colors in output"
)
versionflag :: Opts.Parser (a -> a)
versionflag :: Parser (a -> a)
versionflag =
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
Opts.abortOption (String -> ParseError
Opts.InfoMsg (Version -> String
showVersion Version
version)) (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$
[Mod OptionFields (a -> a)] -> Mod OptionFields (a -> a)
forall a. Monoid a => [a] -> a
mconcat
[String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"version", Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
Opts.hidden, String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Print version"]
parseCommand :: Opts.Parser (NIO ())
parseCommand :: Parser (NIO ())
parseCommand =
Mod CommandFields (NIO ()) -> Parser (NIO ())
forall a. Mod CommandFields a -> Parser a
Opts.subparser
( String -> ParserInfo (NIO ()) -> Mod CommandFields (NIO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command String
"init" ParserInfo (NIO ())
parseCmdInit
Mod CommandFields (NIO ())
-> Mod CommandFields (NIO ()) -> Mod CommandFields (NIO ())
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo (NIO ()) -> Mod CommandFields (NIO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command String
"add" ParserInfo (NIO ())
parseCmdAdd
Mod CommandFields (NIO ())
-> Mod CommandFields (NIO ()) -> Mod CommandFields (NIO ())
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo (NIO ()) -> Mod CommandFields (NIO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command String
"show" ParserInfo (NIO ())
parseCmdShow
Mod CommandFields (NIO ())
-> Mod CommandFields (NIO ()) -> Mod CommandFields (NIO ())
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo (NIO ()) -> Mod CommandFields (NIO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command String
"update" ParserInfo (NIO ())
parseCmdUpdate
Mod CommandFields (NIO ())
-> Mod CommandFields (NIO ()) -> Mod CommandFields (NIO ())
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo (NIO ()) -> Mod CommandFields (NIO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command String
"modify" ParserInfo (NIO ())
parseCmdModify
Mod CommandFields (NIO ())
-> Mod CommandFields (NIO ()) -> Mod CommandFields (NIO ())
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo (NIO ()) -> Mod CommandFields (NIO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command String
"drop" ParserInfo (NIO ())
parseCmdDrop
)
parsePackageName :: Opts.Parser PackageName
parsePackageName :: Parser PackageName
parsePackageName =
Text -> PackageName
PackageName
(Text -> PackageName) -> Parser Text -> Parser PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Opts.argument ReadM Text
forall s. IsString s => ReadM s
Opts.str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"PACKAGE")
parsePackage :: Opts.Parser (PackageName, PackageSpec)
parsePackage :: Parser (PackageName, PackageSpec)
parsePackage = (,) (PackageName -> PackageSpec -> (PackageName, PackageSpec))
-> Parser PackageName
-> Parser (PackageSpec -> (PackageName, PackageSpec))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PackageName
parsePackageName Parser (PackageSpec -> (PackageName, PackageSpec))
-> Parser PackageSpec -> Parser (PackageName, PackageSpec)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Cmd -> Parser PackageSpec
parsePackageSpec Cmd
githubCmd)
data FetchNixpkgs
= NoNixpkgs
| NixpkgsFast
| NixpkgsCustom T.Text Nixpkgs
deriving (Int -> FetchNixpkgs -> ShowS
[FetchNixpkgs] -> ShowS
FetchNixpkgs -> String
(Int -> FetchNixpkgs -> ShowS)
-> (FetchNixpkgs -> String)
-> ([FetchNixpkgs] -> ShowS)
-> Show FetchNixpkgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchNixpkgs] -> ShowS
$cshowList :: [FetchNixpkgs] -> ShowS
show :: FetchNixpkgs -> String
$cshow :: FetchNixpkgs -> String
showsPrec :: Int -> FetchNixpkgs -> ShowS
$cshowsPrec :: Int -> FetchNixpkgs -> ShowS
Show)
data Nixpkgs = Nixpkgs T.Text T.Text
instance Show Nixpkgs where
show :: Nixpkgs -> String
show (Nixpkgs Text
o Text
r) = Text -> String
T.unpack Text
o String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
r
parseCmdInit :: Opts.ParserInfo (NIO ())
parseCmdInit :: ParserInfo (NIO ())
parseCmdInit = Parser (NIO ()) -> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info (FetchNixpkgs -> NIO ()
cmdInit (FetchNixpkgs -> NIO ()) -> Parser FetchNixpkgs -> Parser (NIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FetchNixpkgs
parseNixpkgs Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
Opts.helper) (InfoMod (NIO ()) -> ParserInfo (NIO ()))
-> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a b. (a -> b) -> a -> b
$ [InfoMod (NIO ())] -> InfoMod (NIO ())
forall a. Monoid a => [a] -> a
mconcat [InfoMod (NIO ())]
forall a. [InfoMod a]
desc
where
desc :: [InfoMod a]
desc =
[ InfoMod a
forall a. InfoMod a
Opts.fullDesc,
String -> InfoMod a
forall a. String -> InfoMod a
Opts.progDesc
String
"Initialize a Nix project. Existing files won't be modified."
]
parseNixpkgs :: Opts.Parser FetchNixpkgs
parseNixpkgs :: Parser FetchNixpkgs
parseNixpkgs = Parser FetchNixpkgs
parseNixpkgsFast Parser FetchNixpkgs -> Parser FetchNixpkgs -> Parser FetchNixpkgs
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser FetchNixpkgs
parseNixpkgsLatest Parser FetchNixpkgs -> Parser FetchNixpkgs -> Parser FetchNixpkgs
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser FetchNixpkgs
parseNixpkgsCustom Parser FetchNixpkgs -> Parser FetchNixpkgs -> Parser FetchNixpkgs
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser FetchNixpkgs
parseNoNixpkgs Parser FetchNixpkgs -> Parser FetchNixpkgs -> Parser FetchNixpkgs
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FetchNixpkgs -> Parser FetchNixpkgs
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchNixpkgs
NixpkgsFast
where
parseNixpkgsFast :: Parser FetchNixpkgs
parseNixpkgsFast =
FetchNixpkgs -> Mod FlagFields FetchNixpkgs -> Parser FetchNixpkgs
forall a. a -> Mod FlagFields a -> Parser a
Opts.flag'
FetchNixpkgs
NixpkgsFast
( String -> Mod FlagFields FetchNixpkgs
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"fast"
Mod FlagFields FetchNixpkgs
-> Mod FlagFields FetchNixpkgs -> Mod FlagFields FetchNixpkgs
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields FetchNixpkgs
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Use the latest nixpkgs cached at 'https://github.com/nmattia/niv/blob/master/data/nixpkgs.json'. This is the default."
)
parseNixpkgsLatest :: Parser FetchNixpkgs
parseNixpkgsLatest =
FetchNixpkgs -> Mod FlagFields FetchNixpkgs -> Parser FetchNixpkgs
forall a. a -> Mod FlagFields a -> Parser a
Opts.flag'
(Text -> Nixpkgs -> FetchNixpkgs
NixpkgsCustom Text
"master" (Text -> Text -> Nixpkgs
Nixpkgs Text
"NixOS" Text
"nixpkgs"))
( String -> Mod FlagFields FetchNixpkgs
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"latest"
Mod FlagFields FetchNixpkgs
-> Mod FlagFields FetchNixpkgs -> Mod FlagFields FetchNixpkgs
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields FetchNixpkgs
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Pull the latest unstable nixpkgs from NixOS/nixpkgs."
)
parseNixpkgsCustom :: Parser FetchNixpkgs
parseNixpkgsCustom =
((Text -> Nixpkgs -> FetchNixpkgs)
-> Nixpkgs -> Text -> FetchNixpkgs
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Nixpkgs -> FetchNixpkgs
NixpkgsCustom)
(Nixpkgs -> Text -> FetchNixpkgs)
-> Parser Nixpkgs -> Parser (Text -> FetchNixpkgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ReadM Nixpkgs -> Mod OptionFields Nixpkgs -> Parser Nixpkgs
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opts.option
ReadM Nixpkgs
customNixpkgsReader
( String -> Mod OptionFields Nixpkgs
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"nixpkgs"
Mod OptionFields Nixpkgs
-> Mod OptionFields Nixpkgs -> Mod OptionFields Nixpkgs
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Nixpkgs
forall a (f :: * -> *). Show a => Mod f a
Opts.showDefault
Mod OptionFields Nixpkgs
-> Mod OptionFields Nixpkgs -> Mod OptionFields Nixpkgs
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Nixpkgs
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Use a custom nixpkgs repository from GitHub."
Mod OptionFields Nixpkgs
-> Mod OptionFields Nixpkgs -> Mod OptionFields Nixpkgs
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Nixpkgs
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"OWNER/REPO"
)
)
Parser (Text -> FetchNixpkgs) -> Parser Text -> Parser FetchNixpkgs
forall (f :: * -> *) a b. Applicative f => 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
"nixpkgs-branch"
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
'b'
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 nixpkgs branch when using --nixpkgs ...."
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Text
forall a (f :: * -> *). Show a => Mod f a
Opts.showDefault
)
)
parseNoNixpkgs :: Parser FetchNixpkgs
parseNoNixpkgs =
FetchNixpkgs -> Mod FlagFields FetchNixpkgs -> Parser FetchNixpkgs
forall a. a -> Mod FlagFields a -> Parser a
Opts.flag'
FetchNixpkgs
NoNixpkgs
( String -> Mod FlagFields FetchNixpkgs
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opts.long String
"no-nixpkgs"
Mod FlagFields FetchNixpkgs
-> Mod FlagFields FetchNixpkgs -> Mod FlagFields FetchNixpkgs
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields FetchNixpkgs
forall (f :: * -> *) a. String -> Mod f a
Opts.help String
"Don't add a nixpkgs entry to sources.json."
)
customNixpkgsReader :: ReadM Nixpkgs
customNixpkgsReader = (String -> Maybe Nixpkgs) -> ReadM Nixpkgs
forall a. (String -> Maybe a) -> ReadM a
Opts.maybeReader ((String -> Maybe Nixpkgs) -> ReadM Nixpkgs)
-> (String -> Maybe Nixpkgs) -> ReadM Nixpkgs
forall a b. (a -> b) -> a -> b
$ \(String -> Text
T.pack -> Text
repo) -> case Text -> Text -> [Text]
T.splitOn Text
"/" Text
repo of
[Text
owner, Text
reponame] -> Nixpkgs -> Maybe Nixpkgs
forall a. a -> Maybe a
Just (Text -> Text -> Nixpkgs
Nixpkgs Text
owner Text
reponame)
[Text]
_ -> Maybe Nixpkgs
forall a. Maybe a
Nothing
cmdInit :: FetchNixpkgs -> NIO ()
cmdInit :: FetchNixpkgs -> NIO ()
cmdInit FetchNixpkgs
nixpkgs = do
String -> NIO () -> NIO ()
forall (io :: * -> *).
(MonadUnliftIO io, MonadIO io) =>
String -> io () -> io ()
job String
"Initializing" (NIO () -> NIO ()) -> NIO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ do
FindSourcesJson
fsj <- NIO FindSourcesJson
getFindSourcesJson
[(String, String -> NIO (), String -> ByteString -> NIO ())]
-> ((String, String -> NIO (), String -> ByteString -> NIO ())
-> NIO ())
-> NIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
[ ( String
pathNixSourcesNix,
(String -> ByteString -> NIO ()
`createFile` ByteString
initNixSourcesNixContent),
\String
path ByteString
content -> do
if ByteString -> Bool
shouldUpdateNixSourcesNix ByteString
content
then do
String -> NIO ()
forall (io :: * -> *). MonadIO io => String -> io ()
say String
"Updating sources.nix"
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
B.writeFile String
path ByteString
initNixSourcesNixContent
else String -> NIO ()
forall (io :: * -> *). MonadIO io => String -> io ()
say String
"Not updating sources.nix"
),
( FindSourcesJson -> String
pathNixSourcesJson FindSourcesJson
fsj,
\String
path -> do
String -> ByteString -> NIO ()
createFile String
path ByteString
initNixSourcesJsonContent
FetchNixpkgs -> NIO ()
initNixpkgs FetchNixpkgs
nixpkgs,
\String
path ByteString
_content -> String -> NIO ()
dontCreateFile String
path
)
]
(((String, String -> NIO (), String -> ByteString -> NIO ())
-> NIO ())
-> NIO ())
-> ((String, String -> NIO (), String -> ByteString -> NIO ())
-> NIO ())
-> NIO ()
forall a b. (a -> b) -> a -> b
$ \(String
path, String -> NIO ()
onCreate, String -> ByteString -> NIO ()
onUpdate) -> do
Bool
exists <- IO Bool -> NIO Bool
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO Bool -> NIO Bool) -> IO Bool -> NIO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
Dir.doesFileExist String
path
if Bool
exists then IO ByteString -> NIO ByteString
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (String -> IO ByteString
B.readFile String
path) NIO ByteString -> (ByteString -> NIO ()) -> NIO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ByteString -> NIO ()
onUpdate String
path else String -> NIO ()
onCreate String
path
case FindSourcesJson
fsj of
FindSourcesJson
Auto -> () -> NIO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
AtPath String
fp ->
Text -> NIO ()
forall (io :: * -> *). MonadIO io => Text -> io ()
tsay (Text -> NIO ()) -> Text -> NIO ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.unlines
[ [Text] -> Text
T.unwords
[ T
tbold T -> T
forall a b. (a -> b) -> a -> b
$ T
tblue Text
"INFO:",
Text
"You are using a custom path for sources.json."
],
Text
" You need to configure the sources.nix to use " Text -> T
forall a. Semigroup a => a -> a -> a
<> T
tbold (String -> Text
T.pack String
fp) Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
":",
T
tbold Text
" import sources.nix { sourcesFile = PATH ; }; ",
[Text] -> Text
T.unwords
[ Text
" where",
T
tbold Text
"PATH",
Text
"is the relative path from sources.nix to",
T
tbold (String -> Text
T.pack String
fp) Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
"."
]
]
where
createFile :: FilePath -> B.ByteString -> NIO ()
createFile :: String -> ByteString -> NIO ()
createFile String
path ByteString
content = IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ do
let dir :: String
dir = ShowS
takeDirectory String
path
Bool -> String -> IO ()
Dir.createDirectoryIfMissing Bool
True String
dir
String -> IO ()
forall (io :: * -> *). MonadIO io => String -> io ()
say (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Creating " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path
String -> ByteString -> IO ()
B.writeFile String
path ByteString
content
dontCreateFile :: FilePath -> NIO ()
dontCreateFile :: String -> NIO ()
dontCreateFile String
path = String -> NIO ()
forall (io :: * -> *). MonadIO io => String -> io ()
say (String -> NIO ()) -> String -> NIO ()
forall a b. (a -> b) -> a -> b
$ String
"Not creating " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path
initNixpkgs :: FetchNixpkgs -> NIO ()
initNixpkgs :: FetchNixpkgs -> NIO ()
initNixpkgs FetchNixpkgs
nixpkgs =
case FetchNixpkgs
nixpkgs of
FetchNixpkgs
NoNixpkgs -> String -> NIO ()
forall (io :: * -> *). MonadIO io => String -> io ()
say String
"Not importing 'nixpkgs'."
FetchNixpkgs
NixpkgsFast -> do
String -> NIO ()
forall (io :: * -> *). MonadIO io => String -> io ()
say String
"Using known 'nixpkgs' ..."
PackageSpec
packageSpec <- Response PackageSpec -> PackageSpec
forall a. Response a -> a
HTTP.getResponseBody (Response PackageSpec -> PackageSpec)
-> NIO (Response PackageSpec) -> NIO PackageSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> NIO (Response PackageSpec)
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
HTTP.httpJSON Request
"https://raw.githubusercontent.com/nmattia/niv/master/data/nixpkgs.json"
Cmd -> PackageName -> Attrs -> NIO ()
cmdAdd
Cmd
githubCmd
(Text -> PackageName
PackageName Text
"nixpkgs")
(PackageSpec -> Attrs
specToLockedAttrs PackageSpec
packageSpec)
() -> NIO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
NixpkgsCustom Text
branch Nixpkgs
nixpkgs' -> do
String -> NIO ()
forall (io :: * -> *). MonadIO io => String -> io ()
say String
"Importing 'nixpkgs' ..."
let (Text
owner, Text
repo) = case Nixpkgs
nixpkgs' of
Nixpkgs Text
o Text
r -> (Text
o, Text
r)
Cmd -> PackageName -> Attrs -> NIO ()
cmdAdd
Cmd
githubCmd
(Text -> PackageName
PackageName Text
"nixpkgs")
( PackageSpec -> Attrs
specToFreeAttrs (PackageSpec -> Attrs) -> PackageSpec -> Attrs
forall a b. (a -> b) -> a -> b
$
Object -> PackageSpec
PackageSpec (Object -> PackageSpec) -> Object -> PackageSpec
forall a b. (a -> b) -> a -> b
$
[(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,
Key
"branch" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
branch
]
)
parseCmdAdd :: Opts.ParserInfo (NIO ())
parseCmdAdd :: ParserInfo (NIO ())
parseCmdAdd =
Parser (NIO ()) -> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info
((Parser (NIO ())
parseCommands Parser (NIO ()) -> Parser (NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (NIO ())
parseShortcuts) Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
Opts.helper)
(InfoMod (NIO ()) -> ParserInfo (NIO ()))
-> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a b. (a -> b) -> a -> b
$ (Cmd -> forall a. InfoMod a
description Cmd
githubCmd)
where
parseShortcuts :: Parser (NIO ())
parseShortcuts = Cmd -> Parser (NIO ())
parseShortcut Cmd
githubCmd
parseShortcut :: Cmd -> Parser (NIO ())
parseShortcut Cmd
cmd = (PackageName -> Attrs -> NIO ()) -> (PackageName, Attrs) -> NIO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Cmd -> PackageName -> Attrs -> NIO ()
cmdAdd Cmd
cmd) ((PackageName, Attrs) -> NIO ())
-> Parser (PackageName, Attrs) -> Parser (NIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cmd -> Parser (PackageName, Attrs)
parseShortcutArgs Cmd
cmd)
parseCmd :: Cmd -> Parser (NIO ())
parseCmd Cmd
cmd = (PackageName -> Attrs -> NIO ()) -> (PackageName, Attrs) -> NIO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Cmd -> PackageName -> Attrs -> NIO ()
cmdAdd Cmd
cmd) ((PackageName, Attrs) -> NIO ())
-> Parser (PackageName, Attrs) -> Parser (NIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cmd -> Parser (PackageName, Attrs)
parseCmdArgs Cmd
cmd)
parseCmdAddGit :: ParserInfo (NIO ())
parseCmdAddGit =
Parser (NIO ()) -> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info (Cmd -> Parser (NIO ())
parseCmd Cmd
gitCmd Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
Opts.helper) (Cmd -> forall a. InfoMod a
description Cmd
gitCmd)
parseCmdAddLocal :: ParserInfo (NIO ())
parseCmdAddLocal =
Parser (NIO ()) -> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info (Cmd -> Parser (NIO ())
parseCmd Cmd
localCmd Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
Opts.helper) (Cmd -> forall a. InfoMod a
description Cmd
localCmd)
parseCmdAddGitHub :: ParserInfo (NIO ())
parseCmdAddGitHub =
Parser (NIO ()) -> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info (Cmd -> Parser (NIO ())
parseCmd Cmd
githubCmd Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
Opts.helper) (Cmd -> forall a. InfoMod a
description Cmd
githubCmd)
parseCommands :: Parser (NIO ())
parseCommands =
Mod CommandFields (NIO ()) -> Parser (NIO ())
forall a. Mod CommandFields a -> Parser a
Opts.subparser
( Mod CommandFields (NIO ())
forall (f :: * -> *) a. Mod f a
Opts.hidden
Mod CommandFields (NIO ())
-> Mod CommandFields (NIO ()) -> Mod CommandFields (NIO ())
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields (NIO ())
forall a. String -> Mod CommandFields a
Opts.commandGroup String
"Experimental commands:"
Mod CommandFields (NIO ())
-> Mod CommandFields (NIO ()) -> Mod CommandFields (NIO ())
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo (NIO ()) -> Mod CommandFields (NIO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command String
"git" ParserInfo (NIO ())
parseCmdAddGit
Mod CommandFields (NIO ())
-> Mod CommandFields (NIO ()) -> Mod CommandFields (NIO ())
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo (NIO ()) -> Mod CommandFields (NIO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command String
"github" ParserInfo (NIO ())
parseCmdAddGitHub
Mod CommandFields (NIO ())
-> Mod CommandFields (NIO ()) -> Mod CommandFields (NIO ())
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo (NIO ()) -> Mod CommandFields (NIO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
Opts.command String
"local" ParserInfo (NIO ())
parseCmdAddLocal
)
parseShortcutArgs :: Cmd -> Opts.Parser (PackageName, Attrs)
parseShortcutArgs :: Cmd -> Parser (PackageName, Attrs)
parseShortcutArgs Cmd
cmd = ((PackageName, Object), Maybe PackageName)
-> PackageSpec -> (PackageName, Attrs)
forall a. ((a, Object), Maybe a) -> PackageSpec -> (a, Attrs)
collapse (((PackageName, Object), Maybe PackageName)
-> PackageSpec -> (PackageName, Attrs))
-> Parser ((PackageName, Object), Maybe PackageName)
-> Parser (PackageSpec -> (PackageName, Attrs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ((PackageName, Object), Maybe PackageName)
parseNameAndShortcut Parser (PackageSpec -> (PackageName, Attrs))
-> Parser PackageSpec -> Parser (PackageName, Attrs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cmd -> Parser PackageSpec
parsePackageSpec Cmd
cmd
where
collapse :: ((a, Object), Maybe a) -> PackageSpec -> (a, Attrs)
collapse ((a, Object), Maybe a)
specAndName PackageSpec
pspec = (a
pname, PackageSpec -> Attrs
specToLockedAttrs (PackageSpec -> Attrs) -> PackageSpec -> Attrs
forall a b. (a -> b) -> a -> b
$ PackageSpec
pspec PackageSpec -> PackageSpec -> PackageSpec
forall a. Semigroup a => a -> a -> a
<> PackageSpec
baseSpec)
where
(a
pname, PackageSpec
baseSpec) = case ((a, Object), Maybe a)
specAndName of
((_, spec), Just pname') -> (a
pname', Object -> PackageSpec
PackageSpec Object
spec)
((pname', spec), Nothing) -> (a
pname', Object -> PackageSpec
PackageSpec Object
spec)
parseNameAndShortcut :: Parser ((PackageName, Object), Maybe PackageName)
parseNameAndShortcut =
(,)
((PackageName, Object)
-> Maybe PackageName -> ((PackageName, Object), Maybe PackageName))
-> Parser (PackageName, Object)
-> Parser
(Maybe PackageName -> ((PackageName, Object), Maybe PackageName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (PackageName, Object)
-> Mod ArgumentFields (PackageName, Object)
-> Parser (PackageName, Object)
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Opts.argument
((String -> Maybe (PackageName, Object))
-> ReadM (PackageName, Object)
forall a. (String -> Maybe a) -> ReadM a
Opts.maybeReader (Cmd -> Text -> Maybe (PackageName, Object)
parseCmdShortcut Cmd
cmd (Text -> Maybe (PackageName, Object))
-> (String -> Text) -> String -> Maybe (PackageName, Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack))
(String -> Mod ArgumentFields (PackageName, Object)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"PACKAGE")
Parser
(Maybe PackageName -> ((PackageName, Object), Maybe PackageName))
-> Parser (Maybe PackageName)
-> Parser ((PackageName, Object), Maybe PackageName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe PackageName)
optName
optName :: Parser (Maybe PackageName)
optName =
Parser PackageName -> Parser (Maybe PackageName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opts.optional (Parser PackageName -> Parser (Maybe PackageName))
-> Parser PackageName -> Parser (Maybe PackageName)
forall a b. (a -> b) -> a -> b
$
Text -> PackageName
PackageName
(Text -> PackageName) -> Parser Text -> Parser PackageName
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
"name"
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
'n'
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
"NAME"
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
"Set the package name to <NAME>"
)
parseCmdArgs :: Cmd -> Opts.Parser (PackageName, Attrs)
parseCmdArgs :: Cmd -> Parser (PackageName, Attrs)
parseCmdArgs Cmd
cmd = (Maybe (PackageName, Object), Maybe PackageName)
-> PackageSpec -> (PackageName, Attrs)
collapse ((Maybe (PackageName, Object), Maybe PackageName)
-> PackageSpec -> (PackageName, Attrs))
-> Parser (Maybe (PackageName, Object), Maybe PackageName)
-> Parser (PackageSpec -> (PackageName, Attrs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe (PackageName, Object), Maybe PackageName)
parseNameAndShortcut Parser (PackageSpec -> (PackageName, Attrs))
-> Parser PackageSpec -> Parser (PackageName, Attrs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cmd -> Parser PackageSpec
parsePackageSpec Cmd
cmd
where
collapse :: (Maybe (PackageName, Object), Maybe PackageName)
-> PackageSpec -> (PackageName, Attrs)
collapse (Maybe (PackageName, Object), Maybe PackageName)
specAndName PackageSpec
pspec = (PackageName
pname, PackageSpec -> Attrs
specToLockedAttrs (PackageSpec -> Attrs) -> PackageSpec -> Attrs
forall a b. (a -> b) -> a -> b
$ PackageSpec
pspec PackageSpec -> PackageSpec -> PackageSpec
forall a. Semigroup a => a -> a -> a
<> PackageSpec
baseSpec)
where
(PackageName
pname, PackageSpec
baseSpec) = case (Maybe (PackageName, Object), Maybe PackageName)
specAndName of
(Just (_, spec), Just pname') -> (PackageName
pname', Object -> PackageSpec
PackageSpec Object
spec)
(Just (pname', spec), Nothing) -> (PackageName
pname', Object -> PackageSpec
PackageSpec Object
spec)
(Nothing, Just pname') -> (PackageName
pname', Object -> PackageSpec
PackageSpec Object
forall v. KeyMap v
KM.empty)
(Nothing, Nothing) -> (Text -> PackageName
PackageName Text
"unnamed", Object -> PackageSpec
PackageSpec Object
forall v. KeyMap v
KM.empty)
parseNameAndShortcut :: Parser (Maybe (PackageName, Object), Maybe PackageName)
parseNameAndShortcut =
(,)
(Maybe (PackageName, Object)
-> Maybe PackageName
-> (Maybe (PackageName, Object), Maybe PackageName))
-> Parser (Maybe (PackageName, Object))
-> Parser
(Maybe PackageName
-> (Maybe (PackageName, Object), Maybe PackageName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (PackageName, Object)
-> Parser (Maybe (PackageName, Object))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opts.optional
( ReadM (PackageName, Object)
-> Mod ArgumentFields (PackageName, Object)
-> Parser (PackageName, Object)
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Opts.argument
((String -> Maybe (PackageName, Object))
-> ReadM (PackageName, Object)
forall a. (String -> Maybe a) -> ReadM a
Opts.maybeReader (Cmd -> Text -> Maybe (PackageName, Object)
parseCmdShortcut Cmd
cmd (Text -> Maybe (PackageName, Object))
-> (String -> Text) -> String -> Maybe (PackageName, Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack))
(String -> Mod ArgumentFields (PackageName, Object)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"PACKAGE")
)
Parser
(Maybe PackageName
-> (Maybe (PackageName, Object), Maybe PackageName))
-> Parser (Maybe PackageName)
-> Parser (Maybe (PackageName, Object), Maybe PackageName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe PackageName)
optName
optName :: Parser (Maybe PackageName)
optName =
Parser PackageName -> Parser (Maybe PackageName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opts.optional (Parser PackageName -> Parser (Maybe PackageName))
-> Parser PackageName -> Parser (Maybe PackageName)
forall a b. (a -> b) -> a -> b
$
Text -> PackageName
PackageName
(Text -> PackageName) -> Parser Text -> Parser PackageName
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
"name"
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
'n'
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
"NAME"
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
"Set the package name to <NAME>"
)
cmdAdd :: Cmd -> PackageName -> Attrs -> NIO ()
cmdAdd :: Cmd -> PackageName -> Attrs -> NIO ()
cmdAdd Cmd
cmd PackageName
packageName Attrs
attrs = do
String -> NIO () -> NIO ()
forall (io :: * -> *).
(MonadUnliftIO io, MonadIO io) =>
String -> io () -> io ()
job (String
"Adding package " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (PackageName -> Text
unPackageName PackageName
packageName)) (NIO () -> NIO ()) -> NIO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ do
FindSourcesJson
fsj <- NIO FindSourcesJson
getFindSourcesJson
HashMap PackageName PackageSpec
sources <- Sources -> HashMap PackageName PackageSpec
unSources (Sources -> HashMap PackageName PackageSpec)
-> NIO Sources -> NIO (HashMap PackageName PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Sources -> NIO Sources
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (FindSourcesJson -> IO Sources
getSources FindSourcesJson
fsj)
Bool -> NIO () -> NIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageName -> HashMap PackageName PackageSpec -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HMS.member PackageName
packageName HashMap PackageName PackageSpec
sources) (NIO () -> NIO ()) -> NIO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
PackageName -> IO ()
forall a. PackageName -> IO a
abortCannotAddPackageExists PackageName
packageName
Either SomeException PackageSpec
eFinalSpec <- (Attrs -> PackageSpec)
-> Either SomeException Attrs -> Either SomeException PackageSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attrs -> PackageSpec
attrsToSpec (Either SomeException Attrs -> Either SomeException PackageSpec)
-> NIO (Either SomeException Attrs)
-> NIO (Either SomeException PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either SomeException Attrs) -> NIO (Either SomeException Attrs)
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (Attrs -> Cmd -> IO (Either SomeException Attrs)
doUpdate Attrs
attrs Cmd
cmd)
case Either SomeException PackageSpec
eFinalSpec of
Left SomeException
e -> IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li ([(PackageName, SomeException)] -> IO ()
forall a. [(PackageName, SomeException)] -> IO a
abortUpdateFailed [(PackageName
packageName, SomeException
e)])
Right PackageSpec
finalSpec -> do
String -> NIO ()
forall (io :: * -> *). MonadIO io => String -> io ()
say (String -> NIO ()) -> String -> NIO ()
forall a b. (a -> b) -> a -> b
$ String
"Writing new sources file"
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
FindSourcesJson -> Sources -> IO ()
setSources FindSourcesJson
fsj (Sources -> IO ()) -> Sources -> IO ()
forall a b. (a -> b) -> a -> b
$
HashMap PackageName PackageSpec -> Sources
Sources (HashMap PackageName PackageSpec -> Sources)
-> HashMap PackageName PackageSpec -> Sources
forall a b. (a -> b) -> a -> b
$
PackageName
-> PackageSpec
-> HashMap PackageName PackageSpec
-> HashMap PackageName PackageSpec
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HMS.insert PackageName
packageName PackageSpec
finalSpec HashMap PackageName PackageSpec
sources
parseCmdShow :: Opts.ParserInfo (NIO ())
parseCmdShow :: ParserInfo (NIO ())
parseCmdShow =
Parser (NIO ()) -> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info
((Maybe PackageName -> NIO ()
cmdShow (Maybe PackageName -> NIO ())
-> Parser (Maybe PackageName) -> Parser (NIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PackageName -> Parser (Maybe PackageName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opts.optional Parser PackageName
parsePackageName) Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
Opts.helper)
InfoMod (NIO ())
forall a. InfoMod a
Opts.fullDesc
cmdShow :: Maybe PackageName -> NIO ()
cmdShow :: Maybe PackageName -> NIO ()
cmdShow = \case
Just PackageName
packageName -> do
FindSourcesJson
fsj <- NIO FindSourcesJson
getFindSourcesJson
HashMap PackageName PackageSpec
sources <- Sources -> HashMap PackageName PackageSpec
unSources (Sources -> HashMap PackageName PackageSpec)
-> NIO Sources -> NIO (HashMap PackageName PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Sources -> NIO Sources
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (FindSourcesJson -> IO Sources
getSources FindSourcesJson
fsj)
case PackageName -> HashMap PackageName PackageSpec -> Maybe PackageSpec
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup PackageName
packageName HashMap PackageName PackageSpec
sources of
Just PackageSpec
pspec -> PackageName -> PackageSpec -> NIO ()
forall (io :: * -> *).
MonadIO io =>
PackageName -> PackageSpec -> io ()
showPackage PackageName
packageName PackageSpec
pspec
Maybe PackageSpec
Nothing -> IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ PackageName -> IO ()
forall a. PackageName -> IO a
abortCannotShowNoSuchPackage PackageName
packageName
Maybe PackageName
Nothing -> do
FindSourcesJson
fsj <- NIO FindSourcesJson
getFindSourcesJson
HashMap PackageName PackageSpec
sources <- Sources -> HashMap PackageName PackageSpec
unSources (Sources -> HashMap PackageName PackageSpec)
-> NIO Sources -> NIO (HashMap PackageName PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Sources -> NIO Sources
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (FindSourcesJson -> IO Sources
getSources FindSourcesJson
fsj)
HashMap PackageName PackageSpec
-> (PackageName -> PackageSpec -> NIO ()) -> NIO ()
forall k (m :: * -> *) v1.
(Eq k, Hashable k, Monad m) =>
HashMap k v1 -> (k -> v1 -> m ()) -> m ()
forWithKeyM_ HashMap PackageName PackageSpec
sources ((PackageName -> PackageSpec -> NIO ()) -> NIO ())
-> (PackageName -> PackageSpec -> NIO ()) -> NIO ()
forall a b. (a -> b) -> a -> b
$ PackageName -> PackageSpec -> NIO ()
forall (io :: * -> *).
MonadIO io =>
PackageName -> PackageSpec -> io ()
showPackage
showPackage :: MonadIO io => PackageName -> PackageSpec -> io ()
showPackage :: PackageName -> PackageSpec -> io ()
showPackage (PackageName Text
pname) (PackageSpec Object
spec) = do
Text -> io ()
forall (io :: * -> *). MonadIO io => Text -> io ()
tsay (Text -> io ()) -> Text -> io ()
forall a b. (a -> b) -> a -> b
$ T
tbold Text
pname
[(Key, Value)] -> ((Key, Value) -> io ()) -> io ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
spec) (((Key, Value) -> io ()) -> io ())
-> ((Key, Value) -> io ()) -> io ()
forall a b. (a -> b) -> a -> b
$ \(Key
attrName, Value
attrValValue) -> do
let attrValue :: Text
attrValue = case Value
attrValValue of
Aeson.String Text
str -> Text
str
Value
_ -> T
tfaint Text
"<barabajagal>"
Text -> io ()
forall (io :: * -> *). MonadIO io => Text -> io ()
tsay (Text -> io ()) -> Text -> io ()
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> T
forall a. Semigroup a => a -> a -> a
<> Key -> Text
K.toText Key
attrName Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
attrValue
parseCmdUpdate :: Opts.ParserInfo (NIO ())
parseCmdUpdate :: ParserInfo (NIO ())
parseCmdUpdate =
Parser (NIO ()) -> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info
((Maybe (PackageName, PackageSpec) -> NIO ()
cmdUpdate (Maybe (PackageName, PackageSpec) -> NIO ())
-> Parser (Maybe (PackageName, PackageSpec)) -> Parser (NIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (PackageName, PackageSpec)
-> Parser (Maybe (PackageName, PackageSpec))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opts.optional Parser (PackageName, PackageSpec)
parsePackage) Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
Opts.helper)
(InfoMod (NIO ()) -> ParserInfo (NIO ()))
-> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a b. (a -> b) -> a -> b
$ [InfoMod (NIO ())] -> InfoMod (NIO ())
forall a. Monoid a => [a] -> a
mconcat [InfoMod (NIO ())]
forall a. [InfoMod a]
desc
where
desc :: [InfoMod a]
desc =
[ InfoMod a
forall a. InfoMod a
Opts.fullDesc,
String -> InfoMod a
forall a. String -> InfoMod a
Opts.progDesc String
"Update dependencies",
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
$
Int -> Doc -> Doc
Opts.nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc
"Examples:"
Doc -> Doc -> Doc
Opts.<$$> Doc
""
Doc -> Doc -> Doc
Opts.<$$> [Doc] -> Doc
Opts.vcat
[ Int -> Doc -> Doc
Opts.fill Int
30 Doc
"niv update" Doc -> Doc -> Doc
Opts.<+> Doc
"# update all packages",
Int -> Doc -> Doc
Opts.fill Int
30 Doc
"niv update nixpkgs" Doc -> Doc -> Doc
Opts.<+> Doc
"# update nixpkgs",
Int -> Doc -> Doc
Opts.fill Int
30 Doc
"niv update my-package -v beta-0.2" Doc -> Doc -> Doc
Opts.<+> Doc
"# update my-package to version \"beta-0.2\""
]
]
specToFreeAttrs :: PackageSpec -> Attrs
specToFreeAttrs :: PackageSpec -> Attrs
specToFreeAttrs = KeyMap (Freedom, Value) -> Attrs
forall v. KeyMap v -> HashMap Text v
KM.toHashMapText (KeyMap (Freedom, Value) -> Attrs)
-> (PackageSpec -> KeyMap (Freedom, Value)) -> PackageSpec -> Attrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> (Freedom, Value)) -> Object -> KeyMap (Freedom, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Freedom
Free,) (Object -> KeyMap (Freedom, Value))
-> (PackageSpec -> Object)
-> PackageSpec
-> KeyMap (Freedom, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageSpec -> Object
unPackageSpec
specToLockedAttrs :: PackageSpec -> Attrs
specToLockedAttrs :: PackageSpec -> Attrs
specToLockedAttrs = KeyMap (Freedom, Value) -> Attrs
forall v. KeyMap v -> HashMap Text v
KM.toHashMapText (KeyMap (Freedom, Value) -> Attrs)
-> (PackageSpec -> KeyMap (Freedom, Value)) -> PackageSpec -> Attrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> (Freedom, Value)) -> Object -> KeyMap (Freedom, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Freedom
Locked,) (Object -> KeyMap (Freedom, Value))
-> (PackageSpec -> Object)
-> PackageSpec
-> KeyMap (Freedom, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageSpec -> Object
unPackageSpec
cmdUpdate :: Maybe (PackageName, PackageSpec) -> NIO ()
cmdUpdate :: Maybe (PackageName, PackageSpec) -> NIO ()
cmdUpdate = \case
Just (PackageName
packageName, PackageSpec
cliSpec) ->
String -> NIO () -> NIO ()
forall (io :: * -> *).
(MonadUnliftIO io, MonadIO io) =>
String -> io () -> io ()
job (String
"Update " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (PackageName -> Text
unPackageName PackageName
packageName)) (NIO () -> NIO ()) -> NIO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ do
FindSourcesJson
fsj <- NIO FindSourcesJson
getFindSourcesJson
HashMap PackageName PackageSpec
sources <- Sources -> HashMap PackageName PackageSpec
unSources (Sources -> HashMap PackageName PackageSpec)
-> NIO Sources -> NIO (HashMap PackageName PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Sources -> NIO Sources
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (FindSourcesJson -> IO Sources
getSources FindSourcesJson
fsj)
Either SomeException PackageSpec
eFinalSpec <- case PackageName -> HashMap PackageName PackageSpec -> Maybe PackageSpec
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup PackageName
packageName HashMap PackageName PackageSpec
sources of
Just PackageSpec
defaultSpec -> do
let cmd :: Cmd
cmd = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"type" (PackageSpec -> Object
unPackageSpec PackageSpec
defaultSpec) of
Just Value
"git" -> Cmd
gitCmd
Just Value
"local" -> Cmd
localCmd
Maybe Value
_ -> Cmd
githubCmd
spec :: Attrs
spec = PackageSpec -> Attrs
specToLockedAttrs PackageSpec
cliSpec Attrs -> Attrs -> Attrs
forall a. Semigroup a => a -> a -> a
<> PackageSpec -> Attrs
specToFreeAttrs PackageSpec
defaultSpec
(Attrs -> PackageSpec)
-> Either SomeException Attrs -> Either SomeException PackageSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attrs -> PackageSpec
attrsToSpec (Either SomeException Attrs -> Either SomeException PackageSpec)
-> NIO (Either SomeException Attrs)
-> NIO (Either SomeException PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either SomeException Attrs) -> NIO (Either SomeException Attrs)
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (Attrs -> Cmd -> IO (Either SomeException Attrs)
doUpdate Attrs
spec Cmd
cmd)
Maybe PackageSpec
Nothing -> IO (Either SomeException PackageSpec)
-> NIO (Either SomeException PackageSpec)
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO (Either SomeException PackageSpec)
-> NIO (Either SomeException PackageSpec))
-> IO (Either SomeException PackageSpec)
-> NIO (Either SomeException PackageSpec)
forall a b. (a -> b) -> a -> b
$ PackageName -> IO (Either SomeException PackageSpec)
forall a. PackageName -> IO a
abortCannotUpdateNoSuchPackage PackageName
packageName
case Either SomeException PackageSpec
eFinalSpec of
Left SomeException
e -> IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ [(PackageName, SomeException)] -> IO ()
forall a. [(PackageName, SomeException)] -> IO a
abortUpdateFailed [(PackageName
packageName, SomeException
e)]
Right PackageSpec
finalSpec ->
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
FindSourcesJson -> Sources -> IO ()
setSources FindSourcesJson
fsj (Sources -> IO ()) -> Sources -> IO ()
forall a b. (a -> b) -> a -> b
$
HashMap PackageName PackageSpec -> Sources
Sources (HashMap PackageName PackageSpec -> Sources)
-> HashMap PackageName PackageSpec -> Sources
forall a b. (a -> b) -> a -> b
$
PackageName
-> PackageSpec
-> HashMap PackageName PackageSpec
-> HashMap PackageName PackageSpec
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HMS.insert PackageName
packageName PackageSpec
finalSpec HashMap PackageName PackageSpec
sources
Maybe (PackageName, PackageSpec)
Nothing -> String -> NIO () -> NIO ()
forall (io :: * -> *).
(MonadUnliftIO io, MonadIO io) =>
String -> io () -> io ()
job String
"Updating all packages" (NIO () -> NIO ()) -> NIO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ do
FindSourcesJson
fsj <- NIO FindSourcesJson
getFindSourcesJson
HashMap PackageName PackageSpec
sources <- Sources -> HashMap PackageName PackageSpec
unSources (Sources -> HashMap PackageName PackageSpec)
-> NIO Sources -> NIO (HashMap PackageName PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Sources -> NIO Sources
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (FindSourcesJson -> IO Sources
getSources FindSourcesJson
fsj)
HashMap PackageName (Either SomeException PackageSpec)
esources' <- HashMap PackageName PackageSpec
-> (PackageName
-> PackageSpec -> NIO (Either SomeException PackageSpec))
-> NIO (HashMap PackageName (Either SomeException PackageSpec))
forall k (m :: * -> *) v1 v2.
(Eq k, Hashable k, Monad m) =>
HashMap k v1 -> (k -> v1 -> m v2) -> m (HashMap k v2)
forWithKeyM HashMap PackageName PackageSpec
sources ((PackageName
-> PackageSpec -> NIO (Either SomeException PackageSpec))
-> NIO (HashMap PackageName (Either SomeException PackageSpec)))
-> (PackageName
-> PackageSpec -> NIO (Either SomeException PackageSpec))
-> NIO (HashMap PackageName (Either SomeException PackageSpec))
forall a b. (a -> b) -> a -> b
$
\PackageName
packageName PackageSpec
defaultSpec -> do
Text -> NIO ()
forall (io :: * -> *). MonadIO io => Text -> io ()
tsay (Text -> NIO ()) -> Text -> NIO ()
forall a b. (a -> b) -> a -> b
$ Text
"Package: " Text -> T
forall a. Semigroup a => a -> a -> a
<> PackageName -> Text
unPackageName PackageName
packageName
let initialSpec :: Attrs
initialSpec = PackageSpec -> Attrs
specToFreeAttrs PackageSpec
defaultSpec
let cmd :: Cmd
cmd = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"type" (PackageSpec -> Object
unPackageSpec PackageSpec
defaultSpec) of
Just Value
"git" -> Cmd
gitCmd
Just Value
"local" -> Cmd
localCmd
Maybe Value
_ -> Cmd
githubCmd
Either SomeException PackageSpec
finalSpec <- (Attrs -> PackageSpec)
-> Either SomeException Attrs -> Either SomeException PackageSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attrs -> PackageSpec
attrsToSpec (Either SomeException Attrs -> Either SomeException PackageSpec)
-> NIO (Either SomeException Attrs)
-> NIO (Either SomeException PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either SomeException Attrs) -> NIO (Either SomeException Attrs)
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (Attrs -> Cmd -> IO (Either SomeException Attrs)
doUpdate Attrs
initialSpec Cmd
cmd)
Either SomeException PackageSpec
-> NIO (Either SomeException PackageSpec)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException PackageSpec
finalSpec
let (HashMap PackageName SomeException
failed, HashMap PackageName PackageSpec
sources') = HashMap PackageName (Either SomeException PackageSpec)
-> (HashMap PackageName SomeException,
HashMap PackageName PackageSpec)
forall k a b.
(Eq k, Hashable k) =>
HashMap k (Either a b) -> (HashMap k a, HashMap k b)
partitionEithersHMS HashMap PackageName (Either SomeException PackageSpec)
esources'
Bool -> NIO () -> NIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashMap PackageName SomeException -> Bool
forall k v. HashMap k v -> Bool
HMS.null HashMap PackageName SomeException
failed) (NIO () -> NIO ()) -> NIO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
[(PackageName, SomeException)] -> IO ()
forall a. [(PackageName, SomeException)] -> IO a
abortUpdateFailed (HashMap PackageName SomeException -> [(PackageName, SomeException)]
forall k v. HashMap k v -> [(k, v)]
HMS.toList HashMap PackageName SomeException
failed)
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ FindSourcesJson -> Sources -> IO ()
setSources FindSourcesJson
fsj (Sources -> IO ()) -> Sources -> IO ()
forall a b. (a -> b) -> a -> b
$ HashMap PackageName PackageSpec -> Sources
Sources HashMap PackageName PackageSpec
sources'
doUpdate :: Attrs -> Cmd -> IO (Either SomeException Attrs)
doUpdate :: Attrs -> Cmd -> IO (Either SomeException Attrs)
doUpdate Attrs
attrs Cmd
cmd = do
[Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Cmd -> Attrs -> [Text]
extraLogs Cmd
cmd Attrs
attrs) ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
forall (io :: * -> *). MonadIO io => Text -> io ()
tsay
Attrs -> Update () () -> IO (Either SomeException Attrs)
forall a. Attrs -> Update () a -> IO (Either SomeException Attrs)
tryEvalUpdate Attrs
attrs (Cmd -> Update () ()
updateCmd Cmd
cmd)
partitionEithersHMS ::
(Eq k, Hashable k) =>
HMS.HashMap k (Either a b) ->
(HMS.HashMap k a, HMS.HashMap k b)
partitionEithersHMS :: HashMap k (Either a b) -> (HashMap k a, HashMap k b)
partitionEithersHMS =
(((HashMap k a, HashMap k b)
-> k -> Either a b -> (HashMap k a, HashMap k b))
-> (HashMap k a, HashMap k b)
-> HashMap k (Either a b)
-> (HashMap k a, HashMap k b))
-> (HashMap k a, HashMap k b)
-> ((HashMap k a, HashMap k b)
-> k -> Either a b -> (HashMap k a, HashMap k b))
-> HashMap k (Either a b)
-> (HashMap k a, HashMap k b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((HashMap k a, HashMap k b)
-> k -> Either a b -> (HashMap k a, HashMap k b))
-> (HashMap k a, HashMap k b)
-> HashMap k (Either a b)
-> (HashMap k a, HashMap k b)
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HMS.foldlWithKey' (HashMap k a
forall k v. HashMap k v
HMS.empty, HashMap k b
forall k v. HashMap k v
HMS.empty) (((HashMap k a, HashMap k b)
-> k -> Either a b -> (HashMap k a, HashMap k b))
-> HashMap k (Either a b) -> (HashMap k a, HashMap k b))
-> ((HashMap k a, HashMap k b)
-> k -> Either a b -> (HashMap k a, HashMap k b))
-> HashMap k (Either a b)
-> (HashMap k a, HashMap k b)
forall a b. (a -> b) -> a -> b
$ \(HashMap k a
ls, HashMap k b
rs) k
k -> \case
Left a
l -> (k -> a -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HMS.insert k
k a
l HashMap k a
ls, HashMap k b
rs)
Right b
r -> (HashMap k a
ls, k -> b -> HashMap k b -> HashMap k b
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HMS.insert k
k b
r HashMap k b
rs)
parseCmdModify :: Opts.ParserInfo (NIO ())
parseCmdModify :: ParserInfo (NIO ())
parseCmdModify =
Parser (NIO ()) -> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info
((PackageName -> Maybe PackageName -> PackageSpec -> NIO ()
cmdModify (PackageName -> Maybe PackageName -> PackageSpec -> NIO ())
-> Parser PackageName
-> Parser (Maybe PackageName -> PackageSpec -> NIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PackageName
parsePackageName Parser (Maybe PackageName -> PackageSpec -> NIO ())
-> Parser (Maybe PackageName) -> Parser (PackageSpec -> NIO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe PackageName)
optName Parser (PackageSpec -> NIO ())
-> Parser PackageSpec -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cmd -> Parser PackageSpec
parsePackageSpec Cmd
githubCmd) Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
Opts.helper)
(InfoMod (NIO ()) -> ParserInfo (NIO ()))
-> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a b. (a -> b) -> a -> b
$ [InfoMod (NIO ())] -> InfoMod (NIO ())
forall a. Monoid a => [a] -> a
mconcat [InfoMod (NIO ())]
forall a. [InfoMod a]
desc
where
desc :: [InfoMod a]
desc =
[ InfoMod a
forall a. InfoMod a
Opts.fullDesc,
String -> InfoMod a
forall a. String -> InfoMod a
Opts.progDesc String
"Modify dependency attributes without performing an update",
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 modify nixpkgs -v beta-0.2"
Doc -> Doc -> Doc
Opts.<$$> Doc
" niv modify nixpkgs -a branch=nixpkgs-unstable"
]
optName :: Parser (Maybe PackageName)
optName =
Parser PackageName -> Parser (Maybe PackageName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opts.optional (Parser PackageName -> Parser (Maybe PackageName))
-> Parser PackageName -> Parser (Maybe PackageName)
forall a b. (a -> b) -> a -> b
$
Text -> PackageName
PackageName
(Text -> PackageName) -> Parser Text -> Parser PackageName
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
"name"
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
'n'
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
"NAME"
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
"Set the package name to <NAME>"
)
cmdModify :: PackageName -> Maybe PackageName -> PackageSpec -> NIO ()
cmdModify :: PackageName -> Maybe PackageName -> PackageSpec -> NIO ()
cmdModify PackageName
packageName Maybe PackageName
mNewName PackageSpec
cliSpec = do
Text -> NIO ()
forall (io :: * -> *). MonadIO io => Text -> io ()
tsay (Text -> NIO ()) -> Text -> NIO ()
forall a b. (a -> b) -> a -> b
$ Text
"Modifying package: " Text -> T
forall a. Semigroup a => a -> a -> a
<> PackageName -> Text
unPackageName PackageName
packageName
FindSourcesJson
fsj <- NIO FindSourcesJson
getFindSourcesJson
HashMap PackageName PackageSpec
sources <- Sources -> HashMap PackageName PackageSpec
unSources (Sources -> HashMap PackageName PackageSpec)
-> NIO Sources -> NIO (HashMap PackageName PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Sources -> NIO Sources
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (FindSourcesJson -> IO Sources
getSources FindSourcesJson
fsj)
PackageSpec
finalSpec <- case PackageName -> HashMap PackageName PackageSpec -> Maybe PackageSpec
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup PackageName
packageName HashMap PackageName PackageSpec
sources of
Just PackageSpec
defaultSpec -> PackageSpec -> NIO PackageSpec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageSpec -> NIO PackageSpec) -> PackageSpec -> NIO PackageSpec
forall a b. (a -> b) -> a -> b
$ Attrs -> PackageSpec
attrsToSpec (PackageSpec -> Attrs
specToLockedAttrs PackageSpec
cliSpec Attrs -> Attrs -> Attrs
forall a. Semigroup a => a -> a -> a
<> PackageSpec -> Attrs
specToFreeAttrs PackageSpec
defaultSpec)
Maybe PackageSpec
Nothing -> IO PackageSpec -> NIO PackageSpec
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO PackageSpec -> NIO PackageSpec)
-> IO PackageSpec -> NIO PackageSpec
forall a b. (a -> b) -> a -> b
$ PackageName -> IO PackageSpec
forall a. PackageName -> IO a
abortCannotModifyNoSuchPackage PackageName
packageName
case Maybe PackageName
mNewName of
Just PackageName
newName -> do
Bool -> NIO () -> NIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageName -> HashMap PackageName PackageSpec -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HMS.member PackageName
newName HashMap PackageName PackageSpec
sources) (NIO () -> NIO ()) -> NIO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
PackageName -> IO ()
forall a. PackageName -> IO a
abortCannotAddPackageExists PackageName
newName
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ FindSourcesJson -> Sources -> IO ()
setSources FindSourcesJson
fsj (Sources -> IO ()) -> Sources -> IO ()
forall a b. (a -> b) -> a -> b
$ HashMap PackageName PackageSpec -> Sources
Sources (HashMap PackageName PackageSpec -> Sources)
-> HashMap PackageName PackageSpec -> Sources
forall a b. (a -> b) -> a -> b
$ PackageName
-> PackageSpec
-> HashMap PackageName PackageSpec
-> HashMap PackageName PackageSpec
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HMS.insert PackageName
newName PackageSpec
finalSpec (HashMap PackageName PackageSpec
-> HashMap PackageName PackageSpec)
-> HashMap PackageName PackageSpec
-> HashMap PackageName PackageSpec
forall a b. (a -> b) -> a -> b
$ PackageName
-> HashMap PackageName PackageSpec
-> HashMap PackageName PackageSpec
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HMS.delete PackageName
packageName HashMap PackageName PackageSpec
sources
Maybe PackageName
Nothing ->
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$ FindSourcesJson -> Sources -> IO ()
setSources FindSourcesJson
fsj (Sources -> IO ()) -> Sources -> IO ()
forall a b. (a -> b) -> a -> b
$ HashMap PackageName PackageSpec -> Sources
Sources (HashMap PackageName PackageSpec -> Sources)
-> HashMap PackageName PackageSpec -> Sources
forall a b. (a -> b) -> a -> b
$ PackageName
-> PackageSpec
-> HashMap PackageName PackageSpec
-> HashMap PackageName PackageSpec
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HMS.insert PackageName
packageName PackageSpec
finalSpec HashMap PackageName PackageSpec
sources
parseCmdDrop :: Opts.ParserInfo (NIO ())
parseCmdDrop :: ParserInfo (NIO ())
parseCmdDrop =
Parser (NIO ()) -> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
Opts.info
( (PackageName -> [Text] -> NIO ()
cmdDrop (PackageName -> [Text] -> NIO ())
-> Parser PackageName -> Parser ([Text] -> NIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PackageName
parsePackageName Parser ([Text] -> NIO ()) -> Parser [Text] -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Text]
parseDropAttributes)
Parser (NIO ()) -> Parser (NIO () -> NIO ()) -> Parser (NIO ())
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (NIO () -> NIO ())
forall a. Parser (a -> a)
Opts.helper
)
(InfoMod (NIO ()) -> ParserInfo (NIO ()))
-> InfoMod (NIO ()) -> ParserInfo (NIO ())
forall a b. (a -> b) -> a -> b
$ [InfoMod (NIO ())] -> InfoMod (NIO ())
forall a. Monoid a => [a] -> a
mconcat [InfoMod (NIO ())]
forall a. [InfoMod a]
desc
where
desc :: [InfoMod a]
desc =
[ InfoMod a
forall a. InfoMod a
Opts.fullDesc,
String -> InfoMod a
forall a. String -> InfoMod a
Opts.progDesc String
"Drop 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 drop jq"
Doc -> Doc -> Doc
Opts.<$$> Doc
" niv drop my-package version"
]
parseDropAttributes :: Opts.Parser [T.Text]
parseDropAttributes :: Parser [Text]
parseDropAttributes =
Parser Text -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text -> Parser [Text]) -> Parser Text -> Parser [Text]
forall a b. (a -> b) -> a -> b
$
ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
Opts.argument ReadM Text
forall s. IsString s => ReadM s
Opts.str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opts.metavar String
"ATTRIBUTE")
cmdDrop :: PackageName -> [T.Text] -> NIO ()
cmdDrop :: PackageName -> [Text] -> NIO ()
cmdDrop PackageName
packageName = \case
[] -> do
Text -> NIO ()
forall (io :: * -> *). MonadIO io => Text -> io ()
tsay (Text -> NIO ()) -> Text -> NIO ()
forall a b. (a -> b) -> a -> b
$ Text
"Dropping package: " Text -> T
forall a. Semigroup a => a -> a -> a
<> PackageName -> Text
unPackageName PackageName
packageName
FindSourcesJson
fsj <- NIO FindSourcesJson
getFindSourcesJson
HashMap PackageName PackageSpec
sources <- Sources -> HashMap PackageName PackageSpec
unSources (Sources -> HashMap PackageName PackageSpec)
-> NIO Sources -> NIO (HashMap PackageName PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Sources -> NIO Sources
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (FindSourcesJson -> IO Sources
getSources FindSourcesJson
fsj)
Bool -> NIO () -> NIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ PackageName -> HashMap PackageName PackageSpec -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HMS.member PackageName
packageName HashMap PackageName PackageSpec
sources) (NIO () -> NIO ()) -> NIO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
PackageName -> IO ()
forall a. PackageName -> IO a
abortCannotDropNoSuchPackage PackageName
packageName
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
FindSourcesJson -> Sources -> IO ()
setSources FindSourcesJson
fsj (Sources -> IO ()) -> Sources -> IO ()
forall a b. (a -> b) -> a -> b
$
HashMap PackageName PackageSpec -> Sources
Sources (HashMap PackageName PackageSpec -> Sources)
-> HashMap PackageName PackageSpec -> Sources
forall a b. (a -> b) -> a -> b
$
PackageName
-> HashMap PackageName PackageSpec
-> HashMap PackageName PackageSpec
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HMS.delete PackageName
packageName HashMap PackageName PackageSpec
sources
[Text]
attrs -> do
Text -> NIO ()
forall (io :: * -> *). MonadIO io => Text -> io ()
tsay (Text -> NIO ()) -> Text -> NIO ()
forall a b. (a -> b) -> a -> b
$ Text
"Dropping attributes: " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " [Text]
attrs
Text -> NIO ()
forall (io :: * -> *). MonadIO io => Text -> io ()
tsay (Text -> NIO ()) -> Text -> NIO ()
forall a b. (a -> b) -> a -> b
$ Text
"In package: " Text -> T
forall a. Semigroup a => a -> a -> a
<> PackageName -> Text
unPackageName PackageName
packageName
FindSourcesJson
fsj <- NIO FindSourcesJson
getFindSourcesJson
HashMap PackageName PackageSpec
sources <- Sources -> HashMap PackageName PackageSpec
unSources (Sources -> HashMap PackageName PackageSpec)
-> NIO Sources -> NIO (HashMap PackageName PackageSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Sources -> NIO Sources
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (FindSourcesJson -> IO Sources
getSources FindSourcesJson
fsj)
PackageSpec
packageSpec <- case PackageName -> HashMap PackageName PackageSpec -> Maybe PackageSpec
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup PackageName
packageName HashMap PackageName PackageSpec
sources of
Maybe PackageSpec
Nothing ->
IO PackageSpec -> NIO PackageSpec
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO PackageSpec -> NIO PackageSpec)
-> IO PackageSpec -> NIO PackageSpec
forall a b. (a -> b) -> a -> b
$ PackageName -> IO PackageSpec
forall a. PackageName -> IO a
abortCannotAttributesDropNoSuchPackage PackageName
packageName
Just (PackageSpec Object
packageSpec) ->
PackageSpec -> NIO PackageSpec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageSpec -> NIO PackageSpec) -> PackageSpec -> NIO PackageSpec
forall a b. (a -> b) -> a -> b
$
Object -> PackageSpec
PackageSpec (Object -> PackageSpec) -> Object -> PackageSpec
forall a b. (a -> b) -> a -> b
$
(Key -> Value -> Maybe Value) -> Object -> Object
forall v u. (Key -> v -> Maybe u) -> KeyMap v -> KeyMap u
KM.mapMaybeWithKey
(\Key
k Value
v -> if Key -> Text
K.toText Key
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
attrs then Maybe Value
forall a. Maybe a
Nothing else Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v)
Object
packageSpec
IO () -> NIO ()
forall (io :: * -> *) a. MonadIO io => IO a -> io a
li (IO () -> NIO ()) -> IO () -> NIO ()
forall a b. (a -> b) -> a -> b
$
FindSourcesJson -> Sources -> IO ()
setSources FindSourcesJson
fsj (Sources -> IO ()) -> Sources -> IO ()
forall a b. (a -> b) -> a -> b
$
HashMap PackageName PackageSpec -> Sources
Sources (HashMap PackageName PackageSpec -> Sources)
-> HashMap PackageName PackageSpec -> Sources
forall a b. (a -> b) -> a -> b
$
PackageName
-> PackageSpec
-> HashMap PackageName PackageSpec
-> HashMap PackageName PackageSpec
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HMS.insert PackageName
packageName PackageSpec
packageSpec HashMap PackageName PackageSpec
sources
shouldUpdateNixSourcesNix :: B.ByteString -> Bool
shouldUpdateNixSourcesNix :: ByteString -> Bool
shouldUpdateNixSourcesNix ByteString
content =
ByteString
content ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
initNixSourcesNixContent
Bool -> Bool -> Bool
&& Bool -> Bool
not ((ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ByteString -> Bool
lineForbids (ByteString -> [ByteString]
B8.lines ByteString
content))
where
lineForbids :: B8.ByteString -> Bool
lineForbids :: ByteString -> Bool
lineForbids ByteString
str =
case ByteString -> Maybe (Char, ByteString)
B8.uncons ((Char -> Bool) -> ByteString -> ByteString
B8.dropWhile Char -> Bool
isSpace ByteString
str) of
Just (Char
'#', ByteString
rest) -> case ByteString -> ByteString -> Maybe ByteString
B8.stripPrefix ByteString
"niv:" ((Char -> Bool) -> ByteString -> ByteString
B8.dropWhile Char -> Bool
isSpace ByteString
rest) of
Just ByteString
rest' -> case ByteString -> ByteString -> Maybe ByteString
B8.stripPrefix ByteString
"no_update" ((Char -> Bool) -> ByteString -> ByteString
B8.dropWhile Char -> Bool
isSpace ByteString
rest') of
Just {} -> Bool
True
Maybe ByteString
_ -> Bool
False
Maybe ByteString
_ -> Bool
False
Maybe (Char, ByteString)
_ -> Bool
False
abortCannotAddPackageExists :: PackageName -> IO a
abortCannotAddPackageExists :: PackageName -> IO a
abortCannotAddPackageExists (PackageName Text
n) =
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
$
[Text] -> Text
T.unlines
[ Text
"Cannot add package " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
".",
Text
"The package already exists. Use",
Text
" niv drop " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
n,
Text
"and then re-add the package. Alternatively use",
Text
" niv update " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
" --attribute foo=bar",
Text
"to update the package's attributes."
]
abortCannotUpdateNoSuchPackage :: PackageName -> IO a
abortCannotUpdateNoSuchPackage :: PackageName -> IO a
abortCannotUpdateNoSuchPackage (PackageName Text
n) =
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
$
[Text] -> Text
T.unlines
[ Text
"Cannot update package " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
".",
Text
"The package doesn't exist. Use",
Text
" niv add " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
n,
Text
"to add the package."
]
abortCannotModifyNoSuchPackage :: PackageName -> IO a
abortCannotModifyNoSuchPackage :: PackageName -> IO a
abortCannotModifyNoSuchPackage (PackageName Text
n) =
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
$
[Text] -> Text
T.unlines
[ Text
"Cannot modify package " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
".",
Text
"The package doesn't exist. Use",
Text
" niv add " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
n,
Text
"to add the package."
]
abortCannotDropNoSuchPackage :: PackageName -> IO a
abortCannotDropNoSuchPackage :: PackageName -> IO a
abortCannotDropNoSuchPackage (PackageName Text
n) =
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
$
[Text] -> Text
T.unlines
[ Text
"Cannot drop package " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
".",
Text
"The package doesn't exist."
]
abortCannotShowNoSuchPackage :: PackageName -> IO a
abortCannotShowNoSuchPackage :: PackageName -> IO a
abortCannotShowNoSuchPackage (PackageName Text
n) =
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
$
[Text] -> Text
T.unlines
[ Text
"Cannot show package " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
".",
Text
"The package doesn't exist."
]
abortCannotAttributesDropNoSuchPackage :: PackageName -> IO a
abortCannotAttributesDropNoSuchPackage :: PackageName -> IO a
abortCannotAttributesDropNoSuchPackage (PackageName Text
n) =
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
$
[Text] -> Text
T.unlines
[ Text
"Cannot drop attributes of package " Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
".",
Text
"The package doesn't exist."
]
abortUpdateFailed :: [(PackageName, SomeException)] -> IO a
abortUpdateFailed :: [(PackageName, SomeException)] -> IO a
abortUpdateFailed [(PackageName, SomeException)]
errs =
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
$
[Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
[Text
"One or more packages failed to update:"]
[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ((PackageName, SomeException) -> Text)
-> [(PackageName, SomeException)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map
( \(PackageName Text
pname, SomeException
e) ->
Text
pname Text -> T
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> T
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall a. Show a => a -> Text
tshow SomeException
e
)
[(PackageName, SomeException)]
errs