{-# LANGUAGE CPP #-}
module Cabal
  ( getPackageGhcOpts
  , findCabalFile
  ) where

#ifdef ENABLE_CABAL
import Stack
import Control.Exception (IOException, catch)
import Data.Char (isSpace)
import Data.List (foldl', nub, sort, find, isPrefixOf, isSuffixOf)
#if __GLASGOW_HASKELL__ < 709
import Data.Monoid (Monoid(..))
#endif
import Distribution.Package (PackageIdentifier(..), PackageName)
import Distribution.PackageDescription (PackageDescription(..), Executable(..), TestSuite(..), Benchmark(..), emptyHookedBuildInfo, buildable, libBuildInfo)
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Simple.Configure (configure)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), ComponentLocalBuildInfo(..),
    Component(..), ComponentName(..),
#if __GLASGOW_HASKELL__ < 707
    allComponentsBy,
#endif
    componentBuildInfo, foldComponent)
import Distribution.Simple.Compiler (PackageDB(..))
import Distribution.Simple.GHC (componentGhcOptions)
import Distribution.Simple.Program (defaultProgramConfiguration)
import Distribution.Simple.Program.Db (lookupProgram)
import Distribution.Simple.Program.Types (ConfiguredProgram(programVersion), simpleProgram)
import Distribution.Simple.Program.GHC (GhcOptions(..), renderGhcOptions)
import Distribution.Simple.Setup (ConfigFlags(..), defaultConfigFlags, toFlag)
#if __GLASGOW_HASKELL__ >= 709
import Distribution.Utils.NubList
import qualified Distribution.Simple.GHC as GHC(configure)
#endif
import Distribution.Verbosity (silent)
import Distribution.Version (Version(..))

import System.IO.Error (ioeGetErrorString)
import System.Directory (doesFileExist, getDirectoryContents)
import System.FilePath (takeDirectory, splitFileName, (</>))


componentName :: Component -> ComponentName
componentName =
    foldComponent (const CLibName)
                  (CExeName . exeName)
                  (CTestName . testName)
                  (CBenchName . benchmarkName)

getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo
#if __GLASGOW_HASKELL__ >= 707
getComponentLocalBuildInfo lbi cname = getLocalBuildInfo cname $ componentsConfigs lbi
    where getLocalBuildInfo cname' ((cname'', clbi, _):cfgs) =
            if cname' == cname'' then clbi else getLocalBuildInfo cname' cfgs
          getLocalBuildInfo _ [] = error $ "internal error: missing config"
#else
getComponentLocalBuildInfo lbi CLibName =
    case libraryConfig lbi of
        Nothing -> error $ "internal error: missing library config"
        Just clbi -> clbi
getComponentLocalBuildInfo lbi (CExeName name) =
    case lookup name (executableConfigs lbi) of
        Nothing -> error $ "internal error: missing config for executable " ++ name
        Just clbi -> clbi
getComponentLocalBuildInfo lbi (CTestName name) =
    case lookup name (testSuiteConfigs lbi) of
        Nothing -> error $ "internal error: missing config for test suite " ++ name
        Just clbi -> clbi
getComponentLocalBuildInfo lbi (CBenchName name) =
    case lookup name (testSuiteConfigs lbi) of
        Nothing -> error $ "internal error: missing config for benchmark " ++ name
        Just clbi -> clbi
#endif

#if __GLASGOW_HASKELL__ >= 707
-- TODO: Fix callsites so we don't need `allComponentsBy`. It was taken from
-- http://hackage.haskell.org/package/Cabal-1.16.0.3/docs/src/Distribution-Simple-LocalBuildInfo.html#allComponentsBy
-- since it doesn't exist in Cabal 1.18.*
--
-- | Obtains all components (libs, exes, or test suites), transformed by the
-- given function.  Useful for gathering dependencies with component context.
allComponentsBy :: PackageDescription
                -> (Component -> a)
                -> [a]
allComponentsBy pkg_descr f =
    [ f (CLib  lib) | Just lib <- [library pkg_descr]
                    , buildable (libBuildInfo lib) ]
 ++ [ f (CExe  exe) | exe <- executables pkg_descr
                    , buildable (buildInfo exe) ]
 ++ [ f (CTest tst) | tst <- testSuites pkg_descr
                    , buildable (testBuildInfo tst)
                    , testEnabled tst ]
 ++ [ f (CBench bm) | bm <- benchmarks pkg_descr
                    , buildable (benchmarkBuildInfo bm)
                    , benchmarkEnabled bm ]
#endif

stackifyFlags :: ConfigFlags -> Maybe StackConfig -> ConfigFlags
stackifyFlags cfg Nothing   = cfg
stackifyFlags cfg (Just si) = cfg { configDistPref    = toFlag dist
                                  , configPackageDBs  = pdbs
                                  }
    where
      pdbs                  = [Nothing, Just GlobalPackageDB] ++ pdbs'
      pdbs'                 = Just . SpecificPackageDB <$> stackDbs si
      dist                  = stackDist si

-- via: https://groups.google.com/d/msg/haskell-stack/8HJ6DHAinU0/J68U6AXTsasJ
-- cabal configure --package-db=clear --package-db=global --package-db=$(stack path --snapshot-pkg-db) --package-db=$(stack path --local-pkg-db)

