digital-asset/daml
1
1
Fork 0
mirror of https://github.com/digital-asset/daml.git synced 2024-11-10 00:35:25 +03:00
Code Issues Projects Releases Wiki Activity

Refactoring: Use map in download helper for fetch-dar (#7784)

Browse Source 
The `downloadAllReachablePackages` function, which is part of the
implementation of `featch-dar`, uses an associative list when a `Map`
seems more appropriate. More appropriate in both runtime complexity as
well as code complexity. This has caught my eye while reviewing some
code nearby and I thought I have a minute to spare to improve it.

This PR replaces the associative list with a `Map`.

CHANGELOG_BEGIN
CHANGELOG_END
This commit is contained in:
Martin Huschenbett 2020-10-23 15:07:30 +02:00 committed by GitHub
parent c52fff58af
commit 2adf2c428e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
daml-assistant/daml-helper/src/DA/Daml/Helper/Ledger.hs
View File

@ -29,6 +29,8 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BSL
import Data.List.Extra
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.String (IsString, fromString)
import qualified Data.Text as T
@ -224,18 +226,18 @@ runLedgerFetchDar flags pidString saveAs = do
-- | Reconstruct a DAR file by downloading packages from a ledger. Returns how many packages fetched.
fetchDar :: LedgerArgs -> LF.PackageId -> FilePath -> IO Int
fetchDar args rootPid saveAs = do
xs <- downloadAllReachablePackages args rootPid
[pkg] <- pure [ pkg | (pid,pkg) <- xs, pid == rootPid ]
let (dalf,pkgId) = LFArchive.encodeArchiveAndHash pkg
pkgs <- downloadAllReachablePackages args rootPid
let rootPkg = pkgs Map.! rootPid
let (dalf,pkgId) = LFArchive.encodeArchiveAndHash rootPkg
let dalfDependencies :: [(T.Text,BS.ByteString,LF.PackageId)] =
[ (txt,bs,pkgId)
| (pid,pkg) <- xs, pid /= rootPid
| (pid,pkg) <- Map.toList (Map.delete rootPid pkgs)
, let txt = recoverPackageName pkg ("dep",pid)
, let (bsl,pkgId) = LFArchive.encodeArchiveAndHash pkg
, let bs = BSL.toStrict bsl
]
let (pName,pVersion) = do
let LF.Package {packageMetadata} = pkg
let LF.Package {packageMetadata} = rootPkg
case packageMetadata of
Nothing -> (LF.PackageName $ T.pack "reconstructed",Nothing)
Just LF.PackageMetadata{packageName,packageVersion} -> (packageName,Just packageVersion)
@ -243,7 +245,7 @@ fetchDar args rootPid saveAs = do
let srcRoot = error "unexpected use of srcRoot when there are no sources"
let za = createArchive pName pVersion pSdkVersion pkgId dalf dalfDependencies srcRoot [] [] []
createDarFile saveAs za
return $ length xs
return $ Map.size pkgs
recoverPackageName :: LF.Package -> (String,LF.PackageId) -> T.Text
recoverPackageName pkg (tag,pid)= do
@ -254,18 +256,18 @@ recoverPackageName pkg (tag,pid)= do
Nothing -> T.pack (tag <> "-" <> T.unpack (LF.unPackageId pid))
-- | Download all Packages reachable from a PackageId; fail if any don't exist or can't be decoded.
downloadAllReachablePackages :: LedgerArgs -> LF.PackageId -> IO [(LF.PackageId,LF.Package)]
downloadAllReachablePackages args pid = loop [] [pid]
downloadAllReachablePackages :: LedgerArgs -> LF.PackageId -> IO (Map LF.PackageId LF.Package)
downloadAllReachablePackages args pid = loop Map.empty [pid]
where
loop :: [(LF.PackageId,LF.Package)] -> [LF.PackageId] -> IO [(LF.PackageId,LF.Package)]
loop :: Map LF.PackageId LF.Package -> [LF.PackageId] -> IO (Map LF.PackageId LF.Package)
loop acc = \case
[] -> return acc
pid:morePids ->
if pid `elem` [ pid | (pid,_) <- acc ]
if pid `Map.member` acc
then loop acc morePids
else do
pkg <- downloadPackage args pid
loop ((pid,pkg):acc) (packageRefs pkg ++ morePids)
loop (Map.insert pid pkg acc) (packageRefs pkg ++ morePids)
packageRefs pkg = nubSort [ pid | LF.PRImport pid <- toListOf LF.packageRefs pkg ]