module Hhp.Debug (debugInfo, rootInfo) where

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

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

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