module Hhp.Debug (debugInfo, rootInfo) where

import GHC.Utils.Monad (liftIO)

import Control.Applicative ((<|>))
import Data.List (intercalate)
import Data.Maybe (fromMaybe, isJust, fromJust)

import Hhp.CabalApi
import Hhp.GHCApi
import Hhp.Types

----------------------------------------------------------------

-- | Obtaining debug information.
debugInfo :: Options
          -> Cradle
          -> IO String
debugInfo :: Options -> Cradle -> IO FilePath
debugInfo Options
opt Cradle
cradle = forall a. ToString a => Options -> a -> FilePath
convert Options
opt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    CompilerOptions [FilePath]
gopts [FilePath]
incDir [Package]
pkgs <-
        if Bool
cabal then
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompilerOptions
fromCabalFile forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return CompilerOptions
simpleCompilerOption)
          else
            forall (m :: * -> *) a. Monad m => a -> m a
return CompilerOptions
simpleCompilerOption
    Maybe FilePath
mglibdir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe FilePath)
getSystemLibDir
    forall (m :: * -> *) a. Monad m => a -> m a
return [
        FilePath
"Root directory:      " forall a. [a] -> [a] -> [a]
++ FilePath
rootDir
      , FilePath
"Current directory:   " forall a. [a] -> [a] -> [a]
++ FilePath
currentDir
      , FilePath
"Cabal file:          " forall a. [a] -> [a] -> [a]
++ FilePath
cabalFile
      , FilePath
"GHC options:         " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
gopts
      , FilePath
"Include directories: " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
incDir
      , FilePath
"Dependent packages:  " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " (forall a b. (a -> b) -> [a] -> [b]
map Package -> FilePath
showPkg [Package]
pkgs)
      , FilePath
"System libraries:    " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe FilePath
"" Maybe FilePath
mglibdir
      ]
  where
    currentDir :: FilePath
currentDir = Cradle -> FilePath
cradleCurrentDir Cradle
cradle
    mCabalFile :: Maybe FilePath
mCabalFile = Cradle -> Maybe FilePath
cradleCabalFile Cradle
cradle
    rootDir :: FilePath
rootDir    = Cradle -> FilePath
cradleRootDir Cradle
cradle
    cabal :: Bool
cabal = forall a. Maybe a -> Bool
isJust Maybe FilePath
mCabalFile
    cabalFile :: FilePath
cabalFile = forall a. a -> Maybe a -> a
fromMaybe FilePath
"" Maybe FilePath
mCabalFile
    origGopts :: [FilePath]
origGopts = Options -> [FilePath]
ghcOpts Options
opt
    simpleCompilerOption :: CompilerOptions
simpleCompilerOption = [FilePath] -> [FilePath] -> [Package] -> CompilerOptions
CompilerOptions [FilePath]
origGopts [] []
    fromCabalFile :: IO CompilerOptions
fromCabalFile = do
        PackageDescription
pkgDesc <- FilePath -> IO PackageDescription
parseCabalFile FilePath
file
        [FilePath] -> Cradle -> PackageDescription -> IO CompilerOptions
getCompilerOptions [FilePath]
origGopts Cradle
cradle PackageDescription
pkgDesc
      where
        file :: FilePath
file = forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
mCabalFile

----------------------------------------------------------------

-- | Obtaining root information.
rootInfo :: Options
          -> Cradle
          -> IO String
rootInfo :: Options -> Cradle -> IO FilePath
rootInfo Options
opt Cradle
cradle = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToString a => Options -> a -> FilePath
convert Options
opt forall a b. (a -> b) -> a -> b
$ Cradle -> FilePath
cradleRootDir Cradle
cradle