{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

-- | Copyright: (c) 2021-2022 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 five types of fetchers overall:
--
-- 1. 'FetchGit' -- nix-prefetch-git
-- 2. 'FetchGitHub' -- nix-prefetch-git/nix-prefetch-url
-- 3. 'FetchUrl' -- nix-prefetch-url
-- 4. 'FetchTarball' -- nix-prefetch-url
-- 5. 'FetchDocker' -- nix-prefetch-docker
--
-- 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
    RunFetch (..),
    ForceFetch (..),
    NixFetcher (..),
    FetchStatus (..),
    FetchResult,

    -- * Rules
    prefetchRule,
    prefetch,

    -- * Functions
    gitHubFetcher,
    pypiFetcher,
    gitHubReleaseFetcher,
    gitHubReleaseFetcher',
    gitFetcher,
    urlFetcher,
    openVsxFetcher,
    vscodeMarketplaceFetcher,
    tarballFetcher,
  )
where

import Control.Monad (void, when)
import qualified Data.Aeson as A
import Data.Coerce (coerce)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Development.Shake
import GHC.Generics (Generic)
import NeatInterpolation (trimming)
import NvFetcher.Types
import NvFetcher.Types.ShakeExtras
import Prettyprinter (pretty, (<+>))

--------------------------------------------------------------------------------

sha256ToSri :: Text -> Action Checksum
sha256ToSri :: Text -> Action Checksum
sha256ToSri Text
sha256 = do
  (CmdTime Double
t, Stdout (ByteString -> Text
T.decodeUtf8 -> Text
out), CmdLine String
c) <-
    forall a. Action a -> Action a
quietly forall a b. (a -> b) -> a -> b
$
      forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] String
"nix" [String
"hash", String
"to-sri", String
"--type", String
"sha256", Text -> String
T.unpack Text
sha256]
  String -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ String
"Finishing running " forall a. Semigroup a => a -> a -> a
<> String
c forall a. Semigroup a => a -> a -> a
<> String
", took " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
t forall a. Semigroup a => a -> a -> a
<> String
"s"
  case forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
out of
    [Text
x] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce Text
x
    [Text]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nix hash to-sri: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
out

runNixPrefetchUrl :: Text -> Bool -> Action Checksum
runNixPrefetchUrl :: Text -> Bool -> Action Checksum
runNixPrefetchUrl Text
url Bool
unpack = do
  (CmdTime Double
t, Stdout (ByteString -> Text
T.decodeUtf8 -> Text
out), CmdLine String
c) <-
    forall a. Action a -> Action a
quietly forall a b. (a -> b) -> a -> b
$
      forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] String
"nix-prefetch-url" forall a b. (a -> b) -> a -> b
$
        [Text -> String
T.unpack Text
url] forall a. Semigroup a => a -> a -> a
<> [String
"--unpack" | Bool
unpack]
  String -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ String
"Finishing running " forall a. Semigroup a => a -> a -> a
<> String
c forall a. Semigroup a => a -> a -> a
<> String
", took " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
t forall a. Semigroup a => a -> a -> a
<> String
"s"
  case forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
out of
    [Text
x] -> Text -> Action Checksum
sha256ToSri Text
x
    [Text]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nix-prefetch-url: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
out

newtype FetchedGit = FetchedGit {FetchedGit -> Text
sha256 :: Text}
  deriving (Int -> FetchedGit -> ShowS
[FetchedGit] -> ShowS
FetchedGit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchedGit] -> ShowS
$cshowList :: [FetchedGit] -> ShowS
show :: FetchedGit -> String
$cshow :: FetchedGit -> String
showsPrec :: Int -> FetchedGit -> ShowS
$cshowsPrec :: Int -> FetchedGit -> ShowS
Show, forall x. Rep FetchedGit x -> FetchedGit
forall x. FetchedGit -> Rep FetchedGit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FetchedGit x -> FetchedGit
$cfrom :: forall x. FetchedGit -> Rep FetchedGit x
Generic, Value -> Parser [FetchedGit]
Value -> Parser FetchedGit
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FetchedGit]
$cparseJSONList :: Value -> Parser [FetchedGit]
parseJSON :: Value -> Parser FetchedGit
$cparseJSON :: Value -> Parser FetchedGit
A.FromJSON)

