nmattia/niv
1
1
Fork 0
mirror of https://github.com/nmattia/niv.git synced 2024-11-29 09:42:35 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #159 from nmattia/nm-configure-sources

Browse Source 
Allow custom location for nix/sources.json
This commit is contained in:
Nicolas Mattia 2019-12-08 21:06:09 +01:00 committed by GitHub
commit 22e1f901df
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 181 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
CHANGELOG.md
View File

@ -1,5 +1,9 @@
# Changelog # Changelog
## [0.2.7] 2019-12-08
## Added
* Support for custom path `sources.json` with `--sources-json`
## [0.2.6] 2019-12-05 ## [0.2.6] 2019-12-05
## Changed ## Changed
* Fix `niv update` with `git` specs * Fix `niv update` with `git` specs

5
README.md
View File

@ -199,11 +199,12 @@ $ niv update ghc -v 8.6.2
``` ```
niv - dependency manager for Nix projects niv - dependency manager for Nix projects
version: 0.2.6 version: 0.2.7
Usage: niv COMMAND Usage: niv [-s|--sources-json FILE] COMMAND
Available options: Available options:
-s,--sources-json FILE Use FILE instead of nix/sources.json
-h,--help Show this help text -h,--help Show this help text
Available commands: Available commands:

54
nix/sources.nix
View File

@ -6,13 +6,13 @@ let
# The fetchers. fetch_<type> fetches specs of type <type>. # The fetchers. fetch_<type> fetches specs of type <type>.
# #
fetch_file = spec: fetch_file = pkgs: spec:
if spec.builtin or true then if spec.builtin or true then
builtins_fetchurl { inherit (spec) url sha256; } builtins_fetchurl { inherit (spec) url sha256; }
else else
pkgs.fetchurl { inherit (spec) url sha256; }; pkgs.fetchurl { inherit (spec) url sha256; };
fetch_tarball = spec: fetch_tarball = pkgs: spec:
if spec.builtin or true then if spec.builtin or true then
builtins_fetchTarball { inherit (spec) url sha256; } builtins_fetchTarball { inherit (spec) url sha256; }
else else
@ -43,27 +43,21 @@ let
'' ''
(builtins_fetchurl { inherit (spec) url sha256; }); (builtins_fetchurl { inherit (spec) url sha256; });
#
# The sources to fetch.
#
sources = builtins.fromJSON (builtins.readFile ./sources.json);
# #
# Various helpers # Various helpers
# #
# The set of packages used when specs are fetched using non-builtins. # The set of packages used when specs are fetched using non-builtins.
pkgs = mkPkgs = sources:
if hasNixpkgsPath if hasNixpkgsPath
then then
if hasThisAsNixpkgsPath if hasThisAsNixpkgsPath
then import (builtins_fetchTarball { inherit (sources_nixpkgs) url sha256; }) {} then import (builtins_fetchTarball { inherit (mkNixpkgs sources) url sha256; }) {}
else import <nixpkgs> {} else import <nixpkgs> {}
else else
import (builtins_fetchTarball { inherit (sources_nixpkgs) url sha256; }) {}; import (builtins_fetchTarball { inherit (mkNixpkgs sources) url sha256; }) {};
sources_nixpkgs = mkNixpkgs = sources:
if builtins.hasAttr "nixpkgs" sources if builtins.hasAttr "nixpkgs" sources
then sources.nixpkgs then sources.nixpkgs
else abort else abort
@ -77,12 +71,12 @@ let
(builtins.tryEval <nixpkgs>).success && <nixpkgs> == ./.; (builtins.tryEval <nixpkgs>).success && <nixpkgs> == ./.;
# The actual fetching function. # The actual fetching function.
fetch = name: spec: fetch = pkgs: name: spec:
if ! builtins.hasAttr "type" spec then if ! builtins.hasAttr "type" spec then
abort "ERROR: niv spec ${name} does not have a 'type' attribute" abort "ERROR: niv spec ${name} does not have a 'type' attribute"
else if spec.type == "file" then fetch_file spec else if spec.type == "file" then fetch_file pkgs spec
else if spec.type == "tarball" then fetch_tarball spec else if spec.type == "tarball" then fetch_tarball pkgs spec
else if spec.type == "git" then fetch_git spec else if spec.type == "git" then fetch_git spec
else if spec.type == "builtin-tarball" then fetch_builtin-tarball spec else if spec.type == "builtin-tarball" then fetch_builtin-tarball spec
else if spec.type == "builtin-url" then fetch_builtin-url spec else if spec.type == "builtin-url" then fetch_builtin-url spec
@ -117,12 +111,26 @@ let
else else
fetchurl attrs; fetchurl attrs;
# Create the final "sources" from the config
mkSources = config:
mapAttrs (
name: spec:
if builtins.hasAttr "outPath" spec
then abort
"The values in sources.json should not have an 'outPath' attribute"
else
spec // { outPath = fetch config.pkgs name spec; }
) config.sources;
# The "config" used by the fetchers
mkConfig =
{ sourcesFile ? ./sources.json
}: rec {
# The sources, i.e. the attribute set of spec name to spec
sources = builtins.fromJSON (builtins.readFile sourcesFile);
# The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers
pkgs = mkPkgs sources;
};
in in
mapAttrs ( mkSources (mkConfig {}) //
name: spec: { __functor = _: settings: mkSources (mkConfig settings); }
if builtins.hasAttr "outPath" spec
then abort
"The values in sources.json should not have an 'outPath' attribute"
else
spec // { outPath = fetch name spec; }
) sources

