{-# 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)

-- Inside a handler we have access to the ServerState. The exception layer
-- allows us to fail gracefully, displaying a message to the user via the
-- "ShowMessage" mechanism of the lsp standard.
type HandlerM = ExceptT (Severity, Text) (StateT ServerState IO)

data Severity = Error
              -- ^ Error displayed to the user.
              | Warning
              -- ^ Warning displayed to the user.
              | Info
              -- ^ Information displayed to the user.
              | Log
              -- ^ Log message, not displayed by default.

data ServerConfig = ServerConfig
  { asciiOnly :: Bool
  -- ^ Use ASCII symbols rather than fancy unicode when formatting and linting
  -- code.
  } deriving Show

instance Default ServerConfig where
  def = ServerConfig { asciiOnly = False }

-- We need to derive the FromJSON instance manually in order to provide defaults
-- for absent fields.
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  -- ^ The dhall import cache
  , _errors :: Map J.Uri DhallError  -- ^ Map from dhall files to their errors
  , _httpManager :: Maybe Dynamic
  -- ^ The http manager used by dhall's import infrastructure
  , _lspFuncs :: LSP.LspFuncs ServerConfig
  -- ^ Access to the lsp functions supplied by haskell-lsp
  }

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