runNixPrefetchGit :: Text -> Text -> Bool -> Bool -> Bool -> Action Checksum
runNixPrefetchGit :: Text -> Text -> Bool -> Bool -> Bool -> Action Checksum
runNixPrefetchGit Text
url Text
rev Bool
fetchSubmodules Bool
deepClone Bool
leaveDotGit = do
  (CmdTime Double
t, Stdout ByteString
out, CmdLine String
c) <-
    forall a. Action a -> Action a
quietly forall a b. (a -> b) -> a -> b
$
      forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] String
"nix-prefetch-git" forall a b. (a -> b) -> a -> b
$
        [String
"--url", Text -> String
T.unpack Text
url]
          forall a. Semigroup a => a -> a -> a
<> [String
"--rev", Text -> String
T.unpack Text
rev]
          forall a. Semigroup a => a -> a -> a
<> [String
"--fetch-submodules" | Bool
fetchSubmodules]
          forall a. Semigroup a => a -> a -> a
<> [String
"--deepClone" | Bool
deepClone]
          forall a. Semigroup a => a -> a -> a
<> [String
"--leave-dotGit" | Bool
leaveDotGit]
  String -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ String
"Finishing running " forall a. Semigroup a => a -> a -> a
<> String
c forall a. Semigroup a => a -> a -> a
<> String
", took " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
t forall a. Semigroup a => a -> a -> a
<> String
"s"
  case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
out of
    Right (FetchedGit Text
x) -> Text -> Action Checksum
sha256ToSri Text
x
    Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nix-prefetch-git as JSON: " forall a. Semigroup a => a -> a -> a
<> String
e

--------------------------------------------------------------------------------

runFetcher :: NixFetcher Fresh -> Action (NixFetcher Fetched)
runFetcher :: NixFetcher 'Fresh -> Action (NixFetcher 'Fetched)
runFetcher = \case
  FetchGit {Bool
Maybe Text
Text
FetchResult Checksum 'Fresh
Version
_sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_name :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_leaveDotGit :: forall (k :: FetchStatus). NixFetcher k -> Bool
_fetchSubmodules :: forall (k :: FetchStatus). NixFetcher k -> Bool
_deepClone :: forall (k :: FetchStatus). NixFetcher k -> Bool
_rev :: forall (k :: FetchStatus). NixFetcher k -> Version
_furl :: forall (k :: FetchStatus). NixFetcher k -> Text
_sha256 :: FetchResult Checksum 'Fresh
_name :: Maybe Text
_leaveDotGit :: Bool
_fetchSubmodules :: Bool
_deepClone :: Bool
_rev :: Version
_furl :: Text
..} -> do
    Checksum
result <- Text -> Text -> Bool -> Bool -> Bool -> Action Checksum
runNixPrefetchGit Text
_furl (coerce :: forall a b. Coercible a b => a -> b
coerce Version
_rev) Bool
_fetchSubmodules Bool
_deepClone Bool
_leaveDotGit
    forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchGit {_sha256 :: FetchResult Checksum 'Fetched
_sha256 = coerce :: forall a b. Coercible a b => a -> b
coerce Checksum
result, Bool
Maybe Text
Text
Version
_name :: Maybe Text
_leaveDotGit :: Bool
_fetchSubmodules :: Bool
_deepClone :: Bool
_rev :: Version
_furl :: Text
_name :: Maybe Text
_leaveDotGit :: Bool
_fetchSubmodules :: Bool
_deepClone :: Bool
_rev :: Version
_furl :: Text
..}
  FetchGitHub {Bool
Maybe Text
Text
FetchResult Checksum 'Fresh
Version
_frepo :: forall (k :: FetchStatus). NixFetcher k -> Text
_fowner :: forall (k :: FetchStatus). NixFetcher k -> Text
_sha256 :: FetchResult Checksum 'Fresh
_name :: Maybe Text
_leaveDotGit :: Bool
_fetchSubmodules :: Bool
_deepClone :: Bool
_rev :: Version
_frepo :: Text
_fowner :: Text
_sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_name :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_leaveDotGit :: forall (k :: FetchStatus). NixFetcher k -> Bool
_fetchSubmodules :: forall (k :: FetchStatus). NixFetcher k -> Bool
_deepClone :: forall (k :: FetchStatus). NixFetcher k -> Bool
_rev :: forall (k :: FetchStatus). NixFetcher k -> Version
..} -> do
    let useFetchGit :: Bool
