diff --git a/CHANGELOG.md b/CHANGELOG.md index 3da6189..5341762 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Changelog +## [0.2.7] 2019-12-08 +## Added +* Support for custom path `sources.json` with `--sources-json` + ## [0.2.6] 2019-12-05 ## Changed * Fix `niv update` with `git` specs diff --git a/README.md b/README.md index ef308ba..f49a0bd 100644 --- a/README.md +++ b/README.md @@ -199,11 +199,12 @@ $ niv update ghc -v 8.6.2 ``` 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: + -s,--sources-json FILE Use FILE instead of nix/sources.json -h,--help Show this help text Available commands: diff --git a/nix/sources.nix b/nix/sources.nix index 4c0351c..718ea6f 100644 --- a/nix/sources.nix +++ b/nix/sources.nix @@ -6,13 +6,13 @@ let # The fetchers. fetch_ fetches specs of type . # - fetch_file = spec: + fetch_file = pkgs: spec: if spec.builtin or true then builtins_fetchurl { inherit (spec) url sha256; } else pkgs.fetchurl { inherit (spec) url sha256; }; - fetch_tarball = spec: + fetch_tarball = pkgs: spec: if spec.builtin or true then builtins_fetchTarball { inherit (spec) url sha256; } else @@ -43,27 +43,21 @@ let '' (builtins_fetchurl { inherit (spec) url sha256; }); - # - # The sources to fetch. - # - - sources = builtins.fromJSON (builtins.readFile ./sources.json); - # # Various helpers # # The set of packages used when specs are fetched using non-builtins. - pkgs = + mkPkgs = sources: if hasNixpkgsPath then if hasThisAsNixpkgsPath - then import (builtins_fetchTarball { inherit (sources_nixpkgs) url sha256; }) {} + then import (builtins_fetchTarball { inherit (mkNixpkgs sources) url sha256; }) {} else import {} 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 then sources.nixpkgs else abort @@ -77,12 +71,12 @@ let (builtins.tryEval ).success && == ./.; # The actual fetching function. - fetch = name: spec: + fetch = pkgs: name: spec: if ! builtins.hasAttr "type" spec then abort "ERROR: niv spec ${name} does not have a 'type' attribute" - else if spec.type == "file" then fetch_file spec - else if spec.type == "tarball" then fetch_tarball spec + else if spec.type == "file" then fetch_file pkgs spec + else if spec.type == "tarball" then fetch_tarball pkgs 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-url" then fetch_builtin-url spec @@ -117,12 +111,26 @@ let else 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 -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 name spec; } -) sources +mkSources (mkConfig {}) // + { __functor = _: settings: mkSources (mkConfig settings); } diff --git a/package.yaml b/package.yaml index f4f48f2..774579e 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: niv -version: 0.2.6 +version: 0.2.7 license: MIT author: Nicolas Mattia maintainer: Nicolas Mattia diff --git a/src/Data/Text/Extended.hs b/src/Data/Text/Extended.hs index b869dac..f8e7c2d 100644 --- a/src/Data/Text/Extended.hs +++ b/src/Data/Text/Extended.hs @@ -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 diff --git a/src/Niv/Cli.hs b/src/Niv/Cli.hs index a159625..953a608 100644 --- a/src/Niv/Cli.hs +++ b/src/Niv/Cli.hs @@ -10,11 +10,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 +38,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 +67,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 +96,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 +105,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 +119,10 @@ cmdInit = do if shouldUpdateNixSourcesNix content then do say "Updating sources.nix" - B.writeFile path initNixSourcesNixContent + li $ 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 +143,39 @@ 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 <- li $ Dir.doesFileExist 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 - createFile :: FilePath -> B.ByteString -> IO () - createFile path content = do + createFile :: FilePath -> B.ByteString -> NIO () + createFile path content = li $ 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 +246,51 @@ parseCmdArgs cmd = collapse <$> parseNameAndShortcut <*> parsePackageSpec cmd Opts.help "Set the package name to " ) -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 <$> li (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 +303,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 +328,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 +342,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 +367,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 +391,7 @@ partitionEithersHMS = -- MODIFY ------------------------------------------------------------------------------- -parseCmdModify :: Opts.ParserInfo (IO ()) +parseCmdModify :: Opts.ParserInfo (NIO ()) parseCmdModify = Opts.info ((cmdModify <$> parsePackage) <**> Opts.helper) $ @@ -364,22 +407,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 +443,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 +496,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 <> "." diff --git a/src/Niv/Logger.hs b/src/Niv/Logger.hs index 1763e19..951a26a 100644 --- a/src/Niv/Logger.hs +++ b/src/Niv/Logger.hs @@ -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 = diff --git a/src/Niv/Sources.hs b/src/Niv/Sources.hs index bfb1fdf..0180570 100644 --- a/src/Niv/Sources.hs +++ b/src/Niv/Sources.hs @@ -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.: @@ -136,6 +143,7 @@ data SourcesNixVersion | V10 | V11 | V12 + | V13 deriving stock (Bounded, Enum, Eq) -- | A user friendly version @@ -153,6 +161,7 @@ sourcesVersionToText = \case V10 -> "10" V11 -> "11" V12 -> "12" + V13 -> "13" latestVersionMD5 :: T.Text latestVersionMD5 = sourcesVersionToMD5 maxBound @@ -177,6 +186,7 @@ sourcesVersionToMD5 = \case V10 -> "d8625c0a03dd935e1c79f46407faa8d3" V11 -> "8a95b7d93b16f7c7515d98f49b0ec741" V12 -> "2f9629ad9a8f181ed71d2a59b454970c" + V13 -> "5e23c56b92eaade4e664cb16dcac1e0a" -- | The MD5 sum of ./nix/sources.nix sourcesNixMD5 :: IO T.Text