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

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

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

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

configInfo :: [FilePath] -> IO String
configInfo :: [FilePath] -> IO FilePath
configInfo []   = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"No files given"
configInfo [FilePath]
args =
  ([FilePath] -> FilePath) -> IO [FilePath] -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> FilePath
unlines (IO [FilePath] -> IO FilePath) -> IO [FilePath] -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> (FilePath -> IO FilePath) -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
args ((FilePath -> IO FilePath) -> IO [FilePath])
-> (FilePath -> IO FilePath) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> do
    FilePath
fp' <- FilePath -> IO FilePath
canonicalizePath FilePath
fp
    ((FilePath
"Config for \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\": ") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
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 IO (Maybe FilePath)
-> (Maybe FilePath -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just FilePath
yaml -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
yaml
  Maybe FilePath
_ -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"No explicit config found"

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

cradleInfo :: [FilePath] -> IO String
cradleInfo :: [FilePath] -> IO FilePath
cradleInfo [] = FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"No files given"
cradleInfo [FilePath]
args =
  ([FilePath] -> FilePath) -> IO [FilePath] -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> FilePath
unlines (IO [FilePath] -> IO FilePath) -> IO [FilePath] -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> (FilePath -> IO FilePath) -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
args ((FilePath -> IO FilePath) -> IO [FilePath])
-> (FilePath -> IO FilePath) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> do
    FilePath
fp' <- FilePath -> IO FilePath
canonicalizePath FilePath
fp
    ((FilePath
"Cradle for \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\": ") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)  (FilePath -> FilePath) -> IO FilePath -> IO FilePath
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 IO (Maybe FilePath)
-> (Maybe FilePath -> IO FilePath) -> IO FilePath
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
      FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Cradle Void -> FilePath
forall a. Show a => a -> FilePath
show Cradle Void
crdl
    Maybe FilePath
Nothing -> do
      Cradle Void
crdl <- FilePath -> IO (Cradle Void)
forall a. Show a => FilePath -> IO (Cradle a)
loadImplicitCradle FilePath
fp :: IO (Cradle Void)
      FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Cradle Void -> FilePath
forall a. Show a => a -> FilePath
show Cradle Void
crdl