{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
module Development.IDE.Core.Service(
getIdeOptions,
IdeState, initialise, shutdown,
runAction,
runActionSync,
writeProfile,
getDiagnostics, unsafeClearDiagnostics,
ideLogger,
updatePositionMapping,
) where
import Control.Concurrent.Extra
import Control.Concurrent.Async
import Data.Maybe
import Development.IDE.Types.Options (IdeOptions(..))
import Control.Monad
import Development.IDE.Core.FileStore
import Development.IDE.Core.OfInterest
import Development.IDE.Types.Logger
import Development.Shake
import Data.Either.Extra
import qualified Language.Haskell.LSP.Messages as LSP
import qualified Language.Haskell.LSP.Types as LSP
import Development.IDE.Core.Shake
newtype GlobalIdeOptions = GlobalIdeOptions IdeOptions
instance IsIdeGlobal GlobalIdeOptions
initialise :: Rules ()
-> IO LSP.LspId
-> (LSP.FromServerMessage -> IO ())
-> Logger
-> IdeOptions
-> VFSHandle
-> IO IdeState
initialise mainRule getLspId toDiags logger options vfs =
shakeOpen
getLspId
toDiags
logger
(optShakeProfiling options)
(optReportProgress options)
shakeOptions
{ shakeThreads = optThreads options
, shakeFiles = fromMaybe "/dev/null" (optShakeFiles options)
} $ do
addIdeGlobal $ GlobalIdeOptions options
fileStoreRules vfs
ofInterestRules
mainRule
writeProfile :: IdeState -> FilePath -> IO ()
writeProfile = shakeProfile
shutdown :: IdeState -> IO ()
shutdown = shakeShut
runAction :: IdeState -> Action a -> IO a
runAction ide action = do
bar <- newBarrier
res <- shakeRun ide [do v <- action; liftIO $ signalBarrier bar v; return v]
fmap fromEither $ race (head <$> res) $ waitBarrier bar
runActionSync :: IdeState -> Action a -> IO a
runActionSync s act = fmap head $ join $ shakeRun s [act]
getIdeOptions :: Action IdeOptions
getIdeOptions = do
GlobalIdeOptions x <- getIdeGlobalAction
return x