module Hhp.Check (
    checkSyntax
  , check
  , expandTemplate
  , expand
  ) where

import GHC (Ghc, DynFlags(..))
import GHC.Driver.Session (dopt_set, DumpFlag(Opt_D_dump_splices))

import Hhp.GHCApi
import Hhp.Logger
import Hhp.Types

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

-- | Checking syntax of a target file using GHC.
--   Warnings and errors are returned.
checkSyntax :: Options
            -> Cradle
            -> [FilePath]  -- ^ The target files.
            -> IO String
checkSyntax :: Options -> Cradle -> [FilePath] -> IO FilePath
checkSyntax Options
_   Cradle
_      []    = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
checkSyntax Options
opt Cradle
cradle [FilePath]
files = forall a. FilePath -> Ghc a -> IO a
withGHC FilePath
sessionName forall a b. (a -> b) -> a -> b
$ do
    Options -> Cradle -> Ghc ()
initializeFlagsWithCradle Options
opt Cradle
cradle
    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
<$> Options -> [FilePath] -> Ghc (Either FilePath FilePath)
check Options
opt [FilePath]
files
  where
    sessionName :: FilePath
sessionName = case [FilePath]
files of
      [FilePath
file] -> FilePath
file
      [FilePath]
_      -> FilePath
"MultipleFiles"

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

-- | Checking syntax of a target file using GHC.
--   Warnings and errors are returned.
check :: Options
      -> [FilePath]  -- ^ The target files.
      -> Ghc (Either String String)
check :: Options -> [FilePath] -> Ghc (Either FilePath FilePath)
check Options
opt [FilePath]
fileNames = Options
-> (DynFlags -> DynFlags)
-> Ghc ()
-> Ghc (Either FilePath FilePath)
withLogger Options
opt (DynFlags -> DynFlags
setAllWarningFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> DynFlags
setPartialSignatures forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> DynFlags
setDeferTypedHoles) forall a b. (a -> b) -> a -> b
$
    [FilePath] -> Ghc ()
setTargetFiles [FilePath]
fileNames

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

-- | Expanding Haskell Template.
expandTemplate :: Options
               -> Cradle
               -> [FilePath]  -- ^ The target files.
               -> IO String
expandTemplate :: Options -> Cradle -> [FilePath] -> IO FilePath
expandTemplate Options
_   Cradle
_      []    = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
expandTemplate Options
opt Cradle
cradle [FilePath]
files = forall a. FilePath -> Ghc a -> IO a
withGHC FilePath
sessionName forall a b. (a -> b) -> a -> b
$ do
    Options -> Cradle -> Ghc ()
initializeFlagsWithCradle Options
opt Cradle
cradle
    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
<$> Options -> [FilePath] -> Ghc (Either FilePath FilePath)
expand Options
opt [FilePath]
files
  where
    sessionName :: FilePath
sessionName = case [FilePath]
files of
      [FilePath
file] -> FilePath
file
      [FilePath]
_      -> FilePath
"MultipleFiles"

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

-- | Expanding Haskell Template.
expand :: Options
      -> [FilePath]  -- ^ The target files.
      -> Ghc (Either String String)
expand :: Options -> [FilePath] -> Ghc (Either FilePath FilePath)
expand Options
opt [FilePath]
fileNames = Options
-> (DynFlags -> DynFlags)
-> Ghc ()
-> Ghc (Either FilePath FilePath)
withLogger Options
opt (DynFlags -> DynFlags
setDumpSplices forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> DynFlags
setNoWarningFlags) forall a b. (a -> b) -> a -> b
$
    [FilePath] -> Ghc ()
setTargetFiles [FilePath]
fileNames

setDumpSplices :: DynFlags -> DynFlags
setDumpSplices :: DynFlags -> DynFlags
setDumpSplices DynFlags
dflag = DynFlags -> DumpFlag -> DynFlags
dopt_set DynFlags
dflag DumpFlag
Opt_D_dump_splices