mirror of
https://github.com/nmattia/niv.git
synced 2024-11-29 09:42:35 +03:00
Merge pull request #144 from nmattia/nm-modules
Extract modules out of Niv.Cli
This commit is contained in:
commit
29b4dd4dc3
@ -27,6 +27,10 @@ with rec
|
||||
"^app$"
|
||||
"^app.*.hs$"
|
||||
"^src$"
|
||||
"^src/Data$"
|
||||
"^src/Data/Aeson$"
|
||||
"^src/Data/HashMap$"
|
||||
"^src/Data/HashMap/Strict$"
|
||||
"^src/Niv$"
|
||||
"^src/Niv/GitHub$"
|
||||
"^src/Niv/Update$"
|
||||
|
17
src/Data/Aeson/Extended.hs
Normal file
17
src/Data/Aeson/Extended.hs
Normal file
@ -0,0 +1,17 @@
|
||||
module Data.Aeson.Extended where
|
||||
|
||||
import Data.Aeson (ToJSON)
|
||||
import qualified Data.Aeson.Encode.Pretty as AesonPretty
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
|
||||
--- Aeson
|
||||
|
||||
-- | Efficiently prettify and serialize a JSON value as a lazy 'BL.ByteString'
|
||||
-- and write it to a file.
|
||||
encodeFilePretty :: (ToJSON a) => FilePath -> a -> IO ()
|
||||
encodeFilePretty fp = BL.writeFile fp . AesonPretty.encodePretty' config
|
||||
where
|
||||
config = AesonPretty.defConfig {
|
||||
AesonPretty.confTrailingNewline = True,
|
||||
AesonPretty.confCompare = compare
|
||||
}
|
40
src/Data/HashMap/Strict/Extended.hs
Normal file
40
src/Data/HashMap/Strict/Extended.hs
Normal file
@ -0,0 +1,40 @@
|
||||
|
||||
module Data.HashMap.Strict.Extended where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Hashable (Hashable)
|
||||
import qualified Data.HashMap.Strict as HMS
|
||||
|
||||
--- 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
|
142
src/Niv/Cli.hs
142
src/Niv/Cli.hs
@ -11,16 +11,17 @@ module Niv.Cli where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey, (.=))
|
||||
import Data.Bifunctor (first)
|
||||
import Data.Aeson ((.=))
|
||||
import Data.Char (isSpace)
|
||||
import Data.FileEmbed (embedFile)
|
||||
import Data.Functor
|
||||
import Data.HashMap.Strict.Extended
|
||||
import Data.Hashable (Hashable)
|
||||
import Data.String.QQ (s)
|
||||
import Data.Version (showVersion)
|
||||
import Niv.GitHub
|
||||
import Niv.Logger
|
||||
import Niv.Sources
|
||||
import Niv.Update
|
||||
import System.Environment (getArgs)
|
||||
import System.Exit (ExitCode(ExitSuccess))
|
||||
@ -28,10 +29,8 @@ import System.FilePath ((</>), takeDirectory)
|
||||
import System.Process (readProcessWithExitCode)
|
||||
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
|
||||
@ -68,63 +67,10 @@ parseCommand = Opts.subparser (
|
||||
Opts.command "modify" parseCmdModify <>
|
||||
Opts.command "drop" parseCmdDrop )
|
||||
|
||||
newtype Sources = Sources
|
||||
{ unSources :: HMS.HashMap PackageName PackageSpec }
|
||||
deriving newtype (FromJSON, ToJSON)
|
||||
|
||||
data SourcesError
|
||||
= SourcesDoesntExist
|
||||
| SourceIsntJSON
|
||||
| SpecIsntAMap
|
||||
|
||||
getSourcesEither :: IO (Either SourcesError Sources)
|
||||
getSourcesEither = do
|
||||
Dir.doesFileExist pathNixSourcesJson >>= \case
|
||||
False -> pure $ Left SourcesDoesntExist
|
||||
True ->
|
||||
decodeFileStrict pathNixSourcesJson >>= \case
|
||||
Just value -> case valueToSources value of
|
||||
Nothing -> pure $ Left SpecIsntAMap
|
||||
Just srcs -> pure $ Right srcs
|
||||
Nothing -> pure $ Left SourceIsntJSON
|
||||
where
|
||||
valueToSources :: Aeson.Value -> Maybe Sources
|
||||
valueToSources = \case
|
||||
Aeson.Object obj -> fmap (Sources . mapKeys PackageName) $ traverse
|
||||
(\case
|
||||
Aeson.Object obj' -> Just (PackageSpec obj')
|
||||
_ -> Nothing
|
||||
) obj
|
||||
_ -> Nothing
|
||||
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 =
|
||||
getSourcesEither >>= either
|
||||
(\case
|
||||
SourcesDoesntExist -> abortSourcesDoesntExist
|
||||
SourceIsntJSON -> abortSourcesIsntJSON
|
||||
SpecIsntAMap -> abortSpecIsntAMap
|
||||
) pure
|
||||
|
||||
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 . fmap snd
|
||||
|
||||
parsePackageSpec :: Opts.Parser PackageSpec
|
||||
parsePackageSpec =
|
||||
(PackageSpec . HMS.fromList . fmap fixupAttributes) <$>
|
||||
@ -505,60 +451,6 @@ cmdDrop packageName = \case
|
||||
-- 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, AesonPretty.confCompare = compare }
|
||||
|
||||
--- 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
|
||||
|
||||
nixPrefetchURL :: Bool -> T.Text -> IO T.Text
|
||||
nixPrefetchURL unpack (T.unpack -> url) = do
|
||||
(exitCode, sout, serr) <- runNixPrefetch
|
||||
@ -617,10 +509,6 @@ pathNixSourcesNix = "nix" </> "sources.nix"
|
||||
initNixSourcesNixContent :: B.ByteString
|
||||
initNixSourcesNixContent = $(embedFile "nix/sources.nix")
|
||||
|
||||
-- | @nix/sources.json"
|
||||
pathNixSourcesJson :: FilePath
|
||||
pathNixSourcesJson = "nix" </> "sources.json"
|
||||
|
||||
-- | Empty JSON map
|
||||
initNixSourcesJsonContent :: B.ByteString
|
||||
initNixSourcesJsonContent = "{}"
|
||||
@ -633,14 +521,6 @@ githubUpdate' = githubUpdate nixPrefetchURL githubLatestRev githubRepo
|
||||
-- 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
|
||||
@ -651,22 +531,6 @@ specification, e.g.:
|
||||
{ ... }
|
||||
|]
|
||||
|
||||
abortSpecIsntAMap :: IO a
|
||||
abortSpecIsntAMap = 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 <> "."
|
||||
|
105
src/Niv/Sources.hs
Normal file
105
src/Niv/Sources.hs
Normal file
@ -0,0 +1,105 @@
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Niv.Sources where
|
||||
|
||||
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
|
||||
import Data.Bifunctor (first)
|
||||
import Data.Hashable (Hashable)
|
||||
import Data.String.QQ (s)
|
||||
import Niv.GitHub
|
||||
import Niv.Update
|
||||
import System.FilePath ((</>))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.Aeson.Extended as Aeson
|
||||
import qualified Data.HashMap.Strict as HMS
|
||||
import qualified Data.Text as T
|
||||
import qualified System.Directory as Dir
|
||||
|
||||
data SourcesError
|
||||
= SourcesDoesntExist
|
||||
| SourceIsntJSON
|
||||
| SpecIsntAMap
|
||||
|
||||
newtype Sources = Sources
|
||||
{ unSources :: HMS.HashMap PackageName PackageSpec }
|
||||
deriving newtype (FromJSON, ToJSON)
|
||||
|
||||
getSourcesEither :: IO (Either SourcesError Sources)
|
||||
getSourcesEither = do
|
||||
Dir.doesFileExist pathNixSourcesJson >>= \case
|
||||
False -> pure $ Left SourcesDoesntExist
|
||||
True ->
|
||||
Aeson.decodeFileStrict pathNixSourcesJson >>= \case
|
||||
Just value -> case valueToSources value of
|
||||
Nothing -> pure $ Left SpecIsntAMap
|
||||
Just srcs -> pure $ Right srcs
|
||||
Nothing -> pure $ Left SourceIsntJSON
|
||||
where
|
||||
valueToSources :: Aeson.Value -> Maybe Sources
|
||||
valueToSources = \case
|
||||
Aeson.Object obj -> fmap (Sources . mapKeys PackageName) $ traverse
|
||||
(\case
|
||||
Aeson.Object obj' -> Just (PackageSpec obj')
|
||||
_ -> Nothing
|
||||
) obj
|
||||
_ -> Nothing
|
||||
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 =
|
||||
getSourcesEither >>= either
|
||||
(\case
|
||||
SourcesDoesntExist -> abortSourcesDoesntExist
|
||||
SourceIsntJSON -> abortSourcesIsntJSON
|
||||
SpecIsntAMap -> abortSpecIsntAMap
|
||||
) pure
|
||||
|
||||
setSources :: Sources -> IO ()
|
||||
setSources sources = Aeson.encodeFilePretty pathNixSourcesJson sources
|
||||
|
||||
newtype PackageName = PackageName { unPackageName :: T.Text }
|
||||
deriving newtype (Eq, Hashable, FromJSONKey, ToJSONKey, Show)
|
||||
|
||||
newtype PackageSpec = PackageSpec { unPackageSpec :: Aeson.Object }
|
||||
deriving newtype (FromJSON, ToJSON, Show, Semigroup, Monoid)
|
||||
|
||||
-- | Simply discards the 'Freedom'
|
||||
attrsToSpec :: Attrs -> PackageSpec
|
||||
attrsToSpec = PackageSpec . fmap snd
|
||||
|
||||
-- | @nix/sources.json@
|
||||
pathNixSourcesJson :: FilePath
|
||||
pathNixSourcesJson = "nix" </> "sources.json"
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- ABORT messages
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
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'.
|
||||
|]
|
||||
|
||||
abortSourcesIsntJSON :: IO a
|
||||
abortSourcesIsntJSON = abort $ T.unlines [ line1, line2 ]
|
||||
where
|
||||
line1 = "Cannot use " <> T.pack pathNixSourcesJson
|
||||
line2 = "The sources file should be JSON."
|
||||
|
||||
abortSpecIsntAMap :: IO a
|
||||
abortSpecIsntAMap = 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" } }
|
||||
|]
|
Loading…
Reference in New Issue
Block a user