{-# LANGUAGE PatternGuards #-}

module Portage.Resolve
    ( resolveCategory
    , resolveCategories
    , resolveFullPortageName
    ) where

import qualified Portage.Overlay as Overlay
import qualified Portage.PackageId as Portage

import Distribution.Verbosity
import Distribution.Pretty (prettyShow)
import qualified Distribution.Package as Cabal
import Distribution.Simple.Utils

import qualified Data.Map as Map

import Error

import Debug.Trace (trace)

-- | If a package already exist in the overlay, find which category it has.
-- If it does not exist, we default to \'dev-haskell\'.
resolveCategory :: Verbosity -> Overlay.Overlay -> Cabal.PackageName -> IO Portage.Category
resolveCategory :: Verbosity -> Overlay -> PackageName -> IO Category
resolveCategory Verbosity
verbosity Overlay
overlay PackageName
pn = do
  Verbosity -> String -> IO ()
info Verbosity
verbosity String
"Searching for which category to use..."
  case Overlay -> PackageName -> [Category]
resolveCategories Overlay
overlay PackageName
pn of
    [] -> do
      Verbosity -> String -> IO ()
info Verbosity
verbosity String
"No previous version of this package, defaulting category to dev-haskell."
      Category -> IO Category
forall (m :: * -> *) a. Monad m => a -> m a
return Category
devhaskell
    [Category
cat] -> do
      Verbosity -> String -> IO ()
info Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Exact match of already existing package, using category: "
                         String -> String -> String
forall a. [a] -> [a] -> [a]
++ Category -> String
forall a. Pretty a => a -> String
prettyShow Category
cat
      Category -> IO Category
forall (m :: * -> *) a. Monad m => a -> m a
return Category
cat
    [Category]
cats -> do
      Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Multiple matches of categories: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((Category -> String) -> [Category] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Category -> String
forall a. Pretty a => a -> String
prettyShow [Category]
cats)
      if Category
devhaskell Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
cats
        then do Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"Defaulting to dev-haskell"
                Category -> IO Category
forall (m :: * -> *) a. Monad m => a -> m a
return Category
devhaskell
        else do Verbosity -> String -> IO ()
warn Verbosity
verbosity String
"Multiple matches and no known default. Override by specifying "
                Verbosity -> String -> IO ()
warn Verbosity
verbosity String
"package category like so  'hackport merge categoryname/package[-version]."
                HackPortError -> IO Category
forall a. HackPortError -> IO a
throwEx (String -> HackPortError
ArgumentError String
"Specify package category and try again.")
  where
  devhaskell :: Category
devhaskell = String -> Category
Portage.Category String
"dev-haskell"

resolveCategories :: Overlay.Overlay -> Cabal.PackageName -> [Portage.Category]
resolveCategories :: Overlay -> PackageName -> [Category]
resolveCategories Overlay
overlay PackageName
pn =
  [ Category
cat 
  | (Portage.PackageName Category
cat PackageName
pn') <- Map PackageName [ExistingEbuild] -> [PackageName]
forall k a. Map k a -> [k]
Map.keys Map PackageName [ExistingEbuild]
om
  , PackageName -> PackageName
Portage.normalizeCabalPackageName PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
pn'
  ]
  where
    om :: Map PackageName [ExistingEbuild]
om = Overlay -> Map PackageName [ExistingEbuild]
Overlay.overlayMap Overlay
overlay

resolveFullPortageName :: Overlay.Overlay -> Cabal.PackageName -> Maybe Portage.PackageName
resolveFullPortageName :: Overlay -> PackageName -> Maybe PackageName
resolveFullPortageName Overlay
overlay PackageName
pn =
  case Overlay -> PackageName -> [Category]
resolveCategories Overlay
overlay PackageName
pn of
    [] -> Maybe PackageName
forall a. Maybe a
Nothing
    [Category
cat] -> Category -> Maybe PackageName
forall (m :: * -> *). Monad m => Category -> m PackageName
ret Category
cat
    [Category]
cats | (Category
cat:[Category]
_) <- ((Category -> Bool) -> [Category] -> [Category]
forall a. (a -> Bool) -> [a] -> [a]
filter (Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
cats) [Category]
priority) -> Category -> Maybe PackageName
forall (m :: * -> *). Monad m => Category -> m PackageName
ret Category
cat
         | Bool
otherwise -> String -> Maybe PackageName -> Maybe PackageName
forall a. String -> a -> a
trace (String
"Ambiguous package name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageName -> String
forall a. Show a => a -> String
show PackageName
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", hits: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Category] -> String
forall a. Show a => a -> String
show [Category]
cats) Maybe PackageName
forall a. Maybe a
Nothing
  where
  ret :: Category -> m PackageName
ret Category
c = PackageName -> m PackageName
forall (m :: * -> *) a. Monad m => a -> m a
return (Category -> PackageName -> PackageName
Portage.PackageName Category
c (PackageName -> PackageName
Portage.normalizeCabalPackageName PackageName
pn))
  mkC :: String -> Category
mkC = String -> Category
Portage.Category
  -- if any of these categories show up in the result list, the match isn't
  -- ambiguous, pick the first match in the list
  priority :: [Category]
priority = [ String -> Category
mkC String
"dev-haskell"
             , String -> Category
mkC String
"sys-libs"
             , String -> Category
mkC String
"dev-libs"
             , String -> Category
mkC String
"x11-libs"
             , String -> Category
mkC String
"media-libs"
             , String -> Category
mkC String
"net-libs"
             , String -> Category
mkC String
"sci-libs"
             ]