styling

app/Main.hs

@@ -13,30 +13,28 @@ import Server (runOnPort, runOnStdio)
 
 main :: IO ()
 main = do
-  (Options mode port, _) <- getArgs >>= parseOpts
+  (Options mode logFilePath, _) <- getArgs >>= parseOpts
   case mode of
     ModeHelp -> putStrLn $ usageInfo usage options
-    ModeLSP -> do
-      _ <- runOnStdio "/Users/vince/Documents/gcl-vscode/server_log.txt"
-      return ()
-    ModeDev -> do
-      _ <- runOnPort port
+    ModeRun -> do
+      _ <- runOnStdio logFilePath
       return ()
 
 --------------------------------------------------------------------------------
 
 -- | Command-line arguments
-data Mode = ModeLSP | ModeHelp | ModeDev deriving Show
+data Mode = ModeHelp | ModeRun deriving Show
 
 data Options = Options
   { _mode :: Mode
-  , _port :: String
+  , _out  :: Maybe FilePath
   }
+  deriving Show
 
 defaultOptions :: Options
 defaultOptions = Options
-  { _mode = ModeLSP
-  , _port = "3000"
+  { _mode = ModeRun
+  , _out  = Nothing
   }
 
 options :: [OptDescr (Options -> Options)]
@@ -46,23 +44,16 @@ options =
       ["help"]
       (NoArg (\opts -> opts {_mode = ModeHelp}))
       "print this help message",
-    Option
-      ['d']
-      ["dev"]
-      (NoArg (\opts -> opts {_mode = ModeDev}))
-      "for testing",
     Option
       []
       ["stdio"]
-      (NoArg (\opts -> opts {_mode = ModeLSP}))
-      "for testing",
+      (NoArg (\opts -> opts {_mode = ModeRun}))
+      "for debugging",
     Option
-      ['s']
-      ["socket"]
-      (OptArg (\case
-        Nothing -> id
-        Just portNumber -> \opts -> opts {_port = portNumber}) "PORT_NUMBER")
-      "socket port number"
+      ['o']
+      ["out"]
+      (ReqArg (\logFilePath opts -> opts {_out = Just logFilePath}) "LOG_FILE_PATH")
+      "log file path when -d is set"
   ]
 
 usage :: String

examples/factor.gcl

@@ -6,12 +6,10 @@ var mod : Int -> Int -> Int
     Q = x > 0 ∧ y > 0 ∧ 1 > 0
 :}
 p := p + 1
-[!
+p := 3
 
-!]
-[!
-
-!]
+p := 3
+p := 5
 p,x,y := N-1, 1, 1
 
 { P ∧ Q, bnd: p }

examples/gcl_server.log

@@ -0,0 +1,27 @@
+./gcl_server.logSInitialized is called.
+STextDocumentDidOpen start
+load: start
+ask file state ref
+ask file state map
+lookup file state map
+  not found
+  source read 
+  source parsed 
+  all holes digged
+  abstract program generated
+  program elaborated
+  fileState created
+  fileState updated
+load: success
+ask file state ref
+ask file state map
+lookup file state map
+  found
+load: update notification sent
+load: end
+STextDocumentDidOpen end
+semantic token: start
+ask file state ref
+ask file state map
+lookup file state map
+  found

gcl.cabal

@@ -60,9 +60,9 @@ library
       Server.GoToDefn
       Server.Handler
       Server.Handler.AutoCompletion
+      Server.Handler.GCL.Refine
+      Server.Handler.GCL.Reload
       Server.Handler.GoToDefinition
-      Server.Handler.Guabao.Refine
-      Server.Handler.Guabao.Reload
       Server.Handler.Hover
       Server.Handler.Initialized
       Server.Handler.OnDidChangeTextDocument
@@ -229,9 +229,9 @@ test-suite gcl-test
       Server.GoToDefn
       Server.Handler
       Server.Handler.AutoCompletion
+      Server.Handler.GCL.Refine
+      Server.Handler.GCL.Reload
       Server.Handler.GoToDefinition
