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

-- | Copyright: (c) 2021-2022 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <[email protected]>
-- 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 Control.Monad.Extra (fromMaybeM)
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 qualified TOML as Toml
import Text.Parsec
import Text.Parsec.Text

-- | Rules of fetch rust git dependencies
fetchRustGitDepsRule :: Rules ()
fetchRustGitDepsRule :: Rules ()
fetchRustGitDepsRule = Rules (FetchRustGitDepsQ -> Action (HashMap PackageName Checksum))
-> Rules ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rules (FetchRustGitDepsQ -> Action (HashMap PackageName Checksum))
 -> Rules ())
-> Rules
     (FetchRustGitDepsQ -> Action (HashMap PackageName Checksum))
-> Rules ()
forall a b. (a -> b) -> a -> b
$
  (FetchRustGitDepsQ -> Action (HashMap PackageName Checksum))
-> Rules
     (FetchRustGitDepsQ -> Action (HashMap PackageName Checksum))
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracleCache ((FetchRustGitDepsQ -> Action (HashMap PackageName Checksum))
 -> Rules
      (FetchRustGitDepsQ -> Action (HashMap PackageName Checksum)))
-> (FetchRustGitDepsQ -> Action (HashMap PackageName Checksum))
-> Rules
     (FetchRustGitDepsQ -> Action (HashMap PackageName Checksum))
forall a b. (a -> b) -> a -> b
$ \key :: FetchRustGitDepsQ
key@(FetchRustGitDepsQ NixFetcher 'Fetched
fetcher String
lockPath) -> do
    String -> Action ()
putInfo (String -> Action ())
-> (Doc Any -> String) -> Doc Any -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> Action ()) -> Doc Any -> Action ()
forall a b. (a -> b) -> a -> b
$ Doc Any
"#" Doc Any -> Doc Any -> Doc Any
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FetchRustGitDepsQ -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. FetchRustGitDepsQ -> Doc ann
pretty FetchRustGitDepsQ
key
    PackageName
cargoLock <- [PackageName] -> PackageName
forall a. Partial => [a] -> a
head ([PackageName] -> PackageName)
-> (HashMap String PackageName -> [PackageName])
-> HashMap String PackageName
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap String PackageName -> [PackageName]
forall k v. HashMap k v -> [v]
HMap.elems (HashMap String PackageName -> PackageName)
-> Action (HashMap String PackageName) -> Action PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixFetcher 'Fetched
-> String -> Action (HashMap String PackageName)
extractSrc NixFetcher 'Fetched
fetcher String
lockPath
    [RustDep]
deps <- case Decoder [RustDep] -> PackageName -> Either TOMLError [RustDep]
forall a. Decoder a -> PackageName -> Either TOMLError a
Toml.decodeWith (Decoder [RustDep] -> PackageName -> Decoder [RustDep]
forall a. Decoder a -> PackageName -> Decoder a
Toml.getFieldWith (Decoder RustDep -> Decoder [RustDep]
forall a. Decoder a -> Decoder [a]
Toml.getArrayOf Decoder RustDep
rustDepDecoder) PackageName
"package") PackageName
cargoLock of
      Right [RustDep]
r -> [RustDep] -> Action [RustDep]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([RustDep] -> Action [RustDep]) -> [RustDep] -> Action [RustDep]
forall a b. (a -> b) -> a -> b
$ (RustDep -> Maybe PackageName) -> [RustDep] -> [RustDep]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn RustDep -> Maybe PackageName
rrawSrc [RustDep]
r
      Left TOMLError
err -> String -> Action [RustDep]
forall a. String -> Action a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action [RustDep]) -> String -> Action [RustDep]
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse Cargo.lock: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> PackageName -> String
T.unpack (TOMLError -> PackageName
Toml.renderTOMLError TOMLError
err)
    [(PackageName, Checksum)]
r <-
      [Action (PackageName, Checksum)]
