{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

-- | Copyright: (c) 2021-2022 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
--
-- This module provides function to calculate @cargoLock@ used in @rustPlatform.buildRustPackage@.
module NvFetcher.FetchRustGitDeps
  ( -- * Types
    FetchRustGitDepsQ (..),

    -- * Rules
    fetchRustGitDepsRule,

    -- * Functions
    fetchRustGitDeps,
  )
where

import Control.Monad (void)
import Data.Binary.Instances ()
import Data.Coerce (coerce)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HMap
import Data.List.Extra (nubOrdOn)
import Data.Maybe (maybeToList)
import Data.Text (Text)
import qualified Data.Text as T
import Development.Shake
import NvFetcher.ExtractSrc
import NvFetcher.NixFetcher
import NvFetcher.Types
import Prettyprinter (pretty, (<+>))
import Text.Parsec
import Text.Parsec.Text
import Toml (TomlCodec, (.=))
import qualified Toml

-- | Rules of fetch rust git dependencies
fetchRustGitDepsRule :: Rules ()
fetchRustGitDepsRule :: Rules ()
fetchRustGitDepsRule = 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
$ \key :: FetchRustGitDepsQ
key@(FetchRustGitDepsQ NixFetcher 'Fetched
fetcher String
lockPath) -> do
    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 FetchRustGitDepsQ
key
    Text
cargoLock <- forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [v]
HMap.elems forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixFetcher 'Fetched -> String -> Action (HashMap String Text)
extractSrc NixFetcher 'Fetched
fetcher String
lockPath
    [RustDep]
deps <- case forall a. TomlCodec a -> Text -> Either [TomlDecodeError] a
Toml.decode (forall a. TomlCodec a -> Key -> TomlCodec [a]
Toml.list TomlCodec RustDep
rustDepCodec Key
"package") Text
cargoLock of
      Right [RustDep]
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn RustDep -> Maybe Text
rrawSrc [RustDep]
r
      Left [TomlDecodeError]
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse Cargo.lock: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack ([TomlDecodeError] -> Text
Toml.prettyTomlDecodeErrors [TomlDecodeError]
err)
    [(Text, Checksum)]
r <-
      forall a. [Action a] -> Action [a]
parallel
        [ case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser ParsedGitSrc
gitSrcParser (Text -> String
T.unpack Text
rname) Text
src of
            Right ParsedGitSrc {Text
Version
pgsha :: ParsedGitSrc -> Version
pgurl :: ParsedGitSrc -> Text
pgsha :: Version
pgurl :: Text
..} -> do
              (forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_sha256 -> FetchResult Checksum 'Fetched
sha256) <- NixFetcher 'Fresh -> ForceFetch -> Action (NixFetcher 'Fetched)
prefetch (Text -> PackageFetcher
gitFetcher Text
pgurl Version
pgsha) ForceFetch
NoForceFetch
              -- @${name}-${version}@ -> sha256
              forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
rname forall a. Semigroup a => a -> a -> a
<> Text
"-" forall a. Semigroup a => a -> a -> a
<> coerce :: forall a b. Coercible a b => a -> b
coerce Version
rversion, FetchResult Checksum 'Fetched
sha256)
            Left ParseError
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse git source in Cargo.lock: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParseError
err
          | RustDep {Maybe Text
Text
Version
rversion :: RustDep -> Version
rname :: RustDep -> Text
rrawSrc :: Maybe Text
rversion :: Version
rname :: Text
rrawSrc :: RustDep -> Maybe Text
..} <- [RustDep]
deps,
            -- it's a dependency
            Text
src <- forall a. Maybe a -> [a]
maybeToList Maybe Text
rrawSrc,
            -- it's a git dependency
            Text
"git+" Text -> Text -> Bool
`T.isPrefixOf` Text
src
        ]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList [(Text, Checksum)]
r

-- | Run fetch rust git dependencies
fetchRustGitDeps ::
  -- | prefetched source
  NixFetcher Fetched ->
  -- | relative file path of @Cargo.lock@
  FilePath ->
  Action (HashMap Text Checksum)
fetchRustGitDeps :: NixFetcher 'Fetched -> String -> Action (HashMap Text Checksum)
fetchRustGitDeps NixFetcher 'Fetched
fetcher String
lockPath = forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ NixFetcher 'Fetched -> String -> FetchRustGitDepsQ
FetchRustGitDepsQ NixFetcher 'Fetched
fetcher String
lockPath

