{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# 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 Text.Parsec
import Text.Parsec.Text
import Toml (TomlCodec, (.=))
import qualified Toml
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 FilePath
lockPath) -> do
FilePath -> Action ()
putInfo (FilePath -> Action ())
-> (Doc Any -> FilePath) -> Doc Any -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> FilePath
forall a. Show a => a -> FilePath
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
pretty FetchRustGitDepsQ
key
PackageName
cargoLock <- [PackageName] -> PackageName
forall a. [a] -> a
head ([PackageName] -> PackageName)
-> (HashMap FilePath PackageName -> [PackageName])
-> HashMap FilePath PackageName
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap FilePath PackageName -> [PackageName]
forall k v. HashMap k v -> [v]
HMap.elems (HashMap FilePath PackageName -> PackageName)
-> Action (HashMap FilePath PackageName) -> Action PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixFetcher 'Fetched
-> FilePath -> Action (HashMap FilePath PackageName)
extractSrc NixFetcher 'Fetched
fetcher FilePath
lockPath
[RustDep]
deps <- case TomlCodec [RustDep]
-> PackageName -> Either [TomlDecodeError] [RustDep]
forall a. TomlCodec a -> PackageName -> Either [TomlDecodeError] a
Toml.decode (TomlCodec RustDep -> Key -> TomlCodec [RustDep]
forall a. TomlCodec a -> Key -> TomlCodec [a]
Toml.list TomlCodec RustDep
rustDepCodec Key
"package") PackageName
cargoLock of
Right [RustDep]
r -> [RustDep] -> Action [RustDep]
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 [TomlDecodeError]
err -> FilePath -> Action [RustDep]
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action [RustDep]) -> FilePath -> Action [RustDep]
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse Cargo.lock: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> PackageName -> FilePath
T.unpack ([TomlDecodeError] -> PackageName
Toml.prettyTomlDecodeErrors [TomlDecodeError]
err)
[(PackageName, Checksum)]
r <-
[Action (PackageName, Checksum)]
-> Action [(PackageName, Checksum)]
forall a. [Action a] -> Action [a]
parallel
[ case Parsec PackageName () ParsedGitSrc
-> FilePath -> PackageName -> Either ParseError ParsedGitSrc
forall s t a.
Stream s Identity t =>
Parsec s () a -> FilePath -> s -> Either ParseError a
parse Parsec PackageName () ParsedGitSrc
gitSrcParser (PackageName -> FilePath
T.unpack PackageName
rname) PackageName
src of
Right ParsedGitSrc {PackageName
Version
pgsha :: ParsedGitSrc -> Version
pgurl :: ParsedGitSrc -> PackageName
pgsha :: Version
pgurl :: PackageName
..} -> do
(NixFetcher 'Fetched -> FetchResult 'Fetched
forall (k :: FetchStatus). NixFetcher k -> FetchResult k
_sha256 -> FetchResult 'Fetched
sha256) <- NixFetcher 'Fresh -> Action (NixFetcher 'Fetched)
prefetch (NixFetcher 'Fresh -> Action (NixFetcher 'Fetched))
-> NixFetcher 'Fresh -> Action (NixFetcher 'Fetched)
forall a b. (a -> b) -> a -> b
$ PackageName -> PackageFetcher
gitFetcher PackageName
pgurl Version
pgsha
(PackageName, Checksum) -> Action (PackageName, Checksum)
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
coerce Version
rversion, FetchResult 'Fetched
Checksum
sha256)
Left ParseError
err -> FilePath -> Action (PackageName, Checksum)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action (PackageName, Checksum))
-> FilePath -> Action (PackageName, Checksum)
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse git source in Cargo.lock: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ParseError -> FilePath
forall a. Show a => a -> FilePath
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 <- Maybe PackageName -> [PackageName]
forall a. Maybe a -> [a]
maybeToList Maybe PackageName
rrawSrc,
PackageName
"git+" PackageName -> PackageName -> Bool
`T.isPrefixOf` PackageName
src
]
HashMap PackageName Checksum
-> Action (HashMap PackageName Checksum)
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
fetchRustGitDeps ::
NixFetcher Fetched ->
FilePath ->
Action (HashMap Text Checksum)
fetchRustGitDeps :: NixFetcher 'Fetched
-> FilePath -> Action (HashMap PackageName Checksum)
fetchRustGitDeps NixFetcher 'Fetched
fetcher FilePath
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 -> FilePath -> FetchRustGitDepsQ
FetchRustGitDepsQ NixFetcher 'Fetched
fetcher FilePath
lockPath
data ParsedGitSrc = ParsedGitSrc
{
ParsedGitSrc -> PackageName
pgurl :: Text,
ParsedGitSrc -> Version
pgsha :: Version
}
deriving (Int -> ParsedGitSrc -> FilePath -> FilePath
[ParsedGitSrc] -> FilePath -> FilePath
ParsedGitSrc -> FilePath
(Int -> ParsedGitSrc -> FilePath -> FilePath)
-> (ParsedGitSrc -> FilePath)
-> ([ParsedGitSrc] -> FilePath -> FilePath)
-> Show ParsedGitSrc
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ParsedGitSrc] -> FilePath -> FilePath
$cshowList :: [ParsedGitSrc] -> FilePath -> FilePath
show :: ParsedGitSrc -> FilePath
$cshow :: ParsedGitSrc -> FilePath
showsPrec :: Int -> ParsedGitSrc -> FilePath -> FilePath
$cshowsPrec :: Int -> ParsedGitSrc -> FilePath -> FilePath
Show, ParsedGitSrc -> ParsedGitSrc -> Bool
(ParsedGitSrc -> ParsedGitSrc -> Bool)
-> (ParsedGitSrc -> ParsedGitSrc -> Bool) -> Eq ParsedGitSrc
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
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
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
$cp1Ord :: Eq ParsedGitSrc
Ord)
gitSrcParser :: Parser ParsedGitSrc
gitSrcParser :: Parsec PackageName () ParsedGitSrc
gitSrcParser = do
FilePath
_ <- FilePath -> ParsecT PackageName () Identity FilePath
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m FilePath
string FilePath
"git+"
FilePath
pgurl <- ParsecT PackageName () Identity Char
-> ParsecT PackageName () Identity FilePath
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 FilePath)
-> ParsecT PackageName () Identity Char
-> ParsecT PackageName () Identity FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT PackageName () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
noneOf [Char
'?', Char
'#']
ParsecT PackageName () Identity Char
-> ParsecT PackageName () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (FilePath -> ParsecT PackageName () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> 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
'#'
FilePath
pgsha <- ParsecT PackageName () Identity Char
-> ParsecT PackageName () Identity ()
-> ParsecT PackageName () Identity FilePath
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 (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 (FilePath -> PackageName
T.pack FilePath
pgurl) (PackageName -> Version
coerce (PackageName -> Version) -> PackageName -> Version
forall a b. (a -> b) -> a -> b
$ FilePath -> PackageName
T.pack FilePath
pgsha)
data RustDep = RustDep
{ RustDep -> PackageName
rname :: PackageName,
RustDep -> Version
rversion :: Version,
RustDep -> Maybe PackageName
rrawSrc :: Maybe Text
}
deriving (Int -> RustDep -> FilePath -> FilePath
[RustDep] -> FilePath -> FilePath
RustDep -> FilePath
(Int -> RustDep -> FilePath -> FilePath)
-> (RustDep -> FilePath)
-> ([RustDep] -> FilePath -> FilePath)
-> Show RustDep
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [RustDep] -> FilePath -> FilePath
$cshowList :: [RustDep] -> FilePath -> FilePath
show :: RustDep -> FilePath
$cshow :: RustDep -> FilePath
showsPrec :: Int -> RustDep -> FilePath -> FilePath
$cshowsPrec :: Int -> RustDep -> FilePath -> FilePath
Show, RustDep -> RustDep -> Bool
(RustDep -> RustDep -> Bool)
-> (RustDep -> RustDep -> Bool) -> Eq RustDep
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
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
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
$cp1Ord :: Eq RustDep
Ord)
rustDepCodec :: TomlCodec RustDep
rustDepCodec :: TomlCodec RustDep
rustDepCodec =
PackageName -> Version -> Maybe PackageName -> RustDep
RustDep
(PackageName -> Version -> Maybe PackageName -> RustDep)
-> Codec RustDep PackageName
-> Codec RustDep (Version -> Maybe PackageName -> RustDep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> TomlCodec PackageName
Toml.text Key
"name" TomlCodec PackageName
-> (RustDep -> PackageName) -> Codec RustDep PackageName
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= RustDep -> PackageName
rname
Codec RustDep (Version -> Maybe PackageName -> RustDep)
-> Codec RustDep Version
-> Codec RustDep (Maybe PackageName -> RustDep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec PackageName -> TomlCodec Version
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (Key -> TomlCodec PackageName
Toml.text Key
"version") TomlCodec Version -> (RustDep -> Version) -> Codec RustDep Version
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= RustDep -> Version
rversion
Codec RustDep (Maybe PackageName -> RustDep)
-> Codec RustDep (Maybe PackageName) -> TomlCodec RustDep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TomlCodec PackageName -> TomlCodec (Maybe PackageName)
forall a. TomlCodec a -> TomlCodec (Maybe a)
Toml.dioptional (Key -> TomlCodec PackageName
Toml.text Key
"source") TomlCodec (Maybe PackageName)
-> (RustDep -> Maybe PackageName)
-> Codec RustDep (Maybe PackageName)
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= RustDep -> Maybe PackageName
rrawSrc