-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE TypeFamilies #-}

-- | A Shake implementation of the compiler service, built
--   using the "Shaker" abstraction layer for in-memory use.
--
module Development.IDE.Core.Service(
    getIdeOptions, getIdeOptionsIO,
    IdeState, initialise, shutdown,
    runAction,
    getDiagnostics,
    ideLogger,
    updatePositionMapping,
    Log(..),
    ) where

import           Control.Applicative              ((<|>))
import           Development.IDE.Core.Debouncer
import           Development.IDE.Core.FileExists  (fileExistsRules)
import           Development.IDE.Core.OfInterest  hiding (Log, LogShake)
import           Development.IDE.Graph
import           Development.IDE.Types.Options    (IdeOptions (..))
import           Ide.Logger                       as Logger (Pretty (pretty),
                                                             Priority (Debug),
                                                             Recorder,
                                                             WithPriority,
                                                             cmapWithPrio)
import           Ide.Plugin.Config
import qualified Language.LSP.Protocol.Types      as LSP
import qualified Language.LSP.Server              as LSP

import           Control.Monad
import qualified Development.IDE.Core.FileExists  as FileExists
import qualified Development.IDE.Core.OfInterest  as OfInterest
import           Development.IDE.Core.Shake       hiding (Log)
import qualified Development.IDE.Core.Shake       as Shake
import           Development.IDE.Types.Monitoring (Monitoring)
import           Development.IDE.Types.Shake      (WithHieDb)
import           Ide.Types                        (IdePlugins)
import           System.Environment               (lookupEnv)

data Log
  = LogShake Shake.Log
  | LogOfInterest OfInterest.Log
  | LogFileExists FileExists.Log
  deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogShake Log
msg      -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg
    LogOfInterest Log
msg -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg
    LogFileExists Log
msg -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg


------------------------------------------------------------
-- Exposed API

-- | Initialise the Compiler Service.
initialise :: Recorder (WithPriority Log)
           -> Config
           -> IdePlugins IdeState
           -> Rules ()
           -> Maybe (LSP.LanguageContextEnv Config)
           -> Debouncer LSP.NormalizedUri
           -> IdeOptions
           -> WithHieDb
           -> ThreadQueue
           -> Monitoring
           -> FilePath -- ^ Root directory see Note [Root Directory]
           -> IO IdeState
initialise :: Recorder (WithPriority Log)
-> Config
-> IdePlugins IdeState
-> Rules ()
-> Maybe (LanguageContextEnv Config)
-> Debouncer NormalizedUri
-> IdeOptions
-> WithHieDb
-> ThreadQueue
-> Monitoring
-> String
-> IO IdeState
initialise Recorder (WithPriority Log)
recorder Config
defaultConfig IdePlugins IdeState
plugins Rules ()
mainRule Maybe (LanguageContextEnv Config)
lspEnv Debouncer NormalizedUri
debouncer IdeOptions
options WithHieDb
withHieDb ThreadQueue
hiedbChan Monitoring
metrics String
rootDir = do
    Maybe String
shakeProfiling <- do
        let fromConf :: Maybe String
fromConf = IdeOptions -> Maybe String
optShakeProfiling IdeOptions
options
        Maybe String
fromEnv <- String -> IO (Maybe String)
lookupEnv String
"GHCIDE_BUILD_PROFILING"
        Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe String
fromConf Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
fromEnv
    Recorder (WithPriority Log)
-> Maybe (LanguageContextEnv Config)
-> Config
-> IdePlugins IdeState
-> Debouncer NormalizedUri
-> Maybe String
-> IdeReportProgress
-> IdeTesting
-> WithHieDb
-> ThreadQueue
-> ShakeOptions
-> Monitoring
-> Rules ()
-> String
-> IO IdeState
shakeOpen
        ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder)
        Maybe (LanguageContextEnv Config)
lspEnv
        Config
defaultConfig
        IdePlugins IdeState
plugins
        Debouncer NormalizedUri
debouncer
        Maybe String
shakeProfiling
        (IdeOptions -> IdeReportProgress
optReportProgress IdeOptions
options)
        (IdeOptions -> IdeTesting
optTesting IdeOptions
options)
        (HieDb -> IO a) -> IO a
WithHieDb
withHieDb
        ThreadQueue
hiedbChan
        (IdeOptions -> ShakeOptions
optShakeOptions IdeOptions
options)
        Monitoring
metrics
        (do
            GlobalIdeOptions -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal (GlobalIdeOptions -> Rules ()) -> GlobalIdeOptions -> Rules ()
forall a b. (a -> b) -> a -> b
$ IdeOptions -> GlobalIdeOptions
GlobalIdeOptions IdeOptions
options
            Recorder (WithPriority Log) -> Rules ()
ofInterestRules ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogOfInterest Recorder (WithPriority Log)
recorder)
            Recorder (WithPriority Log)
-> Maybe (LanguageContextEnv Config) -> Rules ()
fileExistsRules ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogFileExists Recorder (WithPriority Log)
recorder) Maybe (LanguageContextEnv Config)
lspEnv
            Rules ()
mainRule)
        String
rootDir

-- | Shutdown the Compiler Service.
shutdown :: IdeState -> IO ()
shutdown :: IdeState -> IO ()
shutdown = IdeState -> IO ()
shakeShut

-- This will return as soon as the result of the action is
-- available.  There might still be other rules running at this point,
-- e.g., the ofInterestRule.
runAction :: String -> IdeState -> Action a -> IO a
runAction :: forall a. String -> IdeState -> Action a -> IO a
runAction String
herald IdeState
ide Action a
act =
  IO (IO a) -> IO a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO a) -> IO a) -> IO (IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> DelayedAction a -> IO (IO a)
forall a. ShakeExtras -> DelayedAction a -> IO (IO a)
shakeEnqueue (IdeState -> ShakeExtras
shakeExtras IdeState
ide) (String -> Priority -> Action a -> DelayedAction a
forall a. String -> Priority -> Action a -> DelayedAction a
mkDelayedAction String
herald Priority
Logger.Debug Action a
act)