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

getOverlays :: IO [String]
getOverlays :: IO [FilePath]
getOverlays = do
  Maybe FilePath
local    <- IO (Maybe FilePath)
getLocalOverlay
  [FilePath]
overlays <- LocalInfo -> [FilePath]
overlay_list (LocalInfo -> [FilePath]) -> IO LocalInfo -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO LocalInfo
getInfo
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
clean ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
                 Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
local
              [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
overlays
  where
  clean :: FilePath -> FilePath
clean FilePath
path = case FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
path of
                Char
'/':FilePath
p -> FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
p
                FilePath
_ -> FilePath
path

getLocalOverlay :: IO (Maybe FilePath)
getLocalOverlay :: IO (Maybe FilePath)
getLocalOverlay = do
  FilePath
curDir <- IO FilePath
SD.getCurrentDirectory
  let lookIn :: [FilePath]
lookIn = ([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> FilePath
joinPath ([[FilePath]] -> [FilePath])
-> (FilePath -> [[FilePath]]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [[FilePath]]
forall a. [a] -> [a]
reverse ([[FilePath]] -> [[FilePath]])
-> (FilePath -> [[FilePath]]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [[FilePath]]
forall a. [a] -> [[a]]
inits ([FilePath] -> [[FilePath]])
-> (FilePath -> [FilePath]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitPath (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
curDir
  ([FilePath] -> Maybe FilePath)
-> IO [FilePath] -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
listToMaybe ((FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
probe [FilePath]
lookIn)

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