Add basic implementation for cmds

Main.hs

@@ -1,15 +1,29 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 -- TODO: qualified imports
 -- TODO: format code
 
-import Options.Applicative
 import Control.Monad
+import Data.Aeson
+import Data.Bifunctor
+import Data.HashMap.Strict as HMap
+import Data.Hashable (Hashable)
 import Data.Semigroup ((<>))
+import Options.Applicative
 import System.Directory
 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 = "nix" </> "fetch.nix"
 
+-- TODO: file "nix/default.nix"
+
 fileFetchNixContent :: String
 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 = do
     putStrLn "Creating directory nix (if it doesn't exist)"
@@ -53,21 +105,134 @@ cmdInit = do
       putStrLn $ "Writing " <> fileVersionsJson
       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 = 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 = putStrLn "update"
+cmdUpdate = do
+    putStrLn $ "Updating versions file"
 
-opts :: Parser (IO ())
-opts = subparser (
-    command "init" (info (pure cmdInit) idm) <>
-    command "add"  (info (pure cmdAdd) idm) <>
-    command "show"  (info (pure cmdAdd) idm) <>
-    command "update"  (info (pure cmdAdd) idm) )
+    VersionsSpec fileVersionsValue <- getVersionsSpec
+
+    fileVersionsValue' <- forWithKeyM fileVersionsValue $ \key spec -> do
+      putStrLn $ "Package: " <> unPackageName key
+
+      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 = 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

README.md

@@ -8,9 +8,9 @@ Inside the provided nix shell:
 
 ``` bash
 $ # GHCi:
-$ snack ghci -p package.yaml
+$ snack ghci
 $ # actual build:
-$ snack build -p package.yaml
+$ snack build
 ```
 
 ## Usage
@@ -48,24 +48,6 @@ let pkgs = import fetch.nixpkgs;
 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
 
 * `<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
 * `--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?
 
 [Nix]: https://nixos.org/nix/

package.yaml

@@ -4,6 +4,8 @@ executable:
     source-dirs: . # remove when https://github.com/nmattia/snack/pull/96 is merged
     main: Main.hs
     dependencies:
+        - aeson
         - directory
         - filepath
         - optparse-applicative
+        - unordered-containers