data ParsedGitSrc = ParsedGitSrc
  { -- | git url
    ParsedGitSrc -> Text
pgurl :: Text,
    ParsedGitSrc -> Version
pgsha :: Version
  }
  deriving (Int -> ParsedGitSrc -> ShowS
[ParsedGitSrc] -> ShowS
ParsedGitSrc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsedGitSrc] -> ShowS
$cshowList :: [ParsedGitSrc] -> ShowS
show :: ParsedGitSrc -> String
$cshow :: ParsedGitSrc -> String
showsPrec :: Int -> ParsedGitSrc -> ShowS
$cshowsPrec :: Int -> ParsedGitSrc -> ShowS
Show, ParsedGitSrc -> ParsedGitSrc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParsedGitSrc -> ParsedGitSrc -> Bool
$c/= :: ParsedGitSrc -> ParsedGitSrc -> Bool
== :: ParsedGitSrc -> ParsedGitSrc -> Bool
$c== :: ParsedGitSrc -> ParsedGitSrc -> Bool
Eq, Eq ParsedGitSrc
ParsedGitSrc -> ParsedGitSrc -> Bool
ParsedGitSrc -> ParsedGitSrc -> Ordering
ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc
$cmin :: ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc
max :: ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc
$cmax :: ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc
>= :: ParsedGitSrc -> ParsedGitSrc -> Bool
$c>= :: ParsedGitSrc -> ParsedGitSrc -> Bool
> :: ParsedGitSrc -> ParsedGitSrc -> Bool
$c> :: ParsedGitSrc -> ParsedGitSrc -> Bool
<= :: ParsedGitSrc -> ParsedGitSrc -> Bool
$c<= :: ParsedGitSrc -> ParsedGitSrc -> Bool
< :: ParsedGitSrc -> ParsedGitSrc -> Bool
$c< :: ParsedGitSrc -> ParsedGitSrc -> Bool
compare :: ParsedGitSrc -> ParsedGitSrc -> Ordering
$ccompare :: ParsedGitSrc -> ParsedGitSrc -> Ordering
Ord)

-- | Parse git src in cargo lock file
-- >>> parse gitSrcParser "test" "git+https://github.com/rust-random/rand.git?rev=0.8.3#6ecbe2626b2cc6110a25c97b1702b347574febc7"
-- Right (ParsedGitSrc {pgurl = "https://github.com/rust-random/rand.git", pgsha = "6ecbe2626b2cc6110a25c97b1702b347574febc7"})
--
-- >>> parse gitSrcParser "test" "git+https://github.com/rust-random/rand.git#f0e01ee0a7257753cc51b291f62666f4765923ef"
-- Right (ParsedGitSrc {pgurl = "https://github.com/rust-random/rand.git", pgsha = "f0e01ee0a7257753cc51b291f62666f4765923ef"})
--
-- >>> parse gitSrcParser "test" "git+https://github.com/rust-lang/cargo?branch=rust-1.53.0#4369396ce7d270972955d876eaa4954bea56bcd9"
-- Right (ParsedGitSrc {pgurl = "https://github.com/rust-lang/cargo", pgsha = "4369396ce7d270972955d876eaa4954bea56bcd9"})
gitSrcParser :: Parser ParsedGitSrc
gitSrcParser :: Parser ParsedGitSrc
gitSrcParser = do
  String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"git+"
  String
pgurl <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'?', Char
'#']
  -- skip things like ?rev and ?branch
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'#'])
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'
  String
pgsha <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Version -> ParsedGitSrc
ParsedGitSrc (String -> Text
T.pack String
pgurl) (coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
pgsha)

data RustDep = RustDep
  { RustDep -> Text
rname :: PackageName,
    RustDep -> Version
rversion :: Version,
    RustDep -> Maybe Text
rrawSrc :: Maybe Text
  }
  deriving (Int -> RustDep -> ShowS
[RustDep] -> ShowS
RustDep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RustDep] -> ShowS
$cshowList :: [RustDep] -> ShowS
show :: RustDep -> String
$cshow :: RustDep -> String
showsPrec :: Int -> RustDep -> ShowS
$cshowsPrec :: Int -> RustDep -> ShowS
Show, RustDep -> RustDep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RustDep -> RustDep -> Bool
$c/= :: RustDep -> RustDep -> Bool
== :: RustDep -> RustDep -> Bool
$c== :: RustDep -> RustDep -> Bool
Eq, Eq RustDep
RustDep -> RustDep -> Bool
RustDep -> RustDep -> Ordering
RustDep -> RustDep -> RustDep
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RustDep -> RustDep -> RustDep
$cmin :: RustDep -> RustDep -> RustDep
max :: RustDep -> RustDep -> RustDep
$cmax :: RustDep -> RustDep -> RustDep
>= :: RustDep -> RustDep -> Bool
$c>= :: RustDep -> RustDep -> Bool
> :: RustDep -> RustDep -> Bool
$c> :: RustDep -> RustDep -> Bool
<= :: RustDep -> RustDep -> Bool
$c<= :: RustDep -> RustDep -> Bool
< :: RustDep -> RustDep -> Bool
$c< :: RustDep -> RustDep -> Bool
compare :: RustDep -> RustDep -> Ordering
$ccompare :: RustDep -> RustDep -> Ordering
Ord)

rustDepCodec :: TomlCodec RustDep
rustDepCodec :: TomlCodec RustDep
rustDepCodec =
  Text -> Version -> Maybe Text -> RustDep
RustDep
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> TomlCodec Text
Toml.text Key
"name" forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= RustDep -> Text
rname
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (Key -> TomlCodec Text
Toml.text Key
"version") forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= RustDep -> Version
rversion
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. TomlCodec a -> TomlCodec (Maybe a)
Toml.dioptional (Key -> TomlCodec Text
Toml.text Key
"source") forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= RustDep -> Maybe Text
rrawSrc