List.hs

{-# 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