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

-- | Copyright: (c) 2021 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <[email protected]>
-- Stability: experimental
-- Portability: portable
--
-- This module provides function to calculate @[email protected] used in @[email protected]
module NvFetcher.FetchRustGitDeps
  ( -- * Types
    FetchRustGitDepsQ (..),

    -- * Rules
    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 Text.Parsec
import Text.Parsec.Text
import Toml (TomlCodec, (.=))
import qualified Toml

-- | 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
$ \(FetchRustGitDepsQ NixFetcher 'Fetched
fetcher FilePath
lockPath) -> do
    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
              -- @${name}-${version}@ -> sha256
              (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,
            -- 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 (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 @[email protected]
  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
  { -- | git url
    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)

-- | 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
  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
'#']
  -- 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 (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