useFetchGit = Bool
_fetchSubmodules Bool -> Bool -> Bool
|| Bool
_leaveDotGit Bool -> Bool -> Bool
|| Bool
_deepClone
        ver :: Text
ver = coerce :: forall a b. Coercible a b => a -> b
coerce Version
_rev
    Checksum
result <-
      if Bool
useFetchGit
        then Text -> Text -> Bool -> Bool -> Bool -> Action Checksum
runNixPrefetchGit [trimming|https://github.com/$_fowner/$_frepo|] (coerce :: forall a b. Coercible a b => a -> b
coerce Version
_rev) Bool
_fetchSubmodules Bool
_deepClone Bool
_leaveDotGit
        else Text -> Bool -> Action Checksum
runNixPrefetchUrl [trimming|https://github.com/$_fowner/$_frepo/archive/$ver.tar.gz|] Bool
True
    forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchGitHub {_sha256 :: FetchResult Checksum 'Fetched
_sha256 = Checksum
result, Bool
Maybe Text
Text
Version
_frepo :: Text
_fowner :: Text
_name :: Maybe Text
_leaveDotGit :: Bool
_fetchSubmodules :: Bool
_deepClone :: Bool
_rev :: Version
_frepo :: Text
_fowner :: Text
_name :: Maybe Text
_leaveDotGit :: Bool
_fetchSubmodules :: Bool
_deepClone :: Bool
_rev :: Version
..}
  FetchUrl {Maybe Text
Text
FetchResult Checksum 'Fresh
_sha256 :: FetchResult Checksum 'Fresh
_name :: Maybe Text
_furl :: Text
_sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_name :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_furl :: forall (k :: FetchStatus). NixFetcher k -> Text
..} -> do
    Checksum
result <- Text -> Bool -> Action Checksum
runNixPrefetchUrl Text
_furl Bool
False
    forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchUrl {_sha256 :: FetchResult Checksum 'Fetched
_sha256 = Checksum
result, Maybe Text
Text
_name :: Maybe Text
_furl :: Text
_name :: Maybe Text
_furl :: Text
..}
  FetchTarball {Text
FetchResult Checksum 'Fresh
_sha256 :: FetchResult Checksum 'Fresh
_furl :: Text
_sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_furl :: forall (k :: FetchStatus). NixFetcher k -> Text
..} -> do
    Checksum
result <- Text -> Bool -> Action Checksum
runNixPrefetchUrl Text
_furl Bool
True
    forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchTarball {_sha256 :: FetchResult Checksum 'Fetched
_sha256 = Checksum
result, Text
_furl :: Text
_furl :: Text
..}
  FetchDocker {Maybe Bool
Maybe Text
Text
FetchResult ContainerDigest 'Fresh
FetchResult Checksum 'Fresh
_tlsVerify :: forall (k :: FetchStatus). NixFetcher k -> Maybe Bool
_finalImageTag :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_finalImageName :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_farch :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_fos :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_imageDigest :: forall (k :: FetchStatus).
NixFetcher k -> FetchResult ContainerDigest k
_imageTag :: forall (k :: FetchStatus). NixFetcher k -> Text
_imageName :: forall (k :: FetchStatus). NixFetcher k -> Text
_tlsVerify :: Maybe Bool
_finalImageTag :: Maybe Text
_finalImageName :: Maybe Text
_farch :: Maybe Text
_fos :: Maybe Text
_sha256 :: FetchResult Checksum 'Fresh
_imageDigest :: FetchResult ContainerDigest 'Fresh
_imageTag :: Text
_imageName :: Text
_sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
..} -> do
    (CmdTime Double
t, Stdout ByteString
out, CmdLine String
c) <-
      forall a. Action a -> Action a
quietly forall a b. (a -> b) -> a -> b
$
        forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] String
"nix-prefetch-docker" forall a b. (a -> b) -> a -> b
$
          [ String
"--json",
            Text -> String
T.unpack Text
_imageName,
            Text -> String
T.unpack Text
_imageTag
          ]
            forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"--os", Text -> String
T.unpack Text
os] | Just Text
os <- [Maybe Text
_fos]]
            forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"--arch", Text -> String
T.unpack Text
arch] | Just Text
arch <- [Maybe Text
_farch]]
    String -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ String
"Finishing running " forall a. Semigroup a => a -> a -> a
<> String
c forall a. Semigroup a => a -> a -> a
<> String
", took " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
t forall a. Semigroup a => a -> a -> a
<> String
"s"
    case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
