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

import Control.Monad
import Colog.Core (LogAction (..), WithSeverity (..))
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 :: forall a. Show a => FilePath -> Cradle a -> IO FilePath
debugInfo FilePath
fp Cradle a
cradle = [FilePath] -> FilePath
unlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    let logger :: LogAction IO (WithSeverity Log)
logger = forall a. Cradle a -> LogAction IO (WithSeverity Log)
cradleLogger Cradle a
cradle
    CradleLoadResult ComponentOptions
res <- forall a.
FilePath
-> [FilePath] -> Cradle a -> IO (CradleLoadResult ComponentOptions)
getCompilerOptions FilePath
fp [] Cradle a
cradle
    FilePath
canonFp <- FilePath -> IO FilePath
canonicalizePath FilePath
fp
    FilePath
conf <- FilePath -> IO FilePath
findConfig FilePath
canonFp
    FilePath
crdl <- LogAction IO (WithSeverity Log) -> FilePath -> IO FilePath
findCradle' LogAction IO (WithSeverity Log)
logger FilePath
canonFp
    CradleLoadResult FilePath
ghcLibDir <- forall a. Cradle a -> IO (CradleLoadResult FilePath)
getRuntimeGhcLibDir Cradle a
cradle
    CradleLoadResult FilePath
ghcVer <- forall a. Cradle a -> IO (CradleLoadResult FilePath)
getRuntimeGhcVersion Cradle a
cradle
    case CradleLoadResult ComponentOptions
res of
      CradleSuccess (ComponentOptions [FilePath]
gopts FilePath
croot [FilePath]
deps) -> do
        forall (m :: * -> *) a. Monad m => a -> m a
return [
            FilePath
"Root directory:        " forall a. [a] -> [a] -> [a]
++ FilePath
rootDir
          , FilePath
"Component directory:   " forall a. [a] -> [a] -> [a]
++ FilePath
croot
          , FilePath
"GHC options:           " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
quoteIfNeeded [FilePath]
gopts)
          , FilePath
"GHC library directory: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show CradleLoadResult FilePath
ghcLibDir
          , FilePath
"GHC version:           " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show CradleLoadResult FilePath
ghcVer
          , FilePath
"Config Location:       " forall a. [a] -> [a] -> [a]
++ FilePath
conf
          , FilePath
"Cradle:                " forall a. [a] -> [a] -> [a]
++ FilePath
crdl
          , FilePath
"Dependencies:          " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
deps
          ]
      CradleFail (CradleError [FilePath]
deps ExitCode
ext [FilePath]
stderr) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
"Cradle failed to load"
               , FilePath
"Deps: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show [FilePath]
deps
               , FilePath
"Exit Code: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ExitCode
ext
               , FilePath
"Stderr: " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines [FilePath]
stderr]
      CradleLoadResult ComponentOptions
CradleNone ->
        forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
"No cradle"]
  where
    rootDir :: FilePath
rootDir    = forall a. Cradle a -> FilePath
cradleRootDir Cradle a
cradle
    quoteIfNeeded :: FilePath -> FilePath
quoteIfNeeded FilePath
option
      | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
Char.isSpace FilePath
option = FilePath
"\"" forall a. [a] -> [a] -> [a]
++ FilePath
option forall a. [a] -> [a] -> [a]
++ FilePath
"\""
      | Bool
otherwise = FilePath
option

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

-- | Get the root directory of the given Cradle.
rootInfo :: Cradle a
          -> IO String
rootInfo :: forall a. Cradle a -> IO FilePath
rootInfo Cradle a
cradle = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Cradle a -> FilePath
cradleRootDir Cradle a
cradle

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

configInfo :: [FilePath] -> IO String
configInfo :: [FilePath] -> IO FilePath
configInfo []   = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"No files given"
configInfo [FilePath]
args =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
args forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> do
    FilePath
fp' <- FilePath -> IO FilePath
canonicalizePath FilePath
fp
    ((FilePath
"Config for \"" forall a. [a] -> [a] -> [a]
++ FilePath
fp' forall a. [a] -> [a] -> [a]
++ FilePath
"\": ") forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
findConfig FilePath
fp'

findConfig :: FilePath -> IO String
findConfig :: FilePath -> IO FilePath
findConfig FilePath
fp = FilePath -> IO (Maybe FilePath)
findCradle FilePath
fp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just FilePath
yaml -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
yaml
  Maybe FilePath
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"No explicit config found"

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

cradleInfo :: LogAction IO (WithSeverity Log) -> [FilePath] -> IO String
cradleInfo :: LogAction IO (WithSeverity Log) -> [FilePath] -> IO FilePath
cradleInfo LogAction IO (WithSeverity Log)
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"No files given"
cradleInfo LogAction IO (WithSeverity Log)
l [FilePath]
args =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
args forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> do
    FilePath
fp' <- FilePath -> IO FilePath
canonicalizePath FilePath
fp
    ((FilePath
"Cradle for \"" forall a. [a] -> [a] -> [a]
++ FilePath
fp' forall a. [a] -> [a] -> [a]
++ FilePath
"\": ") forall a. [a] -> [a] -> [a]
++)  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogAction IO (WithSeverity Log) -> FilePath -> IO FilePath
findCradle' LogAction IO (WithSeverity Log)
l FilePath
fp'

findCradle' :: LogAction IO (WithSeverity Log) -> FilePath -> IO String
findCradle' :: LogAction IO (WithSeverity Log) -> FilePath -> IO FilePath
findCradle' LogAction IO (WithSeverity Log)
l FilePath
fp =
  FilePath -> IO (Maybe FilePath)
findCradle FilePath
fp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just FilePath
yaml -> do
      Cradle Void
crdl <- LogAction IO (WithSeverity Log) -> FilePath -> IO (Cradle Void)
loadCradle LogAction IO (WithSeverity Log)
l FilePath
yaml
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show Cradle Void
crdl
    Maybe FilePath
Nothing -> do
      Cradle Void
crdl <- forall a.
Show a =>
LogAction IO (WithSeverity Log) -> FilePath -> IO (Cradle a)
loadImplicitCradle LogAction IO (WithSeverity Log)
l FilePath
fp :: IO (Cradle Void)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show Cradle Void
crdl