nmattia/niv
1
1
Fork 0
mirror of https://github.com/nmattia/niv.git synced 2024-11-26 07:37:44 +03:00
Code Issues Projects Releases Wiki Activity

HMap -> HMS

Browse Source
This commit is contained in:
Nicolas Mattia 2019-05-14 14:36:31 +02:00
parent 8464154e38
commit 023807d5fe
1 changed files with 30 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
app/Niv.hs
View File

@ -27,7 +27,7 @@ import qualified Data.Aeson.Encode.Pretty as AesonPretty
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.HashMap.Strict as HMap import qualified Data.HashMap.Strict as HMS
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified GitHub as GH import qualified GitHub as GH
@ -54,7 +54,7 @@ parseCommand = Opts.subparser (
Opts.command "drop" parseCmdDrop ) Opts.command "drop" parseCmdDrop )
newtype Sources = Sources newtype Sources = Sources
{ unSources :: HMap.HashMap PackageName PackageSpec } { unSources :: HMS.HashMap PackageName PackageSpec }
deriving newtype (FromJSON, ToJSON) deriving newtype (FromJSON, ToJSON)
getSources :: IO Sources getSources :: IO Sources
@ -68,10 +68,10 @@ getSources = do
decodeFileStrict pathNixSourcesJson >>= \case decodeFileStrict pathNixSourcesJson >>= \case
Just (Aeson.Object obj) -> Just (Aeson.Object obj) ->
fmap (Sources . mconcat) $ fmap (Sources . mconcat) $
forM (HMap.toList obj) $ \(k, v) -> forM (HMS.toList obj) $ \(k, v) ->
case v of case v of
Aeson.Object v' -> Aeson.Object v' ->
pure $ HMap.singleton (PackageName k) (PackageSpec v') pure $ HMS.singleton (PackageName k) (PackageSpec v')
_ -> abortAttributeIsntAMap _ -> abortAttributeIsntAMap
Just _ -> abortSourcesIsntAMap Just _ -> abortSourcesIsntAMap
Nothing -> abortSourcesIsntJSON Nothing -> abortSourcesIsntJSON
@ -91,7 +91,7 @@ newtype PackageSpec = PackageSpec { _unPackageSpec :: Aeson.Object }
parsePackageSpec :: Opts.Parser PackageSpec parsePackageSpec :: Opts.Parser PackageSpec
parsePackageSpec = parsePackageSpec =
(PackageSpec . HMap.fromList . fmap fixupAttributes) <$> (PackageSpec . HMS.fromList . fmap fixupAttributes) <$>
many parseAttribute many parseAttribute
where where
parseAttribute :: Opts.Parser (T.Text, T.Text) parseAttribute :: Opts.Parser (T.Text, T.Text)
@ -283,18 +283,18 @@ getPackageSpecAttr
-> StateT PackageSpec IO (Maybe Aeson.Value) -> StateT PackageSpec IO (Maybe Aeson.Value)
getPackageSpecAttr attrName = do getPackageSpecAttr attrName = do
PackageSpec obj <- get PackageSpec obj <- get
pure $ HMap.lookup attrName obj pure $ HMS.lookup attrName obj
setPackageSpecAttr setPackageSpecAttr
:: T.Text -> Aeson.Value :: T.Text -> Aeson.Value
-> StateT PackageSpec IO () -> StateT PackageSpec IO ()
setPackageSpecAttr attrName attrValue = do setPackageSpecAttr attrName attrValue = do
PackageSpec obj <- get PackageSpec obj <- get
let obj' = HMap.insert attrName attrValue obj let obj' = HMS.insert attrName attrValue obj
put (PackageSpec obj') put (PackageSpec obj')
packageSpecStringValues :: PackageSpec -> [(String, String)] packageSpecStringValues :: PackageSpec -> [(String, String)]
packageSpecStringValues (PackageSpec m) = mapMaybe toVal (HMap.toList m) packageSpecStringValues (PackageSpec m) = mapMaybe toVal (HMS.toList m)
where where
toVal :: (T.Text, Aeson.Value) -> Maybe (String, String) toVal :: (T.Text, Aeson.Value) -> Maybe (String, String)
toVal = \case toVal = \case
@ -334,12 +334,12 @@ cmdInit = do
createFile path initNixSourcesJsonContent createFile path initNixSourcesJsonContent
-- Imports @niv@ and @nixpkgs@ (18.09) -- Imports @niv@ and @nixpkgs@ (18.09)
putStrLn "Importing 'niv' ..." putStrLn "Importing 'niv' ..."
cmdAdd Nothing (PackageName "nmattia/niv", PackageSpec HMap.empty) cmdAdd Nothing (PackageName "nmattia/niv", PackageSpec HMS.empty)
putStrLn "Importing 'nixpkgs' ..." putStrLn "Importing 'nixpkgs' ..."
cmdAdd cmdAdd
(Just (PackageName "nixpkgs")) (Just (PackageName "nixpkgs"))
( PackageName "NixOS/nixpkgs-channels" ( PackageName "NixOS/nixpkgs-channels"
, PackageSpec (HMap.singleton "branch" "nixos-18.09")) , PackageSpec (HMS.singleton "branch" "nixos-18.09"))
, \path _content -> dontCreateFile path) , \path _content -> dontCreateFile path)
] $ \(path, onCreate, onUpdate) -> do ] $ \(path, onCreate, onUpdate) -> do
exists <- Dir.doesFileExist path exists <- Dir.doesFileExist path
@ -399,14 +399,14 @@ cmdAdd mPackageName (PackageName str, spec) = do
let packageName' = fromMaybe packageName mPackageName let packageName' = fromMaybe packageName mPackageName
when (HMap.member packageName' sources) $ when (HMS.member packageName' sources) $
abortCannotAddPackageExists packageName' abortCannotAddPackageExists packageName'
spec'' <- updatePackageSpec =<< completePackageSpec spec' spec'' <- updatePackageSpec =<< completePackageSpec spec'
putStrLn $ "Writing new sources file" putStrLn $ "Writing new sources file"
setSources $ Sources $ setSources $ Sources $
HMap.insert packageName' spec'' sources HMS.insert packageName' spec'' sources
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- SHOW -- SHOW
@ -423,7 +423,7 @@ cmdShow = do
forWithKeyM_ sources $ \key (PackageSpec spec) -> do forWithKeyM_ sources $ \key (PackageSpec spec) -> do
T.putStrLn $ "Package: " <> unPackageName key T.putStrLn $ "Package: " <> unPackageName key
forM_ (HMap.toList spec) $ \(attrName, attrValValue) -> do forM_ (HMS.toList spec) $ \(attrName, attrValValue) -> do
let attrValue = case attrValValue of let attrValue = case attrValValue of
Aeson.String str -> str Aeson.String str -> str
_ -> "<barabajagal>" _ -> "<barabajagal>"
@ -456,7 +456,7 @@ cmdUpdate = \case
T.putStrLn $ "Updating single package: " <> unPackageName packageName T.putStrLn $ "Updating single package: " <> unPackageName packageName
sources <- unSources <$> getSources sources <- unSources <$> getSources
packageSpec' <- case HMap.lookup packageName sources of packageSpec' <- case HMS.lookup packageName sources of
Just packageSpec' -> do Just packageSpec' -> do
-- TODO: something fishy happening here -- TODO: something fishy happening here
@ -466,7 +466,7 @@ cmdUpdate = \case
Nothing -> abortCannotUpdateNoSuchPackage packageName Nothing -> abortCannotUpdateNoSuchPackage packageName
setSources $ Sources $ setSources $ Sources $
HMap.insert packageName packageSpec' sources HMS.insert packageName packageSpec' sources
Nothing -> do Nothing -> do
sources <- unSources <$> getSources sources <- unSources <$> getSources
@ -508,26 +508,26 @@ cmdDrop packageName = \case
T.putStrLn $ "Dropping package: " <> unPackageName packageName T.putStrLn $ "Dropping package: " <> unPackageName packageName
sources <- unSources <$> getSources sources <- unSources <$> getSources
when (not $ HMap.member packageName sources) $ when (not $ HMS.member packageName sources) $
abortCannotDropNoSuchPackage packageName abortCannotDropNoSuchPackage packageName
setSources $ Sources $ setSources $ Sources $
HMap.delete packageName sources HMS.delete packageName sources
attrs -> do attrs -> do
putStrLn $ "Dropping attributes :" <> putStrLn $ "Dropping attributes :" <>
(T.unpack (T.intercalate " " attrs)) (T.unpack (T.intercalate " " attrs))
T.putStrLn $ "In package: " <> unPackageName packageName T.putStrLn $ "In package: " <> unPackageName packageName
sources <- unSources <$> getSources sources <- unSources <$> getSources
packageSpec <- case HMap.lookup packageName sources of packageSpec <- case HMS.lookup packageName sources of
Nothing -> Nothing ->
abortCannotAttributesDropNoSuchPackage packageName abortCannotAttributesDropNoSuchPackage packageName
Just (PackageSpec packageSpec) -> pure $ PackageSpec $ Just (PackageSpec packageSpec) -> pure $ PackageSpec $
HMap.mapMaybeWithKey HMS.mapMaybeWithKey
(\k v -> if k `elem` attrs then Nothing else Just v) packageSpec (\k v -> if k `elem` attrs then Nothing else Just v) packageSpec
setSources $ Sources $ setSources $ Sources $
HMap.insert packageName packageSpec sources HMS.insert packageName packageSpec sources
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- Aux -- Aux
@ -557,14 +557,14 @@ encodeFile fp = L.writeFile fp . AesonPretty.encodePretty' config
forWithKeyM forWithKeyM
:: (Eq k, Hashable k, Monad m) :: (Eq k, Hashable k, Monad m)
=> HMap.HashMap k v1 => HMS.HashMap k v1
-> (k -> v1 -> m v2) -> (k -> v1 -> m v2)
-> m (HMap.HashMap k v2) -> m (HMS.HashMap k v2)
forWithKeyM = flip mapWithKeyM forWithKeyM = flip mapWithKeyM
forWithKeyM_ forWithKeyM_
:: (Eq k, Hashable k, Monad m) :: (Eq k, Hashable k, Monad m)
=> HMap.HashMap k v1 => HMS.HashMap k v1
-> (k -> v1 -> m ()) -> (k -> v1 -> m ())
-> m () -> m ()
forWithKeyM_ = flip mapWithKeyM_ forWithKeyM_ = flip mapWithKeyM_
@ -572,20 +572,20 @@ forWithKeyM_ = flip mapWithKeyM_
mapWithKeyM mapWithKeyM
:: (Eq k, Hashable k, Monad m) :: (Eq k, Hashable k, Monad m)
=> (k -> v1 -> m v2) => (k -> v1 -> m v2)
-> HMap.HashMap k v1 -> HMS.HashMap k v1
-> m (HMap.HashMap k v2) -> m (HMS.HashMap k v2)
mapWithKeyM f m = do mapWithKeyM f m = do
fmap mconcat $ forM (HMap.toList m) $ \(k, v) -> fmap mconcat $ forM (HMS.toList m) $ \(k, v) ->
HMap.singleton k <$> f k v HMS.singleton k <$> f k v
mapWithKeyM_ mapWithKeyM_
:: (Eq k, Hashable k, Monad m) :: (Eq k, Hashable k, Monad m)
=> (k -> v1 -> m ()) => (k -> v1 -> m ())
-> HMap.HashMap k v1 -> HMS.HashMap k v1
-> m () -> m ()
mapWithKeyM_ f m = do mapWithKeyM_ f m = do
forM_ (HMap.toList m) $ \(k, v) -> forM_ (HMS.toList m) $ \(k, v) ->
HMap.singleton k <$> f k v HMS.singleton k <$> f k v
-- | Renders the template. Returns 'Nothing' if some of the attributes are -- | Renders the template. Returns 'Nothing' if some of the attributes are
-- missing. -- missing.