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

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

-- | Get the root directory of the given Cradle.
rootInfo :: Cradle a
          -> IO String
rootInfo :: Cradle a -> IO FilePath
rootInfo cradle :: 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 "No files given"
configInfo args :: [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
$ \fp :: FilePath
fp -> do
    FilePath
fp' <- FilePath -> IO FilePath
canonicalizePath FilePath
fp
    (("Config for \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\": ") 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 fp :: 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 yaml :: FilePath
yaml -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
yaml
  _ -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return "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 "No files given"
cradleInfo args :: [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
$ \fp :: FilePath
fp -> do
    FilePath
fp' <- FilePath -> IO FilePath
canonicalizePath FilePath
fp
    (("Cradle for \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\": ") 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' fp :: 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 yaml :: 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
    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