Debug.hs

{-# LANGUAGE LambdaCase #-}
module HIE.Bios.Internal.Debug (debugInfo, rootInfo, configInfo, cradleInfo) where

import Control.Monad
import Data.Void

import qualified Data.Char as Char

import HIE.Bios.Cradle
import HIE.Bios.Environment
import HIE.Bios.Types
import HIE.Bios.Flags

import System.Directory

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

-- | Obtain debug information for a 'Cradle'.
--
-- Tries to load the 'Cradle' and dump any information associated with it.
-- If loading succeeds, contains information such as the root directory of
-- the cradle, the compiler options to compile a module in this 'Cradle',
-- the file dependencies and so on.
--
-- Otherwise, shows the error message and exit-code.
debugInfo :: Show a
          => FilePath
          -> Cradle a
          -> IO String
debugInfo fp cradle = unlines <$> do
    res <- getCompilerOptions fp cradle
    canonFp <- canonicalizePath fp
    conf <- findConfig canonFp
    crdl <- findCradle' canonFp
    ghcLibDir <- getRuntimeGhcLibDir cradle
    ghcVer <- getRuntimeGhcVersion cradle
    case res of
      CradleSuccess (ComponentOptions gopts croot deps) -> do
        return [
            "Root directory:        " ++ rootDir
          , "Component directory:   " ++ croot
          , "GHC options:           " ++ unwords (map quoteIfNeeded gopts)
          , "GHC library directory: " ++ show ghcLibDir
          , "GHC version:           " ++ show ghcVer
          , "Config Location:       " ++ conf
          , "Cradle:                " ++ crdl
          , "Dependencies:          " ++ unwords deps
          ]
      CradleFail (CradleError deps ext stderr) ->
        return ["Cradle failed to load"
               , "Deps: " ++ show deps
               , "Exit Code: " ++ show ext
               , "Stderr: " ++ unlines stderr]
      CradleNone ->
        return ["No cradle"]
  where
    rootDir    = cradleRootDir cradle
    quoteIfNeeded option
      | any Char.isSpace option = "\"" ++ option ++ "\""
      | otherwise = option

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

-- | Get the root directory of the given Cradle.
rootInfo :: Cradle a
          -> IO String
rootInfo cradle = return $ cradleRootDir cradle

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

configInfo :: [FilePath] -> IO String
configInfo []   = return "No files given"
configInfo args =
  fmap unlines $ forM args $ \fp -> do
    fp' <- canonicalizePath fp
    (("Config for \"" ++ fp' ++ "\": ") ++) <$> findConfig fp'

findConfig :: FilePath -> IO String
findConfig fp = findCradle fp >>= \case
  Just yaml -> return yaml
  _ -> return "No explicit config found"

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

cradleInfo :: [FilePath] -> IO String
cradleInfo [] = return "No files given"
cradleInfo args =
  fmap unlines $ forM args $ \fp -> do
    fp' <- canonicalizePath fp
    (("Cradle for \"" ++ fp' ++ "\": ") ++)  <$> findCradle' fp'

findCradle' :: FilePath -> IO String
findCradle' fp =
  findCradle fp >>= \case
    Just yaml -> do
      crdl <- loadCradle yaml
      return $ show crdl
    Nothing -> do
      crdl <- loadImplicitCradle fp :: IO (Cradle Void)
      return $ show crdl