{-# LANGUAGE DuplicateRecordFields #-}
module Development.IDE.Core.IdeConfiguration
( IdeConfiguration(..)
, registerIdeConfiguration
, getIdeConfiguration
, parseConfiguration
, parseWorkspaceFolder
, isWorkspaceFile
, modifyWorkspaceFolders
, modifyClientSettings
, getClientSettings
)
where
import Control.Concurrent.Strict
import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson.Types (Value)
import Data.Hashable (Hashed, hashed, unhashed)
import Data.HashSet (HashSet, singleton)
import Data.Text (Text, isPrefixOf)
import Development.IDE.Core.Shake
import Development.IDE.Graph
import Development.IDE.Types.Location
import Language.LSP.Types
import System.FilePath (isRelative)
data IdeConfiguration = IdeConfiguration
{ IdeConfiguration -> HashSet NormalizedUri
workspaceFolders :: HashSet NormalizedUri
, IdeConfiguration -> Hashed (Maybe Value)
clientSettings :: Hashed (Maybe Value)
}
deriving (Int -> IdeConfiguration -> ShowS
[IdeConfiguration] -> ShowS
IdeConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeConfiguration] -> ShowS
$cshowList :: [IdeConfiguration] -> ShowS
show :: IdeConfiguration -> String
$cshow :: IdeConfiguration -> String
showsPrec :: Int -> IdeConfiguration -> ShowS
$cshowsPrec :: Int -> IdeConfiguration -> ShowS
Show)
newtype IdeConfigurationVar = IdeConfigurationVar {IdeConfigurationVar -> Var IdeConfiguration
unIdeConfigurationRef :: Var IdeConfiguration}
instance IsIdeGlobal IdeConfigurationVar
registerIdeConfiguration :: ShakeExtras -> IdeConfiguration -> IO ()
registerIdeConfiguration :: ShakeExtras -> IdeConfiguration -> IO ()
registerIdeConfiguration ShakeExtras
extras =
forall a. IsIdeGlobal a => ShakeExtras -> a -> IO ()
addIdeGlobalExtras ShakeExtras
extras forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var IdeConfiguration -> IdeConfigurationVar
IdeConfigurationVar forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. a -> IO (Var a)
newVar
getIdeConfiguration :: Action IdeConfiguration
getIdeConfiguration :: Action IdeConfiguration
getIdeConfiguration =
forall a. (HasCallStack, IsIdeGlobal a) => Action a
getIdeGlobalAction forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Var a -> IO a
readVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeConfigurationVar -> Var IdeConfiguration
unIdeConfigurationRef
parseConfiguration :: InitializeParams -> IdeConfiguration
parseConfiguration :: InitializeParams -> IdeConfiguration
parseConfiguration InitializeParams {Maybe Int32
Maybe Text
Maybe Value
Maybe Trace
Maybe ClientInfo
Maybe ProgressToken
Maybe Uri
Maybe (List WorkspaceFolder)
ClientCapabilities
$sel:_workDoneToken:InitializeParams :: InitializeParams -> Maybe ProgressToken
$sel:_processId:InitializeParams :: InitializeParams -> Maybe Int32
$sel:_clientInfo:InitializeParams :: InitializeParams -> Maybe ClientInfo
$sel:_rootPath:InitializeParams :: InitializeParams -> Maybe Text
$sel:_rootUri:InitializeParams :: InitializeParams -> Maybe Uri
$sel:_initializationOptions:InitializeParams :: InitializeParams -> Maybe Value
$sel:_capabilities:InitializeParams :: InitializeParams -> ClientCapabilities
$sel:_trace:InitializeParams :: InitializeParams -> Maybe Trace
$sel:_workspaceFolders:InitializeParams :: InitializeParams -> Maybe (List WorkspaceFolder)
_workspaceFolders :: Maybe (List WorkspaceFolder)
_trace :: Maybe Trace
_capabilities :: ClientCapabilities
_initializationOptions :: Maybe Value
_rootUri :: Maybe Uri
_rootPath :: Maybe Text
_clientInfo :: Maybe ClientInfo
_processId :: Maybe Int32
_workDoneToken :: Maybe ProgressToken
..} =
IdeConfiguration {Hashed (Maybe Value)
HashSet NormalizedUri
clientSettings :: Hashed (Maybe Value)
workspaceFolders :: HashSet NormalizedUri
$sel:clientSettings:IdeConfiguration :: Hashed (Maybe Value)
$sel:workspaceFolders:IdeConfiguration :: HashSet NormalizedUri
..}
where
workspaceFolders :: HashSet NormalizedUri
workspaceFolders =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Hashable a => a -> HashSet a
singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> NormalizedUri
toNormalizedUri) Maybe Uri
_rootUri
forall a. Semigroup a => a -> a -> a
<> (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap)
(forall a. Hashable a => a -> HashSet a
singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceFolder -> NormalizedUri
parseWorkspaceFolder)
Maybe (List WorkspaceFolder)
_workspaceFolders
clientSettings :: Hashed (Maybe Value)
clientSettings = forall a. Hashable a => a -> Hashed a
hashed Maybe Value
_initializationOptions
parseWorkspaceFolder :: WorkspaceFolder -> NormalizedUri
parseWorkspaceFolder :: WorkspaceFolder -> NormalizedUri
parseWorkspaceFolder WorkspaceFolder{Text
$sel:_uri:WorkspaceFolder :: WorkspaceFolder -> Text
_uri :: Text
_uri} =
Uri -> NormalizedUri
toNormalizedUri (Text -> Uri
Uri Text
_uri)
modifyWorkspaceFolders
:: IdeState -> (HashSet NormalizedUri -> HashSet NormalizedUri) -> IO ()
modifyWorkspaceFolders :: IdeState
-> (HashSet NormalizedUri -> HashSet NormalizedUri) -> IO ()
modifyWorkspaceFolders IdeState
ide HashSet NormalizedUri -> HashSet NormalizedUri
f = IdeState -> (IdeConfiguration -> IdeConfiguration) -> IO ()
modifyIdeConfiguration IdeState
ide IdeConfiguration -> IdeConfiguration
f'
where f' :: IdeConfiguration -> IdeConfiguration
f' (IdeConfiguration HashSet NormalizedUri
ws Hashed (Maybe Value)
initOpts) = HashSet NormalizedUri -> Hashed (Maybe Value) -> IdeConfiguration
IdeConfiguration (HashSet NormalizedUri -> HashSet NormalizedUri
f HashSet NormalizedUri
ws) Hashed (Maybe Value)
initOpts
modifyClientSettings
:: IdeState -> (Maybe Value -> Maybe Value) -> IO ()
modifyClientSettings :: IdeState -> (Maybe Value -> Maybe Value) -> IO ()
modifyClientSettings IdeState
ide Maybe Value -> Maybe Value
f = IdeState -> (IdeConfiguration -> IdeConfiguration) -> IO ()
modifyIdeConfiguration IdeState
ide IdeConfiguration -> IdeConfiguration
f'
where f' :: IdeConfiguration -> IdeConfiguration
f' (IdeConfiguration HashSet NormalizedUri
ws Hashed (Maybe Value)
clientSettings) =
HashSet NormalizedUri -> Hashed (Maybe Value) -> IdeConfiguration
IdeConfiguration HashSet NormalizedUri
ws (forall a. Hashable a => a -> Hashed a
hashed forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Value -> Maybe Value
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashed a -> a
unhashed forall a b. (a -> b) -> a -> b
$ Hashed (Maybe Value)
clientSettings)
modifyIdeConfiguration
:: IdeState -> (IdeConfiguration -> IdeConfiguration) -> IO ()
modifyIdeConfiguration :: IdeState -> (IdeConfiguration -> IdeConfiguration) -> IO ()
modifyIdeConfiguration IdeState
ide IdeConfiguration -> IdeConfiguration
f = do
IdeConfigurationVar Var IdeConfiguration
var <- forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
ide
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. Var a -> (a -> a) -> IO a
modifyVar' Var IdeConfiguration
var IdeConfiguration -> IdeConfiguration
f
isWorkspaceFile :: NormalizedFilePath -> Action Bool
isWorkspaceFile :: NormalizedFilePath -> Action Bool
isWorkspaceFile NormalizedFilePath
file =
if String -> Bool
isRelative (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
file)
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do
IdeConfiguration {Hashed (Maybe Value)
HashSet NormalizedUri
clientSettings :: Hashed (Maybe Value)
workspaceFolders :: HashSet NormalizedUri
$sel:clientSettings:IdeConfiguration :: IdeConfiguration -> Hashed (Maybe Value)
$sel:workspaceFolders:IdeConfiguration :: IdeConfiguration -> HashSet NormalizedUri
..} <- Action IdeConfiguration
getIdeConfiguration
let toText :: NormalizedUri -> Text
toText = Uri -> Text
getUri forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedUri -> Uri
fromNormalizedUri
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
(\NormalizedUri
root -> NormalizedUri -> Text
toText NormalizedUri
root Text -> Text -> Bool
`isPrefixOf` NormalizedUri -> Text
toText (NormalizedFilePath -> NormalizedUri
filePathToUri' NormalizedFilePath
file))
HashSet NormalizedUri
workspaceFolders
getClientSettings :: Action (Maybe Value)
getClientSettings :: Action (Maybe Value)
getClientSettings = forall a. Hashed a -> a
unhashed forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeConfiguration -> Hashed (Maybe Value)
clientSettings forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action IdeConfiguration
getIdeConfiguration