{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Dhall.LSP.State where
import Control.Lens.TH (makeLenses)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.State.Strict (StateT)
import Data.Aeson
( FromJSON (..)
, withObject
, (.!=)
, (.:)
, (.:?)
)
import Data.Default (Default (def))
import Data.Dynamic (Dynamic)
import Data.Map.Strict (Map, empty)
import Data.Text (Text)
import Dhall.LSP.Backend.Dhall (Cache, DhallError, emptyCache)
import Dhall.Pretty (CharacterSet)
import Language.LSP.Server (LspT)
import qualified Language.LSP.Types as J
type HandlerM =
ExceptT (Severity, Text) (StateT ServerState (LspT ServerConfig IO))
data Severity = Error
| Warning
| Info
| Log
data ServerConfig = ServerConfig
{ ServerConfig -> Maybe CharacterSet
chosenCharacterSet :: Maybe CharacterSet
} deriving Int -> ServerConfig -> ShowS
[ServerConfig] -> ShowS
ServerConfig -> String
(Int -> ServerConfig -> ShowS)
-> (ServerConfig -> String)
-> ([ServerConfig] -> ShowS)
-> Show ServerConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerConfig] -> ShowS
$cshowList :: [ServerConfig] -> ShowS
show :: ServerConfig -> String
$cshow :: ServerConfig -> String
showsPrec :: Int -> ServerConfig -> ShowS
$cshowsPrec :: Int -> ServerConfig -> ShowS
Show
instance Default ServerConfig where
def :: ServerConfig
def = ServerConfig :: Maybe CharacterSet -> ServerConfig
ServerConfig { chosenCharacterSet :: Maybe CharacterSet
chosenCharacterSet = Maybe CharacterSet
forall a. Maybe a
Nothing }
instance FromJSON ServerConfig where
parseJSON :: Value -> Parser ServerConfig
parseJSON = String
-> (Object -> Parser ServerConfig) -> Value -> Parser ServerConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"settings" ((Object -> Parser ServerConfig) -> Value -> Parser ServerConfig)
-> (Object -> Parser ServerConfig) -> Value -> Parser ServerConfig
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
Value
s <- Object
v Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vscode-dhall-lsp-server"
((Object -> Parser ServerConfig) -> Value -> Parser ServerConfig)
-> Value -> (Object -> Parser ServerConfig) -> Parser ServerConfig
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String
-> (Object -> Parser ServerConfig) -> Value -> Parser ServerConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"vscode-dhall-lsp-server") Value
s ((Object -> Parser ServerConfig) -> Parser ServerConfig)
-> (Object -> Parser ServerConfig) -> Parser ServerConfig
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe CharacterSet -> ServerConfig
ServerConfig
(Maybe CharacterSet -> ServerConfig)
-> Parser (Maybe CharacterSet) -> Parser ServerConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (Maybe CharacterSet))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"character-set" Parser (Maybe (Maybe CharacterSet))
-> Maybe CharacterSet -> Parser (Maybe CharacterSet)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Maybe CharacterSet
forall a. Maybe a
Nothing
data ServerState = ServerState
{ ServerState -> Cache
_importCache :: Cache
, ServerState -> Map Uri DhallError
_errors :: Map J.Uri DhallError
, ServerState -> Maybe Dynamic
_httpManager :: Maybe Dynamic
}
makeLenses ''ServerState
initialState :: ServerState
initialState :: ServerState
initialState = ServerState :: Cache -> Map Uri DhallError -> Maybe Dynamic -> ServerState
ServerState {Maybe Dynamic
Map Uri DhallError
Cache
forall a. Maybe a
forall k a. Map k a
_httpManager :: forall a. Maybe a
_errors :: forall k a. Map k a
_importCache :: Cache
_httpManager :: Maybe Dynamic
_errors :: Map Uri DhallError
_importCache :: Cache
..}
where
_importCache :: Cache
_importCache = Cache
emptyCache
_errors :: Map k a
_errors = Map k a
forall k a. Map k a
empty
_httpManager :: Maybe a
_httpManager = Maybe a
forall a. Maybe a
Nothing