{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExistentialQuantification #-}
module HIE.Bios.Ghc.Check (
    checkSyntax
  , check
  ) where

import GHC (GhcMonad)
import qualified GHC as G


import Control.Exception
import Control.Monad.IO.Class
import Colog.Core (LogAction (..), WithSeverity (..), Severity (..), (<&), cmap)
import Data.Text.Prettyprint.Doc

import HIE.Bios.Ghc.Api
import HIE.Bios.Ghc.Logger
import HIE.Bios.Types hiding (Log (..))
import qualified HIE.Bios.Types as T
import qualified HIE.Bios.Ghc.Load as Load
import HIE.Bios.Environment


data Log =
  LoadLog Load.Log
  | LogAny T.Log
  | forall a . Show a => LogCradle (Cradle a)

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty (LoadLog Log
l) = forall a ann. Pretty a => a -> Doc ann
pretty Log
l
  pretty (LogAny Log
l) = forall a ann. Pretty a => a -> Doc ann
pretty Log
l
  pretty (LogCradle Cradle a
c) = Doc ann
"Cradle:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow Cradle a
c

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

-- | Checking syntax of a target file using GHC.
--   Warnings and errors are returned.
checkSyntax :: Show a
            => LogAction IO (WithSeverity Log)
            -> Cradle a
            -> [FilePath]  -- ^ The target files.
            -> IO String
checkSyntax :: forall a.
Show a =>
LogAction IO (WithSeverity Log)
-> Cradle a -> [FilePath] -> IO FilePath
checkSyntax LogAction IO (WithSeverity Log)
_           Cradle a
_      []    = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
checkSyntax LogAction IO (WithSeverity Log)
checkLogger Cradle a
cradle [FilePath]
files = do
    CradleLoadResult FilePath
libDirRes <- forall a. Cradle a -> IO (CradleLoadResult FilePath)
getRuntimeGhcLibDir Cradle a
cradle
    forall {m :: * -> *} {a} {t}.
(MonadIO m, IsString a) =>
CradleLoadResult t -> (t -> m a) -> m a
handleRes CradleLoadResult FilePath
libDirRes forall a b. (a -> b) -> a -> b
$ \FilePath
libDir ->
      forall (m :: * -> *) a.
ExceptionMonad m =>
Maybe FilePath -> GhcT m a -> m a
G.runGhcT (forall a. a -> Maybe a
Just FilePath
libDir) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ LogAction IO (WithSeverity Log)
checkLogger forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& forall a. Show a => Cradle a -> Log
LogCradle Cradle a
cradle forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Info
        CradleLoadResult (GhcT IO SuccessFlag, ComponentOptions)
res <- forall (m :: * -> *) a.
GhcMonad m =>
FilePath
-> Cradle a
-> m (CradleLoadResult (m SuccessFlag, ComponentOptions))
initializeFlagsWithCradle (forall a. [a] -> a
head [FilePath]
files) Cradle a
cradle
        forall {m :: * -> *} {a} {t}.
(MonadIO m, IsString a) =>
CradleLoadResult t -> (t -> m a) -> m a
handleRes CradleLoadResult (GhcT IO SuccessFlag, ComponentOptions)
res forall a b. (a -> b) -> a -> b
$ \(GhcT IO SuccessFlag
ini, ComponentOptions
_) -> do
          SuccessFlag
_sf <- GhcT IO SuccessFlag
ini
          forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
GhcMonad m =>
LogAction IO (WithSeverity Log)
-> [FilePath] -> m (Either FilePath FilePath)
check LogAction IO (WithSeverity Log)
checkLogger [FilePath]
files
  where
    handleRes :: CradleLoadResult t -> (t -> m a) -> m a
handleRes (CradleSuccess t
x) t -> m a
f = t -> m a
f t
x
    handleRes (CradleFail CradleError
ce) t -> m a
_f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO CradleError
ce
    handleRes CradleLoadResult t
CradleNone t -> m a
_f = forall (m :: * -> *) a. Monad m => a -> m a
return a
"None cradle"

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

-- | Checking syntax of a target file using GHC.
--   Warnings and errors are returned.
check :: (GhcMonad m)
      => LogAction IO (WithSeverity Log)
      -> [FilePath]  -- ^ The target files.
      -> m (Either String String)
check :: forall (m :: * -> *).
GhcMonad m =>
LogAction IO (WithSeverity Log)
-> [FilePath] -> m (Either FilePath FilePath)
check LogAction IO (WithSeverity Log)
logger [FilePath]
fileNames = do
  forall (m :: * -> *).
GhcMonad m =>
(DynFlags -> DynFlags) -> m () -> m (Either FilePath FilePath)
withLogger forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
GhcMonad m =>
LogAction IO (WithSeverity Log) -> [(FilePath, FilePath)] -> m ()
Load.setTargetFiles (forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
cmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Log -> Log
LoadLog) LogAction IO (WithSeverity Log)
logger) (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> (a, a)
dup [FilePath]
fileNames)

dup :: a -> (a, a)
dup :: forall a. a -> (a, a)
dup a
x = (a
x, a
x)