{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Stack.List ( listPackages ) where import Stack.Prelude import qualified RIO.Map as Map import RIO.List (intercalate) import RIO.Process (HasProcessContext) newtype ListException = CouldNotParsePackageSelectors [String] deriving Typeable instance Exception ListException instance Show ListException where show (CouldNotParsePackageSelectors strs) = unlines $ map ("- " ++) strs -- | Intended to work for the command line command. listPackages :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env) => Maybe RawSnapshot -- ^ when looking up by name, take from this build plan -> [String] -- ^ names or identifiers -> RIO env () listPackages mSnapshot input = do let (errs1, names) = case mSnapshot of Just snapshot | null input -> ([], Map.keys (rsPackages snapshot)) _ -> partitionEithers $ map parse input (errs2, locs) <- partitionEithers <$> traverse toLoc names case errs1 ++ errs2 of [] -> pure () errs -> throwM $ CouldNotParsePackageSelectors errs mapM_ (logInfo . fromString . packageIdentifierString) locs where toLoc | Just snapshot <- mSnapshot = toLocSnapshot snapshot | otherwise = toLocNoSnapshot toLocNoSnapshot :: PackageName -> RIO env (Either String PackageIdentifier) toLocNoSnapshot name = do mloc1 <- getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions mloc <- case mloc1 of Just _ -> pure mloc1 Nothing -> do updated <- updateHackageIndex $ Just $ "Could not find package " <> fromString (packageNameString name) <> ", updating" case updated of UpdateOccurred -> getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions NoUpdateOccurred -> pure Nothing case mloc of Nothing -> do candidates <- getHackageTypoCorrections name pure $ Left $ concat [ "Could not find package " , packageNameString name , " on Hackage" , if null candidates then "" else ". Perhaps you meant: " ++ intercalate ", " (map packageNameString candidates) ] Just loc -> pure $ Right (packageLocationIdent loc) toLocSnapshot :: RawSnapshot -> PackageName -> RIO env (Either String PackageIdentifier) toLocSnapshot snapshot name = case Map.lookup name (rsPackages snapshot) of Nothing -> pure $ Left $ "Package does not appear in snapshot: " ++ packageNameString name Just sp -> do loc <- cplComplete <$> completePackageLocation (rspLocation sp) pure $ Right (packageLocationIdent loc) parse s = case parsePackageName s of Just x -> Right x Nothing -> Left $ "Could not parse as package name or identifier: " ++ s