out of
      Right FetchedContainer {Text
ContainerDigest
$sel:sha256:FetchedContainer :: FetchedContainer -> Text
$sel:imageDigest:FetchedContainer :: FetchedContainer -> ContainerDigest
sha256 :: Text
imageDigest :: ContainerDigest
..} -> do
        Checksum
sri <- Text -> Action Checksum
sha256ToSri Text
sha256
        forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchDocker {_sha256 :: FetchResult Checksum 'Fetched
_sha256 = Checksum
sri, _imageDigest :: FetchResult ContainerDigest 'Fetched
_imageDigest = ContainerDigest
imageDigest, Maybe Bool
Maybe Text
Text
_tlsVerify :: Maybe Bool
_finalImageTag :: Maybe Text
_finalImageName :: Maybe Text
_farch :: Maybe Text
_fos :: Maybe Text
_imageTag :: Text
_imageName :: Text
_tlsVerify :: Maybe Bool
_finalImageTag :: Maybe Text
_finalImageName :: Maybe Text
_farch :: Maybe Text
_fos :: Maybe Text
_imageTag :: Text
_imageName :: Text
..}
      Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nix-prefetch-docker as JSON: " forall a. Semigroup a => a -> a -> a
<> String
e

data FetchedContainer = FetchedContainer
  { FetchedContainer -> ContainerDigest
imageDigest :: ContainerDigest,
    FetchedContainer -> Text
sha256 :: Text
  }
  deriving (Int -> FetchedContainer -> ShowS
[FetchedContainer] -> ShowS
FetchedContainer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchedContainer] -> ShowS
$cshowList :: [FetchedContainer] -> ShowS
show :: FetchedContainer -> String
$cshow :: FetchedContainer -> String
showsPrec :: Int -> FetchedContainer -> ShowS
$cshowsPrec :: Int -> FetchedContainer -> ShowS
Show, forall x. Rep FetchedContainer x -> FetchedContainer
forall x. FetchedContainer -> Rep FetchedContainer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FetchedContainer x -> FetchedContainer
$cfrom :: forall x. FetchedContainer -> Rep FetchedContainer x
Generic, Value -> Parser [FetchedContainer]
Value -> Parser FetchedContainer
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FetchedContainer]
$cparseJSONList :: Value -> Parser [FetchedContainer]
parseJSON :: Value -> Parser FetchedContainer
$cparseJSON :: Value -> Parser FetchedContainer
A.FromJSON)

pypiUrl :: Text -> Version -> Text
pypiUrl :: Text -> Version -> Text
pypiUrl Text
pypi (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
ver) =
  let h :: Text
h = Char -> Text -> Text
T.cons (Text -> Char
T.head Text
pypi) Text
""
   in [trimming|https://pypi.org/packages/source/$h/$pypi/$pypi-$ver.tar.gz|]

--------------------------------------------------------------------------------

-- | Rules of nix fetcher
prefetchRule :: Rules ()
prefetchRule :: Rules ()
prefetchRule = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
  forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracleCache forall a b. (a -> b) -> a -> b
$ \(RunFetch ForceFetch
force NixFetcher 'Fresh
f) -> do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ForceFetch
force forall a. Eq a => a -> a -> Bool
== ForceFetch
ForceFetch) Action ()
alwaysRerun
    String -> Action ()
putInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Doc Any
"#" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty NixFetcher 'Fresh
f
    forall a. Action a -> Action a
withRetry forall a b. (a -> b) -> a -> b
$ NixFetcher 'Fresh -> Action (NixFetcher 'Fetched)
runFetcher NixFetcher 'Fresh
f

-- | Run nix fetcher
prefetch :: NixFetcher Fresh -> ForceFetch -> Action (NixFetcher Fetched)
prefetch :: NixFetcher 'Fresh -> ForceFetch -> Action (NixFetcher 'Fetched)
prefetch NixFetcher 'Fresh
f ForceFetch
force = forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ ForceFetch -> NixFetcher 'Fresh -> RunFetch
RunFetch ForceFetch
force NixFetcher 'Fresh
f

--------------------------------------------------------------------------------

-- | Create a fetcher from git url
gitFetcher :: Text -> PackageFetcher
gitFetcher :: Text -> PackageFetcher
gitFetcher Text
furl Version
rev = forall (k :: FetchStatus).
Text
-> Version
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> FetchResult Checksum k
-> NixFetcher k
FetchGit Text
furl Version
rev Bool
False Bool
True Bool
False forall a. Maybe a
Nothing ()