getPackageGhcOpts :: FilePath -> Maybe StackConfig -> IO (Either String [String])
getPackageGhcOpts path mbStack = do
    getPackageGhcOpts' `catch` (\e -> do
        return $ Left $ "Cabal error: " ++ (ioeGetErrorString (e :: IOException)))
  where
    getPackageGhcOpts' :: IO (Either String [String])
    getPackageGhcOpts' = do
        genPkgDescr <- readPackageDescription silent path
        let cfgFlags'' = (defaultConfigFlags defaultProgramConfiguration)
                            { configDistPref = toFlag $ takeDirectory path </> "dist"
                            -- TODO: figure out how to find out this flag
                            , configUserInstall = toFlag True
                            }
        let cfgFlags'  = stackifyFlags cfgFlags'' mbStack
        let sandboxConfig = takeDirectory path </> "cabal.sandbox.config"
        exists <- doesFileExist sandboxConfig

        cfgFlags <- case exists of
                         False -> return cfgFlags'
                         True -> do
                             sandboxPackageDb <- getSandboxPackageDB sandboxConfig
                             return $ cfgFlags'
                                          { configPackageDBs = [Just sandboxPackageDb]
                                          }
        localBuildInfo <- configure (genPkgDescr, emptyHookedBuildInfo) cfgFlags
        let pkgDescr = localPkgDescr localBuildInfo
        let baseDir = fst . splitFileName $ path
        case getGhcVersion localBuildInfo of
            Nothing -> return $ Left "GHC is not configured"
            Just _  -> do
                let mbLibName = pkgLibName pkgDescr
                let ghcOpts' = foldl' mappend mempty $ map (getComponentGhcOptions localBuildInfo) $ flip allComponentsBy (\c -> c) . localPkgDescr $ localBuildInfo
#if __GLASGOW_HASKELL__ >= 709
                    -- FIX bug in GhcOptions' `mappend`
                    ghcOpts = ghcOpts' { ghcOptExtra = overNubListR (filter (/= "-Werror")) $ ghcOptExtra ghcOpts'
                                       , ghcOptPackageDBs = sort $ nub (ghcOptPackageDBs ghcOpts')
                                       , ghcOptPackages = overNubListR (filter (\(_, pkgId, _) -> Just (pkgName pkgId) /= mbLibName)) $ (ghcOptPackages ghcOpts')
                                       , ghcOptSourcePath = overNubListR (map (baseDir </>)) (ghcOptSourcePath ghcOpts')
                                       }
                putStrLn "configuring"
                (ghcInfo,_,_) <- GHC.configure silent Nothing Nothing defaultProgramConfiguration

                return $ Right $ renderGhcOptions ghcInfo ghcOpts
#else
                    ghcOpts = ghcOpts' { ghcOptExtra = filter (/= "-Werror") $ nub $ ghcOptExtra ghcOpts'
                                       , ghcOptPackages = filter (\(_, pkgId) -> Just (pkgName pkgId) /= mbLibName) $ nub (ghcOptPackages ghcOpts')
                                       , ghcOptSourcePath = map (baseDir </>) (ghcOptSourcePath ghcOpts')
                                       }
                return $ Right $ renderGhcOptions ghcVersion ghcOpts
#endif

pkgLibName :: PackageDescription -> Maybe PackageName
pkgLibName pkgDescr = if hasLibrary pkgDescr
                      then Just $ pkgName . package $ pkgDescr
                      else Nothing

hasLibrary :: PackageDescription -> Bool
hasLibrary = maybe False (\_ -> True) . library

getComponentGhcOptions :: LocalBuildInfo -> Component -> GhcOptions
getComponentGhcOptions lbi comp =
    componentGhcOptions silent lbi bi clbi (buildDir lbi)

  where bi   = componentBuildInfo comp
        clbi = getComponentLocalBuildInfo lbi (componentName comp)

getGhcVersion :: LocalBuildInfo -> Maybe Version
getGhcVersion lbi = let db = withPrograms lbi
                     in do ghc <- lookupProgram (simpleProgram "ghc") db
                           programVersion ghc

getSandboxPackageDB :: FilePath -> IO PackageDB
getSandboxPackageDB sandboxPath = do
    contents <- readFile sandboxPath
    return $ SpecificPackageDB $ extractValue . parse $ contents
  where
    pkgDbKey = "package-db:"
    parse = head . filter (pkgDbKey `isPrefixOf`) . lines
    extractValue = fst . break isSpace . dropWhile isSpace . drop (length pkgDbKey)


findCabalFile :: FilePath -> IO (Maybe FilePath)
findCabalFile dir = do
    allFiles <- getDirectoryContents dir
    let mbCabalFile = find (isCabalFile) allFiles
    case mbCabalFile of
      Just cabalFile -> return $ Just $ dir </> cabalFile
      Nothing ->
        let parentDir = takeDirectory dir
         in if parentDir == dir
            then return Nothing
            else findCabalFile parentDir

  where

    isCabalFile :: FilePath -> Bool
    isCabalFile path = cabalExtension `isSuffixOf` path
                    && length path > length cabalExtension
        where cabalExtension = ".cabal"

# else

getPackageGhcOpts :: FilePath -> IO (Either String [String])
getPackageGhcOpts _ = return $ Right []

findCabalFile :: FilePath -> IO (Maybe FilePath)
findCabalFile _ = return Nothing

#endif