-      Server.Handler.Guabao.Refine
-      Server.Handler.Guabao.Reload
       Server.Handler.Hover
       Server.Handler.Initialized
       Server.Handler.OnDidChangeTextDocument

src/Server.hs

@@ -37,15 +37,20 @@ runOnPort port = do
     Text.putStrLn result
 
 -- entry point of the LSP server
-runOnStdio :: FilePath -> IO Int
-runOnStdio logFile = do
+runOnStdio :: Maybe FilePath -> IO Int
+runOnStdio maybeLogFile = do
   env <- initGlobalEnv
-  writeFile logFile "=== Log file Start ===\n"
-  _threadId <- forkIO (writeLog env)
+  case maybeLogFile of
+    Nothing -> return ()
+    Just logFile -> do
+      writeFile logFile "=== Log file Start ===\n"
+      writeFile logFile logFile
+      _threadId <- forkIO (writeLog env logFile)
+      return ()
   runServer (serverDefn env)
  where
-  writeLog :: GlobalState -> IO ()
-  writeLog env = forever $ do
+  writeLog :: GlobalState -> FilePath -> IO ()
+  writeLog env logFile = forever $ do
     result <- readChan (logChannel env)
     appendFile logFile (Text.unpack result)
 

src/Server/Handler.hs

@@ -28,9 +28,9 @@ import qualified Server.Handler.GoToDefinition as GoToDefinition
 import qualified Server.Handler.AutoCompletion as AutoCompletion
 import qualified Server.Handler.Hover          as Hover
 import qualified Server.Handler.SemanticTokens as SemanticTokens
-import qualified Server.Handler.Guabao.Reload  as Reload
-import qualified Server.Handler.Guabao.Refine  as Refine
-import Server.Monad (ServerM, sendDebugMessage, logText)
+import qualified Server.Handler.GCL.Reload     as Reload
+import qualified Server.Handler.GCL.Refine     as Refine
+import Server.Monad (ServerM, logText)
 import Server.Load (load)
 import qualified Server.Handler.OnDidChangeTextDocument as OnDidChangeTextDocument
 import qualified Data.Text as Text
@@ -80,10 +80,10 @@ handlers = mconcat
     requestHandler LSP.STextDocumentSemanticTokensFull $ \req responder -> do
       let uri = req ^. (LSP.params . LSP.textDocument . LSP.uri)
       SemanticTokens.handler uri responder
-  , -- "guabao/reload" - reload
-    requestHandler (LSP.SCustomMethod "guabao/reload") $ jsonMiddleware Reload.handler
-  , -- "guabao/refine" - refine
-    requestHandler (LSP.SCustomMethod "guabao/refine") $ jsonMiddleware Refine.handler
+  , -- "gcl/reload" - reload
+    requestHandler (LSP.SCustomMethod "gcl/reload") $ jsonMiddleware Reload.handler
+  , -- "gcl/refine" - refine
+    requestHandler (LSP.SCustomMethod "gcl/refine") $ jsonMiddleware Refine.handler
   ]
 
 type CustomMethodHandler params result error = params -> (result -> ServerM ()) -> (error -> ServerM ()) -> ServerM ()

src/Server/Handler/Guabao/Refine.hs → src/Server/Handler/GCL/Refine.hs

@@ -7,7 +7,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 
-module Server.Handler.Guabao.Refine where
+module Server.Handler.GCL.Refine where
 
 import qualified Data.Aeson as JSON
 import GHC.Generics ( Generic )

src/Server/Handler/Guabao/Reload.hs → src/Server/Handler/GCL/Reload.hs

@@ -6,7 +6,7 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DeriveGeneric #-}
 
-module Server.Handler.Guabao.Reload where
+module Server.Handler.GCL.Reload where
 
 import qualified Data.Aeson.Types as JSON
 import GHC.Generics ( Generic )

src/Server/Monad.hs

