Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: v0.2.17
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 72 lines (63 sloc) 2.127 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
module Overlays
    ( getOverlayPath
    ) where

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

import Error
import CacheFile
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 <- doesFileExist (cacheFile x)
          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 <- getCurrentDirectory
  let lookIn = map joinPath . reverse . inits . splitPath $ curDir
  fmap listToMaybe (filterM probe lookIn)

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

Something went wrong with that request. Please try again.