{-# 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
          => LogAction IO (WithSeverity Log)
          -> FilePath
          -> Cradle a
          -> IO String
debugInfo :: forall a.
Show a =>
LogAction IO (WithSeverity Log)
-> FilePath -> Cradle a -> IO FilePath
debugInfo LogAction IO (WithSeverity Log)
logger FilePath
fp Cradle a
cradle = [FilePath] -> FilePath
unlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    CradleLoadResult ComponentOptions
res <- forall a.
LogAction IO (WithSeverity Log)
-> FilePath -> Cradle a -> IO (CradleLoadResult ComponentOptions)
getCompilerOptions LogAction IO (WithSeverity Log)
logger FilePath
fp Cradle a
cradle
    FilePath
canonFp <- FilePath -> IO FilePath
canonicalizePath FilePath
fp
    FilePath
conf <- FilePath -> IO FilePath
findConfig FilePath
canonFp
    FilePath
crdl <- FilePath -> IO FilePath
findCradle' FilePath
canonFp
    CradleLoadResult FilePath
ghcLibDir <- forall a.
LogAction IO (WithSeverity Log)
-> Cradle a -> IO (CradleLoadResult FilePath)
getRuntimeGhcLibDir LogAction IO (WithSeverity Log)
logger Cradle a
cradle
    CradleLoadResult FilePath
ghcVer <- forall a.
LogAction IO (WithSeverity Log)
-> Cradle a -> IO (CradleLoadResult FilePath)
getRuntimeGhcVersion LogAction IO (WithSeverity Log)
logger 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 :: [FilePath] -> IO String
cradleInfo :: [FilePath] -> IO FilePath
cradleInfo [] = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"No files given"
cradleInfo [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
<$> FilePath -> IO FilePath
findCradle' FilePath
fp'

findCradle' :: FilePath -> IO String
findCradle' :: FilePath -> IO FilePath
findCradle' 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 <- FilePath -> IO (Cradle Void)
loadCradle 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 => FilePath -> IO (Cradle a)
loadImplicitCradle 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