1
1
mirror of https://github.com/nmattia/niv.git synced 2024-09-18 19:07:19 +03:00

Allow specifying path to sources.json in executable

The CLI was updated to allow for custom locations of the
`nix/sources.json`:

```

Usage: niv [-s|--sources-json FILE] COMMAND

Available options:
  -s,--sources-json FILE   Use FILE instead of nix/sources.json
  -h,--help                Show this help text
```
This commit is contained in:
Nicolas Mattia 2019-12-08 13:49:56 +01:00
parent 3e1d44bbfa
commit ceab2e1572
5 changed files with 126 additions and 96 deletions

View File

@ -201,9 +201,10 @@ niv - dependency manager for Nix projects
version: 0.2.6
Usage: niv COMMAND
Usage: niv [-s|--sources-json FILE] COMMAND
Available options:
-s,--sources-json FILE Use FILE instead of nix/sources.json
-h,--help Show this help text
Available commands:

View File

@ -3,6 +3,7 @@
module Data.Text.Extended where
import Niv.Logger
import UnliftIO
import System.Exit (exitFailure)
import qualified Data.Text as T
@ -10,7 +11,7 @@ tshow :: Show a => a -> T.Text
tshow = T.pack . show
-- not quite the perfect place for this
abort :: T.Text -> IO a
abort :: MonadIO io => T.Text -> io a
abort msg = do
tsay $ T.unwords [ tbold $ tred "FATAL:", msg ]
exitFailure
liftIO exitFailure

View File

