{-# 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
-- I died a little
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)

-------------------------------------------------------------------------------
-- INIT
-------------------------------------------------------------------------------

-- | Whether or not to fetch nixpkgs
data FetchNixpkgs
  = NoNixpkgs
  | NixpkgsFast -- Pull latest known nixpkgs
  | NixpkgsCustom T.Text Nixpkgs -- branch, 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 -- owner, repo

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
    -- Writes all the default files
    -- a path, a "create" function and an update function for each file.
    [(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

            -- Import nixpkgs, if necessary
            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
                ]
        )

-------------------------------------------------------------------------------
-- ADD
-------------------------------------------------------------------------------

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
    -- XXX: this should parse many shortcuts (github, git). Right now we only
    -- parse GitHub because the git interface is still experimental.  note to
    -- implementer: it'll be tricky to have the correct arguments show up
    -- without repeating "PACKAGE PACKAGE PACKAGE" for every package type.
    parseShortcuts :: 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
        )

-- | only used in shortcuts (niv add foo/bar ...) because PACKAGE is NOT
-- optional
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>"
            )

-- | only used in command (niv add <cmd> ...) because PACKAGE is optional
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

-------------------------------------------------------------------------------
-- SHOW
-------------------------------------------------------------------------------

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

-- TODO: nicer output
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

-------------------------------------------------------------------------------
-- UPDATE
-------------------------------------------------------------------------------

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
          -- lookup the "type" to find a Cmd to run, defaulting to legacy
          -- github
          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
        -- lookup the "type" to find a Cmd to run, defaulting to legacy
        -- github
        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'

-- | pretty much tryEvalUpdate but we might issue some warnings first
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)

-------------------------------------------------------------------------------
-- MODIFY
-------------------------------------------------------------------------------

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

-------------------------------------------------------------------------------
-- DROP
-------------------------------------------------------------------------------

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

-------------------------------------------------------------------------------
-- Files and their content
-------------------------------------------------------------------------------

-- | Checks if content is different than default and if it does /not/ contain
-- a comment line with @niv: no_update@
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

-------------------------------------------------------------------------------
-- Abort
-------------------------------------------------------------------------------

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