@@ -235,81 +235,3 @@ sendDebugMessage message = do
           Nothing
   LSP.sendRequest LSP.SWindowShowMessageRequest requestParams (\_ -> return ())
   return ()
-
--- --------------------------------------------------------------------------------
-
--- convertErrorsToResponsesAndDiagnostics
---   :: [Error] -> ServerM ([ResKind], [J.Diagnostic])
--- convertErrorsToResponsesAndDiagnostics errors = do
-
---   -- convert [Error] to [ResKind]
---   version <- bumpVersion
---   let responses =
---         [ResDisplay version (map renderSection errors), ResUpdateSpecs []]
-
---   -- collect Diagnostics from [Error]
---   let diagnostics = errors >>= collect
-
---   return (responses, diagnostics)
-
--- -- when responding to CustomMethod requests
--- -- ignore `result` when there's `error`
--- customRequestResponder
---   :: FilePath
---   -> (Response -> ServerM ())
---   -> ([Error], Maybe [ResKind])
---   -> ServerM ()
--- customRequestResponder filepath responder (errors, result) = if null errors
---   then do
---     let responsesFromResult = Maybe.fromMaybe [] result
-
---     logText
---       $  "    < Notify with "
---       <> toText (length responsesFromResult)
---       <> " custom responses"
-
---     sendDiagnosticsLSP filepath []
---     responder (Res filepath responsesFromResult)
---   else do
---     (responsesFromError, diagnosticsFromError) <-
---       convertErrorsToResponsesAndDiagnostics errors
-
---     logText
---       $  "    < Notify "
---       <> toText (length errors)
---       <> " errors with "
---       <> toText (length responsesFromError)
---       <> " custom responses and "
---       <> toText (length diagnosticsFromError)
---       <> " diagnostics"
-
---     sendDiagnosticsLSP filepath diagnosticsFromError
---     responder (Res filepath responsesFromError)
-
--- -- when responding to events like `STextDocumentDidChange`
--- -- combine both `result` AND `error`
--- customRequestToNotification
---   :: J.LSP.Uri -> ([Error], Maybe [ResKind]) -> ServerM ()
--- customRequestToNotification uri (errors, result) = case J.uriToFilePath uri of
---   Nothing       -> pure ()
---   Just filepath -> do
---     (responsesFromError, diagnosticsFromError) <-
---       convertErrorsToResponsesAndDiagnostics errors
---     let responsesFromResult = Maybe.fromMaybe [] result
---     let responses           = responsesFromError <> responsesFromResult
-
---     logText
---       $  "    < Respond with "
---       <> toText (length responses)
---       <> " custom responses and "
---       <> toText (length diagnosticsFromError)
---       <> " diagnostics"
-
---     -- send diagnostics
---     sendDiagnosticsLSP filepath diagnosticsFromError
---     -- send responses
---     J.sendNotification (J.SCustomMethod "guabao") $ JSON.toJSON $ Res
---       filepath
---       responses
-
---------------------------------------------------------------------------------

src/Server/Notification/Error.hs

@@ -23,7 +23,7 @@ import GCL.WP.Types (StructError (..))
 sendErrorNotification :: FilePath -> [Error] -> ServerM ()
 sendErrorNotification filePath errors = do
   let json :: JSON.Value = makeErrorNotificationJson filePath errors
-  Server.sendCustomNotification "guabao/error" json
+  Server.sendCustomNotification "gcl/error" json
 
 makeErrorNotificationJson :: FilePath -> [Error] -> JSON.Value
 makeErrorNotificationJson filePath errors = JSON.object

src/Server/Notification/Update.hs

@@ -25,7 +25,7 @@ sendUpdateNotification filePath = do
     Nothing -> return ()
     Just fileState -> do
       let json :: JSON.Value = makeUpdateNotificationJson filePath fileState
-      Server.sendCustomNotification "guabao/update" json
+      Server.sendCustomNotification "gcl/update" json
 
 
 makeUpdateNotificationJson :: FilePath -> FileState -> JSON.Value