@ -1,4 +1,5 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
@ -10,11 +11,11 @@ module Niv.Cli where
import Control.Applicative
import Control.Monad
import Control.Monad.Reader
import Data.Aeson ((.=))
import Data.Char (isSpace)
import Data.HashMap.Strict.Extended
import Data.Hashable (Hashable)
import Data.String.QQ (s)
import Data.Text.Extended
import Data.Version (showVersion)
import Niv.Cmd
@ -38,15 +39,28 @@ import qualified System.Directory as Dir
-- I died a little
import Paths_niv (version)
newtype NIO a = NIO { runNIO :: ReaderT FindSourcesJson IO a }
deriving (Functor, Applicative, Monad, MonadIO, MonadReader FindSourcesJson)
instance MonadUnliftIO NIO where
withRunInIO = wrappedWithRunInIO NIO runNIO
getFindSourcesJson :: NIO FindSourcesJson
getFindSourcesJson = ask
li :: MonadIO io => IO a -> io a
li = liftIO
cli :: IO ()
cli = join $
execParserPure' Opts.defaultPrefs opts <$> getArgs
cli = do
(fsj, nio) <- execParserPure' Opts.defaultPrefs opts <$> getArgs
>>= Opts.handleParseResult
runReaderT (runNIO nio) fsj
where
execParserPure' pprefs pinfo [] = Opts.Failure $
Opts.parserFailure pprefs pinfo Opts.ShowHelpText mempty
execParserPure' pprefs pinfo args = Opts.execParserPure pprefs pinfo args
opts = Opts.info (parseCommand <**> Opts.helper ) $ mconcat desc
opts = Opts.info ((,) <$> parseFindSourcesJson <*> (parseCommand <**> Opts.helper)) $ mconcat desc
desc =
[ Opts.fullDesc
, Opts.headerDoc $ Just $
@ -54,8 +68,16 @@ cli = join $
"" Opts.<$$>
"version:" Opts.<+> Opts.text (showVersion version)
]
parseFindSourcesJson =
AtPath <$> Opts.strOption (
Opts.long "sources-json" <>
Opts.short 's' <>
Opts.metavar "FILE" <>
Opts.help "Use FILE instead of nix/sources.json"
) <|> pure Auto
parseCommand :: Opts.Parser (IO ())
parseCommand :: Opts.Parser (NIO ())
parseCommand = Opts.subparser (
Opts.command "init" parseCmdInit <>
Opts.command "add" parseCmdAdd <>
@ -75,7 +97,7 @@ parsePackage = (,) <$> parsePackageName <*> (parsePackageSpec githubCmd)
-- INIT
-------------------------------------------------------------------------------
parseCmdInit :: Opts.ParserInfo (IO ())
parseCmdInit :: Opts.ParserInfo (NIO ())
parseCmdInit = Opts.info (pure cmdInit <**> Opts.helper) $ mconcat desc
where
desc =
@ -84,9 +106,10 @@ parseCmdInit = Opts.info (pure cmdInit <**> Opts.helper) $ mconcat desc
"Initialize a Nix project. Existing files won't be modified."
]
cmdInit :: IO ()
cmdInit :: NIO ()
cmdInit = do
job "Initializing" $ do
fsj <- getFindSourcesJson
-- Writes all the default files
-- a path, a "create" function and an update function for each file.
@ -97,10 +120,10 @@ cmdInit = do
if shouldUpdateNixSourcesNix content
then do
say "Updating sources.nix"
B.writeFile path initNixSourcesNixContent
liftIO $ B.writeFile path initNixSourcesNixContent
else say "Not updating sources.nix"
)
, ( pathNixSourcesJson
, ( pathNixSourcesJson fsj
, \path -> do
createFile path initNixSourcesJsonContent
-- Imports @niv@ and @nixpkgs@ (19.03)
@ -121,23 +144,23 @@ cmdInit = do
)
, \path _content -> dontCreateFile path)
] $ \(path, onCreate, onUpdate) -> do
exists <- Dir.doesFileExist path
if exists then B.readFile path >>= onUpdate path else onCreate path
exists <- liftIO $ Dir.doesFileExist path
if exists then liftIO (B.readFile path) >>= onUpdate path else onCreate path
where
createFile :: FilePath -> B.ByteString -> IO ()
createFile path content = do
createFile :: FilePath -> B.ByteString -> NIO ()
createFile path content = liftIO $ do
let dir = takeDirectory path
Dir.createDirectoryIfMissing True dir
say $ "Creating " <> path
B.writeFile path content
dontCreateFile :: FilePath -> IO ()
dontCreateFile :: FilePath -> NIO ()
dontCreateFile path = say $ "Not creating " <> path
-------------------------------------------------------------------------------
-- ADD
-------------------------------------------------------------------------------
parseCmdAdd :: Opts.ParserInfo (IO ())
parseCmdAdd :: Opts.ParserInfo (NIO ())
parseCmdAdd =
Opts.info
((parseCommands <|> parseShortcuts) <**> Opts.helper) $
@ -208,48 +231,51 @@ parseCmdArgs cmd = collapse <$> parseNameAndShortcut <*> parsePackageSpec cmd
Opts.help "Set the package name to <NAME>"
)
cmdAdd :: Update () a -> PackageName -> Attrs -> IO ()
cmdAdd :: Update () a -> PackageName -> Attrs -> NIO ()
cmdAdd updateFunc packageName attrs = do
job ("Adding package " <> T.unpack (unPackageName packageName)) $ do
sources <- unSources <$> getSources
fsj <- getFindSourcesJson
sources <- unSources <$> liftIO (getSources fsj)
when (HMS.member packageName sources) $
abortCannotAddPackageExists packageName
li $ abortCannotAddPackageExists packageName
eFinalSpec <- fmap attrsToSpec <$> tryEvalUpdate attrs updateFunc
eFinalSpec <- fmap attrsToSpec <$> li (tryEvalUpdate attrs updateFunc)
case eFinalSpec of
Left e -> abortUpdateFailed [(packageName, e)]
Left e -> li (abortUpdateFailed [(packageName, e)])
Right finalSpec -> do
say $ "Writing new sources file"
setSources $ Sources $
li $ setSources fsj $ Sources $
HMS.insert packageName finalSpec sources
-------------------------------------------------------------------------------
-- SHOW
-------------------------------------------------------------------------------
parseCmdShow :: Opts.ParserInfo (IO ())
parseCmdShow :: Opts.ParserInfo (NIO ())
parseCmdShow =
Opts.info
((cmdShow <$> Opts.optional parsePackageName) <**> Opts.helper)
Opts.fullDesc
-- TODO: nicer output
cmdShow :: Maybe PackageName -> IO ()
cmdShow :: Maybe PackageName -> NIO ()
cmdShow = \case
Just packageName -> do
sources <- unSources <$> getSources
fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
case HMS.lookup packageName sources of
Just pspec -> showPackage packageName pspec
Nothing -> abortCannotShowNoSuchPackage packageName
Nothing -> li $ abortCannotShowNoSuchPackage packageName
Nothing -> do
sources <- unSources <$> getSources
fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
forWithKeyM_ sources $ showPackage
showPackage :: PackageName -> PackageSpec -> IO ()
showPackage :: MonadIO io => PackageName -> PackageSpec -> io ()
showPackage (PackageName pname) (PackageSpec spec) = do
tsay $ tbold pname
forM_ (HMS.toList spec) $ \(attrName, attrValValue) -> do
@ -262,7 +288,7 @@ showPackage (PackageName pname) (PackageSpec spec) = do
-- UPDATE
-------------------------------------------------------------------------------
parseCmdUpdate :: Opts.ParserInfo (IO ())
parseCmdUpdate :: Opts.ParserInfo (NIO ())
parseCmdUpdate =
Opts.info
((cmdUpdate <$> Opts.optional parsePackage) <**> Opts.helper) $
@ -287,11 +313,12 @@ specToFreeAttrs = fmap (Free,) . unPackageSpec
specToLockedAttrs :: PackageSpec -> Attrs
specToLockedAttrs = fmap (Locked,) . unPackageSpec
cmdUpdate :: Maybe (PackageName, PackageSpec) -> IO ()
cmdUpdate :: Maybe (PackageName, PackageSpec) -> NIO ()
cmdUpdate = \case
Just (packageName, cliSpec) ->
job ("Update " <> T.unpack (unPackageName packageName)) $ do
sources <- unSources <$> getSources
fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
eFinalSpec <- case HMS.lookup packageName sources of
Just defaultSpec -> do
@ -300,20 +327,21 @@ cmdUpdate = \case
let cmd = case HMS.lookup "type" (unPackageSpec defaultSpec) of
Just "git" -> gitCmd
_ -> githubCmd
fmap attrsToSpec <$> tryEvalUpdate
fmap attrsToSpec <$> li (tryEvalUpdate
(specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec)
(updateCmd cmd)
(updateCmd cmd))
Nothing -> abortCannotUpdateNoSuchPackage packageName
Nothing -> li $ abortCannotUpdateNoSuchPackage packageName
case eFinalSpec of
Left e -> abortUpdateFailed [(packageName, e)]
Left e -> li $ abortUpdateFailed [(packageName, e)]
Right finalSpec ->
setSources $ Sources $
li $ setSources fsj $ Sources $
HMS.insert packageName finalSpec sources
Nothing -> job "Updating all packages" $ do
sources <- unSources <$> getSources
fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
esources' <- forWithKeyM sources $
\packageName defaultSpec -> do
@ -324,17 +352,17 @@ cmdUpdate = \case
let cmd = case HMS.lookup "type" (unPackageSpec defaultSpec) of
Just "git" -> gitCmd
_ -> githubCmd
finalSpec <- fmap attrsToSpec <$> tryEvalUpdate
finalSpec <- fmap attrsToSpec <$> li (tryEvalUpdate
initialSpec
(updateCmd cmd)
(updateCmd cmd))
pure finalSpec
let (failed, sources') = partitionEithersHMS esources'
unless (HMS.null failed) $
abortUpdateFailed (HMS.toList failed)
li $ abortUpdateFailed (HMS.toList failed)
setSources $ Sources sources'
li $ setSources fsj $ Sources sources'
partitionEithersHMS
:: (Eq k, Hashable k)
@ -348,7 +376,7 @@ partitionEithersHMS =
-- MODIFY
-------------------------------------------------------------------------------
parseCmdModify :: Opts.ParserInfo (IO ())
parseCmdModify :: Opts.ParserInfo (NIO ())
parseCmdModify =
Opts.info
((cmdModify <$> parsePackage) <**> Opts.helper) $
@ -364,22 +392,23 @@ parseCmdModify =
" niv modify nixpkgs -a branch=nixpkgs-unstable"
]
cmdModify :: (PackageName, PackageSpec) -> IO ()
cmdModify :: (PackageName, PackageSpec) -> NIO ()
cmdModify (packageName, cliSpec) = do
tsay $ "Modifying package: " <> unPackageName packageName
sources <- unSources <$> getSources
fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
finalSpec <- case HMS.lookup packageName sources of
Just defaultSpec -> pure $ attrsToSpec (specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec)
Nothing -> abortCannotModifyNoSuchPackage packageName
Nothing -> li $ abortCannotModifyNoSuchPackage packageName
setSources $ Sources $ HMS.insert packageName finalSpec sources
li $ setSources fsj $ Sources $ HMS.insert packageName finalSpec sources
-------------------------------------------------------------------------------
-- DROP
-------------------------------------------------------------------------------
parseCmdDrop :: Opts.ParserInfo (IO ())
parseCmdDrop :: Opts.ParserInfo (NIO ())
parseCmdDrop =
Opts.info
((cmdDrop <$> parsePackageName <*> parseDropAttributes) <**>
@ -399,30 +428,32 @@ parseCmdDrop =
parseDropAttributes = many $
Opts.argument Opts.str (Opts.metavar "ATTRIBUTE")
cmdDrop :: PackageName -> [T.Text] -> IO ()
cmdDrop :: PackageName -> [T.Text] -> NIO ()
cmdDrop packageName = \case
[] -> do
tsay $ "Dropping package: " <> unPackageName packageName
sources <- unSources <$> getSources
fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
when (not $ HMS.member packageName sources) $
abortCannotDropNoSuchPackage packageName
li $ abortCannotDropNoSuchPackage packageName
setSources $ Sources $
li $ setSources fsj $ Sources $
HMS.delete packageName sources
attrs -> do
tsay $ "Dropping attributes :" <> T.intercalate " " attrs
tsay $ "In package: " <> unPackageName packageName
sources <- unSources <$> getSources
fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
packageSpec <- case HMS.lookup packageName sources of
Nothing ->
abortCannotAttributesDropNoSuchPackage packageName
li $ abortCannotAttributesDropNoSuchPackage packageName
Just (PackageSpec packageSpec) -> pure $ PackageSpec $
HMS.mapMaybeWithKey
(\k v -> if k `elem` attrs then Nothing else Just v) packageSpec
setSources $ Sources $
li $ setSources fsj $ Sources $
HMS.insert packageName packageSpec sources
-------------------------------------------------------------------------------
@ -450,16 +481,6 @@ shouldUpdateNixSourcesNix content =
-- Abort
-------------------------------------------------------------------------------
abortSourcesIsntAMap :: IO a
abortSourcesIsntAMap = abort $ T.unlines [ line1, line2 ]
where
line1 = "Cannot use " <> T.pack pathNixSourcesJson
line2 = [s|
The sources file should be a JSON map from package name to package
specification, e.g.:
{ ... }
|]
abortCannotAddPackageExists :: PackageName -> IO a
abortCannotAddPackageExists (PackageName n) = abort $ T.unlines
[ "Cannot add package " <> n <> "."

View File

@ -29,7 +29,7 @@ type S = String -> String
type T = T.Text -> T.Text
-- XXX: this assumes as single thread
job :: String -> IO () -> IO ()
job :: (MonadUnliftIO io, MonadIO io) => String -> io () -> io ()
job str act = do
say (bold str)
indent
@ -41,28 +41,28 @@ job str act = do
let se = show e
(if length se > 40 then ":\n" else ": ") <> se
say $ red "ERROR" <> showErr
exitFailure
liftIO exitFailure
where
indent = void $ atomicModifyIORef jobStack (\x -> (x + 1, undefined))
deindent = void $ atomicModifyIORef jobStack (\x -> (x - 1, undefined))
jobStackSize :: IO Int
jobStackSize :: MonadIO io => io Int
jobStackSize = readIORef jobStack
jobStack :: IORef Int
jobStack = unsafePerformIO $ newIORef 0
{-# NOINLINE jobStackSize #-}
tsay :: T.Text -> IO ()
tsay :: MonadIO io => T.Text -> io ()
tsay = say . T.unpack
say :: String -> IO ()
say :: MonadIO io => String -> io ()
say msg = do
stackSize <- jobStackSize
let indent = replicate (stackSize * 2) ' '
-- we use `intercalate "\n"` because `unlines` prints an extra newline at
-- the end
putStrLn $ intercalate "\n" $ (indent <>) <$> lines msg
liftIO $ putStrLn $ intercalate "\n" $ (indent <>) <$> lines msg
green :: S
green str =

View File

@ -31,6 +31,11 @@ import qualified System.Directory as Dir
-- sources.json related
-------------------------------------------------------------------------------
-- | Where to find the sources.json
data FindSourcesJson
= Auto -- ^ use the default (nix/sources.json)
| AtPath FilePath -- ^ use the specified file path
data SourcesError
= SourcesDoesntExist
| SourceIsntJSON
@ -40,12 +45,12 @@ newtype Sources = Sources
{ unSources :: HMS.HashMap PackageName PackageSpec }
deriving newtype (FromJSON, ToJSON)
getSourcesEither :: IO (Either SourcesError Sources)
getSourcesEither = do
Dir.doesFileExist pathNixSourcesJson >>= \case
getSourcesEither :: FindSourcesJson -> IO (Either SourcesError Sources)
getSourcesEither fsj = do
Dir.doesFileExist (pathNixSourcesJson fsj) >>= \case
False -> pure $ Left SourcesDoesntExist
True ->
Aeson.decodeFileStrict pathNixSourcesJson >>= \case
Aeson.decodeFileStrict (pathNixSourcesJson fsj) >>= \case
Just value -> case valueToSources value of
Nothing -> pure $ Left SpecIsntAMap
Just srcs -> pure $ Right srcs
@ -62,18 +67,18 @@ getSourcesEither = do
mapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> HMS.HashMap k1 v -> HMS.HashMap k2 v
mapKeys f = HMS.fromList . map (first f) . HMS.toList
getSources :: IO Sources
getSources = do
getSources :: FindSourcesJson -> IO Sources
getSources fsj = do
warnIfOutdated
getSourcesEither >>= either
getSourcesEither fsj >>= either
(\case
SourcesDoesntExist -> abortSourcesDoesntExist
SourceIsntJSON -> abortSourcesIsntJSON
SpecIsntAMap -> abortSpecIsntAMap
SourcesDoesntExist -> (abortSourcesDoesntExist fsj)
SourceIsntJSON -> (abortSourcesIsntJSON fsj)
SpecIsntAMap -> (abortSpecIsntAMap fsj)
) pure
setSources :: Sources -> IO ()
setSources sources = Aeson.encodeFilePretty pathNixSourcesJson sources
setSources :: FindSourcesJson -> Sources -> IO ()
setSources fsj sources = Aeson.encodeFilePretty (pathNixSourcesJson fsj) sources
newtype PackageName = PackageName { unPackageName :: T.Text }
deriving newtype (Eq, Hashable, FromJSONKey, ToJSONKey, Show)
@ -85,32 +90,34 @@ newtype PackageSpec = PackageSpec { unPackageSpec :: Aeson.Object }
attrsToSpec :: Attrs -> PackageSpec
attrsToSpec = PackageSpec . fmap snd
-- | @nix/sources.json@
pathNixSourcesJson :: FilePath
pathNixSourcesJson = "nix" </> "sources.json"
-- | @nix/sources.json@ or pointed at by 'FindSourcesJson'
pathNixSourcesJson :: FindSourcesJson -> FilePath
pathNixSourcesJson = \case
Auto -> "nix" </> "sources.json"
AtPath f -> f
--
-- ABORT messages
--
abortSourcesDoesntExist :: IO a
abortSourcesDoesntExist = abort $ T.unlines [ line1, line2 ]
abortSourcesDoesntExist :: FindSourcesJson -> IO a
abortSourcesDoesntExist fsj = abort $ T.unlines [ line1, line2 ]
where
line1 = "Cannot use " <> T.pack pathNixSourcesJson
line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj)
line2 = [s|
The sources file does not exist! You may need to run 'niv init'.
|]
abortSourcesIsntJSON :: IO a
abortSourcesIsntJSON = abort $ T.unlines [ line1, line2 ]
abortSourcesIsntJSON :: FindSourcesJson -> IO a
abortSourcesIsntJSON fsj = abort $ T.unlines [ line1, line2 ]
where
line1 = "Cannot use " <> T.pack pathNixSourcesJson
line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj)
line2 = "The sources file should be JSON."
abortSpecIsntAMap :: IO a
abortSpecIsntAMap = abort $ T.unlines [ line1, line2 ]
abortSpecIsntAMap :: FindSourcesJson -> IO a
abortSpecIsntAMap fsj = abort $ T.unlines [ line1, line2 ]
where
line1 = "Cannot use " <> T.pack pathNixSourcesJson
line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj)
line2 = [s|
The package specifications in the sources file should be JSON maps from
attribute name to attribute value, e.g.: