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 (isPrefixOf)
import Development.IDE.Core.Shake
import Development.IDE.Graph
import Development.IDE.Types.Location
import Language.LSP.Protocol.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
(Int -> IdeConfiguration -> ShowS)
-> (IdeConfiguration -> String)
-> ([IdeConfiguration] -> ShowS)
-> Show IdeConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdeConfiguration -> ShowS
showsPrec :: Int -> IdeConfiguration -> ShowS
$cshow :: IdeConfiguration -> String
show :: IdeConfiguration -> String
$cshowList :: [IdeConfiguration] -> ShowS
showList :: [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 =
ShakeExtras -> IdeConfigurationVar -> IO ()
forall a. IsIdeGlobal a => ShakeExtras -> a -> IO ()
addIdeGlobalExtras ShakeExtras
extras (IdeConfigurationVar -> IO ())
-> (Var IdeConfiguration -> IdeConfigurationVar)
-> Var IdeConfiguration
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var IdeConfiguration -> IdeConfigurationVar
IdeConfigurationVar (Var IdeConfiguration -> IO ())
-> (IdeConfiguration -> IO (Var IdeConfiguration))
-> IdeConfiguration
-> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IdeConfiguration -> IO (Var IdeConfiguration)
forall a. a -> IO (Var a)
newVar
getIdeConfiguration :: Action IdeConfiguration
getIdeConfiguration :: Action IdeConfiguration
getIdeConfiguration =
Action IdeConfigurationVar
forall a. (HasCallStack, IsIdeGlobal a) => Action a
getIdeGlobalAction Action IdeConfigurationVar
-> (IdeConfigurationVar -> Action IdeConfiguration)
-> Action IdeConfiguration
forall a b. Action a -> (a -> Action b) -> Action b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO IdeConfiguration -> Action IdeConfiguration
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeConfiguration -> Action IdeConfiguration)
-> (IdeConfigurationVar -> IO IdeConfiguration)
-> IdeConfigurationVar
-> Action IdeConfiguration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var IdeConfiguration -> IO IdeConfiguration
forall a. Var a -> IO a
readVar (Var IdeConfiguration -> IO IdeConfiguration)
-> (IdeConfigurationVar -> Var IdeConfiguration)
-> IdeConfigurationVar
-> IO IdeConfiguration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeConfigurationVar -> Var IdeConfiguration
unIdeConfigurationRef
parseConfiguration :: InitializeParams -> IdeConfiguration
parseConfiguration :: InitializeParams -> IdeConfiguration
parseConfiguration InitializeParams {Maybe Value
Maybe Text
Maybe ClientInfo
Maybe ProgressToken
Maybe TraceValue
Maybe ([WorkspaceFolder] |? Null)
Maybe (Text |? Null)
ClientCapabilities
Int32 |? Null
Uri |? Null
_workDoneToken :: Maybe ProgressToken
_processId :: Int32 |? Null
_clientInfo :: Maybe ClientInfo
_locale :: Maybe Text
_rootPath :: Maybe (Text |? Null)
_rootUri :: Uri |? Null
_capabilities :: ClientCapabilities
_initializationOptions :: Maybe Value
_trace :: Maybe TraceValue
_workspaceFolders :: Maybe ([WorkspaceFolder] |? Null)
$sel:_capabilities:InitializeParams :: InitializeParams -> ClientCapabilities
$sel:_clientInfo:InitializeParams :: InitializeParams -> Maybe ClientInfo
$sel:_initializationOptions:InitializeParams :: InitializeParams -> Maybe Value
$sel:_locale:InitializeParams :: InitializeParams -> Maybe Text
$sel:_processId:InitializeParams :: InitializeParams -> Int32 |? Null
$sel:_rootPath:InitializeParams :: InitializeParams -> Maybe (Text |? Null)
$sel:_rootUri:InitializeParams :: InitializeParams -> Uri |? Null
$sel:_trace:InitializeParams :: InitializeParams -> Maybe TraceValue
$sel:_workDoneToken:InitializeParams :: InitializeParams -> Maybe ProgressToken
$sel:_workspaceFolders:InitializeParams :: InitializeParams -> Maybe ([WorkspaceFolder] |? Null)
..} =
IdeConfiguration {Hashed (Maybe Value)
HashSet NormalizedUri
workspaceFolders :: HashSet NormalizedUri
clientSettings :: Hashed (Maybe Value)
workspaceFolders :: HashSet NormalizedUri
clientSettings :: Hashed (Maybe Value)
..}
where
workspaceFolders :: HashSet NormalizedUri
workspaceFolders =
(Uri -> HashSet NormalizedUri)
-> Maybe Uri -> HashSet NormalizedUri
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (NormalizedUri -> HashSet NormalizedUri
forall a. Hashable a => a -> HashSet a
singleton (NormalizedUri -> HashSet NormalizedUri)
-> (Uri -> NormalizedUri) -> Uri -> HashSet NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> NormalizedUri
toNormalizedUri) ((Uri |? Null) -> Maybe Uri
forall a. (a |? Null) -> Maybe a
nullToMaybe Uri |? Null
_rootUri)
HashSet NormalizedUri
-> HashSet NormalizedUri -> HashSet NormalizedUri
forall a. Semigroup a => a -> a -> a
<> (([WorkspaceFolder] -> HashSet NormalizedUri)
-> Maybe [WorkspaceFolder] -> HashSet NormalizedUri
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (([WorkspaceFolder] -> HashSet NormalizedUri)
-> Maybe [WorkspaceFolder] -> HashSet NormalizedUri)
-> ((WorkspaceFolder -> HashSet NormalizedUri)
-> [WorkspaceFolder] -> HashSet NormalizedUri)
-> (WorkspaceFolder -> HashSet NormalizedUri)
-> Maybe [WorkspaceFolder]
-> HashSet NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceFolder -> HashSet NormalizedUri)
-> [WorkspaceFolder] -> HashSet NormalizedUri
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap)
(NormalizedUri -> HashSet NormalizedUri
forall a. Hashable a => a -> HashSet a
singleton (NormalizedUri -> HashSet NormalizedUri)
-> (WorkspaceFolder -> NormalizedUri)
-> WorkspaceFolder
-> HashSet NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceFolder -> NormalizedUri
parseWorkspaceFolder)
(([WorkspaceFolder] |? Null) -> Maybe [WorkspaceFolder]
forall a. (a |? Null) -> Maybe a
nullToMaybe (([WorkspaceFolder] |? Null) -> Maybe [WorkspaceFolder])
-> Maybe ([WorkspaceFolder] |? Null) -> Maybe [WorkspaceFolder]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ([WorkspaceFolder] |? Null)
_workspaceFolders)
clientSettings :: Hashed (Maybe Value)
clientSettings = Maybe Value -> Hashed (Maybe Value)
forall a. Hashable a => a -> Hashed a
hashed Maybe Value
_initializationOptions
parseWorkspaceFolder :: WorkspaceFolder -> NormalizedUri
parseWorkspaceFolder :: WorkspaceFolder -> NormalizedUri
parseWorkspaceFolder WorkspaceFolder{Uri
_uri :: Uri
$sel:_uri:WorkspaceFolder :: WorkspaceFolder -> Uri
_uri} =
Uri -> NormalizedUri
toNormalizedUri Uri
_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 (Maybe Value -> Hashed (Maybe Value)
forall a. Hashable a => a -> Hashed a
hashed (Maybe Value -> Hashed (Maybe Value))
-> (Hashed (Maybe Value) -> Maybe Value)
-> Hashed (Maybe Value)
-> Hashed (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Value -> Maybe Value
f (Maybe Value -> Maybe Value)
-> (Hashed (Maybe Value) -> Maybe Value)
-> Hashed (Maybe Value)
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hashed (Maybe Value) -> Maybe Value
forall a. Hashed a -> a
unhashed (Hashed (Maybe Value) -> Hashed (Maybe Value))
-> Hashed (Maybe Value) -> Hashed (Maybe Value)
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 <- IdeState -> IO IdeConfigurationVar
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
ide
IO IdeConfiguration -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO IdeConfiguration -> IO ()) -> IO IdeConfiguration -> IO ()
forall a b. (a -> b) -> a -> b
$ Var IdeConfiguration
-> (IdeConfiguration -> IdeConfiguration) -> IO IdeConfiguration
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 Bool -> Action Bool
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do
IdeConfiguration {Hashed (Maybe Value)
HashSet NormalizedUri
workspaceFolders :: IdeConfiguration -> HashSet NormalizedUri
clientSettings :: IdeConfiguration -> Hashed (Maybe Value)
workspaceFolders :: HashSet NormalizedUri
clientSettings :: Hashed (Maybe Value)
..} <- Action IdeConfiguration
getIdeConfiguration
let toText :: NormalizedUri -> Text
toText = Uri -> Text
getUri (Uri -> Text) -> (NormalizedUri -> Uri) -> NormalizedUri -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedUri -> Uri
fromNormalizedUri
Bool -> Action Bool
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Action Bool) -> Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$
(NormalizedUri -> Bool) -> HashSet NormalizedUri -> Bool
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 = Hashed (Maybe Value) -> Maybe Value
forall a. Hashed a -> a
unhashed (Hashed (Maybe Value) -> Maybe Value)
-> (IdeConfiguration -> Hashed (Maybe Value))
-> IdeConfiguration
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeConfiguration -> Hashed (Maybe Value)
clientSettings (IdeConfiguration -> Maybe Value)
-> Action IdeConfiguration -> Action (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action IdeConfiguration
getIdeConfiguration