2
package.yaml
View File

@ -1,5 +1,5 @@
name: niv name: niv
version: 0.2.6 version: 0.2.7
license: MIT license: MIT
author: Nicolas Mattia <nicolas@nmattia.com> author: Nicolas Mattia <nicolas@nmattia.com>
maintainer: Nicolas Mattia <nicolas@nmattia.com> maintainer: Nicolas Mattia <nicolas@nmattia.com>

5
src/Data/Text/Extended.hs
View File

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

162
src/Niv/Cli.hs
View File

@ -10,11 +10,11 @@ module Niv.Cli where
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
import Control.Monad.Reader
import Data.Aeson ((.=)) import Data.Aeson ((.=))
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.HashMap.Strict.Extended import Data.HashMap.Strict.Extended
import Data.Hashable (Hashable) import Data.Hashable (Hashable)
import Data.String.QQ (s)
import Data.Text.Extended import Data.Text.Extended
import Data.Version (showVersion) import Data.Version (showVersion)
import Niv.Cmd import Niv.Cmd
@ -38,15 +38,28 @@ import qualified System.Directory as Dir
-- I died a little -- I died a little
import Paths_niv (version) 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 :: IO ()
cli = join $ cli = do
execParserPure' Opts.defaultPrefs opts <$> getArgs (fsj, nio) <- execParserPure' Opts.defaultPrefs opts <$> getArgs
>>= Opts.handleParseResult >>= Opts.handleParseResult
runReaderT (runNIO nio) fsj
where where
execParserPure' pprefs pinfo [] = Opts.Failure $ execParserPure' pprefs pinfo [] = Opts.Failure $
Opts.parserFailure pprefs pinfo Opts.ShowHelpText mempty Opts.parserFailure pprefs pinfo Opts.ShowHelpText mempty
execParserPure' pprefs pinfo args = Opts.execParserPure pprefs pinfo args 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 = desc =
[ Opts.fullDesc [ Opts.fullDesc
, Opts.headerDoc $ Just $ , Opts.headerDoc $ Just $
@ -54,8 +67,16 @@ cli = join $
"" Opts.<$$> "" Opts.<$$>
"version:" Opts.<+> Opts.text (showVersion version) "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 ( parseCommand = Opts.subparser (
Opts.command "init" parseCmdInit <> Opts.command "init" parseCmdInit <>
Opts.command "add" parseCmdAdd <> Opts.command "add" parseCmdAdd <>
@ -75,7 +96,7 @@ parsePackage = (,) <$> parsePackageName <*> (parsePackageSpec githubCmd)
-- INIT -- INIT
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
parseCmdInit :: Opts.ParserInfo (IO ()) parseCmdInit :: Opts.ParserInfo (NIO ())
parseCmdInit = Opts.info (pure cmdInit <**> Opts.helper) $ mconcat desc parseCmdInit = Opts.info (pure cmdInit <**> Opts.helper) $ mconcat desc
where where
desc = desc =
@ -84,9 +105,10 @@ parseCmdInit = Opts.info (pure cmdInit <**> Opts.helper) $ mconcat desc
"Initialize a Nix project. Existing files won't be modified." "Initialize a Nix project. Existing files won't be modified."
] ]
cmdInit :: IO () cmdInit :: NIO ()
cmdInit = do cmdInit = do
job "Initializing" $ do job "Initializing" $ do
fsj <- getFindSourcesJson
-- Writes all the default files -- Writes all the default files
-- a path, a "create" function and an update function for each file. -- a path, a "create" function and an update function for each file.
@ -97,10 +119,10 @@ cmdInit = do
if shouldUpdateNixSourcesNix content if shouldUpdateNixSourcesNix content
then do then do
say "Updating sources.nix" say "Updating sources.nix"
B.writeFile path initNixSourcesNixContent li $ B.writeFile path initNixSourcesNixContent
else say "Not updating sources.nix" else say "Not updating sources.nix"
) )
, ( pathNixSourcesJson , ( pathNixSourcesJson fsj
, \path -> do , \path -> do
createFile path initNixSourcesJsonContent createFile path initNixSourcesJsonContent
-- Imports @niv@ and @nixpkgs@ (19.03) -- Imports @niv@ and @nixpkgs@ (19.03)
@ -121,23 +143,39 @@ cmdInit = do
) )
, \path _content -> dontCreateFile path) , \path _content -> dontCreateFile path)
] $ \(path, onCreate, onUpdate) -> do ] $ \(path, onCreate, onUpdate) -> do
exists <- Dir.doesFileExist path exists <- li $ Dir.doesFileExist path
if exists then B.readFile path >>= onUpdate path else onCreate path if exists then li (B.readFile path) >>= onUpdate path else onCreate path
case fsj of
Auto -> pure ()
AtPath fp ->
tsay $ T.unlines
[ T.unwords
[ tbold $ tblue "INFO:"
, "You are using a custom path for sources.json."
]
, " You need to configure the sources.nix to use " <> tbold (T.pack fp) <> ":"
, tbold " import sources.nix { sourcesJson = PATH ; }; "
, T.unwords
[ " where", tbold "PATH", "is the relative path from sources.nix to"
, tbold (T.pack fp) <> "." ]
]
where where
createFile :: FilePath -> B.ByteString -> IO () createFile :: FilePath -> B.ByteString -> NIO ()
createFile path content = do createFile path content = li $ do
let dir = takeDirectory path let dir = takeDirectory path
Dir.createDirectoryIfMissing True dir Dir.createDirectoryIfMissing True dir
say $ "Creating " <> path say $ "Creating " <> path
B.writeFile path content B.writeFile path content
dontCreateFile :: FilePath -> IO () dontCreateFile :: FilePath -> NIO ()
dontCreateFile path = say $ "Not creating " <> path dontCreateFile path = say $ "Not creating " <> path
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- ADD -- ADD
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
parseCmdAdd :: Opts.ParserInfo (IO ()) parseCmdAdd :: Opts.ParserInfo (NIO ())
parseCmdAdd = parseCmdAdd =
Opts.info Opts.info
((parseCommands <|> parseShortcuts) <**> Opts.helper) $ ((parseCommands <|> parseShortcuts) <**> Opts.helper) $
@ -208,48 +246,51 @@ parseCmdArgs cmd = collapse <$> parseNameAndShortcut <*> parsePackageSpec cmd
Opts.help "Set the package name to <NAME>" 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 cmdAdd updateFunc packageName attrs = do
job ("Adding package " <> T.unpack (unPackageName packageName)) $ do job ("Adding package " <> T.unpack (unPackageName packageName)) $ do
sources <- unSources <$> getSources fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
when (HMS.member packageName sources) $ 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 case eFinalSpec of
Left e -> abortUpdateFailed [(packageName, e)] Left e -> li (abortUpdateFailed [(packageName, e)])
Right finalSpec -> do Right finalSpec -> do
say $ "Writing new sources file" say $ "Writing new sources file"
setSources $ Sources $ li $ setSources fsj $ Sources $
HMS.insert packageName finalSpec sources HMS.insert packageName finalSpec sources
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- SHOW -- SHOW
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
parseCmdShow :: Opts.ParserInfo (IO ()) parseCmdShow :: Opts.ParserInfo (NIO ())
parseCmdShow = parseCmdShow =
Opts.info Opts.info
((cmdShow <$> Opts.optional parsePackageName) <**> Opts.helper) ((cmdShow <$> Opts.optional parsePackageName) <**> Opts.helper)
Opts.fullDesc Opts.fullDesc
-- TODO: nicer output -- TODO: nicer output
cmdShow :: Maybe PackageName -> IO () cmdShow :: Maybe PackageName -> NIO ()
cmdShow = \case cmdShow = \case
Just packageName -> do Just packageName -> do
sources <- unSources <$> getSources fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
case HMS.lookup packageName sources of case HMS.lookup packageName sources of
Just pspec -> showPackage packageName pspec Just pspec -> showPackage packageName pspec
Nothing -> abortCannotShowNoSuchPackage packageName Nothing -> li $ abortCannotShowNoSuchPackage packageName
Nothing -> do Nothing -> do
sources <- unSources <$> getSources fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
forWithKeyM_ sources $ showPackage forWithKeyM_ sources $ showPackage
showPackage :: PackageName -> PackageSpec -> IO () showPackage :: MonadIO io => PackageName -> PackageSpec -> io ()
showPackage (PackageName pname) (PackageSpec spec) = do showPackage (PackageName pname) (PackageSpec spec) = do
tsay $ tbold pname tsay $ tbold pname
forM_ (HMS.toList spec) $ \(attrName, attrValValue) -> do forM_ (HMS.toList spec) $ \(attrName, attrValValue) -> do
@ -262,7 +303,7 @@ showPackage (PackageName pname) (PackageSpec spec) = do
-- UPDATE -- UPDATE
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
parseCmdUpdate :: Opts.ParserInfo (IO ()) parseCmdUpdate :: Opts.ParserInfo (NIO ())
parseCmdUpdate = parseCmdUpdate =
Opts.info Opts.info
((cmdUpdate <$> Opts.optional parsePackage) <**> Opts.helper) $ ((cmdUpdate <$> Opts.optional parsePackage) <**> Opts.helper) $
@ -287,11 +328,12 @@ specToFreeAttrs = fmap (Free,) . unPackageSpec
specToLockedAttrs :: PackageSpec -> Attrs specToLockedAttrs :: PackageSpec -> Attrs
specToLockedAttrs = fmap (Locked,) . unPackageSpec specToLockedAttrs = fmap (Locked,) . unPackageSpec
cmdUpdate :: Maybe (PackageName, PackageSpec) -> IO () cmdUpdate :: Maybe (PackageName, PackageSpec) -> NIO ()
cmdUpdate = \case cmdUpdate = \case
Just (packageName, cliSpec) -> Just (packageName, cliSpec) ->
job ("Update " <> T.unpack (unPackageName packageName)) $ do job ("Update " <> T.unpack (unPackageName packageName)) $ do
sources <- unSources <$> getSources fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
eFinalSpec <- case HMS.lookup packageName sources of eFinalSpec <- case HMS.lookup packageName sources of
Just defaultSpec -> do Just defaultSpec -> do
@ -300,20 +342,21 @@ cmdUpdate = \case
let cmd = case HMS.lookup "type" (unPackageSpec defaultSpec) of let cmd = case HMS.lookup "type" (unPackageSpec defaultSpec) of
Just "git" -> gitCmd Just "git" -> gitCmd
_ -> githubCmd _ -> githubCmd
fmap attrsToSpec <$> tryEvalUpdate fmap attrsToSpec <$> li (tryEvalUpdate
(specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec) (specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec)
(updateCmd cmd) (updateCmd cmd))
Nothing -> abortCannotUpdateNoSuchPackage packageName Nothing -> li $ abortCannotUpdateNoSuchPackage packageName
case eFinalSpec of case eFinalSpec of
Left e -> abortUpdateFailed [(packageName, e)] Left e -> li $ abortUpdateFailed [(packageName, e)]
Right finalSpec -> Right finalSpec ->
setSources $ Sources $ li $ setSources fsj $ Sources $
HMS.insert packageName finalSpec sources HMS.insert packageName finalSpec sources
Nothing -> job "Updating all packages" $ do Nothing -> job "Updating all packages" $ do
sources <- unSources <$> getSources fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
esources' <- forWithKeyM sources $ esources' <- forWithKeyM sources $
\packageName defaultSpec -> do \packageName defaultSpec -> do
@ -324,17 +367,17 @@ cmdUpdate = \case
let cmd = case HMS.lookup "type" (unPackageSpec defaultSpec) of let cmd = case HMS.lookup "type" (unPackageSpec defaultSpec) of
Just "git" -> gitCmd Just "git" -> gitCmd
_ -> githubCmd _ -> githubCmd
finalSpec <- fmap attrsToSpec <$> tryEvalUpdate finalSpec <- fmap attrsToSpec <$> li (tryEvalUpdate
initialSpec initialSpec
(updateCmd cmd) (updateCmd cmd))
pure finalSpec pure finalSpec
let (failed, sources') = partitionEithersHMS esources' let (failed, sources') = partitionEithersHMS esources'
unless (HMS.null failed) $ unless (HMS.null failed) $
abortUpdateFailed (HMS.toList failed) li $ abortUpdateFailed (HMS.toList failed)
setSources $ Sources sources' li $ setSources fsj $ Sources sources'
partitionEithersHMS partitionEithersHMS
:: (Eq k, Hashable k) :: (Eq k, Hashable k)
@ -348,7 +391,7 @@ partitionEithersHMS =
-- MODIFY -- MODIFY
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
parseCmdModify :: Opts.ParserInfo (IO ()) parseCmdModify :: Opts.ParserInfo (NIO ())
parseCmdModify = parseCmdModify =
Opts.info Opts.info
((cmdModify <$> parsePackage) <**> Opts.helper) $ ((cmdModify <$> parsePackage) <**> Opts.helper) $
@ -364,22 +407,23 @@ parseCmdModify =
" niv modify nixpkgs -a branch=nixpkgs-unstable" " niv modify nixpkgs -a branch=nixpkgs-unstable"
] ]
cmdModify :: (PackageName, PackageSpec) -> IO () cmdModify :: (PackageName, PackageSpec) -> NIO ()
cmdModify (packageName, cliSpec) = do cmdModify (packageName, cliSpec) = do
tsay $ "Modifying package: " <> unPackageName packageName tsay $ "Modifying package: " <> unPackageName packageName
sources <- unSources <$> getSources fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
finalSpec <- case HMS.lookup packageName sources of finalSpec <- case HMS.lookup packageName sources of
Just defaultSpec -> pure $ attrsToSpec (specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec) 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 -- DROP
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
parseCmdDrop :: Opts.ParserInfo (IO ()) parseCmdDrop :: Opts.ParserInfo (NIO ())
parseCmdDrop = parseCmdDrop =
Opts.info Opts.info
((cmdDrop <$> parsePackageName <*> parseDropAttributes) <**> ((cmdDrop <$> parsePackageName <*> parseDropAttributes) <**>
@ -399,30 +443,32 @@ parseCmdDrop =
parseDropAttributes = many $ parseDropAttributes = many $
Opts.argument Opts.str (Opts.metavar "ATTRIBUTE") Opts.argument Opts.str (Opts.metavar "ATTRIBUTE")
cmdDrop :: PackageName -> [T.Text] -> IO () cmdDrop :: PackageName -> [T.Text] -> NIO ()
cmdDrop packageName = \case cmdDrop packageName = \case
[] -> do [] -> do
tsay $ "Dropping package: " <> unPackageName packageName tsay $ "Dropping package: " <> unPackageName packageName
sources <- unSources <$> getSources fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
when (not $ HMS.member packageName sources) $ when (not $ HMS.member packageName sources) $
abortCannotDropNoSuchPackage packageName li $ abortCannotDropNoSuchPackage packageName
setSources $ Sources $ li $ setSources fsj $ Sources $
HMS.delete packageName sources HMS.delete packageName sources
attrs -> do attrs -> do
tsay $ "Dropping attributes :" <> T.intercalate " " attrs tsay $ "Dropping attributes :" <> T.intercalate " " attrs
tsay $ "In package: " <> unPackageName packageName tsay $ "In package: " <> unPackageName packageName
sources <- unSources <$> getSources fsj <- getFindSourcesJson
sources <- unSources <$> li (getSources fsj)
packageSpec <- case HMS.lookup packageName sources of packageSpec <- case HMS.lookup packageName sources of
Nothing -> Nothing ->
abortCannotAttributesDropNoSuchPackage packageName li $ abortCannotAttributesDropNoSuchPackage packageName
Just (PackageSpec packageSpec) -> pure $ PackageSpec $ Just (PackageSpec packageSpec) -> pure $ PackageSpec $
HMS.mapMaybeWithKey HMS.mapMaybeWithKey
(\k v -> if k `elem` attrs then Nothing else Just v) packageSpec (\k v -> if k `elem` attrs then Nothing else Just v) packageSpec
setSources $ Sources $ li $ setSources fsj $ Sources $
HMS.insert packageName packageSpec sources HMS.insert packageName packageSpec sources
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
@ -450,16 +496,6 @@ shouldUpdateNixSourcesNix content =
-- Abort -- 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 -> IO a
abortCannotAddPackageExists (PackageName n) = abort $ T.unlines abortCannotAddPackageExists (PackageName n) = abort $ T.unlines
[ "Cannot add package " <> n <> "." [ "Cannot add package " <> n <> "."

12
src/Niv/Logger.hs
View File

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

58
src/Niv/Sources.hs
View File

@ -31,6 +31,11 @@ import qualified System.Directory as Dir
-- sources.json related -- 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 data SourcesError
= SourcesDoesntExist = SourcesDoesntExist
| SourceIsntJSON | SourceIsntJSON
@ -40,12 +45,12 @@ newtype Sources = Sources
{ unSources :: HMS.HashMap PackageName PackageSpec } { unSources :: HMS.HashMap PackageName PackageSpec }
deriving newtype (FromJSON, ToJSON) deriving newtype (FromJSON, ToJSON)
getSourcesEither :: IO (Either SourcesError Sources) getSourcesEither :: FindSourcesJson -> IO (Either SourcesError Sources)
getSourcesEither = do getSourcesEither fsj = do
Dir.doesFileExist pathNixSourcesJson >>= \case Dir.doesFileExist (pathNixSourcesJson fsj) >>= \case
False -> pure $ Left SourcesDoesntExist False -> pure $ Left SourcesDoesntExist
True -> True ->
Aeson.decodeFileStrict pathNixSourcesJson >>= \case Aeson.decodeFileStrict (pathNixSourcesJson fsj) >>= \case
Just value -> case valueToSources value of Just value -> case valueToSources value of
Nothing -> pure $ Left SpecIsntAMap Nothing -> pure $ Left SpecIsntAMap
Just srcs -> pure $ Right srcs 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 :: (Eq k2, Hashable k2) => (k1 -> k2) -> HMS.HashMap k1 v -> HMS.HashMap k2 v
mapKeys f = HMS.fromList . map (first f) . HMS.toList mapKeys f = HMS.fromList . map (first f) . HMS.toList
getSources :: IO Sources getSources :: FindSourcesJson -> IO Sources
getSources = do getSources fsj = do
warnIfOutdated warnIfOutdated
getSourcesEither >>= either getSourcesEither fsj >>= either
(\case (\case
SourcesDoesntExist -> abortSourcesDoesntExist SourcesDoesntExist -> (abortSourcesDoesntExist fsj)
SourceIsntJSON -> abortSourcesIsntJSON SourceIsntJSON -> (abortSourcesIsntJSON fsj)
SpecIsntAMap -> abortSpecIsntAMap SpecIsntAMap -> (abortSpecIsntAMap fsj)
) pure ) pure
setSources :: Sources -> IO () setSources :: FindSourcesJson -> Sources -> IO ()
setSources sources = Aeson.encodeFilePretty pathNixSourcesJson sources setSources fsj sources = Aeson.encodeFilePretty (pathNixSourcesJson fsj) sources
newtype PackageName = PackageName { unPackageName :: T.Text } newtype PackageName = PackageName { unPackageName :: T.Text }
deriving newtype (Eq, Hashable, FromJSONKey, ToJSONKey, Show) deriving newtype (Eq, Hashable, FromJSONKey, ToJSONKey, Show)
@ -85,32 +90,34 @@ newtype PackageSpec = PackageSpec { unPackageSpec :: Aeson.Object }
attrsToSpec :: Attrs -> PackageSpec attrsToSpec :: Attrs -> PackageSpec
attrsToSpec = PackageSpec . fmap snd attrsToSpec = PackageSpec . fmap snd
-- | @nix/sources.json@ -- | @nix/sources.json@ or pointed at by 'FindSourcesJson'
pathNixSourcesJson :: FilePath pathNixSourcesJson :: FindSourcesJson -> FilePath
pathNixSourcesJson = "nix" </> "sources.json" pathNixSourcesJson = \case
Auto -> "nix" </> "sources.json"
AtPath f -> f
-- --
-- ABORT messages -- ABORT messages
-- --
abortSourcesDoesntExist :: IO a abortSourcesDoesntExist :: FindSourcesJson -> IO a
abortSourcesDoesntExist = abort $ T.unlines [ line1, line2 ] abortSourcesDoesntExist fsj = abort $ T.unlines [ line1, line2 ]
where where
line1 = "Cannot use " <> T.pack pathNixSourcesJson line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj)
line2 = [s| line2 = [s|
The sources file does not exist! You may need to run 'niv init'. The sources file does not exist! You may need to run 'niv init'.
|] |]
abortSourcesIsntJSON :: IO a abortSourcesIsntJSON :: FindSourcesJson -> IO a
abortSourcesIsntJSON = abort $ T.unlines [ line1, line2 ] abortSourcesIsntJSON fsj = abort $ T.unlines [ line1, line2 ]
where where
line1 = "Cannot use " <> T.pack pathNixSourcesJson line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj)
line2 = "The sources file should be JSON." line2 = "The sources file should be JSON."
abortSpecIsntAMap :: IO a abortSpecIsntAMap :: FindSourcesJson -> IO a
abortSpecIsntAMap = abort $ T.unlines [ line1, line2 ] abortSpecIsntAMap fsj = abort $ T.unlines [ line1, line2 ]
where where
line1 = "Cannot use " <> T.pack pathNixSourcesJson line1 = "Cannot use " <> T.pack (pathNixSourcesJson fsj)
line2 = [s| line2 = [s|
The package specifications in the sources file should be JSON maps from The package specifications in the sources file should be JSON maps from
attribute name to attribute value, e.g.: attribute name to attribute value, e.g.:
@ -136,6 +143,7 @@ data SourcesNixVersion
| V10 | V10
| V11 | V11
| V12 | V12
| V13
deriving stock (Bounded, Enum, Eq) deriving stock (Bounded, Enum, Eq)
-- | A user friendly version -- | A user friendly version
@ -153,6 +161,7 @@ sourcesVersionToText = \case
V10 -> "10" V10 -> "10"
V11 -> "11" V11 -> "11"
V12 -> "12" V12 -> "12"
V13 -> "13"
latestVersionMD5 :: T.Text latestVersionMD5 :: T.Text
latestVersionMD5 = sourcesVersionToMD5 maxBound latestVersionMD5 = sourcesVersionToMD5 maxBound
@ -177,6 +186,7 @@ sourcesVersionToMD5 = \case
V10 -> "d8625c0a03dd935e1c79f46407faa8d3" V10 -> "d8625c0a03dd935e1c79f46407faa8d3"
V11 -> "8a95b7d93b16f7c7515d98f49b0ec741" V11 -> "8a95b7d93b16f7c7515d98f49b0ec741"
V12 -> "2f9629ad9a8f181ed71d2a59b454970c" V12 -> "2f9629ad9a8f181ed71d2a59b454970c"
V13 -> "5e23c56b92eaade4e664cb16dcac1e0a"
-- | The MD5 sum of ./nix/sources.nix -- | The MD5 sum of ./nix/sources.nix
sourcesNixMD5 :: IO T.Text sourcesNixMD5 :: IO T.Text