{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module NvFetcher.FetchRustGitDeps
(
FetchRustGitDepsQ (..),
fetchRustGitDepsRule,
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 qualified TOML as Toml
import Text.Parsec
import Text.Parsec.Text
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
PackageName
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 PackageName)
extractSrc NixFetcher 'Fetched
fetcher String
lockPath
[RustDep]
deps <- case forall a. Decoder a -> PackageName -> Either TOMLError a
Toml.decodeWith (forall a. Decoder a -> PackageName -> Decoder a
Toml.getFieldWith (forall a. Decoder a -> Decoder [a]
Toml.getArrayOf Decoder RustDep
rustDepDecoder) PackageName
"package") PackageName
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 PackageName
rrawSrc [RustDep]
r
Left TOMLError
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
<> PackageName -> String
T.unpack (TOMLError -> PackageName
Toml.renderTOMLError TOMLError
err)
[(PackageName, 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 (PackageName -> String
T.unpack PackageName
rname) PackageName
src of
Right ParsedGitSrc {PackageName
Version
pgsha :: ParsedGitSrc -> Version
pgurl :: ParsedGitSrc -> PackageName
pgsha :: Version
pgurl :: PackageName
..} -> do
(forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_sha256 -> FetchResult Checksum 'Fetched
sha256) <- NixFetcher 'Fresh -> ForceFetch -> Action (NixFetcher 'Fetched)
prefetch (PackageName -> PackageFetcher
gitFetcher PackageName
pgurl Version
pgsha) ForceFetch
NoForceFetch
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageName
rname forall a. Semigroup a => a -> a -> a
<> PackageName
"-" 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 PackageName
PackageName
Version
rversion :: RustDep -> Version
rname :: RustDep -> PackageName
rrawSrc :: Maybe PackageName
rversion :: Version
rname :: PackageName
rrawSrc :: RustDep -> Maybe PackageName
..} <- [RustDep]
deps,
PackageName
src <- forall a. Maybe a -> [a]
maybeToList Maybe PackageName
rrawSrc,
PackageName
"git+" PackageName -> PackageName -> Bool
`T.isPrefixOf` PackageName
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 [(PackageName, Checksum)]
r
fetchRustGitDeps ::
NixFetcher Fetched ->
FilePath ->
Action (HashMap Text Checksum)
fetchRustGitDeps :: NixFetcher 'Fetched
-> String -> Action (HashMap PackageName 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
{
ParsedGitSrc -> PackageName
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)
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
'#']
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
$ PackageName -> Version -> ParsedGitSrc
ParsedGitSrc (String -> PackageName
T.pack String
pgurl) (coerce :: forall a b. Coercible a b => a -> b
coerce 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 -> 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)
rustDepDecoder :: Toml.Decoder RustDep
rustDepDecoder :: Decoder RustDep
rustDepDecoder =
PackageName -> Version -> Maybe PackageName -> RustDep
RustDep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. DecodeTOML a => PackageName -> Decoder a
Toml.getField PackageName
"name"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (coerce :: forall a b. Coercible a b => a -> b
coerce @Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. DecodeTOML a => PackageName -> Decoder a
Toml.getField PackageName
"version")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. DecodeTOML a => PackageName -> Decoder (Maybe a)
Toml.getFieldOpt PackageName
"source"