packages feed

nvfetcher (empty) → 0.1.0.0

raw patch · 16 files changed

+1649/−0 lines, 16 filesdep +aesondep +basedep +binarysetup-changed

Dependencies added: aeson, base, binary, bytestring, extra, free, neat-interpolation, nvfetcher, shake, text, tomland, transformers, unordered-containers, validation-selective

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for nvfetcher++## 0.1.0.0++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2021 berberman++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Main_example.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import NvFetcher++main :: IO ()+main = runNvFetcher defaultArgs packageSet++packageSet :: PackageSet ()+packageSet = do+  define $ package "feeluown-core" `fromPypi` "feeluown"++  define $ package "qliveplayer" `fromGitHub` ("IsoaSFlus", "QLivePlayer")++  define $+    package "fcitx5-pinyin-zhwiki"+      `sourceAur` "fcitx5-pinyin-zhwiki"+      `fetchUrl` \v ->+        "https://github.com/felixonmars/fcitx5-pinyin-zhwiki/releases/download/0.2.2/zhwiki-"+          <> coerce v+          <> ".dict"++  define $+    package "apple-emoji"+      `sourceManual` "0.0.0.20200413"+      `fetchUrl` const+        "https://github.com/samuelngs/apple-emoji-linux/releases/download/latest/AppleColorEmoji.ttf"++  define $+    package "nvfetcher-git"+      `sourceGit` "https://github.com/berberman/nvfetcher"+      `fetchGitHub` ("berberman", "nvfetcher")
+ README.md view
@@ -0,0 +1,132 @@+# nvfetcher++[![Hackage](https://img.shields.io/hackage/v/nvfetcher.svg?logo=haskell)](https://hackage.haskell.org/package/nvfetcher)+[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE)+[![nix](https://github.com/berberman/nvfetcher/actions/workflows/nix.yml/badge.svg)](https://github.com/berberman/nvfetcher/actions/workflows/nix.yml)++nvfetcher is a tool to automate packages updates in flakes repos. It's built on top of [shake](https://www.shakebuild.com/),+integrating [nvchecker](https://github.com/lilydjwg/nvchecker).+It's very simple -- most complicated works are done by nvchecker, nvfetcher just wires it with prefetch tools,+producing only one artifact as the result of build.+nvfetcher cli program accepts a TOML file as config, which defines a set of package sources to run.++## Overview++For example, given the following configuration file:++```toml+# nvfetcher.toml+[feeluown-core]+src.pypi = "feeluown"+fetch.pypi = "feeluown"++[qliveplayer]+src.github = "IsoaSFlus/QLivePlayer"+fetch.github = "IsoaSFlus/QLivePlayer"+```++running `nvfetcher build` will create `sources.nix` like:++```nix+# sources.nix+{ fetchgit, fetchurl }:+{+  feeluown-core = {+    pname = "feeluown-core";+    version = "3.7.6";+    src = fetchurl {+      sha256 = "1bsz149dv3j5sfbynjrqsqbkkxdxkdlq4sdx2vi8whvfwfg0j2f0";+      url = "https://pypi.io/packages/source/f/feeluown/feeluown-3.7.6.tar.gz";+    };+  };+  qliveplayer = {+    pname = "qliveplayer";+    version = "3.22.0";+    src = fetchgit {+      url = "https://github.com/IsoaSFlus/QLivePlayer";+      rev = "3.22.0";+      fetchSubmodules = false;+      deepClone = false;+      leaveDotGit = false;+      sha256 = "192g42pvibms2rsjh68fck4bj59b10ay9zqcf2hqhcka0xmnyb09";+    };+  };+}+```++We tell nvfetcher how to get the latest version number of packages and how to fetch their sources given version numbers,+and nvfetcher will help us keep their version and prefetched SHA256 sums up-to-date, stored in `sources.nix`.+Shake will help us handle necessary rebuilds -- we check versions of packages during each run, but only prefetch them when needed.++## Live examples++How to use the generated sources file? Here are some examples:++* My [flakes repo](https://github.com/berberman/flakes)++* Nick Cao's [flakes repo](https://gitlab.com/NickCao/flakes/-/tree/master/pkgs)++## Usage++Basically, there are two ways to use nvfetcher, where the difference is how we provide package sources definitions to it. +No matter which way you use it in, CLI options are inherited from shake with two targets, typically used as:++* `nvfetcher build` - our main purpose, creating `sources.nix`+* `nvfetcher clean` - clean up cache and remove `sources.nix`++> nvfetcher uses `build` as the target if no specified++> You can specify `-j` to enable parallelism++### CLI++To run nvfetcher as a CLI program, you'll need to provide package sources defined in TOML.++Aavailable CLI options:+* `-c` (`--config`) - path to the TOML configuration file+* `-o` (`--output`) - path to the output nix file+* `-v` (`--version`) - print nvfetcher version+* `-l` (`--log`) - path to log file, where nvfetcher dumps the version changes ++Each *package* corresponds to a TOML table, whose name is encoded as table key;+there are two pairs in each table:+* a nvchecker configuration, how to track version updates+  * `src.github = owner/repo` - the latest gituhb release+  * `src.pypi = pypi_name` - the latest pypi release+  * `src.git = git_url` - the latest commit of a repo+  * `src.archpkg = archlinux_pkg_name` -- the latest version of an archlinux package+  * `src.aur = aur_pkg_name` -- the latest version of an aur package+  * `src.manual = v` -- a fixed version, which never updates+  * `src.repology = project:repo` -- the latest version from repology+* a nix fetcher function, how to fetch the package given the version number. `$ver` is available, which will be set to the result of nvchecker.+  * `fetch.github = owner/repo` or `owner/repo:rev` (default to `$ver` if no `rev` specified)+  * `fetch.pypi = pypi_name` or `pypi_name:ver` (default to `$ver` if no `ver` specified)+  * `fetch.git = git_url` or `git_url:rev` (default to `$ver` if no `rev` specified)+  * `fetch.url = url`++You can find an example of the configuration file, see [`nvfetcher_example.toml`](nvfetcher_example.toml).++### Haskell library++nvfetcher itsetlf is a Haskell library as well, whereas the CLI program is just a trivial wrapper of the library. You can create a Haskell program depending on it directly, creating an entry point. In this case, we can define packages in Haskell language, getting rid of TOML constraints.++You can find an example of using nvfetcher in the library way, see [`Main_example.hs`](Main_example.hs).++## Documentation++For details of the library, documentation of released versions is available on [Hackage](https://hackage.haskell.org/package/nvfetcher),+and of master is on our [github pages](https://nvfetcher.berberman.space).++## Limitations++There is no way to check the equality over version sources and fetchers, so If you change either of them in a package,+you will need to rebuild everything, i.e. run `nvfetcher clean` to remove shake databsae, to make sure that+our build system works correctly. We could automate this process, for example,+calculate the hash of the configuration file and bump `shakeVersion` to trigger the rebuild.+However, this shouldn't happen frequently and we want to minimize the changes, so it's left for you to do manually.++> Adding or removing a package doesn't require such rebuild++## Contributing++Issues and PRs are always welcome. **\_(:з」∠)\_**
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Config.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++module Config where++import Control.Applicative ((<|>))+import Data.List.NonEmpty (NonEmpty ((:|)))+import qualified Data.Text as T+import NvFetcher+import NvFetcher.NixFetcher+import Toml (TOML, TomlCodec, (.=))+import qualified Toml+import Validation (validationToEither)++parseConfig :: TOML -> Either [Toml.TomlDecodeError] [Package]+parseConfig toml = go tables [] []+  where+    go (Left errs : xs) se sp = go xs (se <> errs) sp+    go (Right x : xs) se sp = go xs se (x : sp)+    go [] [] sp = Right sp+    go [] se _ = Left se+    tables = [fmap (uncurry (Package k)) $ validationToEither $ Toml.runTomlCodec iCodec v | (Toml.unKey -> (Toml.unPiece -> k) :| _, v) <- Toml.toList $ Toml.tomlTables toml]+    iCodec = (,) <$> versionSourceCodec .= fst <*> fetcherCodec .= snd++versionSourceCodec :: TomlCodec VersionSource+versionSourceCodec =+  Toml.dimatch+    ( \case+        GitHubRelease {..} -> Just GitHubRelease {..}+        _ -> Nothing+    )+    id+    ( Toml.textBy+        ( \case+            GitHubRelease {..} -> owner <> "/" <> repo+            _ -> error "impossible"+        )+        ( \x -> case T.split (== '/') x of+            [owner, repo] -> Right GitHubRelease {..}+            _ -> Left "unexpected github srouce: it should be something like [owner]/[repo]"+        )+        "src.github"+    )+    <|> Toml.dimatch+      ( \case+          Git {..} -> Just vurl+          _ -> Nothing+      )+      Git+      (Toml.text "src.git")+    <|> Toml.dimatch+      ( \case+          Pypi {..} -> Just pypi+          _ -> Nothing+      )+      Pypi+      (Toml.text "src.pypi")+    <|> Toml.dimatch+      ( \case+          ArchLinux {..} -> Just archpkg+          _ -> Nothing+      )+      ArchLinux+      (Toml.text "src.archpkg")+    <|> Toml.dimatch+      ( \case+          Aur {..} -> Just aur+          _ -> Nothing+      )+      Aur+      (Toml.text "src.aur")+    <|> Toml.dimatch+      ( \case+          Manual {..} -> Just manual+          _ -> Nothing+      )+      Manual+      (Toml.text "src.manual")+    <|> Toml.dimatch+      ( \case+          Repology {..} -> Just Repology {..}+          _ -> Nothing+      )+      id+      ( Toml.textBy+          ( \case+              Repology {..} -> repology <> ":" <> repo+              _ -> error "impossible"+          )+          ( \t -> case T.split (== ':') t of+              [repology, repo] -> Right Repology {..}+              _ -> Left "unexpected repology source: it should be something like [project]:[repo]"+          )+          "src.repology"+      )++unsupportError :: a+unsupportError = error "serialization of fetchers is unsupported"++-- | Use it only for deserialization!!!+fetcherCodec :: TomlCodec PackageFetcher+fetcherCodec =+  Toml.textBy+    unsupportError+    ( \t -> case T.split (== '/') t of+        [owner, rest] -> case T.split (== ':') rest of+          [repo, rawV] ->+            Right $ \(coerce -> realV) -> gitHubFetcher (owner, repo) $ coerce $ T.replace "$ver" rawV realV+          [repo] -> Right $ gitHubFetcher (owner, repo)+          _ -> Left "unexpected github fetcher: it should be something like [owner]/[repo] or [owner]/[repo]:[ver]"+        _ -> Left "unexpected github fetcher: it should be something like [owner]/[repo] or [owner]/[repo]:[ver]"+    )+    "fetch.github"+    <|> Toml.textBy+      unsupportError+      ( \t -> case T.split (== ':') t of+          [fpypi, rawV] ->+            Right $ \(coerce -> realV) -> pypiFetcher fpypi $ coerce $ T.replace "$ver" rawV realV+          [fpypi] -> Right $ pypiFetcher fpypi+          _ -> Left "unexpected pypi fetcher: it should be something like [pypi] or [pypi]:[ver]"+      )+      "fetch.pypi"+    <|> Toml.textBy+      unsupportError+      ( \t -> case T.split (== ':') t of+          [furl, rawV] ->+            Right $ \(coerce -> realV) -> gitFetcher furl $ coerce $ T.replace "$ver" rawV realV+          [furl] -> Right $ gitFetcher furl+          _ -> Left "unexpected git fetcher: it should be something like [git_url] or [git_url]:[ver]"+      )+      "fetch.git"+    <|> Toml.textBy+      unsupportError+      (\t -> Right $ \(coerce -> v) -> urlFetcher $ T.replace "$ver" v t)+      "fetch.url"
+ app/Main.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++module Main where++import Config+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Data.Version (showVersion)+import Development.Shake+import NvFetcher+import Paths_nvfetcher+import System.Console.GetOpt+import qualified Toml++data CLIOptions = CLIOptions+  { configPath :: FilePath,+    outputPath :: FilePath,+    versionMode :: Bool,+    logPath :: Maybe FilePath+  }+  deriving (Show)++defaultCLIArgs :: CLIOptions+defaultCLIArgs = CLIOptions "nvfetcher.toml" "sources.nix" False Nothing++flags :: [OptDescr (Either String (CLIOptions -> CLIOptions))]+flags =+  [ Option ['c'] ["config"] (ReqArg (\s -> Right $ \o -> o {configPath = s}) "FILE") "Path to nvfetcher config",+    Option ['o'] ["output"] (ReqArg (\s -> Right $ \o -> o {outputPath = s}) "FILE") "Path to output nix file",+    Option ['v'] ["version"] (NoArg $ Right $ \o -> o {versionMode = True}) "Print nvfetcher version",+    Option ['l'] ["log"] (ReqArg (\s -> Right $ \o -> o {logPath = Just s}) "FILE") "Path to log file"+  ]++logChangesToFile :: FilePath -> Action ()+logChangesToFile fp = do+  changes <- getVersionChanges+  writeFile' fp $ unlines $ show <$> changes++main :: IO ()+main = runNvFetcherWith flags $ \flagValues -> do+  let CLIOptions {..} = foldl (flip id) defaultCLIArgs flagValues+  if versionMode+    then putStrLn ("nvfetcher " <> showVersion version) >> pure Nothing+    else do+      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 $ Toml.prettyTomlDecodeErrors e+          Right x ->+            pure $+              Just+                ( defaultArgs+                    { argOutputFilePath = outputPath,+                      argActionAfterBuild = case logPath of+                        Just fp -> logChangesToFile fp+                        _ -> pure ()+                    },+                  purePackageSet x+                )
+ nvfetcher.cabal view
@@ -0,0 +1,89 @@+cabal-version:   2.4+name:            nvfetcher+version:         0.1.0.0+synopsis:+  Generate nix sources expr for the latest version of packages++description:     Please see README+homepage:        https://github.com/berberman/nvfetcher+bug-reports:     https://github.com/berberman/nvfetcher/issues+license:         MIT+license-file:    LICENSE+author:          berberman+maintainer:      berberman <berberman.yandex.com>+copyright:       2021 berberman+category:        Nix+build-type:      Simple+extra-doc-files:+  CHANGELOG.md+  README.md++source-repository head+  type:     git+  location: https://github.com/berberman/nvfetcher.git++common common-options+  build-depends:+    , aeson                 ^>=1.5.6+    , base                  >=4.8    && <5+    , binary+    , bytestring+    , extra                 ^>=1.7.9+    , free                  ^>=5.1.5+    , neat-interpolation    ^>=0.5.1+    , shake                 ^>=0.19.4+    , text+    , transformers+    , unordered-containers++  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+    -Wincomplete-record-updates -Wredundant-constraints+    -fhide-source-paths -Wno-name-shadowing+    -Wno-unticked-promoted-constructors++  default-language: Haskell2010++library+  import:          common-options+  hs-source-dirs:  src+  other-modules:   NvFetcher.Utils+  exposed-modules:+    NvFetcher+    NvFetcher.Core+    NvFetcher.NixFetcher+    NvFetcher.Nvchecker+    NvFetcher.PackageSet+    NvFetcher.ShakeExtras+    NvFetcher.Types++executable nvfetcher+  import:          common-options+  hs-source-dirs:  app+  main-is:         Main.hs+  other-modules:+    Config+    Paths_nvfetcher++  autogen-modules: Paths_nvfetcher+  build-depends:+    , nvfetcher+    , tomland               ^>=1.3.2+    , validation-selective++  ghc-options:     -threaded -rtsopts -with-rtsopts=-N++flag build-example+  description: Build example executable+  manual:      True+  default:     False++executable example+  import:        common-options++  if !flag(build-example)+    buildable: False++  main-is:       Main_example.hs+  build-depends: nvfetcher+  ghc-options:   -threaded -rtsopts -with-rtsopts=-N
+ src/NvFetcher.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++-- | Copyright: (c) 2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+--+-- The main module of nvfetcher. If you want to create CLI program with it, it's enough to import only this module.+--+-- Example:+--+-- @+-- module Main where+--+-- import NvFetcher+--+-- main :: IO ()+-- main = defaultMain defaultArgs packageSet+--+-- packageSet :: PackageSet ()+-- packageSet = do+--   define $ package "feeluown-core" `fromPypi` "feeluown"+--   define $ package "qliveplayer" `fromGitHub` ("IsoaSFlus", "QLivePlayer")+-- @+--+-- You can find more examples of packages in @Main_example.hs@.+--+-- Running the created program:+--+-- * @main@ -- abbreviation of @main build@+-- * @main build@ -- build nix sources expr from given @packageSet@+-- * @main clean@ -- delete .shake dir and generated nix file+-- * @main -j@ -- build with parallelism+--+-- All shake options are inherited.+module NvFetcher+  ( Args (..),+    defaultArgs,+    runNvFetcher,+    runNvFetcherWith,+    module NvFetcher.PackageSet,+    module NvFetcher.Types,+    module NvFetcher.ShakeExtras,+  )+where++import Control.Monad.Trans.Maybe+import Data.Text (Text)+import qualified Data.Text as T+import Development.Shake+import NeatInterpolation (trimming)+import NvFetcher.Core+import NvFetcher.NixFetcher+import NvFetcher.Nvchecker+import NvFetcher.PackageSet+import NvFetcher.ShakeExtras+import NvFetcher.Types+import System.Console.GetOpt (OptDescr)++-- | Arguments for running nvfetcher+data Args = Args+  { -- | tweak shake options+    argShakeOptions :: ShakeOptions -> ShakeOptions,+    -- | Output file path+    argOutputFilePath :: FilePath,+    -- | Custom rules+    argRules :: Rules (),+    -- | Action run after build rule+    argActionAfterBuild :: Action (),+    -- | Action run after clean rule+    argActionAfterClean :: Action ()+  }++-- | Default arguments of 'defaultMain'+--+-- Output file path is @sources.nix@.+defaultArgs :: Args+defaultArgs =+  Args+    ( \x ->+        x+          { shakeTimings = True,+            shakeProgress = progressSimple+          }+    )+    "sources.nix"+    (pure ())+    (pure ())+    (pure ())++-- | Entry point of nvfetcher+runNvFetcher :: Args -> PackageSet () -> IO ()+runNvFetcher args packageSet = runNvFetcherWith [] $ const $ pure $ Just (args, packageSet)++-- | Like 'runNvFetcher' but allows to define custom cli flags+runNvFetcherWith ::+  -- | Custom flags+  [OptDescr (Either String a)] ->+  -- | Continuation, the build system won't run if it returns Nothing+  ([a] -> IO (Maybe (Args, PackageSet ()))) ->+  IO ()+runNvFetcherWith flags f = do+  shakeArgsOptionsWith+    shakeOptions+    flags+    $ \opts flagValues argValues -> runMaybeT $ do+      (args@Args {..}, packageSet) <- MaybeT $ f flagValues+      pkgs <- liftIO $ runPackageSet packageSet+      shakeExtras <- liftIO $ initShakeExtras pkgs+      let opts' =+            let old = argShakeOptions opts+             in old+                  { shakeExtra = addShakeExtra shakeExtras (shakeExtra old)+                  }+          rules = mainRules args+      pure $ case argValues of+        [] -> (opts', want ["build"] >> rules)+        files -> (opts', want files >> rules)++mainRules :: Args -> Rules ()+mainRules Args {..} = do+  addHelpSuffix "It's important to keep .shake dir if you want to get correct version changes and proper cache"+  addHelpSuffix "Changing input packages will lead to a fully cleanup, requiring to rebuild everything next run"++  "clean" ~> do+    removeFilesAfter ".shake" ["//*"]+    removeFilesAfter "." [argOutputFilePath]+    argActionAfterClean++  "build" ~> do+    allKeys <- getAllPackageKeys+    body <- parallel $ generateNixSourceExpr <$> allKeys+    getVersionChanges >>= \changes ->+      if null changes+        then putInfo "Up to date"+        else do+          putInfo "Changes:"+          putInfo $ unlines $ show <$> changes+    writeFileChanged argOutputFilePath $ T.unpack $ srouces $ T.unlines body+    putInfo $ "Generate " <> argOutputFilePath+    argActionAfterBuild++  argRules+  coreRules++srouces :: Text -> Text+srouces body =+  [trimming|+    # This file was generated by nvfetcher, please do not modify it manually.+    { fetchgit, fetchurl }:+    {+      $body+    }+  |]
+ src/NvFetcher/Core.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++-- | Copyright: (c) 2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+module NvFetcher.Core+  ( coreRules,+    generateNixSourceExpr,+  )+where++import Data.Coerce (coerce)+import Data.Text (Text)+import Development.Shake+import Development.Shake.Rule+import NeatInterpolation (trimming)+import NvFetcher.NixFetcher+import NvFetcher.Nvchecker+import NvFetcher.ShakeExtras+import NvFetcher.Types+import NvFetcher.Utils++-- | The core rule of nvchecker.+-- nvchecker rule and prefetch rule are wired here.+coreRules :: Rules ()+coreRules = do+  nvcheckerRule+  prefetchRule+  addBuiltinRule noLint noIdentity $ \(WithPackageKey (Core, pkg)) mOld mode -> case mode of+    RunDependenciesSame+      | Just old <- mOld,+        (expr, _) <- decode' @(NixExpr, Version) old ->+        pure $ RunResult ChangedNothing old expr+    _ ->+      lookupPackage pkg >>= \case+        Nothing -> fail $ "Unkown package key: " <> show pkg+        Just Package {..} -> do+          (NvcheckerResult version mOldV) <- checkVersion pversion pkg+          prefetched <- prefetch $ pfetcher version+          case mOldV of+            Nothing ->+              recordVersionChange pname Nothing version+            Just old+              | old /= version ->+                recordVersionChange pname (Just old) version+            _ -> pure ()+          let result = gen pname version prefetched+          pure $ RunResult ChangedRecomputeDiff (encode' (result, version)) result++-- | Run the core rule.+-- Given a package key, run nvchecker and then prefetch it,+-- resulting a nix source snippet like:+--+-- @@+-- feeluown-core = {+--     pname = "feeluown-core";+--     version = "3.7.7";+--     src = fetchurl {+--       sha256 = "06d3j39ff9znqxkhp9ly81lcgajkhg30hyqxy2809yn23xixg3x2";+--       url = "https://pypi.io/packages/source/f/feeluown/feeluown-3.7.7.tar.gz";+--     };+--   };+-- @@+generateNixSourceExpr :: PackageKey -> Action NixExpr+generateNixSourceExpr k = apply1 $ WithPackageKey (Core, k)++gen :: PackageName -> Version -> NixFetcher Prefetched -> Text+gen name (coerce -> ver) (toNixExpr -> srcP) =+  [trimming|+  $name = {+    pname = "$name";+    version = "$ver";+    src = $srcP;+  };+|]
+ src/NvFetcher/NixFetcher.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++-- | Copyright: (c) 2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+--+-- 'NixFetcher' is used to describe how to fetch package sources.+--+-- There are two types of fetchers overall:+--+-- 1. 'FetchGit' -- nix-prefetch-git+-- 2. 'FetchUrl' -- nix-prefetch-url+--+-- As you can see the type signature of 'prefetch':+-- a fetcher will be filled with the fetch result (hash) after the prefetch.+module NvFetcher.NixFetcher+  ( -- * Types+    NixFetcher (..),+    Prefetch (..),+    ToNixExpr (..),+    PrefetchResult,++    -- * Rules+    prefetchRule,+    prefetch,++    -- * Functions+    gitHubFetcher,+    pypiFetcher,+    gitHubReleaseFetcher,+    gitFetcher,+    urlFetcher,+  )+where++import Control.Monad (void, (<=<))+import qualified Data.Aeson as A+import qualified Data.Aeson.Types as A+import Data.Coerce (coerce)+import Data.Maybe (maybeToList)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Development.Shake+import NeatInterpolation (trimming)+import NvFetcher.Types++--------------------------------------------------------------------------------++-- | Types can be converted into nix expr+class ToNixExpr a where+  toNixExpr :: a -> NixExpr++instance ToNixExpr (NixFetcher Fresh) where+  toNixExpr = buildNixFetcher "lib.fakeSha256"++instance ToNixExpr (NixFetcher Prefetched) where+  -- add quotation marks+  toNixExpr f = buildNixFetcher (T.pack $ show $ T.unpack $ coerce $ sha256 f) f++instance ToNixExpr Bool where+  toNixExpr True = "true"+  toNixExpr False = "false"++instance ToNixExpr Version where+  toNixExpr = coerce++runFetcher :: NixFetcher Fresh -> Action SHA256+runFetcher = \case+  FetchGit {..} -> do+    let parser = A.withObject "nix-prefetch-git" $ \o -> SHA256 <$> o A..: "sha256"+    (CmdTime t, Stdout out, CmdLine c) <-+      command [EchoStderr False] "nix-prefetch-git" $+        [T.unpack furl]+          <> ["--rev", T.unpack $ coerce rev]+          <> ["--fetch-submodules" | fetchSubmodules]+          <> ["--branch-name " <> T.unpack b | b <- maybeToList branch]+          <> ["--deepClone" | deepClone]+          <> ["--leave-dotGit" | leaveDotGit]+    putInfo $ "Finishing running " <> c <> ", took " <> show t <> "s"+    let result = A.parseMaybe parser <=< A.decodeStrict $ out+    case result of+      Just x -> pure x+      _ -> fail $ "Failed to parse output from nix-prefetch-git: " <> T.unpack (T.decodeUtf8 out)+  FetchUrl {..} -> do+    (CmdTime t, Stdout (T.decodeUtf8 -> out), CmdLine c) <- command [EchoStderr False] "nix-prefetch-url" [T.unpack furl]+    putInfo $ "Finishing running " <> c <> ", took " <> show t <> "s"+    case takeWhile (not . T.null) $ reverse $ T.lines out of+      [x] -> pure $ coerce x+      _ -> fail $ "Failed to parse output from nix-prefetch-url: " <> T.unpack out++buildNixFetcher :: Text -> NixFetcher k -> Text+buildNixFetcher sha256 = \case+  FetchGit+    { sha256 = _,+      rev = toNixExpr -> rev,+      fetchSubmodules = toNixExpr -> fetchSubmodules,+      deepClone = toNixExpr -> deepClone,+      leaveDotGit = toNixExpr -> leaveDotGit,+      ..+    } ->+      [trimming|+          fetchgit {+            url = "$furl";+            rev = "$rev";+            fetchSubmodules = $fetchSubmodules;+            deepClone = $deepClone;+            leaveDotGit = $leaveDotGit;+            sha256 = $sha256;+          }+    |]+  (FetchUrl url _) ->+    [trimming|+          fetchurl {+            sha256 = $sha256;+            url = "$url";+          }+    |]++pypiUrl :: Text -> Version -> Text+pypiUrl pypi (coerce -> ver) =+  let h = T.cons (T.head pypi) ""+   in [trimming|https://pypi.io/packages/source/$h/$pypi/$pypi-$ver.tar.gz|]++--------------------------------------------------------------------------------++-- | Rules of nix fetcher+prefetchRule :: Rules ()+prefetchRule = void $+  addOracleCache $ \(f :: NixFetcher Fresh) -> do+    sha256 <- runFetcher f+    pure $ f {sha256 = sha256}++-- | Run nix fetcher+prefetch :: NixFetcher Fresh -> Action (NixFetcher Prefetched)+prefetch = askOracle++--------------------------------------------------------------------------------++-- | Create a fetcher from git url+gitFetcher :: Text -> PackageFetcher+gitFetcher furl rev = FetchGit furl rev Nothing False False False ()++-- | Create a fetcher from github repo+gitHubFetcher ::+  -- | owner and repo+  (Text, Text) ->+  PackageFetcher+gitHubFetcher (owner, repo) = gitFetcher [trimming|https://github.com/$owner/$repo|]++-- | Create a fetcher from pypi+pypiFetcher :: Text -> PackageFetcher+pypiFetcher p v = urlFetcher $ pypiUrl p v++-- | Create a fetcher from github release+gitHubReleaseFetcher ::+  -- | owner and repo+  (Text, Text) ->+  -- | file name+  Text ->+  PackageFetcher+gitHubReleaseFetcher (owner, repo) fp (coerce -> ver) =+  urlFetcher+    [trimming|https://github.com/$owner/$repo/releases/download/$ver/$fp|]++-- | Create a fetcher from url+urlFetcher :: Text -> NixFetcher Fresh+urlFetcher = flip FetchUrl ()
+ src/NvFetcher/Nvchecker.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | Copyright: (c) 2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+--+-- [nvchecker](https://github.com/lilydjwg/nvchecker) is a program checking new versions of packages.+-- We encode the checking process into shake build system, generating configuration of nvchecker and calling it externally.+-- Now we call nvchecker for each 'VersionSource', which seems not to be efficient, but it's tolerable when running in parallel.+--+-- Meanwhile, we lose the capabilities of tracking version updates, i.e. normally nvchecker will help us maintain a list of old versions,+-- so that we are able to know which package's version is updated in this run. Fortunately, we can reimplement this using shake database,+-- see 'nvcheckerRule' for details.+module NvFetcher.Nvchecker+  ( -- * Types+    VersionSource (..),+    NvcheckerResult (..),++    -- * Rules+    nvcheckerRule,+    checkVersion,+  )+where++import qualified Data.Aeson as A+import Data.Coerce (coerce)+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Development.Shake+import Development.Shake.Rule+import NeatInterpolation (trimming)+import NvFetcher.ShakeExtras+import NvFetcher.Types+import NvFetcher.Utils++-- | Rules of nvchecker+nvcheckerRule :: Rules ()+nvcheckerRule = addBuiltinRule noLint noIdentity $ \(WithPackageKey (q, pkg)) old _mode ->+  -- If the package was removed after the last run,+  -- shake still runs the nvchecker rule for this package.+  -- So we record a version change here, indicating that the package has been removed.+  -- Ideally, this should be done in the core rule+  isPackageKeyTarget pkg >>= \case+    False -> do+      let oldVer = decode' <$> old+      recordVersionChange (coerce pkg) oldVer "∅"+      pure $ RunResult ChangedRecomputeDiff mempty undefined -- skip running, returning a never consumed result+    _ ->+      withTempFile $ \config -> do+        writeFile' config $ T.unpack $ genNvConfig "pkg" q+        need [config]+        (CmdTime t, Stdout out, CmdLine c) <- cmd $ "nvchecker --logger json -c " <> config+        putInfo $ "Finishing running " <> c <> ", took " <> show t <> "s"+        let out' = T.decodeUtf8 out+            result = mapMaybe (A.decodeStrict . T.encodeUtf8) (T.lines out')+        now <- case result of+          [x] -> pure x+          _ -> fail $ "Failed to parse output from nvchecker: " <> T.unpack out'+        pure $ case old of+          Just lastRun+            | cachedResult <- decode' lastRun ->+              if cachedResult == nvNow now+                then -- try to get the version in last run from store, filling it into 'now'+                  RunResult ChangedRecomputeSame lastRun now {nvOld = Just cachedResult}+                else RunResult ChangedRecomputeDiff (encode' $ nvNow now) now {nvOld = Just cachedResult}+          Nothing -> RunResult ChangedRecomputeDiff (encode' $ nvNow now) now++genNvConfig :: Text -> VersionSource -> Text+genNvConfig srcName = \case+  GitHubRelease {..} ->+    [trimming|+          [$srcName]+          source = "github"+          github = "$owner/$repo"+          use_latest_release = true+    |]+  Git {..} ->+    [trimming|+          [$srcName]+          source = "git"+          git = "$vurl"+          use_commit = true+    |]+  Aur {..} ->+    [trimming|+          [$srcName]+          source = "aur"+          aur = "$aur"+          strip_release = true+    |]+  ArchLinux {..} ->+    [trimming|+          [$srcName]+          source = "archpkg"+          archpkg = "$archpkg"+          strip_release = true+    |]+  Pypi {..} ->+    [trimming|+          [$srcName]+          source = "pypi"+          pypi = "$pypi"+    |]+  Manual {..} ->+    [trimming|+          [$srcName]+          source = "manual"+          manual = "$manual"+    |]+  Repology {..} ->+    [trimming|+          [$srcName]+          source = "repology"+          repology = "$repology"+          repo = "$repo"+    |]++-- | Run nvchecker+checkVersion :: VersionSource -> PackageKey -> Action NvcheckerResult+checkVersion v k = apply1 $ WithPackageKey (v, k)
+ src/NvFetcher/PackageSet.hs view
@@ -0,0 +1,325 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Copyright: (c) 2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+--+-- This module mainly contains two things: 'PackageSet' and 'PkgDSL'.+-- NvFetcher accepts the former one -- a set of packages to produce nix sources expr;+-- the later one is used to construct a single package.+--+-- There are many combinators for defining packages. See the documentation of 'define' for example.+module NvFetcher.PackageSet+  ( -- * Package set+    PackageSetF,+    PackageSet,+    newPackage,+    purePackageSet,+    runPackageSet,++    -- * Package DSL++    -- ** Primitives+    PkgDSL (..),+    define,+    package,+    src,+    fetch,++    -- ** Two-in-one functions+    fromGitHub,+    fromPypi,++    -- ** Version sources+    sourceGitHub,+    sourceGit,+    sourcePypi,+    sourceAur,+    sourceArchLinux,+    sourceManual,+    sourceRepology,++    -- ** Fetchers+    fetchGitHub,+    fetchGitHubRelease,+    fetchPypi,+    fetchGit,+    fetchUrl,++    -- ** Miscellaneous+    Prod,+    Member,+    NotElem,+    coerce,+    liftIO,+  )+where++import Control.Monad.Free+import Control.Monad.IO.Class+import Data.Coerce (coerce)+import Data.Kind (Constraint, Type)+import Data.HashMap.Strict as HMap+import Data.Maybe (isJust)+import Data.Text (Text)+import GHC.TypeLits+import NvFetcher.NixFetcher+import NvFetcher.Types++--------------------------------------------------------------------------------++-- | Atomic terms of package set+data PackageSetF f+  = NewPackage !Package f+  | forall a. EmbedIO !(IO a) (a -> f)++instance Functor PackageSetF where+  fmap f (NewPackage p g) = NewPackage p $ f g+  fmap f (EmbedIO action g) = EmbedIO action $ f <$> g++-- | Package set is a monad equipped with two capabilities:+--+-- 1. Carry defined packages+-- 2. Run IO actions+--+-- Package set is evaluated be for shake runs.+-- Use 'newPackage' to add a new package, 'liftIO' to run an IO action.+type PackageSet = Free PackageSetF++instance MonadIO PackageSet where+  liftIO io = liftF $ EmbedIO io id++-- | Add a package to package set+newPackage ::+  PackageName ->+  VersionSource ->+  PackageFetcher ->+  PackageSet ()+newPackage name source fetcher = liftF $ NewPackage (Package name source fetcher) ()++-- | Add a list of packages into package set+purePackageSet :: [Package] -> PackageSet ()+purePackageSet = mapM_ (liftF . flip NewPackage ())++-- | Run package set into a set of packages+--+-- Throws exception as more then one packages with the same name+-- are defined+runPackageSet :: PackageSet () -> IO (HashMap PackageKey Package)+runPackageSet = \case+  Free (NewPackage p g) ->+    runPackageSet g >>= \m ->+      if isJust (HMap.lookup (PackageKey $ pname p) m)+        then fail $ "Duplicate package name: " <> show (pname p)+        else pure $ HMap.insert (PackageKey $ pname p) p m+  Free (EmbedIO action g) -> action >>= runPackageSet . g+  Pure _ -> pure mempty++--------------------------------------------------------------------------------++-- | Simple HList+data Prod (r :: [Type]) where+  Nil :: Prod '[]+  Cons :: !x -> Prod xs -> Prod (x ': xs)++-- | Project elements from 'Prod'+class Member (a :: Type) (r :: [Type]) where+  proj :: Prod r -> a++instance {-# OVERLAPPING #-} NotElem x xs => Member x (x ': xs) where+  proj (Cons x _) = x++instance Member x xs => Member x (_y ': xs) where+  proj (Cons _ r) = proj r++instance TypeError (ShowType x :<>: 'Text " is undefined") => Member x '[] where+  proj = undefined++-- | Constraint for producing error messages+type family NotElem (x :: Type) (xs :: [Type]) :: Constraint where+  NotElem x (x ': xs) = TypeError (ShowType x :<>: 'Text " is defined more than one times")+  NotElem x (_ ': xs) = NotElem x xs+  NotElem x '[] = ()++--------------------------------------------------------------------------------++-- | A tagless final style DSL for constructing packages+class PkgDSL f where+  new :: f PackageName -> f (Prod '[PackageName])+  andThen :: f (Prod r) -> f a -> f (Prod (a ': r))+  end :: (Member PackageName r, Member VersionSource r, Member PackageFetcher r) => f (Prod r) -> f ()++instance PkgDSL PackageSet where+  new e = do+    name <- e+    pure $ Cons name Nil+  andThen e e' = do+    p <- e+    x <- e'+    pure $ Cons x p+  end e = do+    p <- e+    newPackage (proj p) (proj p) (proj p)++-- | 'PkgDSL' version of 'newPackage'+--+-- Example:+--+-- @+-- define $ package "nvfetcher-git" `sourceGit` "nvfetcher" `fetchGitHub` ("berberman", "nvfetcher")+-- @+define ::+  ( Member PackageName r,+    Member VersionSource r,+    Member PackageFetcher r+  ) =>+  PackageSet (Prod r) ->+  PackageSet ()+define = end++-- | Start chaining with the name of package to define+package :: PackageName -> PackageSet (Prod '[PackageName])+package = new . pure++-- | Attach version sources+src :: PackageSet (Prod r) -> VersionSource -> PackageSet (Prod (VersionSource ': r))+src = (. pure) . andThen++-- | Attach fetchers+fetch ::+  PackageSet (Prod r) ->+  PackageFetcher ->+  PackageSet (Prod (PackageFetcher ': r))+fetch = (. pure) . andThen++--------------------------------------------------------------------------------++-- | A synonym of 'fetchGitHub' and 'sourceGitHub'+fromGitHub ::+  PackageSet (Prod r) ->+  (Text, Text) ->+  PackageSet+    (Prod (PackageFetcher : VersionSource : r))+fromGitHub e p = fetchGitHub (sourceGitHub e p) p++-- | A synonym of 'fetchPypi' and 'sourcePypi'+fromPypi ::+  PackageSet (Prod r) ->+  Text ->+  PackageSet+    (Prod (PackageFetcher : VersionSource : r))+fromPypi e p = fetchPypi (sourcePypi e p) p++--------------------------------------------------------------------------------++-- | This package follows the latest github release+sourceGitHub ::+  PackageSet (Prod r) ->+  -- | owner and repo+  (Text, Text) ->+  PackageSet (Prod (VersionSource : r))+sourceGitHub e (owner, repo) = src e $ GitHubRelease owner repo++-- | This package follows the latest git commit+sourceGit ::+  PackageSet (Prod r) ->+  -- | git url+  Text ->+  PackageSet (Prod (VersionSource : r))+sourceGit e vurl = src e Git {..}++-- | This package follows the latest pypi release+sourcePypi ::+  PackageSet (Prod r) ->+  -- | pypi name+  Text ->+  PackageSet (Prod (VersionSource : r))+sourcePypi e pypi = src e Pypi {..}++-- | This package follows the version of an Arch Linux package+sourceArchLinux ::+  PackageSet (Prod r) ->+  -- | package name in Arch Linux repo+  Text ->+  PackageSet (Prod (VersionSource : r))+sourceArchLinux e archpkg = src e ArchLinux {..}++-- | This package follows the version of an Aur package+sourceAur ::+  PackageSet (Prod r) ->+  -- | package name in Aur+  Text ->+  PackageSet (Prod (VersionSource : r))+sourceAur e aur = src e Aur {..}++-- | This package follows a pinned version+sourceManual ::+  PackageSet (Prod r) ->+  Text ->+  PackageSet (Prod (VersionSource : r))+sourceManual e manual = src e Manual {..}++-- | This package follows the version of a repology package+sourceRepology ::+  PackageSet (Prod r) ->+  -- | repology project name and repo+  (Text, Text) ->+  PackageSet (Prod (VersionSource : r))+sourceRepology e (project, repo) = src e $ Repology project repo++--------------------------------------------------------------------------------++-- | This package is fetched from a github repo+fetchGitHub ::+  PackageSet (Prod r) ->+  -- | owner and repo+  (Text, Text) ->+  PackageSet (Prod (PackageFetcher : r))+fetchGitHub e p = fetch e $ gitHubFetcher p++-- | This package is fetched from a file in github release+fetchGitHubRelease ::+  PackageSet (Prod r) ->+  -- | owner, repo, and file name+  (Text, Text, Text) ->+  PackageSet (Prod (PackageFetcher : r))+fetchGitHubRelease e (owner, repo, fp) = fetch e $ gitHubReleaseFetcher (owner, repo) fp++-- | This package is fetched from pypi+fetchPypi ::+  PackageSet (Prod r) ->+  -- | pypi name+  Text ->+  PackageSet (Prod (PackageFetcher : r))+fetchPypi e = fetch e . pypiFetcher++-- | This package is fetched from git+fetchGit ::+  PackageSet (Prod r) ->+  -- | git url+  Text ->+  PackageSet (Prod (PackageFetcher : r))+fetchGit e = fetch e . gitFetcher++-- | This package is fetched from url+fetchUrl ::+  PackageSet (Prod r) ->+  -- | url, given a specific version+  (Version -> Text) ->+  PackageSet (Prod (PackageFetcher : r))+fetchUrl e f = fetch e (urlFetcher . f)++--------------------------------------------------------------------------------
+ src/NvFetcher/ShakeExtras.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++-- | Copyright: (c) 2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+--+-- This module is about global information we use in rules.+module NvFetcher.ShakeExtras+  ( -- * Types+    ShakeExtras (..),+    initShakeExtras,+    getShakeExtras,++    -- * Packages+    lookupPackage,+    getAllPackageKeys,+    isPackageKeyTarget,++    -- * Version changes+    recordVersionChange,+    getVersionChanges,+  )+where++import Control.Concurrent.Extra+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HMap+import Development.Shake+import NvFetcher.Types++-- | Values we use during the build. It's stored in 'shakeExtra'+data ShakeExtras = ShakeExtras+  { versionChanges :: Var [VersionChange],+    targetPackages :: HashMap PackageKey Package+  }++-- | Get our values from shake+getShakeExtras :: Action ShakeExtras+getShakeExtras =+  getShakeExtra @ShakeExtras >>= \case+    Just x -> pure x+    _ -> fail "ShakeExtras is missing!"++-- | Create an empty 'ShakeExtras' from packages to build+initShakeExtras :: HashMap PackageKey Package -> IO ShakeExtras+initShakeExtras targetPackages = do+  versionChanges <- newVar mempty+  pure ShakeExtras {..}++-- | Get keys of all packages to build+getAllPackageKeys :: Action [PackageKey]+getAllPackageKeys = do+  ShakeExtras {..} <- getShakeExtras+  pure $ HMap.keys targetPackages++-- | Find a package given its key+lookupPackage :: PackageKey -> Action (Maybe Package)+lookupPackage key = do+  ShakeExtras {..} <- getShakeExtras+  pure $ HMap.lookup key targetPackages++-- | Check if we need build this package+isPackageKeyTarget :: PackageKey -> Action Bool+isPackageKeyTarget k = HMap.member k . targetPackages <$> getShakeExtras++-- | Record version change of a package+recordVersionChange :: PackageName -> Maybe Version -> Version -> Action ()+recordVersionChange vcName vcOld vcNew = do+  ShakeExtras {..} <- getShakeExtras+  liftIO $ modifyVar_ versionChanges (pure . (++ [VersionChange {..}]))++-- | Get version changes since the last run+getVersionChanges :: Action [VersionChange]+getVersionChanges = do+  ShakeExtras {..} <- getShakeExtras+  liftIO $ readVar versionChanges
+ src/NvFetcher/Types.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++-- | Copyright: (c) 2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+--+-- Types used in this program.+module NvFetcher.Types+  ( -- * Common types+    Version (..),+    SHA256 (..),+    NixExpr,+    VersionChange (..),+    WithPackageKey (..),+    Core (..),++    -- * Nvchecker types+    VersionSource (..),+    NvcheckerResult (..),++    -- * Nix fetcher types+    NixFetcher (..),+    Prefetch (..),+    PrefetchResult,++    -- * Package types+    PackageName,+    PackageFetcher,+    Package (..),+    PackageKey (..),+  )+where++import qualified Data.Aeson as A+import Data.Coerce (coerce)+import Data.Maybe (fromMaybe)+import Data.String (IsString)+import Data.Text (Text)+import qualified Data.Text as T+import Development.Shake+import Development.Shake.Classes+import GHC.Generics (Generic)++--------------------------------------------------------------------------------++-- | Package version+newtype Version = Version Text+  deriving newtype (Eq, Show, Ord, IsString, Semigroup, Monoid, A.FromJSON, A.ToJSON)+  deriving stock (Typeable, Generic)+  deriving anyclass (Hashable, Binary, NFData)++-- | SHA 256 sum+newtype SHA256 = SHA256 Text+  deriving newtype (Show, Eq)+  deriving stock (Typeable, Generic)+  deriving anyclass (Hashable, Binary, NFData)++-- | Version change of a package+--+-- >>> VersionChange "foo" Nothing "2.3.3"+-- foo: ∅ → 2.3.3+--+-- >>> VersionChange "bar" (Just "2.2.2") "2.3.3"+-- bar: 2.2.2 → 2.3.3+data VersionChange = VersionChange+  { vcName :: PackageName,+    vcOld :: Maybe Version,+    vcNew :: Version+  }+  deriving (Eq)++instance Show VersionChange where+  show VersionChange {..} =+    T.unpack $ vcName <> ": " <> fromMaybe "∅" (coerce vcOld) <> " → " <> coerce vcNew++-- | Nix expression+type NixExpr = Text++--------------------------------------------------------------------------------++-- | The input of nvchecker+data VersionSource+  = GitHubRelease {owner :: Text, repo :: Text}+  | Git {vurl :: Text}+  | Pypi {pypi :: Text}+  | ArchLinux {archpkg :: Text}+  | Aur {aur :: Text}+  | Manual {manual :: Text}+  | Repology {repology :: Text, repo :: Text}+  deriving (Show, Typeable, Eq, Ord, Generic, Hashable, Binary, NFData)++-- | The result of running nvchecker+data NvcheckerResult = NvcheckerResult+  { nvNow :: Version,+    -- | nvchecker doesn't give this value, but shake restores it from last run+    nvOld :: Maybe Version+  }+  deriving (Show, Typeable, Eq, Generic, Hashable, Binary, NFData)++instance A.FromJSON NvcheckerResult where+  parseJSON = A.withObject "NvcheckerResult" $ \o ->+    NvcheckerResult <$> o A..: "version" <*> pure Nothing++type instance RuleResult VersionSource = NvcheckerResult++--------------------------------------------------------------------------------++-- | If the package is prefetched, then we can obtain the SHA256+data NixFetcher (k :: Prefetch)+  = FetchGit+      { furl :: Text,+        rev :: Version,+        branch :: Maybe Text,+        deepClone :: Bool,+        fetchSubmodules :: Bool,+        leaveDotGit :: Bool,+        sha256 :: PrefetchResult k+      }+  | FetchUrl {furl :: Text, sha256 :: PrefetchResult k}+  deriving (Typeable, Generic)++-- | Prefetch status+data Prefetch = Fresh | Prefetched++-- | Prefetched fetchers hold hashes+type family PrefetchResult (k :: Prefetch) where+  PrefetchResult Fresh = ()+  PrefetchResult Prefetched = SHA256++type instance RuleResult (NixFetcher Fresh) = NixFetcher Prefetched++deriving instance Show (PrefetchResult k) => Show (NixFetcher k)++deriving instance Eq (PrefetchResult k) => Eq (NixFetcher k)++deriving instance Ord (PrefetchResult k) => Ord (NixFetcher k)++deriving instance Hashable (PrefetchResult k) => Hashable (NixFetcher k)++deriving instance Binary (PrefetchResult k) => Binary (NixFetcher k)++deriving instance NFData (PrefetchResult k) => NFData (NixFetcher k)++--------------------------------------------------------------------------------++-- | Package name, used in generating nix expr+type PackageName = Text++-- | How to create package source fetcher given a version+type PackageFetcher = Version -> NixFetcher Fresh++-- | A package is defined with:+--+-- 1. its name+-- 2. how to track its version+-- 3. how to fetch it as we have the version+--+-- /INVARIANT: 'Version' passed to 'PackageFetcher' MUST be used textually,/+-- /i.e. can only be concatenated with other strings,/+-- /in case we can't check the equality between fetcher functions./+data Package = Package+  { pname :: PackageName,+    pversion :: VersionSource,+    pfetcher :: PackageFetcher+  }++-- | Package key is the name of a package.+-- We use this type to index packages.+newtype PackageKey = PackageKey PackageName+  deriving newtype (Eq, Show, Ord)+  deriving stock (Typeable, Generic)+  deriving anyclass (Hashable, Binary, NFData)++-- | The key type of nvfetcher rule. See "NvFetcher.Core"+data Core = Core+  deriving (Eq, Show, Ord, Typeable, Generic, Hashable, Binary, NFData)++type instance RuleResult Core = NixExpr++--------------------------------------------------------------------------------++-- | Decorate a rule's key with 'PackageKey'+newtype WithPackageKey k = WithPackageKey (k, PackageKey)+  deriving newtype (Eq, Hashable, Binary, NFData)++instance Show k => Show (WithPackageKey k) where+  show (WithPackageKey (k, n)) = show k <> " (" <> show n <> ")"++type instance RuleResult (WithPackageKey k) = RuleResult k
+ src/NvFetcher/Utils.hs view
@@ -0,0 +1,11 @@+module NvFetcher.Utils where++import Data.Binary+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS++encode' :: Binary a => a -> BS.ByteString+encode' = BS.concat . LBS.toChunks . encode++decode' :: Binary a => BS.ByteString -> a+decode' = decode . LBS.fromChunks . pure