nvfetcher 0.6.1.0 → 0.6.2.0

raw patch · 10 files changed

+376/−484 lines, 10 filesdep +toml-readerdep −tomlanddep ~aesondep ~extradep ~freePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: toml-reader

Dependencies removed: tomland

Dependency ranges changed: aeson, extra, free, regex-tdfa

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +2/−0
• app/Config.hs +124/−111
• app/Config/Common.hs +23/−0
• app/Config/PackageFetcher.hs +69/−123
• app/Config/VersionSource.hs +101/−199
• app/Main.hs +6/−8
• nvfetcher.cabal +4/−3
• src/NvFetcher/FetchRustGitDeps.hs +9/−9
• src/NvFetcher/Nvchecker.hs +34/−31

@@ -1,5 +1,9 @@ # Revision history for nvfetcher +## 0.6.2.0++* Rework config parsing with toml-reader+ ## 0.6.1.0  * Replace `nix-prefetch` with `nix-prefetch-git` and `nix-prefetch-url`

@@ -224,6 +224,8 @@  - `passthru = { k1 = "v1", k2 = "v2", ... }` +Note: currently the values can only be strings+ #### Pinned  If a package is pinned, we call nvchecker to check the new version iff there's no existing version.

@@ -1,142 +1,155 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -module Config where+module Config (prettyPackageConfigParseError, parseConfig, PackageConfigValidateError (..)) where  import Config.PackageFetcher import Config.VersionSource-import Data.Coerce (coerce)-import Data.Either.Extra (mapLeft)+import Control.Monad.Trans.Except import qualified Data.HashMap.Strict as HMap-import Data.List (intersect)-import Data.List.NonEmpty (NonEmpty ((:|)))-import qualified Data.List.NonEmpty as NE+import Data.List (foldl', intersect)+import qualified Data.Map.Strict as Map import Data.Text (Text) import qualified Data.Text as T import NvFetcher.Types-import Toml-import Validation (validationToEither)+import TOML+import TOML.Decode -data PackageConfigParseError = TomlErrors [TomlDecodeError] | KeyConflicts [[Key]]+-- should be NE+newtype MyKey = MyKey {unMyKey :: [Text]} -instance Semigroup PackageConfigParseError where-  TomlErrors e <> _ = TomlErrors e-  _ <> TomlErrors e = TomlErrors e-  KeyConflicts xs <> KeyConflicts ys = KeyConflicts $ xs <> ys+myKeyToText :: MyKey -> Text+myKeyToText = T.intercalate "." . unMyKey -prettyPackageConfigParseError :: PackageConfigParseError -> Text-prettyPackageConfigParseError (TomlErrors e) = prettyTomlDecodeErrors e-prettyPackageConfigParseError (KeyConflicts xs) = "Skip parsing!\n" <> T.unlines ["Key conflict: " <> T.intercalate ", " [prettyKey k | k <- ks] | ks <- xs]+data PackageConfigValidateError+  = TomlError TOMLError+  | KeyConflicts PackageName [[Text]]+  | KeyUnexpected PackageName [Text] -parseConfig :: TOML -> Either PackageConfigParseError [Package]-parseConfig toml = go tables Nothing []-  where-    go (Left errs : xs) (Just se) sp = go xs (Just (se <> errs)) sp-    go (Left errs : xs) Nothing sp = go xs (Just errs) sp-    go (Right x : xs) se sp = go xs se (x : sp)-    go [] Nothing sp = Right sp-    go [] (Just se) _ = Left se-    tables =-      [ fmap (toPackage (coerce k)) $ validateKeys v >> mapLeft TomlErrors (validationToEither (Toml.runTomlCodec packageConfigCodec v))-        | (Toml.unKey -> (Toml.unPiece -> k) :| _, v) <- Toml.toList $ Toml.tomlTables toml-      ]+prettyPackageConfigParseError :: PackageConfigValidateError -> Text+prettyPackageConfigParseError (TomlError e) = "Failed to parse config file: " <> renderTOMLError e+prettyPackageConfigParseError (KeyConflicts pkg xs) = T.unlines ["In [" <> pkg <> "], key conflicts occurred: " <> T.intercalate ", " ks | ks <- xs]+prettyPackageConfigParseError (KeyUnexpected pkg xs) = T.unlines ["In [" <> pkg <> "], unexpected keys found: " <> k | k <- xs] -validateKeys :: TOML -> Either PackageConfigParseError ()-validateKeys toml = if null e then Right () else Left $ foldl1 (<>) e+parseConfig :: Text -> Either [PackageConfigValidateError] [Package]+parseConfig raw = runExcept $ case decodeWith tableDecoder raw of+  Right (Map.toList -> x) -> mapM (uncurry eachP) x+  Left err -> throwE [TomlError err]   where-    allKeys = HMap.keys $ Toml.tomlPairs toml-    go xs = let intersection = xs `intersect` allKeys in if length intersection > 1 then intersection else []-    e = [KeyConflicts [t] | k <- [versionSourceKeys, fetcherKeys], let t = go k, not $ null t]+    tableDecoder =+      makeDecoder $ \case+        (Table t) -> pure t+        v -> typeMismatch v+    eachP pkg v@(Table _) = do+      let keys = myKeyToText <$> allKeys [] v+      checkConflicts pkg keys+      checkUnexpected pkg keys+      case unDecodeM (runDecoder (packageConfigDecoder pkg) v) [] of+        Left e -> throwE [TomlError $ uncurry DecodeError e]+        Right x -> pure x+    eachP pkg _ = throwE [KeyUnexpected pkg [pkg]]+    allKeys prefix (Table t) =+      mconcat+        [ case x of+            (Table _) -> []+            _ -> [MyKey $ prefix <> [k]]+          | (k, x) <- Map.toList t+        ]+        <> Map.foldrWithKey (\k v acc -> allKeys (prefix <> [k]) v <> acc) [] t+    allKeys _ _ = []+    checkConflicts pkg keys =+      throwN+        [ KeyConflicts pkg [intersection]+          | k <-+              [ ("src." <>) <$> versionSourceKeys,+                ("fetch." <>) <$> fetcherKeys+              ],+            let intersection = keys `intersect` k,+            length intersection > 1+        ]+    checkUnexpected pkg keys =+      throwN $+        -- git+        [ KeyUnexpected pkg gk+          | let gk = filter (T.isPrefixOf "git.") keys,+            not $ null gk,+            "fetch.git" `notElem` keys && "fetch.github" `notElem` keys+        ]+          -- docker+          <> [ KeyUnexpected pkg dk+               | let dk = filter (T.isPrefixOf "docker.") keys,+                 not $ null dk,+                 "fetch.docker" `notElem` keys+             ]+          -- list options+          <> [ KeyUnexpected pkg lk+               | let lk = listOptionsKeys `intersect` keys,+                 not $ null lk,+                 "src.docker" `notElem` keys+                   && "src.httpheader" `notElem` keys+                   && "src.container" `notElem` keys+                   && "src.github_tag" `notElem` keys+             ]+    throwN [] = pure ()+    throwN xs = throwE xs  -------------------------------------------------------------------------------- -data PackageConfig = PackageConfig-  { pcVersionSource :: VersionSource,-    pcFetcher :: PackageFetcher,-    pcExtractFiles :: Maybe PackageExtractSrc,-    pcCargoLockFiles :: Maybe PackageCargoLockFiles,-    pcNvcheckerOptions :: NvcheckerOptions,-    pcPassthru :: PackagePassthru,-    pcUseStale :: UseStaleVersion,-    pcGitDateFormat :: DateFormat,-    pcForceFetch :: ForceFetch-  }--toPackage :: PackageKey -> PackageConfig -> Package-toPackage k PackageConfig {..} =-  Package-    (coerce k)-    (CheckVersion pcVersionSource pcNvcheckerOptions)-    pcFetcher-    pcExtractFiles-    pcCargoLockFiles-    pcPassthru-    pcUseStale-    pcGitDateFormat-    pcForceFetch--packageConfigCodec :: TomlCodec PackageConfig-packageConfigCodec =-  PackageConfig-    <$> versionSourceCodec .= pcVersionSource-    <*> fetcherCodec .= pcFetcher-    <*> extractFilesCodec .= pcExtractFiles-    <*> cargoLockPathCodec .= pcCargoLockFiles-    <*> nvcheckerOptionsCodec .= pcNvcheckerOptions-    <*> passthruCodec .= pcPassthru-    <*> pinnedCodec .= pcUseStale-    <*> gitDateFormatCodec .= pcGitDateFormat-    <*> forceFetchCodec .= pcForceFetch+packageConfigDecoder :: PackageName -> Decoder Package+packageConfigDecoder name =+  Package name+    <$> (CheckVersion <$> versionSourceDecoder <*> nvcheckerOptionsDecoder)+    <*> fetcherDecoder+    <*> extractFilesDecoder+    <*> cargoLockPathDecoder+    <*> passthruDecoder+    <*> pinnedDecoder+    <*> gitDateFormatDecoder+    <*> forceFetchDecoder  -------------------------------------------------------------------------------- -extractFilesCodec :: TomlCodec (Maybe PackageExtractSrc)-extractFilesCodec =-  dimap-    (fmap (NE.toList . coerce))-    (\mxs -> coerce <$> (mxs >>= NE.nonEmpty))-    $ dioptional $ arrayOf _String "extract"+extractFilesDecoder :: Decoder (Maybe PackageExtractSrc)+extractFilesDecoder = fmap PackageExtractSrc <$> getFieldOpt "extract" -cargoLockPathCodec :: TomlCodec (Maybe PackageCargoLockFiles)-cargoLockPathCodec =-  dimap-    (fmap (NE.toList . coerce))-    (\mxs -> coerce <$> (mxs >>= NE.nonEmpty))-    $ dioptional $ arrayOf _String "cargo_locks"+cargoLockPathDecoder :: Decoder (Maybe PackageCargoLockFiles)+cargoLockPathDecoder = fmap PackageCargoLockFiles <$> getFieldOpt "cargo_locks" -nvcheckerOptionsCodec :: TomlCodec NvcheckerOptions-nvcheckerOptionsCodec =+nvcheckerOptionsDecoder :: Decoder NvcheckerOptions+nvcheckerOptionsDecoder =   NvcheckerOptions-    <$> dioptional (text "src.prefix") .= _stripPrefix-    <*> dioptional (text "src.from_pattern") .= _fromPattern-    <*> dioptional (text "src.to_pattern") .= _toPattern+    <$> getFieldsOpt ["src", "prefix"]+    <*> getFieldsOpt ["src", "from_pattern"]+    <*> getFieldsOpt ["src", "to_pattern"] -passthruCodec :: TomlCodec PackagePassthru-passthruCodec = diwrap $ tableHashMap _KeyText text "passthru"+passthruDecoder :: Decoder PackagePassthru+passthruDecoder =+  getFieldOpt @Value "passthru" >>= \case+    Just (Table t) -> go [] t >>= \(mconcat -> fs) -> pure $ PackagePassthru $ foldl' (flip ($)) HMap.empty fs+    Just _ -> makeDecoder typeMismatch+    Nothing -> pure $ PackagePassthru HMap.empty+  where+    go prefix x =+      sequenceA+        [ case v of+            (String text) -> pure [HMap.insert (myKeyToText $ MyKey $ prefix <> [k]) text]+            Table t -> mconcat <$> go (prefix <> [k]) t+            _ -> makeDecoder (\_ -> invalidValue "passthru value must be string for now" v)+          | (k, v) <- Map.toList x+        ] -pinnedCodec :: TomlCodec UseStaleVersion-pinnedCodec =-  dimap-    ( \case-        PermanentStale -> Just True-        TemporaryStale -> error "Impossible!"-        NoStale -> Just False-    )-    (maybe NoStale (\x -> if x then PermanentStale else NoStale))-    $ dioptional $ bool "pinned"+pinnedDecoder :: Decoder UseStaleVersion+pinnedDecoder =+  maybe NoStale (\x -> if x then PermanentStale else NoStale)+    <$> getFieldOpt "pinned" -gitDateFormatCodec :: TomlCodec DateFormat-gitDateFormatCodec = diwrap $ dioptional $ text "git.date_format"+gitDateFormatDecoder :: Decoder DateFormat+gitDateFormatDecoder = DateFormat <$> getFieldsOpt ["git", "date_format"] -forceFetchCodec :: TomlCodec ForceFetch-forceFetchCodec =-  dimap-    ( \case-        ForceFetch -> Just True-        NoForceFetch -> Just False-    )-    (maybe NoForceFetch (\x -> if x then ForceFetch else NoForceFetch))-    $ dioptional $ bool "fetch.force"+forceFetchDecoder :: Decoder ForceFetch+forceFetchDecoder =+  maybe NoForceFetch (\x -> if x then ForceFetch else NoForceFetch)+    <$> getFieldsOpt ["fetch", "force"]

@@ -0,0 +1,23 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Config.Common where++import Data.Text (Text)+import qualified Data.Text as T+import TOML++githubDecoder :: Decoder (Text, Text)+githubDecoder = makeDecoder $ \case+  v@(String s) -> case T.split (== '/') s of+    [owner, repo] -> pure (owner, repo)+    _ -> invalidValue "unexpected github format: it should be in the format of [owner]/[repo]" v+  v -> typeMismatch v++vscodeExtensionDecoder :: Decoder (Text, Text)+vscodeExtensionDecoder = makeDecoder $ \case+  -- assume that we can't have '.' in extension's name+  v@(String s) -> case T.split (== '.') s of+    [publisher, extName] -> pure (publisher, extName)+    _ -> invalidValue "unexpected vscode extension format: it should be in the format of [publisher].[extName]" v+  v -> typeMismatch v

@@ -1,56 +1,48 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} -module Config.PackageFetcher-  ( fetcherCodec,-    fetcherKeys,-  )-where+module Config.PackageFetcher (fetcherDecoder, fetcherKeys) where +import Config.Common import Data.Coerce (coerce)-import Data.Default (Default, def) import Data.Foldable (asum) import Data.Maybe (fromMaybe)+import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) import Lens.Micro-import Lens.Micro.Extras (view) import NvFetcher.NixFetcher import NvFetcher.Types import NvFetcher.Types.Lens-import Toml--unsupportError :: a-unsupportError = error "serialization is unsupported"+import TOML -fetcherCodec :: TomlCodec PackageFetcher-fetcherCodec =+fetcherDecoder :: Decoder PackageFetcher+fetcherDecoder =   asum-    [ gitHubCodec,-      pypiCodec,-      openVsxCodec,-      vscodeMarketplaceCodec,-      gitCodec,-      urlCodec,-      tarballCodec,-      dockerCodec+    [ gitHubDecoder,+      pypiDecoder,+      openVsxDecoder,+      vscodeMarketplaceDecoder,+      gitDecoder,+      urlDecoder,+      tarballDecoder,+      dockerDecoder     ] -fetcherKeys :: [Key]+fetcherKeys :: [Text] fetcherKeys =-  [ "fetch.github",-    "fetch.pypi",-    "fetch.openvsx",-    "fetch.vsmarketplace",-    "fetch.git",-    "fetch.url",-    "fetch.tarball",-    "fetch.docker"+  [ "github",+    "pypi",+    "openvsx",+    "vsmarketplace",+    "git",+    "url",+    "tarball",+    "docker"   ]  --------------------------------------------------------------------------------@@ -60,14 +52,14 @@     goFetchSubmodules :: Maybe Bool,     goLeaveDotGit :: Maybe Bool   }-  deriving (Eq, Generic, Default)+  deriving (Eq, Generic) -gitOptionsCodec :: TomlCodec GitOptions-gitOptionsCodec =+gitOptionsDecoder :: Decoder GitOptions+gitOptionsDecoder =   GitOptions-    <$> dioptional (bool "git.deepClone") .= goDeepClone-    <*> dioptional (bool "git.fetchSubmodules") .= goFetchSubmodules-    <*> dioptional (bool "git.leaveDotGit") .= goLeaveDotGit+    <$> getFieldsOpt ["git", "deepClone"]+    <*> getFieldsOpt ["git", "fetchSubmodules"]+    <*> getFieldsOpt ["git", "leaveDotGit"]  _GitOptions :: Traversal' (NixFetcher f) GitOptions _GitOptions f x@FetchGit {..} =@@ -90,108 +82,62 @@  -------------------------------------------------------------------------------- -gitHubICodec :: TomlCodec PackageFetcher-gitHubICodec =-  textBy-    unsupportError-    ( \t -> case T.split (== '/') t of-        [owner, repo] -> Right $ gitHubFetcher (owner, repo)-        _ -> Left "unexpected github fetcher: it should be something like [owner]/[repo]"-    )-    "fetch.github"--gitHubCodec :: TomlCodec PackageFetcher-gitHubCodec =-  dimap-    ( \f -> let fake = f "$ver" in (f, fromMaybe def $ fake ^? _GitOptions)-    )-    (\(f, g) v -> f v & _GitOptions .~ g)-    $ (,) <$> gitHubICodec .= view _1 <*> gitOptionsCodec .= view _2+gitHubDecoder :: Decoder PackageFetcher+gitHubDecoder = do+  (owner, repo) <- getFieldsWith githubDecoder ["fetch", "github"]+  gitOptions <- gitOptionsDecoder+  pure $ \v -> gitHubFetcher (owner, repo) v & _GitOptions .~ gitOptions  ---------------------------------------------------------------------------------gitICodec :: TomlCodec PackageFetcher-gitICodec =-  textBy-    unsupportError-    (Right . gitFetcher)-    "fetch.git" -gitCodec :: TomlCodec PackageFetcher-gitCodec =-  dimap-    ( \f -> let fake = f "$ver" in (f, fromMaybe def $ fake ^? _GitOptions)-    )-    (\(f, g) v -> f v & _GitOptions .~ g)-    $ (,) <$> gitICodec .= view _1 <*> gitOptionsCodec .= view _2+gitDecoder :: Decoder PackageFetcher+gitDecoder = do+  url <- getFields ["fetch", "git"]+  gitOptions <- gitOptionsDecoder+  pure $ \v -> gitFetcher url v & _GitOptions .~ gitOptions  ---------------------------------------------------------------------------------pypiCodec :: TomlCodec PackageFetcher-pypiCodec =-  Toml.textBy-    unsupportError-    (Right . pypiFetcher)-    "fetch.pypi" +pypiDecoder :: Decoder PackageFetcher+pypiDecoder = pypiFetcher <$> getFields ["fetch", "pypi"]+ -------------------------------------------------------------------------------- -openVsxCodec :: TomlCodec PackageFetcher-openVsxCodec =-  textBy-    unsupportError-    ( \t -> case T.split (== '.') t of-        -- assume we can't have '.' in extension's name-        [publisher, extName] -> Right $ openVsxFetcher (publisher, extName)-        _ -> Left "unexpected openvsx fetcher: it should be something like [publisher]/[extName]"-    )-    "fetch.openvsx"+openVsxDecoder :: Decoder PackageFetcher+openVsxDecoder = openVsxFetcher <$> getFieldsWith vscodeExtensionDecoder ["fetch", "openvsx"]  -------------------------------------------------------------------------------- -vscodeMarketplaceCodec :: TomlCodec PackageFetcher-vscodeMarketplaceCodec =-  textBy-    unsupportError-    ( \t -> case T.split (== '.') t of-        -- assume we can't have '.' in extension's name-        [publisher, extName] -> Right $ vscodeMarketplaceFetcher (publisher, extName)-        _ -> Left "unexpected vscode marketplace fetcher: it should be something like [publisher]/[extName]"-    )-    "fetch.vsmarketplace"+vscodeMarketplaceDecoder :: Decoder PackageFetcher+vscodeMarketplaceDecoder = vscodeMarketplaceFetcher <$> getFieldsWith vscodeExtensionDecoder ["fetch", "vsmarketplace"]  ---------------------------------------------------------------------------------urlCodec :: TomlCodec PackageFetcher-urlCodec =-  Toml.textBy-    unsupportError-    (\t -> Right $ \(coerce -> v) -> urlFetcher $ T.replace "$ver" v t)-    "fetch.url" +urlDecoder :: Decoder PackageFetcher+urlDecoder = do+  url <- getFields ["fetch", "url"]+  pure $ \(coerce -> v) -> urlFetcher $ T.replace "$ver" v url+ -------------------------------------------------------------------------------- -tarballCodec :: TomlCodec PackageFetcher-tarballCodec =-  Toml.textBy-    unsupportError-    (\t -> Right $ \(coerce -> v) -> tarballFetcher $ T.replace "$ver" v t)-    "fetch.tarball"+tarballDecoder :: Decoder PackageFetcher+tarballDecoder = do+  url <- getFields ["fetch", "tarball"]+  pure $ \(coerce -> v) -> tarballFetcher $ T.replace "$ver" v url  -------------------------------------------------------------------------------- -dockerCodec :: TomlCodec PackageFetcher-dockerCodec =-  dimap unsupportError setImageTag codec-  where-    setImageTag t (Version v) = t & imageTag .~ v--    codec :: TomlCodec (NixFetcher Fresh)-    codec =-      FetchDocker-        <$> Toml.text "fetch.docker" .= _imageName-        <*> pure "" -- will be set in setImageTag-        <*> pure () .= _imageDigest-        <*> pure () .= _sha256-        <*> dioptional (text "docker.os") .= _fos-        <*> dioptional (text "docker.arch") .= _farch-        <*> dioptional (text "docker.finalImageName") .= _finalImageName-        <*> dioptional (text "docker.finalImageTag") .= _finalImageTag-        <*> dioptional (bool "docker.tlsVerify") .= _tlsVerify+dockerDecoder :: Decoder PackageFetcher+dockerDecoder =+  (\f (coerce -> v) -> f & imageTag .~ v)+    <$> ( FetchDocker+            <$> getFields ["fetch", "docker"]+            <*> pure "" -- set in fmap+            <*> pure ()+            <*> pure ()+            <*> getFieldsOpt ["docker", "os"]+            <*> getFieldsOpt ["docker", "arch"]+            <*> getFieldsOpt ["docker", "finalImageName"]+            <*> getFieldsOpt ["docker", "finalImageTag"]+            <*> getFieldsOpt ["docker", "tlsVerify"]+        )

@@ -1,258 +1,160 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-} -module Config.VersionSource-  ( versionSourceCodec,-    versionSourceKeys,-  )-where+module Config.VersionSource (versionSourceDecoder, versionSourceKeys, listOptionsKeys) where +import Config.Common+import Data.Coerce (coerce) import Data.Foldable (asum) import Data.Text (Text) import qualified Data.Text as T-import Data.Tuple.Extra (uncurry3)-import Lens.Micro-import Lens.Micro.Extras (view) import NvFetcher.Types-import NvFetcher.Types.Lens-import Toml+import TOML -versionSourceCodec :: TomlCodec VersionSource-versionSourceCodec =-  asum-    [ gitHubReleaseCodec,-      gitHubTagCodec,-      gitCodec,-      pypiCodec,-      archLinuxCodec,-      aurCodec,-      manualCodec,-      repologyCodec,-      webpageCodec,-      httpHeaderCodec,-      openVsxCodec,-      vscodeMarketplaceCodec,-      cmdCodec,-      containerCodec-    ]+versionSourceDecoder :: Decoder VersionSource+versionSourceDecoder =+  -- everything is in src table+  flip getFieldWith "src" $+    asum+      [ gitHubReleaseDecoder,+        gitHubTagDecoder,+        gitDecoder,+        pypiDecoder,+        archLinuxDecoder,+        aurDecoder,+        manualDecoder,+        repologyDecoder,+        webpageDecoder,+        httpHeaderDecoder,+        openVsxDecoder,+        vscodeMarketplaceDecoder,+        cmdDecoder,+        containerDecoder+      ] -versionSourceKeys :: [Key]+versionSourceKeys :: [Text] versionSourceKeys =-  [ "src.github",-    "src.github_tag",-    "src.git",-    "src.pypi",-    "src.archpkg",-    "src.aur",-    "src.manual",-    "src.webpage",-    "src.httpheader",-    "src.openvsx",-    "src.vsmarketplace",-    "src.cmd",-    "src.container"+  [ "github",+    "github_tag",+    "git",+    "pypi",+    "archpkg",+    "aur",+    "manual",+    "webpage",+    "httpheader",+    "openvsx",+    "vsmarketplace",+    "cmd",+    "container"   ] ---------------------------------------------------------------------------------+listOptionsKeys :: [Text]+listOptionsKeys =+  [ "include_regex",+    "exclude_regex",+    "sort_version_key",+    "ignored"+  ] -githubICodec :: Key -> TomlCodec (Text, Text)-githubICodec =-  textBy-    (\(owner, repo) -> owner <> "/" <> repo)-    ( \t ->-        case T.split (== '/') t of-          [owner, repo] -> Right (owner, repo)-          _ -> Left "unexpected github source format: it should be something like [owner]/[repo]"-    )+-------------------------------------------------------------------------------- -listOptionsCodec :: TomlCodec ListOptions-listOptionsCodec =+listOptionsDecoder :: Decoder ListOptions+listOptionsDecoder =   ListOptions-    <$> dioptional (text "src.include_regex") .= _includeRegex-    <*> dioptional (text "src.exclude_regex") .= _excludeRegex-    <*> dioptional-      ( textBy-          (T.pack . show)-          ( \case-              "parse_version" -> Right ParseVersion-              "vercmp" -> Right Vercmp-              _ -> Left "unexpected sort_version_key: it should be either parse_version or vercmp"-          )-          "src.sort_version_key"-      )-      .= _sortVersionKey-    <*> dioptional (text "src.ignored") .= _ignored+    <$> getFieldOpt "include_regex"+    <*> getFieldOpt "exclude_regex"+    <*> ( getFieldOpt @Text "sort_version_key" >>= \case+            Just "parse_version" -> pure $ Just ParseVersion+            Just "vercmp" -> pure $ Just Vercmp+            Just _ -> makeDecoder $ invalidValue "unexpected sort_version_key: it should be either parse_version or vercmp"+            Nothing -> pure Nothing+        )+    <*> getFieldOpt "ignored"  -------------------------------------------------------------------------------- -matchGitHubRelease :: VersionSource -> Maybe (Text, Text)-matchGitHubRelease x = (,) <$> x ^? owner <*> x ^? repo--gitHubReleaseCodec :: TomlCodec VersionSource-gitHubReleaseCodec = dimatch matchGitHubRelease (uncurry GitHubRelease) $ githubICodec "src.github"+gitHubReleaseDecoder :: Decoder VersionSource+gitHubReleaseDecoder = uncurry GitHubRelease <$> getFieldWith githubDecoder "github"  -------------------------------------------------------------------------------- -matchGitHubTag :: VersionSource -> Maybe ((Text, Text), ListOptions)-matchGitHubTag x = do-  o <- x ^? owner-  r <- x ^? repo-  l <- x ^? listOptions-  pure ((o, r), l)--gitHubTagICodec :: TomlCodec ((Text, Text), ListOptions)-gitHubTagICodec =-  (,) <$> githubICodec "src.github_tag" .= view _1-    <*> listOptionsCodec .= view _2--gitHubTagCodec :: TomlCodec VersionSource-gitHubTagCodec = dimatch matchGitHubTag (\((_owner, _repo), _listOptions) -> GitHubTag {..}) gitHubTagICodec+gitHubTagDecoder :: Decoder VersionSource+gitHubTagDecoder = do+  (_owner, _repo) <- getFieldWith githubDecoder "github_tag"+  _listOptions <- listOptionsDecoder+  pure GitHubTag {..}  -------------------------------------------------------------------------------- -matchGit :: VersionSource -> Maybe (Text, Branch)-matchGit x = (,) <$> x ^? vurl <*> x ^? vbranch--gitICodec :: TomlCodec (Text, Branch)-gitICodec = (,) <$> text "src.git" .= view _1 <*> diwrap (dioptional (text "src.branch")) .= view _2--gitCodec :: TomlCodec VersionSource-gitCodec = dimatch matchGit (uncurry Git) gitICodec+gitDecoder :: Decoder VersionSource+gitDecoder = Git <$> getField "git" <*> (coerce @(Maybe Text) <$> getFieldOpt "branch")  -------------------------------------------------------------------------------- -matchPypi :: VersionSource -> Maybe Text-matchPypi x = x ^? pypi--pypiCodec :: TomlCodec VersionSource-pypiCodec = dimatch matchPypi Pypi (text "src.pypi")+pypiDecoder :: Decoder VersionSource+pypiDecoder = Pypi <$> getField "pypi"  -------------------------------------------------------------------------------- -matchArchLinux :: VersionSource -> Maybe Text-matchArchLinux x = x ^? archpkg--archLinuxCodec :: TomlCodec VersionSource-archLinuxCodec = dimatch matchArchLinux ArchLinux (text "src.archpkg")+archLinuxDecoder :: Decoder VersionSource+archLinuxDecoder = ArchLinux <$> getField "archpkg"  -------------------------------------------------------------------------------- -matchAur :: VersionSource -> Maybe Text-matchAur x = x ^? aur--aurCodec :: TomlCodec VersionSource-aurCodec = dimatch matchAur Aur (text "src.aur")+aurDecoder :: Decoder VersionSource+aurDecoder = Aur <$> getField "aur"  -------------------------------------------------------------------------------- -matchManual :: VersionSource -> Maybe Text-matchManual x = x ^? manual--manualCodec :: TomlCodec VersionSource-manualCodec = dimatch matchManual Manual (text "src.manual")+manualDecoder :: Decoder VersionSource+manualDecoder = Manual <$> getField "manual"  -------------------------------------------------------------------------------- -matchRepology :: VersionSource -> Maybe (Text, Text)-matchRepology x = (,) <$> x ^? repology <*> x ^? repo--repologyICodec :: TomlCodec (Text, Text)-repologyICodec =-  textBy-    (\(repology, repo) -> repology <> ":" <> repo)-    ( \t ->-        case T.split (== ':') t of-          [owner, repo] -> Right (owner, repo)-          _ -> Left "unexpected repology source format: it should be something like [repology]:[repo]"-    )-    "src.repology"--repologyCodec :: TomlCodec VersionSource-repologyCodec = dimatch matchRepology (uncurry Repology) repologyICodec+repologyDecoder :: Decoder VersionSource+repologyDecoder = makeDecoder $ \case+  v@(String s) -> case T.split (== ':') s of+    [_repology, _repo] -> pure Repology {..}+    _ -> invalidValue "unexpected repology format: it should be in the format of [repology]:[repo]" v+  v -> typeMismatch v  ------------------------------------------------------------ -matchWebpage :: VersionSource -> Maybe (Text, Text, ListOptions)-matchWebpage x = (,,) <$> x ^? vurl <*> x ^? regex <*> x ^? listOptions--webpageICodec :: TomlCodec (Text, Text, ListOptions)-webpageICodec =-  (,,) <$> text "src.webpage" .= view _1-    <*> text "src.regex" .= view _2-    <*> listOptionsCodec .= view _3--webpageCodec :: TomlCodec VersionSource-webpageCodec = dimatch matchWebpage (uncurry3 Webpage) webpageICodec+webpageDecoder :: Decoder VersionSource+webpageDecoder = do+  _vurl <- getField "webpage"+  _regex <- getField "regex"+  _listOptions <- listOptionsDecoder+  pure Webpage {..}  -------------------------------------------------------------------------------- -matchHttpHeader :: VersionSource -> Maybe (Text, Text, ListOptions)-matchHttpHeader x = (,,) <$> x ^? vurl <*> x ^? regex <*> x ^? listOptions--httpHeaderICodec :: TomlCodec (Text, Text, ListOptions)-httpHeaderICodec =-  (,,) <$> text "src.httpheader" .= view _1-    <*> text "src.regex" .= view _2-    <*> listOptionsCodec .= view _3--httpHeaderCodec :: TomlCodec VersionSource-httpHeaderCodec = dimatch matchHttpHeader (uncurry3 HttpHeader) httpHeaderICodec+httpHeaderDecoder :: Decoder VersionSource+httpHeaderDecoder = do+  _vurl <- getField "httpheader"+  _regex <- getField "regex"+  _listOptions <- listOptionsDecoder+  pure HttpHeader {..}  -------------------------------------------------------------------------------- -matchOpenVsx :: VersionSource -> Maybe (Text, Text)-matchOpenVsx x = (,) <$> x ^? ovPublisher <*> x ^? ovExtName--openVsxICodec :: TomlCodec (Text, Text)-openVsxICodec =-  textBy-    (\(publisher, extName) -> publisher <> "." <> extName)-    ( \t ->-        case T.split (== '.') t of-          -- assume we can't have '.' in extension's name-          [publisher, extName] -> Right (publisher, extName)-          _ -> Left "unexpected openvsx source format: it should be something like [publisher].[extName]"-    )-    "src.openvsx"--openVsxCodec :: TomlCodec VersionSource-openVsxCodec = dimatch matchOpenVsx (uncurry OpenVsx) openVsxICodec+openVsxDecoder :: Decoder VersionSource+openVsxDecoder = uncurry OpenVsx <$> getFieldWith vscodeExtensionDecoder "openvsx"  -------------------------------------------------------------------------------- -matchVscodeMarketplace :: VersionSource -> Maybe (Text, Text)-matchVscodeMarketplace x = (,) <$> x ^? vsmPublisher <*> x ^? vsmExtName--vscodeMarketplaceICodec :: TomlCodec (Text, Text)-vscodeMarketplaceICodec =-  textBy-    (\(publisher, extName) -> publisher <> "." <> extName)-    ( \t ->-        case T.split (== '.') t of-          -- assume we can't have '.' in extension's name-          [publisher, extName] -> Right (publisher, extName)-          _ -> Left "unexpected vscode marketplace source format: it should be something like [publisher].[extName]"-    )-    "src.vsmarketplace"--vscodeMarketplaceCodec :: TomlCodec VersionSource-vscodeMarketplaceCodec = dimatch matchVscodeMarketplace (uncurry VscodeMarketplace) vscodeMarketplaceICodec+vscodeMarketplaceDecoder :: Decoder VersionSource+vscodeMarketplaceDecoder = uncurry VscodeMarketplace <$> getFieldWith vscodeExtensionDecoder "vsmarketplace"  -------------------------------------------------------------------------------- -matchCmd :: VersionSource -> Maybe Text-matchCmd x = x ^? vcmd--cmdCodec :: TomlCodec VersionSource-cmdCodec = dimatch matchCmd Cmd (text "src.cmd")+cmdDecoder :: Decoder VersionSource+cmdDecoder = Cmd <$> getField "cmd"  -------------------------------------------------------------------------------- -matchContainer :: VersionSource -> Maybe (Text, ListOptions)-matchContainer x = (,) <$> x ^? vcontainer <*> x ^? listOptions--containerCodec :: TomlCodec VersionSource-containerCodec =-  dimatch matchContainer (uncurry Container) $-    Toml.pair (text "src.container") listOptionsCodec+containerDecoder :: Decoder VersionSource+containerDecoder = Container <$> getField "container" <*> listOptionsDecoder

@@ -9,12 +9,12 @@ import NvFetcher import NvFetcher.Options import Options.Applicative.Simple-import qualified Toml  getCLIOptionsWithConfig :: IO (CLIOptions, FilePath) getCLIOptionsWithConfig =   getCLIOptions $-    (,) <$> cliOptionsParser+    (,)+      <$> cliOptionsParser       <*> strOption         ( long "config"             <> short 'c'@@ -28,9 +28,7 @@ main :: IO () main = do   (opt, configPath) <- getCLIOptionsWithConfig-  toml <- Toml.parse <$> T.readFile configPath-  case toml of-    Left e -> error $ T.unpack $ Toml.prettyTomlDecodeError $ Toml.ParseError e-    Right x -> case parseConfig x of-      Left e -> error $ T.unpack $ prettyPackageConfigParseError e-      Right pkgs -> applyCliOptions def opt >>= \o -> runNvFetcherNoCLI o (optTarget opt) $ purePackageSet pkgs+  raw <- T.readFile configPath+  case parseConfig raw of+    Left e -> error $ T.unpack $ T.unlines $ prettyPackageConfigParseError <$> e+    Right pkgs -> applyCliOptions def opt >>= \o -> runNvFetcherNoCLI o (optTarget opt) $ purePackageSet pkgs

@@ -1,6 +1,6 @@ cabal-version:   2.4 name:            nvfetcher-version:         0.6.1.0+version:         0.6.2.0 synopsis:   Generate nix sources expr for the latest version of packages @@ -26,7 +26,7 @@  common common-options   build-depends:-    , aeson                 >=1.5.6    && <2.1+    , aeson                 >=1.5.6    && <2.3     , aeson-pretty     , base                  >=4.8      && <5     , binary@@ -45,7 +45,7 @@     , regex-tdfa            ^>=1.3.1.1     , shake                 ^>=0.19     , text-    , tomland               ^>=1.3.2+    , toml-reader           ^>=0.2     , transformers     , unordered-containers @@ -86,6 +86,7 @@   main-is:        Main.hs   other-modules:     Config+    Config.Common     Config.PackageFetcher     Config.VersionSource 

@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-}  -- | Copyright: (c) 2021-2022 berberman@@ -36,10 +37,9 @@ import NvFetcher.NixFetcher import NvFetcher.Types import Prettyprinter (pretty, (<+>))+import qualified TOML as Toml import Text.Parsec import Text.Parsec.Text-import Toml (TomlCodec, (.=))-import qualified Toml  -- | Rules of fetch rust git dependencies fetchRustGitDepsRule :: Rules ()@@ -47,9 +47,9 @@   addOracleCache $ \key@(FetchRustGitDepsQ fetcher lockPath) -> do     putInfo . show $ "#" <+> pretty key     cargoLock <- head . HMap.elems <$> extractSrc fetcher lockPath-    deps <- case Toml.decode (Toml.list rustDepCodec "package") cargoLock of+    deps <- case Toml.decodeWith (Toml.getFieldWith (Toml.getArrayOf rustDepDecoder) "package") cargoLock of       Right r -> pure $ nubOrdOn rrawSrc r-      Left err -> fail $ "Failed to parse Cargo.lock: " <> T.unpack (Toml.prettyTomlDecodeErrors err)+      Left err -> fail $ "Failed to parse Cargo.lock: " <> T.unpack (Toml.renderTOMLError err)     r <-       parallel         [ case parse gitSrcParser (T.unpack rname) src of@@ -108,9 +108,9 @@   }   deriving (Show, Eq, Ord) -rustDepCodec :: TomlCodec RustDep-rustDepCodec =+rustDepDecoder :: Toml.Decoder RustDep+rustDepDecoder =   RustDep-    <$> Toml.text "name" .= rname-    <*> Toml.diwrap (Toml.text "version") .= rversion-    <*> Toml.dioptional (Toml.text "source") .= rrawSrc+    <$> Toml.getField "name"+    <*> (coerce @Text <$> Toml.getField "version")+    <*> Toml.getFieldOpt "source"

@@ -1,3 +1,4 @@+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -35,11 +36,12 @@  import Control.Monad (void) import Control.Monad.Extra (fromMaybeM)+import Control.Monad.Trans.Writer.CPS import qualified Data.Aeson as A import qualified Data.ByteString.Char8 as BS import Data.Coerce (coerce) import Data.Maybe (fromJust)-import Data.String (fromString)+import Data.Text (Text) import qualified Data.Text as T import Development.Shake import Development.Shake.Rule@@ -47,9 +49,6 @@ import NvFetcher.Types.ShakeExtras import NvFetcher.Utils import Prettyprinter (pretty, (<+>))-import Toml (Value (Bool, Text))-import qualified Toml-import Toml.Type.Edsl  -- | Rules of nvchecker nvcheckerRule :: Rules ()@@ -105,7 +104,7 @@ runNvchecker :: PackageKey -> NvcheckerOptions -> VersionSource -> Action Version runNvchecker pkg options versionSource = withTempFile $ \config -> withRetry $ do   mKeyfile <- getKeyfilePath-  let nvcheckerConfig = T.unpack $ Toml.pretty $ mkToml $ genNvConfig pkg options mKeyfile versionSource+  let nvcheckerConfig = T.unpack $ T.unlines $ execWriter $ genNvConfig pkg options mKeyfile versionSource   putVerbose $ "Generated nvchecker config for " <> show pkg <> ":" <> nvcheckerConfig   writeFile' config nvcheckerConfig   (CmdTime t, Stdout out, CmdLine c) <- quietly . cmd $ "nvchecker --logger json -c " <> config@@ -116,77 +115,81 @@       NvcheckerError err -> fail $ "Failed to run nvchecker: " <> T.unpack err     _ -> fail $ "Failed to parse output from nvchecker: " <> out -genNvConfig :: PackageKey -> NvcheckerOptions -> Maybe FilePath -> VersionSource -> TDSL+type BuildTOML = Writer [Text] ()++genNvConfig :: PackageKey -> NvcheckerOptions -> Maybe FilePath -> VersionSource -> BuildTOML genNvConfig pkg options mKeyfile versionSource =   case mKeyfile of     Just keyfile -> do       table "__config__" $-        "keyfile" =: Text (T.pack keyfile)+        "keyfile" =: T.pack keyfile     _ -> pure ()     >> table-      (fromString $ T.unpack $ coerce pkg)+      (coerce pkg)       ( do           genVersionSource versionSource           genOptions options       )   where-    key =:? (Just x) = key =: Text x+    key =: x = tell [key <> " = " <> T.pack (show $ T.unpack x)]+    key =:? (Just x) = key =: x     _ =:? _ = pure ()+    table t m = tell ["[" <> t <> "]"] >> m >> tell [""]     genVersionSource = \case       GitHubRelease {..} -> do         "source" =: "github"-        "github" =: Text (_owner <> "/" <> _repo)-        "use_latest_release" =: Bool True+        "github" =: (_owner <> "/" <> _repo)+        "use_latest_release" =: "true"       GitHubTag {..} -> do         "source" =: "github"-        "github" =: Text (_owner <> "/" <> _repo)-        "use_max_tag" =: Bool True+        "github" =: (_owner <> "/" <> _repo)+        "use_max_tag" =: "true"         genListOptions _listOptions       Git {..} -> do         "source" =: "git"-        "git" =: Text _vurl+        "git" =: _vurl         "branch" =:? coerce _vbranch-        "use_commit" =: Bool True+        "use_commit" =: "true"       Aur {..} -> do         "source" =: "aur"-        "aur" =: Text _aur-        "strip_release" =: Bool True+        "aur" =: _aur+        "strip_release" =: "true"       ArchLinux {..} -> do         "source" =: "archpkg"-        "archpkg" =: Text _archpkg-        "strip_release" =: Bool True+        "archpkg" =: _archpkg+        "strip_release" =: "true"       Pypi {..} -> do         "source" =: "pypi"-        "pypi" =: Text _pypi+        "pypi" =: _pypi       Manual {..} -> do         "source" =: "manual"-        "manual" =: Text _manual+        "manual" =: _manual       Repology {..} -> do         "source" =: "repology"-        "repology" =: Text _repology-        "repo" =: Text _repo+        "repology" =: _repology+        "repo" =: _repo       Webpage {..} -> do         "source" =: "regex"-        "url" =: Text _vurl-        "regex" =: Text _regex+        "url" =: _vurl+        "regex" =: _regex         genListOptions _listOptions       HttpHeader {..} -> do         "source" =: "httpheader"-        "url" =: Text _vurl-        "regex" =: Text _regex+        "url" =: _vurl+        "regex" =: _regex         genListOptions _listOptions       OpenVsx {..} -> do         "source" =: "openvsx"-        "openvsx" =: Text (_ovPublisher <> "." <> _ovExtName)+        "openvsx" =: (_ovPublisher <> "." <> _ovExtName)       VscodeMarketplace {..} -> do         "source" =: "vsmarketplace"-        "vsmarketplace" =: Text (_vsmPublisher <> "." <> _vsmExtName)+        "vsmarketplace" =: (_vsmPublisher <> "." <> _vsmExtName)       Cmd {..} -> do         "source" =: "cmd"-        "cmd" =: Text _vcmd+        "cmd" =: _vcmd       Container {..} -> do         "source" =: "container"-        "container" =: Text _vcontainer+        "container" =: _vcontainer         genListOptions _listOptions     genListOptions ListOptions {..} = do       "include_regex" =:? _includeRegex