{-# 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 Lens.Family (LensLike')
import qualified Language.Haskell.LSP.Core as LSP
import qualified Language.Haskell.LSP.Messages as LSP
import qualified Language.Haskell.LSP.Types as J
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