-- | Create a fetcher from github repo
gitHubFetcher ::
  -- | owner and repo
  (Text, Text) ->
  PackageFetcher
gitHubFetcher :: (Text, Text) -> PackageFetcher
gitHubFetcher (Text
owner, Text
repo) Version
rev = forall (k :: FetchStatus).
Text
-> Text
-> Version
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> FetchResult Checksum k
-> NixFetcher k
FetchGitHub Text
owner Text
repo Version
rev Bool
False Bool
False Bool
False forall a. Maybe a
Nothing ()

-- | Create a fetcher from pypi
pypiFetcher :: Text -> PackageFetcher
pypiFetcher :: Text -> PackageFetcher
pypiFetcher Text
p Version
v = Text -> NixFetcher 'Fresh
urlFetcher forall a b. (a -> b) -> a -> b
$ Text -> Version -> Text
pypiUrl Text
p Version
v

-- | Create a fetcher from github release
gitHubReleaseFetcher ::
  -- | owner and repo
  (Text, Text) ->
  -- | file name
  Text ->
  PackageFetcher
gitHubReleaseFetcher :: (Text, Text) -> Text -> PackageFetcher
gitHubReleaseFetcher (Text
owner, Text
repo) Text
fp = (Text, Text) -> (Version -> Text) -> PackageFetcher
gitHubReleaseFetcher' (Text
owner, Text
repo) forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Text
fp

-- | Create a fetcher from github release
gitHubReleaseFetcher' ::
  -- | owner and repo
  (Text, Text) ->
  -- | file name computed from version
  (Version -> Text) ->
  PackageFetcher
gitHubReleaseFetcher' :: (Text, Text) -> (Version -> Text) -> PackageFetcher
gitHubReleaseFetcher' (Text
owner, Text
repo) Version -> Text
f (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
ver) =
  let fp :: Text
fp = Version -> Text
f forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce Text
ver
   in Text -> NixFetcher 'Fresh
urlFetcher
        [trimming|https://github.com/$owner/$repo/releases/download/$ver/$fp|]

-- | Create a fetcher from url
urlFetcher :: Text -> NixFetcher Fresh
urlFetcher :: Text -> NixFetcher 'Fresh
urlFetcher Text
url = forall (k :: FetchStatus).
Text -> Maybe Text -> FetchResult Checksum k -> NixFetcher k
FetchUrl Text
url forall a. Maybe a
Nothing ()

-- | Create a fetcher from openvsx
openVsxFetcher ::
  -- | publisher and extension name
  (Text, Text) ->
  PackageFetcher
openVsxFetcher :: (Text, Text) -> PackageFetcher
openVsxFetcher (Text
publisher, Text
extName) (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
ver) =
  forall (k :: FetchStatus).
Text -> Maybe Text -> FetchResult Checksum k -> NixFetcher k
FetchUrl
    [trimming|https://open-vsx.org/api/$publisher/$extName/$ver/file/$publisher.$extName-$ver.vsix|]
    (forall a. a -> Maybe a
Just [trimming|$extName-$ver.zip|])
    ()

-- | Create a fetcher from vscode marketplace
vscodeMarketplaceFetcher ::
  -- | publisher and extension name
  (Text, Text) ->
  PackageFetcher
vscodeMarketplaceFetcher :: (Text, Text) -> PackageFetcher
vscodeMarketplaceFetcher (Text
publisher, Text
extName) (coerce :: forall a b. Coercible a b => a -> b
coerce -> Text
ver) =
  forall (k :: FetchStatus).
Text -> Maybe Text -> FetchResult Checksum k -> NixFetcher k
FetchUrl
    [trimming|https://$publisher.gallery.vsassets.io/_apis/public/gallery/publisher/$publisher/extension/$extName/$ver/assetbyname/Microsoft.VisualStudio.Services.VSIXPackage|]
    (forall a. a -> Maybe a
Just [trimming|$extName-$ver.zip|])
    ()

-- | Create a fetcher from url, using fetchTarball
tarballFetcher :: Text -> NixFetcher Fresh
tarballFetcher :: Text -> NixFetcher 'Fresh
tarballFetcher Text
url = forall (k :: FetchStatus).
Text -> FetchResult Checksum k -> NixFetcher k
FetchTarball Text
url ()