-> Action [(PackageName, Checksum)]
forall a. [Action a] -> Action [a]
parallel
        [ case Parsec PackageName () ParsedGitSrc
-> String -> PackageName -> Either ParseError ParsedGitSrc
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec PackageName () ParsedGitSrc
gitSrcParser (PackageName -> String
T.unpack PackageName
rname) PackageName
src of
            Right ParsedGitSrc {PackageName
Version
pgurl :: PackageName
pgsha :: Version
pgurl :: ParsedGitSrc -> PackageName
pgsha :: ParsedGitSrc -> Version
..} -> do
              (NixFetcher 'Fetched -> FetchResult Checksum 'Fetched
forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_sha256 -> FetchResult Checksum 'Fetched
sha256) <- Action (NixFetcher 'Fetched)
-> Action (Maybe (NixFetcher 'Fetched))
-> Action (NixFetcher 'Fetched)
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
fromMaybeM (String -> Action (NixFetcher 'Fetched)
forall a. String -> Action a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action (NixFetcher 'Fetched))
-> String -> Action (NixFetcher 'Fetched)
forall a b. (a -> b) -> a -> b
$ String
"Prefetch failed for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> PackageName -> String
T.unpack PackageName
pgurl) (Action (Maybe (NixFetcher 'Fetched))
 -> Action (NixFetcher 'Fetched))
-> Action (Maybe (NixFetcher 'Fetched))
-> Action (NixFetcher 'Fetched)
forall a b. (a -> b) -> a -> b
$ NixFetcher 'Fresh
-> ForceFetch -> Action (Maybe (NixFetcher 'Fetched))
prefetch (PackageName -> PackageFetcher
gitFetcher PackageName
pgurl Version
pgsha) ForceFetch
NoForceFetch
              -- @${name}-${version}@ -> sha256
              (PackageName, Checksum) -> Action (PackageName, Checksum)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageName
rname PackageName -> PackageName -> PackageName
forall a. Semigroup a => a -> a -> a
<> PackageName
"-" PackageName -> PackageName -> PackageName
forall a. Semigroup a => a -> a -> a
<> Version -> PackageName
forall a b. Coercible a b => a -> b
coerce Version
rversion, FetchResult Checksum 'Fetched
Checksum
sha256)
            Left ParseError
err -> String -> Action (PackageName, Checksum)
forall a. String -> Action a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action (PackageName, Checksum))
-> String -> Action (PackageName, Checksum)
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse git source in Cargo.lock: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ParseError -> String
forall a. Show a => a -> String
show ParseError
err
          | RustDep {Maybe PackageName
PackageName
Version
rrawSrc :: RustDep -> Maybe PackageName
rname :: PackageName
rversion :: Version
rrawSrc :: Maybe PackageName
rname :: RustDep -> PackageName
rversion :: RustDep -> Version
..} <- [RustDep]
deps,
            -- it's a dependency
            PackageName
src <- Maybe PackageName -> [PackageName]
forall a. Maybe a -> [a]
maybeToList Maybe PackageName
rrawSrc,
            -- it's a git dependency
            PackageName
"git+" PackageName -> PackageName -> Bool
`T.isPrefixOf` PackageName
src
        ]
    HashMap PackageName Checksum
-> Action (HashMap PackageName Checksum)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap PackageName Checksum
 -> Action (HashMap PackageName Checksum))
-> HashMap PackageName Checksum
-> Action (HashMap PackageName Checksum)
forall a b. (a -> b) -> a -> b
$ [(PackageName, Checksum)] -> HashMap PackageName Checksum
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList [(PackageName, 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 PackageName Checksum)
fetchRustGitDeps NixFetcher 'Fetched
fetcher String
lockPath = FetchRustGitDepsQ -> Action (HashMap PackageName Checksum)
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (FetchRustGitDepsQ -> Action (HashMap PackageName Checksum))
-> FetchRustGitDepsQ -> Action (HashMap PackageName Checksum)
forall a b. (a -> b) -> a -> b
$ NixFetcher 'Fetched -> String -> FetchRustGitDepsQ
FetchRustGitDepsQ NixFetcher 'Fetched
fetcher String
lockPath

data ParsedGitSrc = ParsedGitSrc
  { -- | git url
    ParsedGitSrc -> PackageName
pgurl :: Text,
    ParsedGitSrc -> Version
pgsha :: Version
  }
  deriving (Int -> ParsedGitSrc -> String -> String
[ParsedGitSrc] -> String -> String
ParsedGitSrc -> String
(Int -> ParsedGitSrc -> String -> String)
-> (ParsedGitSrc -> String)
-> ([ParsedGitSrc] -> String -> String)
-> Show ParsedGitSrc
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ParsedGitSrc -> String -> String
showsPrec :: Int -> ParsedGitSrc -> String -> String
$cshow :: ParsedGitSrc -> String
show :: ParsedGitSrc -> String
$cshowList :: [ParsedGitSrc] -> String -> String
showList :: [ParsedGitSrc] -> String -> String
Show, ParsedGitSrc -> ParsedGitSrc -> Bool
(ParsedGitSrc -> ParsedGitSrc -> Bool)
-> (ParsedGitSrc -> ParsedGitSrc -> Bool) -> Eq ParsedGitSrc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParsedGitSrc -> ParsedGitSrc -> Bool
== :: ParsedGitSrc -> ParsedGitSrc -> Bool
$c/= :: ParsedGitSrc -> ParsedGitSrc -> Bool
/= :: ParsedGitSrc -> ParsedGitSrc -> Bool
Eq, Eq ParsedGitSrc
Eq ParsedGitSrc =>
(ParsedGitSrc -> ParsedGitSrc -> Ordering)
-> (ParsedGitSrc -> ParsedGitSrc -> Bool)
-> (ParsedGitSrc -> ParsedGitSrc -> Bool)
-> (ParsedGitSrc -> ParsedGitSrc -> Bool)
-> (ParsedGitSrc -> ParsedGitSrc -> Bool)
-> (ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc)
-> (ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc)
-> Ord 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
$ccompare :: ParsedGitSrc -> ParsedGitSrc -> Ordering
compare :: ParsedGitSrc -> ParsedGitSrc -> Ordering
$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
>= :: ParsedGitSrc -> ParsedGitSrc -> Bool
$cmax :: ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc
max :: ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc
$cmin :: ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc
min :: ParsedGitSrc -> ParsedGitSrc -> ParsedGitSrc
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 :: Parsec PackageName () ParsedGitSrc
gitSrcParser = do
  String
_ <- String -> ParsecT PackageName () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"git+"
  String
pgurl <- ParsecT PackageName () Identity Char
-> ParsecT PackageName () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT PackageName () Identity Char
 -> ParsecT PackageName () Identity String)
-> ParsecT PackageName () Identity Char
-> ParsecT PackageName () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT PackageName () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'?', Char
'#']
  -- skip things like ?rev and ?branch
  ParsecT PackageName () Identity Char
-> ParsecT PackageName () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (String -> ParsecT PackageName () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'#'])
  Char
_ <- Char -> ParsecT PackageName () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'
  String
pgsha <- ParsecT PackageName () Identity Char
-> ParsecT PackageName () Identity ()
-> ParsecT PackageName () Identity String
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 ParsecT PackageName () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT PackageName () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  ParsedGitSrc -> Parsec PackageName () ParsedGitSrc
forall a. a -> ParsecT PackageName () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParsedGitSrc -> Parsec PackageName () ParsedGitSrc)
-> ParsedGitSrc -> Parsec PackageName () ParsedGitSrc
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> ParsedGitSrc
ParsedGitSrc (String -> PackageName
T.pack String
pgurl) (PackageName -> Version
forall a b. Coercible a b => a -> b
coerce (PackageName -> Version) -> PackageName -> Version
forall a b. (a -> b) -> a -> b
$ String -> PackageName
T.pack String
pgsha)

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

rustDepDecoder :: Toml.Decoder RustDep
rustDepDecoder :: Decoder RustDep
rustDepDecoder =
  PackageName -> Version -> Maybe PackageName -> RustDep
RustDep
    (PackageName -> Version -> Maybe PackageName -> RustDep)
-> Decoder PackageName
-> Decoder (Version -> Maybe PackageName -> RustDep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageName -> Decoder PackageName
forall a. DecodeTOML a => PackageName -> Decoder a
Toml.getField PackageName
"name"
    Decoder (Version -> Maybe PackageName -> RustDep)
-> Decoder Version -> Decoder (Maybe PackageName -> RustDep)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @Text (PackageName -> Version) -> Decoder PackageName -> Decoder Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageName -> Decoder PackageName
forall a. DecodeTOML a => PackageName -> Decoder a
Toml.getField PackageName
"version")
    Decoder (Maybe PackageName -> RustDep)
-> Decoder (Maybe PackageName) -> Decoder RustDep
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackageName -> Decoder (Maybe PackageName)
forall a. DecodeTOML a => PackageName -> Decoder (Maybe a)
Toml.getFieldOpt PackageName
"source"