hackport-0.5: Overlays.hs

module Overlays
    ( getOverlayPath
    ) where

import Control.Monad
import Data.List (nub, inits)
import Data.Maybe (maybeToList, listToMaybe, isJust, fromJust)
import qualified System.Directory as SD
import System.FilePath ((</>), splitPath, joinPath)

import Error
import Portage.Host

-- cabal
import Distribution.Verbosity
import Distribution.Simple.Utils ( info )

getOverlayPath :: Verbosity -> Maybe FilePath -> IO String
getOverlayPath verbosity override_overlay = do
  overlays <- if isJust override_overlay
                  then do info verbosity $ "Forced " ++ fromJust override_overlay
                          return [fromJust override_overlay]
                  else getOverlays
  case overlays of
    [] -> throwEx NoOverlay
    [x] -> return x
    mul -> search mul
  where
  search :: [String] -> IO String
  search mul = do
    let loop [] = throwEx (MultipleOverlays mul)
        loop (x:xs) = do
          info verbosity $ "Checking '" ++ x ++ "'..."
          found <- SD.doesDirectoryExist (x </> ".hackport")
          if found
            then do
              info verbosity "OK!"
              return x
            else do
              info verbosity "Not ok."
              loop xs
    info verbosity "There are several overlays in your configuration."
    mapM_ (info verbosity . (" * " ++)) mul
    info verbosity "Looking for one with a HackPort cache..."
    overlay <- loop mul
    info verbosity $ "I choose " ++ overlay
    info verbosity "Override my decision with hackport --overlay /my/overlay"
    return overlay

getOverlays :: IO [String]
getOverlays = do
  local    <- getLocalOverlay
  overlays <- overlay_list `fmap` getInfo
  return $ nub $ map clean $
                 maybeToList local
              ++ overlays
  where
  clean path = case reverse path of
                '/':p -> reverse p
                _ -> path

getLocalOverlay :: IO (Maybe FilePath)
getLocalOverlay = do
  curDir <- SD.getCurrentDirectory
  let lookIn = map joinPath . reverse . inits . splitPath $ curDir
  fmap listToMaybe (filterM probe lookIn)

  where
    probe dir = SD.doesDirectoryExist (dir </> "dev-haskell")