1
1
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:
Nicolas Mattia 2019-11-20 17:51:52 +01:00 committed by GitHub
commit 29b4dd4dc3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 169 additions and 139 deletions

View File

@ -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$"

View 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
}

View 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

View File

@ -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
View 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" } }
|]