mirror of
https://github.com/nmattia/niv.git
synced 2024-11-25 01:42:46 +03:00
Fight cabal
This commit is contained in:
Nicolas Mattia
parent
cd066313ca
commit
7bc9e797f8
634
app/Niv.hs
634
app/Niv.hs
@ -1,634 +1,6 @@
|
|||||||
{-# LANGUAGE DerivingStrategies #-}
|
module Niv where
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
||||||
{-# LANGUAGE LambdaCase #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE TupleSections #-}
|
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
|
||||||
|
|
||||||
module Main where
|
import Niv.Cli
|
||||||
|
|
||||||
import Control.Applicative
|
|
||||||
import Control.Monad
|
|
||||||
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey, (.=))
|
|
||||||
import Data.Char (isSpace)
|
|
||||||
import Data.FileEmbed (embedFile)
|
|
||||||
import Data.Hashable (Hashable)
|
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
import Data.String.QQ (s)
|
|
||||||
import Niv.GitHub
|
|
||||||
import Niv.Update
|
|
||||||
import System.Exit (exitFailure)
|
|
||||||
import System.FilePath ((</>), takeDirectory)
|
|
||||||
import System.Process (readProcess)
|
|
||||||
import UnliftIO
|
|
||||||
import qualified Data.Aeson as Aeson
|
|
||||||
import qualified Data.Aeson.Encode.Pretty as AesonPretty
|
|
||||||
import qualified Data.ByteString as B
|
|
||||||
import qualified Data.ByteString.Char8 as B8
|
|
||||||
import qualified Data.ByteString.Lazy as L
|
|
||||||
import qualified Data.HashMap.Strict as HMS
|
|
||||||
import qualified Data.Text as T
|
|
||||||
import qualified Data.Text.IO as T
|
|
||||||
import qualified GitHub as GH
|
|
||||||
import qualified Options.Applicative as Opts
|
|
||||||
import qualified Options.Applicative.Help.Pretty as Opts
|
|
||||||
import qualified System.Directory as Dir
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = join $ Opts.execParser opts
|
main = Niv.Cli.cli
|
||||||
where
|
|
||||||
opts = Opts.info (parseCommand <**> Opts.helper) $ mconcat desc
|
|
||||||
desc =
|
|
||||||
[ Opts.fullDesc
|
|
||||||
, Opts.header "NIV - Version manager for Nix projects"
|
|
||||||
]
|
|
||||||
|
|
||||||
parseCommand :: Opts.Parser (IO ())
|
|
||||||
parseCommand = Opts.subparser (
|
|
||||||
Opts.command "init" parseCmdInit <>
|
|
||||||
Opts.command "add" parseCmdAdd <>
|
|
||||||
Opts.command "show" parseCmdShow <>
|
|
||||||
Opts.command "update" parseCmdUpdate <>
|
|
||||||
Opts.command "drop" parseCmdDrop )
|
|
||||||
|
|
||||||
newtype Sources = Sources
|
|
||||||
{ unSources :: HMS.HashMap PackageName PackageSpec }
|
|
||||||
deriving newtype (FromJSON, ToJSON)
|
|
||||||
|
|
||||||
getSources :: IO Sources
|
|
||||||
getSources = do
|
|
||||||
exists <- Dir.doesFileExist pathNixSourcesJson
|
|
||||||
unless exists abortSourcesDoesntExist
|
|
||||||
|
|
||||||
warnIfOutdated
|
|
||||||
-- TODO: if doesn't exist: run niv init
|
|
||||||
putStrLn $ "Reading sources file"
|
|
||||||
decodeFileStrict pathNixSourcesJson >>= \case
|
|
||||||
Just (Aeson.Object obj) ->
|
|
||||||
fmap (Sources . mconcat) $
|
|
||||||
forM (HMS.toList obj) $ \(k, v) ->
|
|
||||||
case v of
|
|
||||||
Aeson.Object v' ->
|
|
||||||
pure $ HMS.singleton (PackageName k) (PackageSpec v')
|
|
||||||
_ -> abortAttributeIsntAMap
|
|
||||||
Just _ -> abortSourcesIsntAMap
|
|
||||||
Nothing -> abortSourcesIsntJSON
|
|
||||||
|
|
||||||
setSources :: Sources -> IO ()
|
|
||||||
setSources sources = encodeFile pathNixSourcesJson sources
|
|
||||||
|
|
||||||
newtype PackageName = PackageName { unPackageName :: T.Text }
|
|
||||||
deriving newtype (Eq, Hashable, FromJSONKey, ToJSONKey, Show)
|
|
||||||
|
|
||||||
parsePackageName :: Opts.Parser PackageName
|
|
||||||
parsePackageName = PackageName <$>
|
|
||||||
Opts.argument Opts.str (Opts.metavar "PACKAGE")
|
|
||||||
|
|
||||||
newtype PackageSpec = PackageSpec { unPackageSpec :: Aeson.Object }
|
|
||||||
deriving newtype (FromJSON, ToJSON, Show, Semigroup, Monoid)
|
|
||||||
|
|
||||||
-- | Simply discards the 'Freedom'
|
|
||||||
attrsToSpec :: Attrs -> PackageSpec
|
|
||||||
attrsToSpec = PackageSpec . dropNulls . fmap snd
|
|
||||||
where
|
|
||||||
dropNulls
|
|
||||||
:: HMS.HashMap T.Text Aeson.Value
|
|
||||||
-> HMS.HashMap T.Text Aeson.Value
|
|
||||||
dropNulls = HMS.mapMaybe $ \case
|
|
||||||
x@Aeson.Object{} -> Just x
|
|
||||||
x@Aeson.Array{} -> Just x
|
|
||||||
x@Aeson.String{} -> Just x
|
|
||||||
x@Aeson.Number{} -> Just x
|
|
||||||
x@Aeson.Bool{} -> Just x
|
|
||||||
Aeson.Null -> Nothing
|
|
||||||
|
|
||||||
|
|
||||||
parsePackageSpec :: Opts.Parser PackageSpec
|
|
||||||
parsePackageSpec =
|
|
||||||
(PackageSpec . HMS.fromList . fmap fixupAttributes) <$>
|
|
||||||
many parseAttribute
|
|
||||||
where
|
|
||||||
parseAttribute :: Opts.Parser (T.Text, T.Text)
|
|
||||||
parseAttribute =
|
|
||||||
Opts.option (Opts.maybeReader parseKeyVal)
|
|
||||||
( Opts.long "attribute" <>
|
|
||||||
Opts.short 'a' <>
|
|
||||||
Opts.metavar "KEY=VAL" <>
|
|
||||||
Opts.help "Set the package spec attribute <KEY> to <VAL>"
|
|
||||||
) <|> shortcutAttributes <|>
|
|
||||||
(("url_template",) <$> Opts.strOption
|
|
||||||
( Opts.long "template" <>
|
|
||||||
Opts.short 't' <>
|
|
||||||
Opts.metavar "URL" <>
|
|
||||||
Opts.help "Used during 'update' when building URL. Occurrences of <foo> are replaced with attribute 'foo'."
|
|
||||||
)) <|>
|
|
||||||
(("type",) <$> Opts.strOption
|
|
||||||
( Opts.long "type" <>
|
|
||||||
Opts.short 'T' <>
|
|
||||||
Opts.metavar "TYPE" <>
|
|
||||||
Opts.help "The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL."
|
|
||||||
))
|
|
||||||
|
|
||||||
-- Parse "key=val" into ("key", "val")
|
|
||||||
parseKeyVal :: String -> Maybe (T.Text, T.Text)
|
|
||||||
parseKeyVal str = case span (/= '=') str of
|
|
||||||
(key, '=':val) -> Just (T.pack key, T.pack val)
|
|
||||||
_ -> Nothing
|
|
||||||
|
|
||||||
-- Shortcuts for common attributes
|
|
||||||
shortcutAttributes :: Opts.Parser (T.Text, T.Text)
|
|
||||||
shortcutAttributes = foldr (<|>) empty $ mkShortcutAttribute <$>
|
|
||||||
[ "branch", "owner", "repo", "version" ]
|
|
||||||
|
|
||||||
-- TODO: infer those shortcuts from 'Update' keys
|
|
||||||
mkShortcutAttribute :: T.Text -> Opts.Parser (T.Text, T.Text)
|
|
||||||
mkShortcutAttribute = \case
|
|
||||||
attr@(T.uncons -> Just (c,_)) -> (attr,) <$> Opts.strOption
|
|
||||||
( Opts.long (T.unpack attr) <>
|
|
||||||
Opts.short c <>
|
|
||||||
Opts.metavar (T.unpack $ T.toUpper attr) <>
|
|
||||||
Opts.help
|
|
||||||
( T.unpack $
|
|
||||||
"Equivalent to --attribute " <>
|
|
||||||
attr <> "=<" <> (T.toUpper attr) <> ">"
|
|
||||||
)
|
|
||||||
)
|
|
||||||
_ -> empty
|
|
||||||
|
|
||||||
fixupAttributes :: (T.Text, T.Text) -> (T.Text, Aeson.Value)
|
|
||||||
fixupAttributes (k, v) = (k, Aeson.String v)
|
|
||||||
|
|
||||||
parsePackage :: Opts.Parser (PackageName, PackageSpec)
|
|
||||||
parsePackage = (,) <$> parsePackageName <*> parsePackageSpec
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- INIT
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
parseCmdInit :: Opts.ParserInfo (IO ())
|
|
||||||
parseCmdInit = Opts.info (pure cmdInit <**> Opts.helper) $ mconcat desc
|
|
||||||
where
|
|
||||||
desc =
|
|
||||||
[ Opts.fullDesc
|
|
||||||
, Opts.progDesc
|
|
||||||
"Initialize a Nix project. Existing files won't be modified."
|
|
||||||
]
|
|
||||||
|
|
||||||
cmdInit :: IO ()
|
|
||||||
cmdInit = do
|
|
||||||
|
|
||||||
-- Writes all the default files
|
|
||||||
-- a path, a "create" function and an update function for each file.
|
|
||||||
forM_
|
|
||||||
[ ( pathNixSourcesNix
|
|
||||||
, (`createFile` initNixSourcesNixContent)
|
|
||||||
, \path content -> do
|
|
||||||
if shouldUpdateNixSourcesNix content
|
|
||||||
then do
|
|
||||||
putStrLn "Updating sources.nix"
|
|
||||||
B.writeFile path initNixSourcesNixContent
|
|
||||||
else putStrLn "Not updating sources.nix"
|
|
||||||
)
|
|
||||||
, ( pathNixSourcesJson
|
|
||||||
, \path -> do
|
|
||||||
createFile path initNixSourcesJsonContent
|
|
||||||
-- Imports @niv@ and @nixpkgs@ (18.09)
|
|
||||||
putStrLn "Importing 'niv' ..."
|
|
||||||
cmdAdd Nothing (PackageName "nmattia/niv", PackageSpec HMS.empty)
|
|
||||||
putStrLn "Importing 'nixpkgs' ..."
|
|
||||||
cmdAdd
|
|
||||||
(Just (PackageName "nixpkgs"))
|
|
||||||
( PackageName "NixOS/nixpkgs-channels"
|
|
||||||
, PackageSpec (HMS.singleton "branch" "nixos-18.09"))
|
|
||||||
, \path _content -> dontCreateFile path)
|
|
||||||
] $ \(path, onCreate, onUpdate) -> do
|
|
||||||
exists <- Dir.doesFileExist path
|
|
||||||
if exists then B.readFile path >>= onUpdate path else onCreate path
|
|
||||||
where
|
|
||||||
createFile :: FilePath -> B.ByteString -> IO ()
|
|
||||||
createFile path content = do
|
|
||||||
let dir = takeDirectory path
|
|
||||||
Dir.createDirectoryIfMissing True dir
|
|
||||||
putStrLn $ "Creating " <> path
|
|
||||||
B.writeFile path content
|
|
||||||
dontCreateFile :: FilePath -> IO ()
|
|
||||||
dontCreateFile path = putStrLn $ "Not creating " <> path
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- ADD
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
parseCmdAdd :: Opts.ParserInfo (IO ())
|
|
||||||
parseCmdAdd =
|
|
||||||
Opts.info ((cmdAdd <$> optName <*> parsePackage) <**> Opts.helper) $
|
|
||||||
mconcat desc
|
|
||||||
where
|
|
||||||
optName :: Opts.Parser (Maybe PackageName)
|
|
||||||
optName = Opts.optional $ PackageName <$> Opts.strOption
|
|
||||||
( Opts.long "name" <>
|
|
||||||
Opts.short 'n' <>
|
|
||||||
Opts.metavar "NAME" <>
|
|
||||||
Opts.help "Set the package name to <NAME>"
|
|
||||||
)
|
|
||||||
desc =
|
|
||||||
[ Opts.fullDesc
|
|
||||||
, Opts.progDesc "Add dependency"
|
|
||||||
, Opts.headerDoc $ Just $
|
|
||||||
"Examples:" Opts.<$$>
|
|
||||||
"" Opts.<$$>
|
|
||||||
" niv add stedolan/jq" Opts.<$$>
|
|
||||||
" niv add NixOS/nixpkgs-channels -n nixpkgs -b nixos-18.09" Opts.<$$>
|
|
||||||
" niv add my-package -v alpha-0.1 -t http://example.com/archive/<version>.zip"
|
|
||||||
]
|
|
||||||
|
|
||||||
cmdAdd :: Maybe PackageName -> (PackageName, PackageSpec) -> IO ()
|
|
||||||
cmdAdd mPackageName (PackageName str, cliSpec) = do
|
|
||||||
|
|
||||||
-- Figures out the owner and repo
|
|
||||||
let (packageName, defaultSpec) = case T.span (/= '/') str of
|
|
||||||
( owner@(T.null -> False)
|
|
||||||
, T.uncons -> Just ('/', repo@(T.null -> False))) -> do
|
|
||||||
(PackageName repo, HMS.fromList [ "owner" .= owner, "repo" .= repo ])
|
|
||||||
_ -> (PackageName str, HMS.empty)
|
|
||||||
|
|
||||||
sources <- unSources <$> getSources
|
|
||||||
|
|
||||||
let packageName' = fromMaybe packageName mPackageName
|
|
||||||
|
|
||||||
when (HMS.member packageName' sources) $
|
|
||||||
abortCannotAddPackageExists packageName'
|
|
||||||
|
|
||||||
let defaultSpec' = PackageSpec $ defaultSpec
|
|
||||||
|
|
||||||
spec'' <- attrsToSpec <$> evalUpdate
|
|
||||||
(specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec')
|
|
||||||
(githubUpdate nixPrefetchURL githubLatestRev githubRepo)
|
|
||||||
|
|
||||||
putStrLn $ "Writing new sources file"
|
|
||||||
setSources $ Sources $
|
|
||||||
HMS.insert packageName' spec'' sources
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- SHOW
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
parseCmdShow :: Opts.ParserInfo (IO ())
|
|
||||||
parseCmdShow = Opts.info (pure cmdShow <**> Opts.helper) Opts.fullDesc
|
|
||||||
|
|
||||||
-- TODO: nicer output
|
|
||||||
cmdShow :: IO ()
|
|
||||||
cmdShow = do
|
|
||||||
putStrLn $ "Showing sources file"
|
|
||||||
|
|
||||||
sources <- unSources <$> getSources
|
|
||||||
|
|
||||||
forWithKeyM_ sources $ \key (PackageSpec spec) -> do
|
|
||||||
T.putStrLn $ "Package: " <> unPackageName key
|
|
||||||
forM_ (HMS.toList spec) $ \(attrName, attrValValue) -> do
|
|
||||||
let attrValue = case attrValValue of
|
|
||||||
Aeson.String str -> str
|
|
||||||
_ -> "<barabajagal>"
|
|
||||||
putStrLn $ " " <> T.unpack attrName <> ": " <> T.unpack attrValue
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- UPDATE
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
parseCmdUpdate :: Opts.ParserInfo (IO ())
|
|
||||||
parseCmdUpdate =
|
|
||||||
Opts.info
|
|
||||||
((cmdUpdate <$> Opts.optional parsePackage) <**> Opts.helper) $
|
|
||||||
mconcat desc
|
|
||||||
where
|
|
||||||
desc =
|
|
||||||
[ Opts.fullDesc
|
|
||||||
, Opts.progDesc "Update dependencies"
|
|
||||||
, Opts.headerDoc $ Just $
|
|
||||||
"Examples:" Opts.<$$>
|
|
||||||
"" Opts.<$$>
|
|
||||||
" niv update" Opts.<$$>
|
|
||||||
" niv update nixpkgs" Opts.<$$>
|
|
||||||
" niv update my-package -v beta-0.2"
|
|
||||||
]
|
|
||||||
|
|
||||||
specToFreeAttrs :: PackageSpec -> Attrs
|
|
||||||
specToFreeAttrs = fmap (Free,) . unPackageSpec
|
|
||||||
|
|
||||||
specToLockedAttrs :: PackageSpec -> Attrs
|
|
||||||
specToLockedAttrs = fmap (Locked,) . unPackageSpec
|
|
||||||
|
|
||||||
-- TODO: sexy logging + concurrent updates
|
|
||||||
cmdUpdate :: Maybe (PackageName, PackageSpec) -> IO ()
|
|
||||||
cmdUpdate = \case
|
|
||||||
Just (packageName, packageSpec) -> do
|
|
||||||
T.putStrLn $ "Updating single package: " <> unPackageName packageName
|
|
||||||
sources <- unSources <$> getSources
|
|
||||||
|
|
||||||
packageSpec' <- case HMS.lookup packageName sources of
|
|
||||||
Just packageSpec' -> do
|
|
||||||
attrsToSpec <$> evalUpdate
|
|
||||||
(specToLockedAttrs packageSpec <> specToFreeAttrs packageSpec')
|
|
||||||
(githubUpdate nixPrefetchURL githubLatestRev githubRepo)
|
|
||||||
|
|
||||||
Nothing -> abortCannotUpdateNoSuchPackage packageName
|
|
||||||
|
|
||||||
setSources $ Sources $
|
|
||||||
HMS.insert packageName packageSpec' sources
|
|
||||||
|
|
||||||
Nothing -> do
|
|
||||||
sources <- unSources <$> getSources
|
|
||||||
|
|
||||||
sources' <- forWithKeyM sources $
|
|
||||||
\packageName packageSpec -> do
|
|
||||||
T.putStrLn $ "Package: " <> unPackageName packageName
|
|
||||||
attrsToSpec <$> evalUpdate
|
|
||||||
(specToFreeAttrs packageSpec)
|
|
||||||
(githubUpdate nixPrefetchURL githubLatestRev githubRepo)
|
|
||||||
|
|
||||||
setSources $ Sources sources'
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- DROP
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
parseCmdDrop :: Opts.ParserInfo (IO ())
|
|
||||||
parseCmdDrop =
|
|
||||||
Opts.info
|
|
||||||
((cmdDrop <$> parsePackageName <*> parseDropAttributes) <**>
|
|
||||||
Opts.helper) $
|
|
||||||
mconcat desc
|
|
||||||
where
|
|
||||||
desc =
|
|
||||||
[ Opts.fullDesc
|
|
||||||
, Opts.progDesc "Drop dependency"
|
|
||||||
, Opts.headerDoc $ Just $
|
|
||||||
"Examples:" Opts.<$$>
|
|
||||||
"" Opts.<$$>
|
|
||||||
" niv drop jq" Opts.<$$>
|
|
||||||
" niv drop my-package version"
|
|
||||||
]
|
|
||||||
parseDropAttributes :: Opts.Parser [T.Text]
|
|
||||||
parseDropAttributes = many $
|
|
||||||
Opts.argument Opts.str (Opts.metavar "ATTRIBUTE")
|
|
||||||
|
|
||||||
cmdDrop :: PackageName -> [T.Text] -> IO ()
|
|
||||||
cmdDrop packageName = \case
|
|
||||||
[] -> do
|
|
||||||
T.putStrLn $ "Dropping package: " <> unPackageName packageName
|
|
||||||
sources <- unSources <$> getSources
|
|
||||||
|
|
||||||
when (not $ HMS.member packageName sources) $
|
|
||||||
abortCannotDropNoSuchPackage packageName
|
|
||||||
|
|
||||||
setSources $ Sources $
|
|
||||||
HMS.delete packageName sources
|
|
||||||
attrs -> do
|
|
||||||
putStrLn $ "Dropping attributes :" <>
|
|
||||||
(T.unpack (T.intercalate " " attrs))
|
|
||||||
T.putStrLn $ "In package: " <> unPackageName packageName
|
|
||||||
sources <- unSources <$> getSources
|
|
||||||
|
|
||||||
packageSpec <- case HMS.lookup packageName sources of
|
|
||||||
Nothing ->
|
|
||||||
abortCannotAttributesDropNoSuchPackage packageName
|
|
||||||
Just (PackageSpec packageSpec) -> pure $ PackageSpec $
|
|
||||||
HMS.mapMaybeWithKey
|
|
||||||
(\k v -> if k `elem` attrs then Nothing else Just v) packageSpec
|
|
||||||
|
|
||||||
setSources $ Sources $
|
|
||||||
HMS.insert packageName packageSpec sources
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- Aux
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
--- Aeson
|
|
||||||
|
|
||||||
-- | Efficiently deserialize a JSON value from a file.
|
|
||||||
-- If this fails due to incomplete or invalid input, 'Nothing' is
|
|
||||||
-- returned.
|
|
||||||
--
|
|
||||||
-- The input file's content must consist solely of a JSON document,
|
|
||||||
-- with no trailing data except for whitespace.
|
|
||||||
--
|
|
||||||
-- This function parses immediately, but defers conversion. See
|
|
||||||
-- 'json' for details.
|
|
||||||
decodeFileStrict :: (FromJSON a) => FilePath -> IO (Maybe a)
|
|
||||||
decodeFileStrict = fmap Aeson.decodeStrict . B.readFile
|
|
||||||
|
|
||||||
-- | Efficiently serialize a JSON value as a lazy 'L.ByteString' and write it to a file.
|
|
||||||
encodeFile :: (ToJSON a) => FilePath -> a -> IO ()
|
|
||||||
encodeFile fp = L.writeFile fp . AesonPretty.encodePretty' config
|
|
||||||
where
|
|
||||||
config = AesonPretty.defConfig { AesonPretty.confTrailingNewline = True }
|
|
||||||
|
|
||||||
--- HashMap
|
|
||||||
|
|
||||||
forWithKeyM
|
|
||||||
:: (Eq k, Hashable k, Monad m)
|
|
||||||
=> HMS.HashMap k v1
|
|
||||||
-> (k -> v1 -> m v2)
|
|
||||||
-> m (HMS.HashMap k v2)
|
|
||||||
forWithKeyM = flip mapWithKeyM
|
|
||||||
|
|
||||||
forWithKeyM_
|
|
||||||
:: (Eq k, Hashable k, Monad m)
|
|
||||||
=> HMS.HashMap k v1
|
|
||||||
-> (k -> v1 -> m ())
|
|
||||||
-> m ()
|
|
||||||
forWithKeyM_ = flip mapWithKeyM_
|
|
||||||
|
|
||||||
mapWithKeyM
|
|
||||||
:: (Eq k, Hashable k, Monad m)
|
|
||||||
=> (k -> v1 -> m v2)
|
|
||||||
-> HMS.HashMap k v1
|
|
||||||
-> m (HMS.HashMap k v2)
|
|
||||||
mapWithKeyM f m = do
|
|
||||||
fmap mconcat $ forM (HMS.toList m) $ \(k, v) ->
|
|
||||||
HMS.singleton k <$> f k v
|
|
||||||
|
|
||||||
mapWithKeyM_
|
|
||||||
:: (Eq k, Hashable k, Monad m)
|
|
||||||
=> (k -> v1 -> m ())
|
|
||||||
-> HMS.HashMap k v1
|
|
||||||
-> m ()
|
|
||||||
mapWithKeyM_ f m = do
|
|
||||||
forM_ (HMS.toList m) $ \(k, v) ->
|
|
||||||
HMS.singleton k <$> f k v
|
|
||||||
|
|
||||||
abort :: T.Text -> IO a
|
|
||||||
abort msg = do
|
|
||||||
T.putStrLn msg
|
|
||||||
exitFailure
|
|
||||||
|
|
||||||
nixPrefetchURL :: Bool -> T.Text -> IO T.Text
|
|
||||||
nixPrefetchURL unpack (T.unpack -> url) =
|
|
||||||
lines <$> readProcess "nix-prefetch-url" args "" >>=
|
|
||||||
\case
|
|
||||||
(l:_) -> pure (T.pack l)
|
|
||||||
_ -> abortNixPrefetchExpectedOutput
|
|
||||||
where args = if unpack then ["--unpack", url] else [url]
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- 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 content =
|
|
||||||
content /= initNixSourcesNixContent &&
|
|
||||||
not (any lineForbids (B8.lines content))
|
|
||||||
where
|
|
||||||
lineForbids :: B8.ByteString -> Bool
|
|
||||||
lineForbids str =
|
|
||||||
case B8.uncons (B8.dropWhile isSpace str) of
|
|
||||||
Just ('#',rest) -> case B8.stripPrefix "niv:" (B8.dropWhile isSpace rest) of
|
|
||||||
Just rest' -> case B8.stripPrefix "no_update" (B8.dropWhile isSpace rest') of
|
|
||||||
Just{} -> True
|
|
||||||
_ -> False
|
|
||||||
_ -> False
|
|
||||||
_ -> False
|
|
||||||
|
|
||||||
warnIfOutdated :: IO ()
|
|
||||||
warnIfOutdated = do
|
|
||||||
tryAny (B.readFile pathNixSourcesNix) >>= \case
|
|
||||||
Left e -> T.putStrLn $ T.unlines
|
|
||||||
[ "Could not read " <> T.pack pathNixSourcesNix
|
|
||||||
, "Error: " <> tshow e
|
|
||||||
]
|
|
||||||
Right content ->
|
|
||||||
if shouldUpdateNixSourcesNix content
|
|
||||||
then
|
|
||||||
T.putStrLn $ T.unlines
|
|
||||||
[ "WARNING: " <> T.pack pathNixSourcesNix <> " is out of date."
|
|
||||||
, "Please run"
|
|
||||||
, " niv init"
|
|
||||||
, "or add the following line in the " <> T.pack pathNixSourcesNix <> " file:"
|
|
||||||
, " # niv: no_update"
|
|
||||||
]
|
|
||||||
else pure ()
|
|
||||||
|
|
||||||
-- | @nix/sources.nix@
|
|
||||||
pathNixSourcesNix :: FilePath
|
|
||||||
pathNixSourcesNix = "nix" </> "sources.nix"
|
|
||||||
|
|
||||||
-- | Glue code between nix and sources.json
|
|
||||||
initNixSourcesNixContent :: B.ByteString
|
|
||||||
initNixSourcesNixContent = $(embedFile "nix/sources.nix")
|
|
||||||
|
|
||||||
-- | @nix/sources.json"
|
|
||||||
pathNixSourcesJson :: FilePath
|
|
||||||
pathNixSourcesJson = "nix" </> "sources.json"
|
|
||||||
|
|
||||||
-- | Empty JSON map
|
|
||||||
initNixSourcesJsonContent :: B.ByteString
|
|
||||||
initNixSourcesJsonContent = "{}"
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- Warn
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
warnCouldNotFetchGitHubRepo :: GH.Error -> (String, String) -> IO ()
|
|
||||||
warnCouldNotFetchGitHubRepo e (owner, repo) =
|
|
||||||
putStrLn $ unlines [ line1, line2, line3 ]
|
|
||||||
where
|
|
||||||
line1 = "WARNING: Could not read from GitHub repo: " <> owner <> "/" <> repo
|
|
||||||
line2 = [s|
|
|
||||||
I assumed that your package was a GitHub repository. An error occurred while
|
|
||||||
gathering information from the repository. Check whether your package was added
|
|
||||||
correctly:
|
|
||||||
|
|
||||||
niv show
|
|
||||||
|
|
||||||
If not, try re-adding it:
|
|
||||||
|
|
||||||
niv drop <package>
|
|
||||||
niv add <package-without-typo>
|
|
||||||
|
|
||||||
Make sure the repository exists.
|
|
||||||
|]
|
|
||||||
line3 = unwords [ "(Error was:", show e, ")" ]
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- Abort
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
abortSourcesDoesntExist :: IO a
|
|
||||||
abortSourcesDoesntExist = abort $ T.unlines [ line1, line2 ]
|
|
||||||
where
|
|
||||||
line1 = "Cannot use " <> T.pack pathNixSourcesJson
|
|
||||||
line2 = [s|
|
|
||||||
The sources file does not exist! You may need to run 'niv init'.
|
|
||||||
|]
|
|
||||||
|
|
||||||
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.:
|
|
||||||
{ ... }
|
|
||||||
|]
|
|
||||||
|
|
||||||
abortAttributeIsntAMap :: IO a
|
|
||||||
abortAttributeIsntAMap = abort $ T.unlines [ line1, line2 ]
|
|
||||||
where
|
|
||||||
line1 = "Cannot use " <> T.pack pathNixSourcesJson
|
|
||||||
line2 = [s|
|
|
||||||
The package specifications in the sources file should be JSON maps from
|
|
||||||
attribute name to attribute value, e.g.:
|
|
||||||
{ "nixpkgs": { "foo": "bar" } }
|
|
||||||
|]
|
|
||||||
|
|
||||||
abortSourcesIsntJSON :: IO a
|
|
||||||
abortSourcesIsntJSON = abort $ T.unlines [ line1, line2 ]
|
|
||||||
where
|
|
||||||
line1 = "Cannot use " <> T.pack pathNixSourcesJson
|
|
||||||
line2 = "The sources file should be JSON."
|
|
||||||
|
|
||||||
abortCannotAddPackageExists :: PackageName -> IO a
|
|
||||||
abortCannotAddPackageExists (PackageName n) = abort $ T.unlines
|
|
||||||
[ "Cannot add package " <> n <> "."
|
|
||||||
, "The package already exists. Use"
|
|
||||||
, " niv drop " <> n
|
|
||||||
, "and then re-add the package. Alternatively use"
|
|
||||||
, " niv update " <> n <> " --attr foo=bar"
|
|
||||||
, "to update the package's attributes."
|
|
||||||
]
|
|
||||||
|
|
||||||
abortCannotUpdateNoSuchPackage :: PackageName -> IO a
|
|
||||||
abortCannotUpdateNoSuchPackage (PackageName n) = abort $ T.unlines
|
|
||||||
[ "Cannot update package " <> n <> "."
|
|
||||||
, "The package doesn't exist. Use"
|
|
||||||
, " niv add " <> n
|
|
||||||
, "to add the package."
|
|
||||||
]
|
|
||||||
|
|
||||||
abortCannotDropNoSuchPackage :: PackageName -> IO a
|
|
||||||
abortCannotDropNoSuchPackage (PackageName n) = abort $ T.unlines
|
|
||||||
[ "Cannot drop package " <> n <> "."
|
|
||||||
, "The package doesn't exist."
|
|
||||||
]
|
|
||||||
|
|
||||||
abortCannotAttributesDropNoSuchPackage :: PackageName -> IO a
|
|
||||||
abortCannotAttributesDropNoSuchPackage (PackageName n) = abort $ T.unlines
|
|
||||||
[ "Cannot drop attributes of package " <> n <> "."
|
|
||||||
, "The package doesn't exist."
|
|
||||||
]
|
|
||||||
|
|
||||||
abortNixPrefetchExpectedOutput :: IO a
|
|
||||||
abortNixPrefetchExpectedOutput = abort [s|
|
|
||||||
Could not read the output of 'nix-prefetch-url'. This is a bug. Please create a
|
|
||||||
ticket:
|
|
||||||
|
|
||||||
https://github.com/nmattia/niv/issues/new
|
|
||||||
|
|
||||||
Thanks! I'll buy you a beer.
|
|
||||||
|]
|
|
||||||
|
|
||||||
tshow :: Show a => a -> T.Text
|
|
||||||
tshow = T.pack . show
|
|
||||||
|
|||||||
6
app/NivTest.hs
Normal file
6
app/NivTest.hs
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
module NivTest where
|
||||||
|
|
||||||
|
import Niv.Test
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = Niv.Test.test
|
||||||
@ -1,8 +0,0 @@
|
|||||||
module Main where
|
|
||||||
|
|
||||||
import Niv.Test
|
|
||||||
import qualified Test.Tasty as Tasty
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = Tasty.defaultMain $ Niv.Test.tests
|
|
||||||
|
|
||||||
@ -35,7 +35,7 @@ with rec
|
|||||||
''
|
''
|
||||||
repl() {
|
repl() {
|
||||||
shopt -s globstar
|
shopt -s globstar
|
||||||
ghci -Wall app/**/*.hs src/**/*.hs
|
ghci -Wall app/NivTest.hs src/**/*.hs
|
||||||
}
|
}
|
||||||
|
|
||||||
echo "To start a REPL session, run:"
|
echo "To start a REPL session, run:"
|
||||||
|
|||||||
32
package.yaml
32
package.yaml
@ -10,10 +10,22 @@ ghc-options:
|
|||||||
- -optP-Wno-nonportable-include-path
|
- -optP-Wno-nonportable-include-path
|
||||||
|
|
||||||
dependencies:
|
dependencies:
|
||||||
|
- aeson
|
||||||
|
- aeson-pretty
|
||||||
- base
|
- base
|
||||||
- text
|
- bytestring
|
||||||
|
- directory
|
||||||
|
- file-embed
|
||||||
|
- filepath
|
||||||
|
- github
|
||||||
|
- hashable
|
||||||
- mtl
|
- mtl
|
||||||
|
- optparse-applicative
|
||||||
|
- process
|
||||||
|
- string-qq
|
||||||
|
- text
|
||||||
- unliftio
|
- unliftio
|
||||||
|
- unordered-containers
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs:
|
source-dirs:
|
||||||
@ -27,25 +39,15 @@ library:
|
|||||||
|
|
||||||
executables:
|
executables:
|
||||||
niv:
|
niv:
|
||||||
main: app/niv.hs
|
main: Niv.main
|
||||||
|
source-dirs: app
|
||||||
data-files:
|
data-files:
|
||||||
- nix/sources.nix
|
- nix/sources.nix
|
||||||
dependencies:
|
dependencies:
|
||||||
- aeson
|
|
||||||
- aeson-pretty
|
|
||||||
- bytestring
|
|
||||||
- directory
|
|
||||||
- filepath
|
|
||||||
- github
|
|
||||||
- hashable
|
|
||||||
- file-embed
|
|
||||||
- niv
|
- niv
|
||||||
- optparse-applicative
|
|
||||||
- process
|
|
||||||
- string-qq
|
|
||||||
- unordered-containers
|
|
||||||
niv-test:
|
niv-test:
|
||||||
main: app/test.hs
|
main: NivTest.main
|
||||||
|
source-dirs: app
|
||||||
dependencies:
|
dependencies:
|
||||||
- tasty
|
- tasty
|
||||||
- niv
|
- niv
|
||||||
|
|||||||
634
src/Niv/Cli.hs
Normal file
634
src/Niv/Cli.hs
Normal file
@ -0,0 +1,634 @@
|
|||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
|
||||||
|
module Niv.Cli where
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
|
import Control.Monad
|
||||||
|
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey, (.=))
|
||||||
|
import Data.Char (isSpace)
|
||||||
|
import Data.FileEmbed (embedFile)
|
||||||
|
import Data.Hashable (Hashable)
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.String.QQ (s)
|
||||||
|
import Niv.GitHub
|
||||||
|
import Niv.Update
|
||||||
|
import System.Exit (exitFailure)
|
||||||
|
import System.FilePath ((</>), takeDirectory)
|
||||||
|
import System.Process (readProcess)
|
||||||
|
import UnliftIO
|
||||||
|
import qualified Data.Aeson as Aeson
|
||||||
|
import qualified Data.Aeson.Encode.Pretty as AesonPretty
|
||||||
|
import qualified Data.ByteString as B
|
||||||
|
import qualified Data.ByteString.Char8 as B8
|
||||||
|
import qualified Data.ByteString.Lazy as L
|
||||||
|
import qualified Data.HashMap.Strict as HMS
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.IO as T
|
||||||
|
import qualified GitHub as GH
|
||||||
|
import qualified Options.Applicative as Opts
|
||||||
|
import qualified Options.Applicative.Help.Pretty as Opts
|
||||||
|
import qualified System.Directory as Dir
|
||||||
|
|
||||||
|
cli :: IO ()
|
||||||
|
cli = join $ Opts.execParser opts
|
||||||
|
where
|
||||||
|
opts = Opts.info (parseCommand <**> Opts.helper) $ mconcat desc
|
||||||
|
desc =
|
||||||
|
[ Opts.fullDesc
|
||||||
|
, Opts.header "NIV - Version manager for Nix projects"
|
||||||
|
]
|
||||||
|
|
||||||
|
parseCommand :: Opts.Parser (IO ())
|
||||||
|
parseCommand = Opts.subparser (
|
||||||
|
Opts.command "init" parseCmdInit <>
|
||||||
|
Opts.command "add" parseCmdAdd <>
|
||||||
|
Opts.command "show" parseCmdShow <>
|
||||||
|
Opts.command "update" parseCmdUpdate <>
|
||||||
|
Opts.command "drop" parseCmdDrop )
|
||||||
|
|
||||||
|
newtype Sources = Sources
|
||||||
|
{ unSources :: HMS.HashMap PackageName PackageSpec }
|
||||||
|
deriving newtype (FromJSON, ToJSON)
|
||||||
|
|
||||||
|
getSources :: IO Sources
|
||||||
|
getSources = do
|
||||||
|
exists <- Dir.doesFileExist pathNixSourcesJson
|
||||||
|
unless exists abortSourcesDoesntExist
|
||||||
|
|
||||||
|
warnIfOutdated
|
||||||
|
-- TODO: if doesn't exist: run niv init
|
||||||
|
putStrLn $ "Reading sources file"
|
||||||
|
decodeFileStrict pathNixSourcesJson >>= \case
|
||||||
|
Just (Aeson.Object obj) ->
|
||||||
|
fmap (Sources . mconcat) $
|
||||||
|
forM (HMS.toList obj) $ \(k, v) ->
|
||||||
|
case v of
|
||||||
|
Aeson.Object v' ->
|
||||||
|
pure $ HMS.singleton (PackageName k) (PackageSpec v')
|
||||||
|
_ -> abortAttributeIsntAMap
|
||||||
|
Just _ -> abortSourcesIsntAMap
|
||||||
|
Nothing -> abortSourcesIsntJSON
|
||||||
|
|
||||||
|
setSources :: Sources -> IO ()
|
||||||
|
setSources sources = encodeFile pathNixSourcesJson sources
|
||||||
|
|
||||||
|
newtype PackageName = PackageName { unPackageName :: T.Text }
|
||||||
|
deriving newtype (Eq, Hashable, FromJSONKey, ToJSONKey, Show)
|
||||||
|
|
||||||
|
parsePackageName :: Opts.Parser PackageName
|
||||||
|
parsePackageName = PackageName <$>
|
||||||
|
Opts.argument Opts.str (Opts.metavar "PACKAGE")
|
||||||
|
|
||||||
|
newtype PackageSpec = PackageSpec { unPackageSpec :: Aeson.Object }
|
||||||
|
deriving newtype (FromJSON, ToJSON, Show, Semigroup, Monoid)
|
||||||
|
|
||||||
|
-- | Simply discards the 'Freedom'
|
||||||
|
attrsToSpec :: Attrs -> PackageSpec
|
||||||
|
attrsToSpec = PackageSpec . dropNulls . fmap snd
|
||||||
|
where
|
||||||
|
dropNulls
|
||||||
|
:: HMS.HashMap T.Text Aeson.Value
|
||||||
|
-> HMS.HashMap T.Text Aeson.Value
|
||||||
|
dropNulls = HMS.mapMaybe $ \case
|
||||||
|
x@Aeson.Object{} -> Just x
|
||||||
|
x@Aeson.Array{} -> Just x
|
||||||
|
x@Aeson.String{} -> Just x
|
||||||
|
x@Aeson.Number{} -> Just x
|
||||||
|
x@Aeson.Bool{} -> Just x
|
||||||
|
Aeson.Null -> Nothing
|
||||||
|
|
||||||
|
|
||||||
|
parsePackageSpec :: Opts.Parser PackageSpec
|
||||||
|
parsePackageSpec =
|
||||||
|
(PackageSpec . HMS.fromList . fmap fixupAttributes) <$>
|
||||||
|
many parseAttribute
|
||||||
|
where
|
||||||
|
parseAttribute :: Opts.Parser (T.Text, T.Text)
|
||||||
|
parseAttribute =
|
||||||
|
Opts.option (Opts.maybeReader parseKeyVal)
|
||||||
|
( Opts.long "attribute" <>
|
||||||
|
Opts.short 'a' <>
|
||||||
|
Opts.metavar "KEY=VAL" <>
|
||||||
|
Opts.help "Set the package spec attribute <KEY> to <VAL>"
|
||||||
|
) <|> shortcutAttributes <|>
|
||||||
|
(("url_template",) <$> Opts.strOption
|
||||||
|
( Opts.long "template" <>
|
||||||
|
Opts.short 't' <>
|
||||||
|
Opts.metavar "URL" <>
|
||||||
|
Opts.help "Used during 'update' when building URL. Occurrences of <foo> are replaced with attribute 'foo'."
|
||||||
|
)) <|>
|
||||||
|
(("type",) <$> Opts.strOption
|
||||||
|
( Opts.long "type" <>
|
||||||
|
Opts.short 'T' <>
|
||||||
|
Opts.metavar "TYPE" <>
|
||||||
|
Opts.help "The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL."
|
||||||
|
))
|
||||||
|
|
||||||
|
-- Parse "key=val" into ("key", "val")
|
||||||
|
parseKeyVal :: String -> Maybe (T.Text, T.Text)
|
||||||
|
parseKeyVal str = case span (/= '=') str of
|
||||||
|
(key, '=':val) -> Just (T.pack key, T.pack val)
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
-- Shortcuts for common attributes
|
||||||
|
shortcutAttributes :: Opts.Parser (T.Text, T.Text)
|
||||||
|
shortcutAttributes = foldr (<|>) empty $ mkShortcutAttribute <$>
|
||||||
|
[ "branch", "owner", "repo", "version" ]
|
||||||
|
|
||||||
|
-- TODO: infer those shortcuts from 'Update' keys
|
||||||
|
mkShortcutAttribute :: T.Text -> Opts.Parser (T.Text, T.Text)
|
||||||
|
mkShortcutAttribute = \case
|
||||||
|
attr@(T.uncons -> Just (c,_)) -> (attr,) <$> Opts.strOption
|
||||||
|
( Opts.long (T.unpack attr) <>
|
||||||
|
Opts.short c <>
|
||||||
|
Opts.metavar (T.unpack $ T.toUpper attr) <>
|
||||||
|
Opts.help
|
||||||
|
( T.unpack $
|
||||||
|
"Equivalent to --attribute " <>
|
||||||
|
attr <> "=<" <> (T.toUpper attr) <> ">"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
_ -> empty
|
||||||
|
|
||||||
|
fixupAttributes :: (T.Text, T.Text) -> (T.Text, Aeson.Value)
|
||||||
|
fixupAttributes (k, v) = (k, Aeson.String v)
|
||||||
|
|
||||||
|
parsePackage :: Opts.Parser (PackageName, PackageSpec)
|
||||||
|
parsePackage = (,) <$> parsePackageName <*> parsePackageSpec
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- INIT
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
parseCmdInit :: Opts.ParserInfo (IO ())
|
||||||
|
parseCmdInit = Opts.info (pure cmdInit <**> Opts.helper) $ mconcat desc
|
||||||
|
where
|
||||||
|
desc =
|
||||||
|
[ Opts.fullDesc
|
||||||
|
, Opts.progDesc
|
||||||
|
"Initialize a Nix project. Existing files won't be modified."
|
||||||
|
]
|
||||||
|
|
||||||
|
cmdInit :: IO ()
|
||||||
|
cmdInit = do
|
||||||
|
|
||||||
|
-- Writes all the default files
|
||||||
|
-- a path, a "create" function and an update function for each file.
|
||||||
|
forM_
|
||||||
|
[ ( pathNixSourcesNix
|
||||||
|
, (`createFile` initNixSourcesNixContent)
|
||||||
|
, \path content -> do
|
||||||
|
if shouldUpdateNixSourcesNix content
|
||||||
|
then do
|
||||||
|
putStrLn "Updating sources.nix"
|
||||||
|
B.writeFile path initNixSourcesNixContent
|
||||||
|
else putStrLn "Not updating sources.nix"
|
||||||
|
)
|
||||||
|
, ( pathNixSourcesJson
|
||||||
|
, \path -> do
|
||||||
|
createFile path initNixSourcesJsonContent
|
||||||
|
-- Imports @niv@ and @nixpkgs@ (18.09)
|
||||||
|
putStrLn "Importing 'niv' ..."
|
||||||
|
cmdAdd Nothing (PackageName "nmattia/niv", PackageSpec HMS.empty)
|
||||||
|
putStrLn "Importing 'nixpkgs' ..."
|
||||||
|
cmdAdd
|
||||||
|
(Just (PackageName "nixpkgs"))
|
||||||
|
( PackageName "NixOS/nixpkgs-channels"
|
||||||
|
, PackageSpec (HMS.singleton "branch" "nixos-18.09"))
|
||||||
|
, \path _content -> dontCreateFile path)
|
||||||
|
] $ \(path, onCreate, onUpdate) -> do
|
||||||
|
exists <- Dir.doesFileExist path
|
||||||
|
if exists then B.readFile path >>= onUpdate path else onCreate path
|
||||||
|
where
|
||||||
|
createFile :: FilePath -> B.ByteString -> IO ()
|
||||||
|
createFile path content = do
|
||||||
|
let dir = takeDirectory path
|
||||||
|
Dir.createDirectoryIfMissing True dir
|
||||||
|
putStrLn $ "Creating " <> path
|
||||||
|
B.writeFile path content
|
||||||
|
dontCreateFile :: FilePath -> IO ()
|
||||||
|
dontCreateFile path = putStrLn $ "Not creating " <> path
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- ADD
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
parseCmdAdd :: Opts.ParserInfo (IO ())
|
||||||
|
parseCmdAdd =
|
||||||
|
Opts.info ((cmdAdd <$> optName <*> parsePackage) <**> Opts.helper) $
|
||||||
|
mconcat desc
|
||||||
|
where
|
||||||
|
optName :: Opts.Parser (Maybe PackageName)
|
||||||
|
optName = Opts.optional $ PackageName <$> Opts.strOption
|
||||||
|
( Opts.long "name" <>
|
||||||
|
Opts.short 'n' <>
|
||||||
|
Opts.metavar "NAME" <>
|
||||||
|
Opts.help "Set the package name to <NAME>"
|
||||||
|
)
|
||||||
|
desc =
|
||||||
|
[ Opts.fullDesc
|
||||||
|
, Opts.progDesc "Add dependency"
|
||||||
|
, Opts.headerDoc $ Just $
|
||||||
|
"Examples:" Opts.<$$>
|
||||||
|
"" Opts.<$$>
|
||||||
|
" niv add stedolan/jq" Opts.<$$>
|
||||||
|
" niv add NixOS/nixpkgs-channels -n nixpkgs -b nixos-18.09" Opts.<$$>
|
||||||
|
" niv add my-package -v alpha-0.1 -t http://example.com/archive/<version>.zip"
|
||||||
|
]
|
||||||
|
|
||||||
|
cmdAdd :: Maybe PackageName -> (PackageName, PackageSpec) -> IO ()
|
||||||
|
cmdAdd mPackageName (PackageName str, cliSpec) = do
|
||||||
|
|
||||||
|
-- Figures out the owner and repo
|
||||||
|
let (packageName, defaultSpec) = case T.span (/= '/') str of
|
||||||
|
( owner@(T.null -> False)
|
||||||
|
, T.uncons -> Just ('/', repo@(T.null -> False))) -> do
|
||||||
|
(PackageName repo, HMS.fromList [ "owner" .= owner, "repo" .= repo ])
|
||||||
|
_ -> (PackageName str, HMS.empty)
|
||||||
|
|
||||||
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
|
let packageName' = fromMaybe packageName mPackageName
|
||||||
|
|
||||||
|
when (HMS.member packageName' sources) $
|
||||||
|
abortCannotAddPackageExists packageName'
|
||||||
|
|
||||||
|
let defaultSpec' = PackageSpec $ defaultSpec
|
||||||
|
|
||||||
|
finalSpec <- attrsToSpec <$> evalUpdate
|
||||||
|
(specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec')
|
||||||
|
(githubUpdate nixPrefetchURL githubLatestRev githubRepo)
|
||||||
|
|
||||||
|
putStrLn $ "Writing new sources file"
|
||||||
|
setSources $ Sources $
|
||||||
|
HMS.insert packageName' finalSpec sources
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- SHOW
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
parseCmdShow :: Opts.ParserInfo (IO ())
|
||||||
|
parseCmdShow = Opts.info (pure cmdShow <**> Opts.helper) Opts.fullDesc
|
||||||
|
|
||||||
|
-- TODO: nicer output
|
||||||
|
cmdShow :: IO ()
|
||||||
|
cmdShow = do
|
||||||
|
putStrLn $ "Showing sources file"
|
||||||
|
|
||||||
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
|
forWithKeyM_ sources $ \key (PackageSpec spec) -> do
|
||||||
|
T.putStrLn $ "Package: " <> unPackageName key
|
||||||
|
forM_ (HMS.toList spec) $ \(attrName, attrValValue) -> do
|
||||||
|
let attrValue = case attrValValue of
|
||||||
|
Aeson.String str -> str
|
||||||
|
_ -> "<barabajagal>"
|
||||||
|
putStrLn $ " " <> T.unpack attrName <> ": " <> T.unpack attrValue
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- UPDATE
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
parseCmdUpdate :: Opts.ParserInfo (IO ())
|
||||||
|
parseCmdUpdate =
|
||||||
|
Opts.info
|
||||||
|
((cmdUpdate <$> Opts.optional parsePackage) <**> Opts.helper) $
|
||||||
|
mconcat desc
|
||||||
|
where
|
||||||
|
desc =
|
||||||
|
[ Opts.fullDesc
|
||||||
|
, Opts.progDesc "Update dependencies"
|
||||||
|
, Opts.headerDoc $ Just $
|
||||||
|
"Examples:" Opts.<$$>
|
||||||
|
"" Opts.<$$>
|
||||||
|
" niv update" Opts.<$$>
|
||||||
|
" niv update nixpkgs" Opts.<$$>
|
||||||
|
" niv update my-package -v beta-0.2"
|
||||||
|
]
|
||||||
|
|
||||||
|
specToFreeAttrs :: PackageSpec -> Attrs
|
||||||
|
specToFreeAttrs = fmap (Free,) . unPackageSpec
|
||||||
|
|
||||||
|
specToLockedAttrs :: PackageSpec -> Attrs
|
||||||
|
specToLockedAttrs = fmap (Locked,) . unPackageSpec
|
||||||
|
|
||||||
|
-- TODO: sexy logging + concurrent updates
|
||||||
|
cmdUpdate :: Maybe (PackageName, PackageSpec) -> IO ()
|
||||||
|
cmdUpdate = \case
|
||||||
|
Just (packageName, cliSpec) -> do
|
||||||
|
T.putStrLn $ "Updating single package: " <> unPackageName packageName
|
||||||
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
|
finalSpec <- case HMS.lookup packageName sources of
|
||||||
|
Just defaultSpec -> do
|
||||||
|
attrsToSpec <$> evalUpdate
|
||||||
|
(specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec)
|
||||||
|
(githubUpdate nixPrefetchURL githubLatestRev githubRepo)
|
||||||
|
|
||||||
|
Nothing -> abortCannotUpdateNoSuchPackage packageName
|
||||||
|
|
||||||
|
setSources $ Sources $
|
||||||
|
HMS.insert packageName finalSpec sources
|
||||||
|
|
||||||
|
Nothing -> do
|
||||||
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
|
sources' <- forWithKeyM sources $
|
||||||
|
\packageName defaultSpec -> do
|
||||||
|
T.putStrLn $ "Package: " <> unPackageName packageName
|
||||||
|
attrsToSpec <$> evalUpdate
|
||||||
|
(specToFreeAttrs defaultSpec)
|
||||||
|
(githubUpdate nixPrefetchURL githubLatestRev githubRepo)
|
||||||
|
|
||||||
|
setSources $ Sources sources'
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- DROP
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
parseCmdDrop :: Opts.ParserInfo (IO ())
|
||||||
|
parseCmdDrop =
|
||||||
|
Opts.info
|
||||||
|
((cmdDrop <$> parsePackageName <*> parseDropAttributes) <**>
|
||||||
|
Opts.helper) $
|
||||||
|
mconcat desc
|
||||||
|
where
|
||||||
|
desc =
|
||||||
|
[ Opts.fullDesc
|
||||||
|
, Opts.progDesc "Drop dependency"
|
||||||
|
, Opts.headerDoc $ Just $
|
||||||
|
"Examples:" Opts.<$$>
|
||||||
|
"" Opts.<$$>
|
||||||
|
" niv drop jq" Opts.<$$>
|
||||||
|
" niv drop my-package version"
|
||||||
|
]
|
||||||
|
parseDropAttributes :: Opts.Parser [T.Text]
|
||||||
|
parseDropAttributes = many $
|
||||||
|
Opts.argument Opts.str (Opts.metavar "ATTRIBUTE")
|
||||||
|
|
||||||
|
cmdDrop :: PackageName -> [T.Text] -> IO ()
|
||||||
|
cmdDrop packageName = \case
|
||||||
|
[] -> do
|
||||||
|
T.putStrLn $ "Dropping package: " <> unPackageName packageName
|
||||||
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
|
when (not $ HMS.member packageName sources) $
|
||||||
|
abortCannotDropNoSuchPackage packageName
|
||||||
|
|
||||||
|
setSources $ Sources $
|
||||||
|
HMS.delete packageName sources
|
||||||
|
attrs -> do
|
||||||
|
putStrLn $ "Dropping attributes :" <>
|
||||||
|
(T.unpack (T.intercalate " " attrs))
|
||||||
|
T.putStrLn $ "In package: " <> unPackageName packageName
|
||||||
|
sources <- unSources <$> getSources
|
||||||
|
|
||||||
|
packageSpec <- case HMS.lookup packageName sources of
|
||||||
|
Nothing ->
|
||||||
|
abortCannotAttributesDropNoSuchPackage packageName
|
||||||
|
Just (PackageSpec packageSpec) -> pure $ PackageSpec $
|
||||||
|
HMS.mapMaybeWithKey
|
||||||
|
(\k v -> if k `elem` attrs then Nothing else Just v) packageSpec
|
||||||
|
|
||||||
|
setSources $ Sources $
|
||||||
|
HMS.insert packageName packageSpec sources
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Aux
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
--- Aeson
|
||||||
|
|
||||||
|
-- | Efficiently deserialize a JSON value from a file.
|
||||||
|
-- If this fails due to incomplete or invalid input, 'Nothing' is
|
||||||
|
-- returned.
|
||||||
|
--
|
||||||
|
-- The input file's content must consist solely of a JSON document,
|
||||||
|
-- with no trailing data except for whitespace.
|
||||||
|
--
|
||||||
|
-- This function parses immediately, but defers conversion. See
|
||||||
|
-- 'json' for details.
|
||||||
|
decodeFileStrict :: (FromJSON a) => FilePath -> IO (Maybe a)
|
||||||
|
decodeFileStrict = fmap Aeson.decodeStrict . B.readFile
|
||||||
|
|
||||||
|
-- | Efficiently serialize a JSON value as a lazy 'L.ByteString' and write it to a file.
|
||||||
|
encodeFile :: (ToJSON a) => FilePath -> a -> IO ()
|
||||||
|
encodeFile fp = L.writeFile fp . AesonPretty.encodePretty' config
|
||||||
|
where
|
||||||
|
config = AesonPretty.defConfig { AesonPretty.confTrailingNewline = True }
|
||||||
|
|
||||||
|
--- HashMap
|
||||||
|
|
||||||
|
forWithKeyM
|
||||||
|
:: (Eq k, Hashable k, Monad m)
|
||||||
|
=> HMS.HashMap k v1
|
||||||
|
-> (k -> v1 -> m v2)
|
||||||
|
-> m (HMS.HashMap k v2)
|
||||||
|
forWithKeyM = flip mapWithKeyM
|
||||||
|
|
||||||
|
forWithKeyM_
|
||||||
|
:: (Eq k, Hashable k, Monad m)
|
||||||
|
=> HMS.HashMap k v1
|
||||||
|
-> (k -> v1 -> m ())
|
||||||
|
-> m ()
|
||||||
|
forWithKeyM_ = flip mapWithKeyM_
|
||||||
|
|
||||||
|
mapWithKeyM
|
||||||
|
:: (Eq k, Hashable k, Monad m)
|
||||||
|
=> (k -> v1 -> m v2)
|
||||||
|
-> HMS.HashMap k v1
|
||||||
|
-> m (HMS.HashMap k v2)
|
||||||
|
mapWithKeyM f m = do
|
||||||
|
fmap mconcat $ forM (HMS.toList m) $ \(k, v) ->
|
||||||
|
HMS.singleton k <$> f k v
|
||||||
|
|
||||||
|
mapWithKeyM_
|
||||||
|
:: (Eq k, Hashable k, Monad m)
|
||||||
|
=> (k -> v1 -> m ())
|
||||||
|
-> HMS.HashMap k v1
|
||||||
|
-> m ()
|
||||||
|
mapWithKeyM_ f m = do
|
||||||
|
forM_ (HMS.toList m) $ \(k, v) ->
|
||||||
|
HMS.singleton k <$> f k v
|
||||||
|
|
||||||
|
abort :: T.Text -> IO a
|
||||||
|
abort msg = do
|
||||||
|
T.putStrLn msg
|
||||||
|
exitFailure
|
||||||
|
|
||||||
|
nixPrefetchURL :: Bool -> T.Text -> IO T.Text
|
||||||
|
nixPrefetchURL unpack (T.unpack -> url) =
|
||||||
|
lines <$> readProcess "nix-prefetch-url" args "" >>=
|
||||||
|
\case
|
||||||
|
(l:_) -> pure (T.pack l)
|
||||||
|
_ -> abortNixPrefetchExpectedOutput
|
||||||
|
where args = if unpack then ["--unpack", url] else [url]
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- 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 content =
|
||||||
|
content /= initNixSourcesNixContent &&
|
||||||
|
not (any lineForbids (B8.lines content))
|
||||||
|
where
|
||||||
|
lineForbids :: B8.ByteString -> Bool
|
||||||
|
lineForbids str =
|
||||||
|
case B8.uncons (B8.dropWhile isSpace str) of
|
||||||
|
Just ('#',rest) -> case B8.stripPrefix "niv:" (B8.dropWhile isSpace rest) of
|
||||||
|
Just rest' -> case B8.stripPrefix "no_update" (B8.dropWhile isSpace rest') of
|
||||||
|
Just{} -> True
|
||||||
|
_ -> False
|
||||||
|
_ -> False
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
warnIfOutdated :: IO ()
|
||||||
|
warnIfOutdated = do
|
||||||
|
tryAny (B.readFile pathNixSourcesNix) >>= \case
|
||||||
|
Left e -> T.putStrLn $ T.unlines
|
||||||
|
[ "Could not read " <> T.pack pathNixSourcesNix
|
||||||
|
, "Error: " <> tshow e
|
||||||
|
]
|
||||||
|
Right content ->
|
||||||
|
if shouldUpdateNixSourcesNix content
|
||||||
|
then
|
||||||
|
T.putStrLn $ T.unlines
|
||||||
|
[ "WARNING: " <> T.pack pathNixSourcesNix <> " is out of date."
|
||||||
|
, "Please run"
|
||||||
|
, " niv init"
|
||||||
|
, "or add the following line in the " <> T.pack pathNixSourcesNix <> " file:"
|
||||||
|
, " # niv: no_update"
|
||||||
|
]
|
||||||
|
else pure ()
|
||||||
|
|
||||||
|
-- | @nix/sources.nix@
|
||||||
|
pathNixSourcesNix :: FilePath
|
||||||
|
pathNixSourcesNix = "nix" </> "sources.nix"
|
||||||
|
|
||||||
|
-- | Glue code between nix and sources.json
|
||||||
|
initNixSourcesNixContent :: B.ByteString
|
||||||
|
initNixSourcesNixContent = $(embedFile "nix/sources.nix")
|
||||||
|
|
||||||
|
-- | @nix/sources.json"
|
||||||
|
pathNixSourcesJson :: FilePath
|
||||||
|
pathNixSourcesJson = "nix" </> "sources.json"
|
||||||
|
|
||||||
|
-- | Empty JSON map
|
||||||
|
initNixSourcesJsonContent :: B.ByteString
|
||||||
|
initNixSourcesJsonContent = "{}"
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Warn
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
warnCouldNotFetchGitHubRepo :: GH.Error -> (String, String) -> IO ()
|
||||||
|
warnCouldNotFetchGitHubRepo e (owner, repo) =
|
||||||
|
putStrLn $ unlines [ line1, line2, line3 ]
|
||||||
|
where
|
||||||
|
line1 = "WARNING: Could not read from GitHub repo: " <> owner <> "/" <> repo
|
||||||
|
line2 = [s|
|
||||||
|
I assumed that your package was a GitHub repository. An error occurred while
|
||||||
|
gathering information from the repository. Check whether your package was added
|
||||||
|
correctly:
|
||||||
|
|
||||||
|
niv show
|
||||||
|
|
||||||
|
If not, try re-adding it:
|
||||||
|
|
||||||
|
niv drop <package>
|
||||||
|
niv add <package-without-typo>
|
||||||
|
|
||||||
|
Make sure the repository exists.
|
||||||
|
|]
|
||||||
|
line3 = unwords [ "(Error was:", show e, ")" ]
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- Abort
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
abortSourcesDoesntExist :: IO a
|
||||||
|
abortSourcesDoesntExist = abort $ T.unlines [ line1, line2 ]
|
||||||
|
where
|
||||||
|
line1 = "Cannot use " <> T.pack pathNixSourcesJson
|
||||||
|
line2 = [s|
|
||||||
|
The sources file does not exist! You may need to run 'niv init'.
|
||||||
|
|]
|
||||||
|
|
||||||
|
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.:
|
||||||
|
{ ... }
|
||||||
|
|]
|
||||||
|
|
||||||
|
abortAttributeIsntAMap :: IO a
|
||||||
|
abortAttributeIsntAMap = abort $ T.unlines [ line1, line2 ]
|
||||||
|
where
|
||||||
|
line1 = "Cannot use " <> T.pack pathNixSourcesJson
|
||||||
|
line2 = [s|
|
||||||
|
The package specifications in the sources file should be JSON maps from
|
||||||
|
attribute name to attribute value, e.g.:
|
||||||
|
{ "nixpkgs": { "foo": "bar" } }
|
||||||
|
|]
|
||||||
|
|
||||||
|
abortSourcesIsntJSON :: IO a
|
||||||
|
abortSourcesIsntJSON = abort $ T.unlines [ line1, line2 ]
|
||||||
|
where
|
||||||
|
line1 = "Cannot use " <> T.pack pathNixSourcesJson
|
||||||
|
line2 = "The sources file should be JSON."
|
||||||
|
|
||||||
|
abortCannotAddPackageExists :: PackageName -> IO a
|
||||||
|
abortCannotAddPackageExists (PackageName n) = abort $ T.unlines
|
||||||
|
[ "Cannot add package " <> n <> "."
|
||||||
|
, "The package already exists. Use"
|
||||||
|
, " niv drop " <> n
|
||||||
|
, "and then re-add the package. Alternatively use"
|
||||||
|
, " niv update " <> n <> " --attr foo=bar"
|
||||||
|
, "to update the package's attributes."
|
||||||
|
]
|
||||||
|
|
||||||
|
abortCannotUpdateNoSuchPackage :: PackageName -> IO a
|
||||||
|
abortCannotUpdateNoSuchPackage (PackageName n) = abort $ T.unlines
|
||||||
|
[ "Cannot update package " <> n <> "."
|
||||||
|
, "The package doesn't exist. Use"
|
||||||
|
, " niv add " <> n
|
||||||
|
, "to add the package."
|
||||||
|
]
|
||||||
|
|
||||||
|
abortCannotDropNoSuchPackage :: PackageName -> IO a
|
||||||
|
abortCannotDropNoSuchPackage (PackageName n) = abort $ T.unlines
|
||||||
|
[ "Cannot drop package " <> n <> "."
|
||||||
|
, "The package doesn't exist."
|
||||||
|
]
|
||||||
|
|
||||||
|
abortCannotAttributesDropNoSuchPackage :: PackageName -> IO a
|
||||||
|
abortCannotAttributesDropNoSuchPackage (PackageName n) = abort $ T.unlines
|
||||||
|
[ "Cannot drop attributes of package " <> n <> "."
|
||||||
|
, "The package doesn't exist."
|
||||||
|
]
|
||||||
|
|
||||||
|
abortNixPrefetchExpectedOutput :: IO a
|
||||||
|
abortNixPrefetchExpectedOutput = abort [s|
|
||||||
|
Could not read the output of 'nix-prefetch-url'. This is a bug. Please create a
|
||||||
|
ticket:
|
||||||
|
|
||||||
|
https://github.com/nmattia/niv/issues/new
|
||||||
|
|
||||||
|
Thanks! I'll buy you a beer.
|
||||||
|
|]
|
||||||
|
|
||||||
|
tshow :: Show a => a -> T.Text
|
||||||
|
tshow = T.pack . show
|
||||||
@ -1,10 +1,13 @@
|
|||||||
module Niv.Test (tests) where
|
module Niv.Test (tests, test) where
|
||||||
|
|
||||||
import Niv.GitHub.Test
|
import Niv.GitHub.Test
|
||||||
import Niv.Update.Test
|
import Niv.Update.Test
|
||||||
import qualified Test.Tasty as Tasty
|
import qualified Test.Tasty as Tasty
|
||||||
import qualified Test.Tasty.HUnit as Tasty
|
import qualified Test.Tasty.HUnit as Tasty
|
||||||
|
|
||||||
|
test :: IO ()
|
||||||
|
test = Tasty.defaultMain tests
|
||||||
|
|
||||||
tests :: Tasty.TestTree
|
tests :: Tasty.TestTree
|
||||||
tests = Tasty.testGroup "niv"
|
tests = Tasty.testGroup "niv"
|
||||||
[ Tasty.testGroup "update"
|
[ Tasty.testGroup "update"
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user