content: {-# 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.Protocol.Types as J
  
  -- 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 (LspT ServerConfig 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
    { chosenCharacterSet :: Maybe CharacterSet
    } deriving Show
  
  instance Default ServerConfig where
    def = ServerConfig { chosenCharacterSet = Nothing }
  
  -- 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 .:? "character-set" .!= Nothing
  
  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
    }
  
  makeLenses ''ServerState
  
  initialState :: ServerState
  initialState = ServerState {..}
    where
      _importCache = emptyCache
      _errors = empty
      _httpManager = Nothing
  