{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE OverloadedStrings #-}

-- | @futhark lsp@
module Futhark.CLI.LSP (main) where

import Control.Concurrent.MVar (newMVar)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Futhark.LSP.Handlers (handlers)
import Futhark.LSP.State (emptyState)
import Futhark.Util (debug)
import Language.LSP.Server
import Language.LSP.Types
  ( SaveOptions (SaveOptions),
    TextDocumentSyncKind (TdSyncIncremental),
    TextDocumentSyncOptions (..),
    type (|?) (InR),
  )
import System.Log.Logger (Priority (DEBUG))

-- | Run @futhark lsp@
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main String
_prog [String]
_args = do
  MVar State
state_mvar <- State -> IO (MVar State)
forall a. a -> IO (MVar a)
newMVar State
emptyState
  String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"Init with emptyState"
  Maybe String -> [String] -> Priority -> IO ()
setupLogger Maybe String
forall a. Maybe a
Nothing [String
"futhark"] Priority
DEBUG
  Int
_ <-
    ServerDefinition () -> IO Int
forall config. ServerDefinition config -> IO Int
runServer (ServerDefinition () -> IO Int) -> ServerDefinition () -> IO Int
forall a b. (a -> b) -> a -> b
$
      ServerDefinition :: forall config (m :: * -> *) a.
config
-> (config -> Value -> Either Text config)
-> (LanguageContextEnv config
    -> Message 'Initialize -> IO (Either ResponseError a))
-> Handlers m
-> (a -> m <~> IO)
-> Options
-> ServerDefinition config
ServerDefinition
        { onConfigurationChange :: () -> Value -> Either Text ()
onConfigurationChange = (Value -> Either Text ()) -> () -> Value -> Either Text ()
forall a b. a -> b -> a
const ((Value -> Either Text ()) -> () -> Value -> Either Text ())
-> (Value -> Either Text ()) -> () -> Value -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Either Text () -> Value -> Either Text ()
forall a b. a -> b -> a
const (Either Text () -> Value -> Either Text ())
-> Either Text () -> Value -> Either Text ()
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right (),
          defaultConfig :: ()
defaultConfig = (),
          doInitialize :: LanguageContextEnv ()
-> Message 'Initialize
-> IO (Either ResponseError (LanguageContextEnv ()))
doInitialize = \LanguageContextEnv ()
env Message 'Initialize
_req -> do Either ResponseError (LanguageContextEnv ())
-> IO (Either ResponseError (LanguageContextEnv ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (LanguageContextEnv ())
 -> IO (Either ResponseError (LanguageContextEnv ())))
-> Either ResponseError (LanguageContextEnv ())
-> IO (Either ResponseError (LanguageContextEnv ()))
forall a b. (a -> b) -> a -> b
$ LanguageContextEnv ()
-> Either ResponseError (LanguageContextEnv ())
forall a b. b -> Either a b
Right LanguageContextEnv ()
env,
          staticHandlers :: Handlers (LspM ())
staticHandlers = MVar State -> Handlers (LspM ())
handlers MVar State
state_mvar,
          interpretHandler :: LanguageContextEnv () -> LspM () <~> IO
interpretHandler = \LanguageContextEnv ()
env -> (forall a. LspM () a -> IO a)
-> (forall a. IO a -> LspM () a) -> LspM () <~> IO
forall k (m :: k -> *) (n :: k -> *).
(forall (a :: k). m a -> n a)
-> (forall (a :: k). n a -> m a) -> m <~> n
Iso (LanguageContextEnv () -> LspT () IO a -> IO a
forall config (m :: * -> *) a.
LanguageContextEnv config -> LspT config m a -> m a
runLspT LanguageContextEnv ()
env) forall a. IO a -> LspM () a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO,
          options :: Options
options =
            Options
defaultOptions
              { textDocumentSync :: Maybe TextDocumentSyncOptions
textDocumentSync = TextDocumentSyncOptions -> Maybe TextDocumentSyncOptions
forall a. a -> Maybe a
Just TextDocumentSyncOptions
syncOptions
              }
        }
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

syncOptions :: TextDocumentSyncOptions
syncOptions :: TextDocumentSyncOptions
syncOptions =
  TextDocumentSyncOptions :: Maybe Bool
-> Maybe TextDocumentSyncKind
-> Maybe Bool
-> Maybe Bool
-> Maybe (Bool |? SaveOptions)
-> TextDocumentSyncOptions
TextDocumentSyncOptions
    { $sel:_openClose:TextDocumentSyncOptions :: Maybe Bool
_openClose = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
      $sel:_change:TextDocumentSyncOptions :: Maybe TextDocumentSyncKind
_change = TextDocumentSyncKind -> Maybe TextDocumentSyncKind
forall a. a -> Maybe a
Just TextDocumentSyncKind
TdSyncIncremental,
      $sel:_willSave:TextDocumentSyncOptions :: Maybe Bool
_willSave = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
      $sel:_willSaveWaitUntil:TextDocumentSyncOptions :: Maybe Bool
_willSaveWaitUntil = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
      $sel:_save:TextDocumentSyncOptions :: Maybe (Bool |? SaveOptions)
_save = (Bool |? SaveOptions) -> Maybe (Bool |? SaveOptions)
forall a. a -> Maybe a
Just ((Bool |? SaveOptions) -> Maybe (Bool |? SaveOptions))
-> (Bool |? SaveOptions) -> Maybe (Bool |? SaveOptions)
forall a b. (a -> b) -> a -> b
$ SaveOptions -> Bool |? SaveOptions
forall a b. b -> a |? b
InR (SaveOptions -> Bool |? SaveOptions)
-> SaveOptions -> Bool |? SaveOptions
forall a b. (a -> b) -> a -> b
$ Maybe Bool -> SaveOptions
SaveOptions (Maybe Bool -> SaveOptions) -> Maybe Bool -> SaveOptions
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    }