{-# LANGUAGE TemplateHaskell #-}
module Dhall.LSP.State where
import qualified Language.Haskell.LSP.Core as LSP
import qualified Language.Haskell.LSP.Messages as LSP
import qualified Language.Haskell.LSP.Types as J
import Control.Lens.TH (makeLenses)
import Lens.Family (LensLike')
import Data.Aeson (FromJSON(..), withObject, (.:), (.:?), (.!=))
import Data.Map.Strict (Map, empty)
import Data.Default (Default(def))
import Data.Dynamic (Dynamic)
import Dhall.LSP.Backend.Dhall (DhallError, Cache, emptyCache)
import Data.Text (Text)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.State.Strict (StateT)
type HandlerM = ExceptT (Severity, Text) (StateT ServerState IO)
data Severity = Error
| Warning
| Info
| Log
data ServerConfig = ServerConfig
{ asciiOnly :: Bool
} deriving Show
instance Default ServerConfig where
def = ServerConfig { asciiOnly = False }
instance FromJSON ServerConfig where
parseJSON = withObject "settings" $ \v -> do
s <- v .: "vscode-dhall-lsp-server"
flip (withObject "vscode-dhall-lsp-server") s $ \o -> ServerConfig
<$> o .:? "asciiOnly" .!= asciiOnly def
data ServerState = ServerState
{ _importCache :: Cache
, _errors :: Map J.Uri DhallError
, _httpManager :: Maybe Dynamic
, _lspFuncs :: LSP.LspFuncs ServerConfig
}
makeLenses ''ServerState
sendFunc :: Functor f =>
LensLike' f (LSP.LspFuncs ServerConfig) (LSP.FromServerMessage -> IO ())
sendFunc k s = fmap (\x -> s {LSP.sendFunc = x}) (k (LSP.sendFunc s))
initialState :: LSP.LspFuncs ServerConfig -> ServerState
initialState lsp = ServerState {..}
where
_importCache = emptyCache
_errors = empty
_httpManager = Nothing
_lspFuncs = lsp