mirror of
https://github.com/nmattia/niv.git
synced 2024-09-18 19:07:19 +03:00
Add basic implementation for cmds
This commit is contained in:
parent
f3cc2718e1
commit
8ceb834aa0
189
Main.hs
189
Main.hs
@ -1,15 +1,29 @@
|
|||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
-- TODO: qualified imports
|
-- TODO: qualified imports
|
||||||
-- TODO: format code
|
-- TODO: format code
|
||||||
|
|
||||||
import Options.Applicative
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Data.Aeson
|
||||||
|
import Data.Bifunctor
|
||||||
|
import Data.HashMap.Strict as HMap
|
||||||
|
import Data.Hashable (Hashable)
|
||||||
import Data.Semigroup ((<>))
|
import Data.Semigroup ((<>))
|
||||||
|
import Options.Applicative
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
import qualified Data.ByteString as B
|
||||||
|
import qualified Data.ByteString.Lazy as L
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
fileFetchNix :: FilePath
|
fileFetchNix :: FilePath
|
||||||
fileFetchNix = "nix" </> "fetch.nix"
|
fileFetchNix = "nix" </> "fetch.nix"
|
||||||
|
|
||||||
|
-- TODO: file "nix/default.nix"
|
||||||
|
|
||||||
fileFetchNixContent :: String
|
fileFetchNixContent :: String
|
||||||
fileFetchNixContent = unlines
|
fileFetchNixContent = unlines
|
||||||
[
|
[
|
||||||
@ -26,6 +40,44 @@ fileVersionsJsonContent = unlines
|
|||||||
|
|
||||||
]
|
]
|
||||||
|
|
||||||
|
getVersionsSpec :: IO VersionsSpec
|
||||||
|
getVersionsSpec = do
|
||||||
|
putStrLn $ "Reading versions file"
|
||||||
|
decodeFileStrict fileVersionsJson >>= \case
|
||||||
|
Just (Object v) ->
|
||||||
|
fmap (VersionsSpec . mconcat) $
|
||||||
|
forM (HMap.toList v) $ \(k, v) ->
|
||||||
|
case v of
|
||||||
|
Object v' ->
|
||||||
|
pure $ HMap.singleton (PackageName (T.unpack k)) (PackageSpec v')
|
||||||
|
_ -> error "baaaaz"
|
||||||
|
Just _ -> error "foo"
|
||||||
|
Nothing -> error "Cannot decode versions"
|
||||||
|
|
||||||
|
|
||||||
|
newtype PackageName = PackageName { unPackageName :: String }
|
||||||
|
deriving newtype (Eq, Hashable, FromJSONKey, ToJSONKey)
|
||||||
|
|
||||||
|
newtype PackageSpec = PackageSpec { unPackageSpec :: Object }
|
||||||
|
deriving newtype (FromJSON, ToJSON)
|
||||||
|
|
||||||
|
newtype VersionsSpec = VersionsSpec
|
||||||
|
{ unVersionsSpec :: HMap.HashMap PackageName PackageSpec }
|
||||||
|
deriving newtype (FromJSON, ToJSON)
|
||||||
|
|
||||||
|
parsePackageName :: Parser PackageName
|
||||||
|
parsePackageName = undefined
|
||||||
|
|
||||||
|
preparePackageURL :: PackageSpec -> IO String
|
||||||
|
preparePackageURL = const $ pure "foo"
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- INIT
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
parseCmdInit :: ParserInfo (IO ())
|
||||||
|
parseCmdInit = (info (pure cmdInit <**> helper)) fullDesc
|
||||||
|
|
||||||
cmdInit :: IO ()
|
cmdInit :: IO ()
|
||||||
cmdInit = do
|
cmdInit = do
|
||||||
putStrLn "Creating directory nix (if it doesn't exist)"
|
putStrLn "Creating directory nix (if it doesn't exist)"
|
||||||
@ -53,21 +105,134 @@ cmdInit = do
|
|||||||
putStrLn $ "Writing " <> fileVersionsJson
|
putStrLn $ "Writing " <> fileVersionsJson
|
||||||
writeFile fileVersionsJson fileVersionsJsonContent
|
writeFile fileVersionsJson fileVersionsJsonContent
|
||||||
|
|
||||||
cmdAdd :: IO ()
|
-------------------------------------------------------------------------------
|
||||||
cmdAdd = putStrLn "add"
|
-- ADD
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
cmdAdd :: PackageName -> IO ()
|
||||||
|
cmdAdd packageName = do
|
||||||
|
putStrLn $ "Adding " <> unPackageName packageName
|
||||||
|
|
||||||
|
VersionsSpec versionsSpec <- getVersionsSpec
|
||||||
|
|
||||||
|
-- TODO: new package Spec
|
||||||
|
let fileVersionsValue' = versionsSpec <> HMap.empty
|
||||||
|
|
||||||
|
putStrLn $ "Writing new versions file"
|
||||||
|
encodeFile fileVersionsJson fileVersionsValue'
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- SHOW
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
cmdShow :: IO ()
|
cmdShow :: IO ()
|
||||||
cmdShow = putStrLn "show"
|
cmdShow = do
|
||||||
|
putStrLn $ "Showing versions file"
|
||||||
|
|
||||||
|
VersionsSpec fileVersionsValue <- getVersionsSpec
|
||||||
|
|
||||||
|
forWithKeyM_ fileVersionsValue $ \key (PackageSpec spec) -> do
|
||||||
|
putStrLn $ "Package: " <> unPackageName key
|
||||||
|
forM_ (HMap.toList spec) $ \(attrName, attrValValue) -> do
|
||||||
|
let attrValue = case attrValValue of
|
||||||
|
String str -> str
|
||||||
|
_ -> "<barabajagal>"
|
||||||
|
putStrLn $ " " <> T.unpack attrName <> ": " <> T.unpack attrValue
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- UPDATE
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
cmdUpdate :: IO ()
|
cmdUpdate :: IO ()
|
||||||
cmdUpdate = putStrLn "update"
|
cmdUpdate = do
|
||||||
|
putStrLn $ "Updating versions file"
|
||||||
|
|
||||||
opts :: Parser (IO ())
|
VersionsSpec fileVersionsValue <- getVersionsSpec
|
||||||
opts = subparser (
|
|
||||||
command "init" (info (pure cmdInit) idm) <>
|
fileVersionsValue' <- forWithKeyM fileVersionsValue $ \key spec -> do
|
||||||
command "add" (info (pure cmdAdd) idm) <>
|
putStrLn $ "Package: " <> unPackageName key
|
||||||
command "show" (info (pure cmdAdd) idm) <>
|
|
||||||
command "update" (info (pure cmdAdd) idm) )
|
packageUrl <- preparePackageURL spec
|
||||||
|
|
||||||
|
putStrLn $ " URL: " <> packageUrl
|
||||||
|
|
||||||
|
sha256 <- nixPrefetchURL packageUrl
|
||||||
|
|
||||||
|
putStrLn $ " SHA256: " <> sha256
|
||||||
|
|
||||||
|
putStrLn $ "Writing new versions file"
|
||||||
|
encodeFile fileVersionsJson fileVersionsValue'
|
||||||
|
|
||||||
|
parseCommand :: Parser (IO ())
|
||||||
|
parseCommand = subparser (
|
||||||
|
command "init" parseCmdInit <>
|
||||||
|
command "add" (info (cmdAdd <$> parsePackageName) idm) <>
|
||||||
|
command "show" (info (pure cmdShow) idm) <>
|
||||||
|
command "update" (info (pure cmdUpdate) idm) )
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = join $ execParser (info opts idm)
|
main = join $ execParser opts
|
||||||
|
where
|
||||||
|
opts = info (parseCommand <**> helper)
|
||||||
|
( fullDesc
|
||||||
|
<> header "NIV - Nix Version manager" )
|
||||||
|
|
||||||
|
nixPrefetchURL :: String -> IO String
|
||||||
|
nixPrefetchURL = pure
|
||||||
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
|
-- 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 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 . encode
|
||||||
|
|
||||||
|
--- HashMap
|
||||||
|
|
||||||
|
forWithKeyM
|
||||||
|
:: (Eq k, Hashable k, Monad m)
|
||||||
|
=> HMap.HashMap k v1
|
||||||
|
-> (k -> v1 -> m v2)
|
||||||
|
-> m (HMap.HashMap k v2)
|
||||||
|
forWithKeyM = flip mapWithKeyM
|
||||||
|
|
||||||
|
forWithKeyM_
|
||||||
|
:: (Eq k, Hashable k, Monad m)
|
||||||
|
=> HMap.HashMap k v1
|
||||||
|
-> (k -> v1 -> m ())
|
||||||
|
-> m ()
|
||||||
|
forWithKeyM_ = flip mapWithKeyM_
|
||||||
|
|
||||||
|
|
||||||
|
mapWithKeyM
|
||||||
|
:: (Eq k, Hashable k, Monad m)
|
||||||
|
=> (k -> v1 -> m v2)
|
||||||
|
-> HMap.HashMap k v1
|
||||||
|
-> m (HMap.HashMap k v2)
|
||||||
|
mapWithKeyM f m = do
|
||||||
|
fmap mconcat $ forM (HMap.toList m) $ \(k, v) ->
|
||||||
|
HMap.singleton k <$> f k v
|
||||||
|
|
||||||
|
mapWithKeyM_
|
||||||
|
:: (Eq k, Hashable k, Monad m)
|
||||||
|
=> (k -> v1 -> m ())
|
||||||
|
-> HMap.HashMap k v1
|
||||||
|
-> m ()
|
||||||
|
mapWithKeyM_ f m = do
|
||||||
|
forM_ (HMap.toList m) $ \(k, v) ->
|
||||||
|
HMap.singleton k <$> f k v
|
||||||
|
40
README.md
40
README.md
@ -8,9 +8,9 @@ Inside the provided nix shell:
|
|||||||
|
|
||||||
``` bash
|
``` bash
|
||||||
$ # GHCi:
|
$ # GHCi:
|
||||||
$ snack ghci -p package.yaml
|
$ snack ghci
|
||||||
$ # actual build:
|
$ # actual build:
|
||||||
$ snack build -p package.yaml
|
$ snack build
|
||||||
```
|
```
|
||||||
|
|
||||||
## Usage
|
## Usage
|
||||||
@ -48,24 +48,6 @@ let pkgs = import fetch.nixpkgs;
|
|||||||
in pkgs.hello
|
in pkgs.hello
|
||||||
```
|
```
|
||||||
|
|
||||||
#### show
|
|
||||||
|
|
||||||
`[--branch] [--rev] [--owner] [--repo] [--attribute <attribute>] <p1> <p2>`...
|
|
||||||
if no attribute (br, rev, ...) is given, all attributes are shown for
|
|
||||||
`<packages>`. Otherwise the specified attributes are shown. If no package is
|
|
||||||
specified: `<packages> = <all packages>`, otherwise `<packages>` is set to
|
|
||||||
the specified packages.
|
|
||||||
|
|
||||||
#### update
|
|
||||||
|
|
||||||
* `[p [--commit] [--branch]]`
|
|
||||||
- `[]`: all packages are updated
|
|
||||||
- `[p1 p2 ...]`: the specified packages are updated
|
|
||||||
|
|
||||||
* `--commit <rev>`: `rev` is set to `<rev>` and the package is prefetched
|
|
||||||
* `--branch <branch>`: `branch` is set to `<branch>`, `rev` is set to the
|
|
||||||
latest revision on that branch and the package is prefetched
|
|
||||||
|
|
||||||
#### add
|
#### add
|
||||||
|
|
||||||
* `<package>`: adds the following to the versions file where `let <username/repo> = <package>`
|
* `<package>`: adds the following to the versions file where `let <username/repo> = <package>`
|
||||||
@ -85,6 +67,24 @@ in pkgs.hello
|
|||||||
* `--gitlab`: use gitlab instead of GitHub
|
* `--gitlab`: use gitlab instead of GitHub
|
||||||
* `--attribute <attribute> <value>`: sets `<attribute>` to `<value>`
|
* `--attribute <attribute> <value>`: sets `<attribute>` to `<value>`
|
||||||
|
|
||||||
|
#### update
|
||||||
|
|
||||||
|
* `[p [--commit] [--branch]]`
|
||||||
|
- `[]`: all packages are updated
|
||||||
|
- `[p1 p2 ...]`: the specified packages are updated
|
||||||
|
|
||||||
|
* `--commit <rev>`: `rev` is set to `<rev>` and the package is prefetched
|
||||||
|
* `--branch <branch>`: `branch` is set to `<branch>`, `rev` is set to the
|
||||||
|
latest revision on that branch and the package is prefetched
|
||||||
|
|
||||||
|
#### show
|
||||||
|
|
||||||
|
`[--branch] [--rev] [--owner] [--repo] [--attribute <attribute>] <p1> <p2>`...
|
||||||
|
if no attribute (br, rev, ...) is given, all attributes are shown for
|
||||||
|
`<packages>`. Otherwise the specified attributes are shown. If no package is
|
||||||
|
specified: `<packages> = <all packages>`, otherwise `<packages>` is set to
|
||||||
|
the specified packages.
|
||||||
|
|
||||||
**NOTE**: should the URLs be used instead? or more simply, how do we differentiate between Gitlab/GitHub?
|
**NOTE**: should the URLs be used instead? or more simply, how do we differentiate between Gitlab/GitHub?
|
||||||
|
|
||||||
[Nix]: https://nixos.org/nix/
|
[Nix]: https://nixos.org/nix/
|
||||||
|
@ -4,6 +4,8 @@ executable:
|
|||||||
source-dirs: . # remove when https://github.com/nmattia/snack/pull/96 is merged
|
source-dirs: . # remove when https://github.com/nmattia/snack/pull/96 is merged
|
||||||
main: Main.hs
|
main: Main.hs
|
||||||
dependencies:
|
dependencies:
|
||||||
|
- aeson
|
||||||
- directory
|
- directory
|
||||||
- filepath
|
- filepath
|
||||||
- optparse-applicative
|
- optparse-applicative
|
||||||
|
- unordered-containers
|
||||||
|
Loading…
Reference in New Issue
Block a user