Split Compile from Language Feature (#33)

* WIP: how to make the frege compiler configurable

explore the effort of reading a gradle plugin property with
the gradle tooling api.

* feat: add shouldCorrectlyConfigureExtraClasspath test

Expose two environment variables to configure the frege compiler:
- FREGE_LSP_SOURCE_DIR
- FREGE_LSP_EXTRA_CLASSPATH

* refactor: split compilerHelper into compileOptions, compileGlobal and
compileExecutor modules

* refactor: WIP: separate compile from language feature

code changes should drive the compilation. Therefore, compile the code
in the didSave, didChange events and update the global. The language
features the just get the information from the global.

This does currently not work because I wrongly used an IO Global as
state. Instead it should be a Global only that we can get with
performUnsafe. Otherwise we stay in IO and due to the laziness no work,
that means no compilation is done.

Search for the marked TODO in the code to see where to make the changes.

Rebase on main first!

* refactor: use Global instead of IO Global as state

Resolves all the todos introduced by the previous commit.

* chore: update version

gradle.properties

@@ -1,2 +1,2 @@
-version       = 3.2.0-alpha
+version       = 3.2.1-alpha
 gradleVersion = 7.4.2

src/main/frege/ch/fhnw/thga/fregelanguageserver/compile/CompileExecutor.fr

@@ -108,10 +108,8 @@ private compileSourceCode fregeCode = do
     g <- getSTT
     return g
 
-compile :: String -> IO Global -> IO Global
-compile fregeCode global = do
-    startGlobal <- global
-    execStateT (compileSourceCode fregeCode) startGlobal
+compile :: String -> Global -> IO Global
+compile fregeCode = execStateT $ compileSourceCode fregeCode
 
 runpass :: (StIO (String, Int), String) -> StIO ()
 runpass (pass, description) = do
@@ -126,9 +124,9 @@ shouldCorrectlyConfigureExtraClasspath = once $ morallyDubiousIOProperty do
         "module FregeFxDep where\n\n"++ 
         "import fregefx.JavaFxType\n\n" ++ 
         "main = println \"Hello FregeFX\""
-    fregefxGlobal = CompileGlobal.fromOptions standardCompileOptions.
+    fregefxGlobal          <- CompileGlobal.fromOptions standardCompileOptions.
         {
             path = [ "./src/main/resources/fregefx-0.8.2-SNAPSHOT.jar" ]
         }
-    actual <- compile fregeCodeWithDependency fregefxGlobal
-    pure    $ actual.errors == 0
+    actual                 <- compile fregeCodeWithDependency fregefxGlobal
+    pure                    $ actual.errors == 0

src/main/frege/ch/fhnw/thga/fregelanguageserver/diagnostic/Diagnostic.fr

@@ -67,21 +67,23 @@ extractDiagnostics = do
     diagnostics = fmap createDiagnosticFromMessage gl.sub.messages
     sequence diagnostics
 
-compileAndGetDiagnostics :: String -> IO [ Diagnostic ]
-compileAndGetDiagnostics fregeCode = do
-    gl          <- compile fregeCode standardCompileGlobal
-    pure         $ evalState (extractDiagnostics) gl
+getDiagnostics :: Global -> [ Diagnostic ]
+getDiagnostics = evalState $ extractDiagnostics
 
 fregeLSPServerShouldMapNoCompilerMessagesToEmptyArray :: Property
 fregeLSPServerShouldMapNoCompilerMessagesToEmptyArray = once $ morallyDubiousIOProperty do
     fregeCodeWithoutError = "module CorrectFregeTest where\n\n" ++ "ok = 42 + 42"
+    global               <- standardCompileGlobal
+    compiledGlobal       <- compile fregeCodeWithoutError global
     expected              = []
-    actual               <- compileAndGetDiagnostics fregeCodeWithoutError
+    actual                = getDiagnostics compiledGlobal
     pure                  $ expected == actual
 
 fregeLSPServerShouldMapSingleCompilerMessageToDiagnostics :: Property
 fregeLSPServerShouldMapSingleCompilerMessageToDiagnostics = once $ morallyDubiousIOProperty do
     fregeCodeWithError = "module ch.fhnw.thga.FaultyFregeTest where\n\nimport Does.not.Exist"
+    global            <- standardCompileGlobal
+    compiledGlobal    <- compile fregeCodeWithError global
     expected           = 
         [ 
             Diagnostic 
@@ -92,13 +94,14 @@ fregeLSPServerShouldMapSingleCompilerMessageToDiagnostics = once $ morallyDubiou
                 message  = "Could not import module frege.does.not.Exist\n(java.lang.ClassNotFoundException: frege.does.not.Exist)" 
             } 
         ]
-    gl     <- standardCompileGlobal
-    actual <- compileAndGetDiagnostics fregeCodeWithError
+    actual  = getDiagnostics compiledGlobal
     pure    $ expected == actual
 
 fregeLSPServerShouldMapMultipleCompilerMessageToDiagnostics :: Property
 fregeLSPServerShouldMapMultipleCompilerMessageToDiagnostics = once $ morallyDubiousIOProperty do
     fregeCodeWithErrors = "module ch.fhnw.thga.FaultyFregeTest where\n\nerr1 = do\n  x = 42\n\nerr2 = [ 22.0 ] ++ \"42\"\n\nerr3 = 42 + \"42\""
+    global             <- standardCompileGlobal
+    compiledGlobal     <- compile fregeCodeWithErrors global 
     expected            = 
         [ 
             Diagnostic 
@@ -123,8 +126,7 @@ fregeLSPServerShouldMapMultipleCompilerMessageToDiagnostics = once $ morallyDubi
                 message  = "last statement in a monadic do block must not\nbe let decls" 
             }
         ]
-    gl     <- standardCompileGlobal
-    actual <- compileAndGetDiagnostics fregeCodeWithErrors
+    actual  = getDiagnostics compiledGlobal
     pure    $ expected == actual
 
 posToTokens :: [ TokenPosition ] -> Global -> [ Token ]
@@ -135,7 +137,8 @@ main :: IO ()
 main = do
     let fregeCode       = "module ch.fhnw.thga.FaultyFregeTest where\n\nerr1 = do\n  x = 42\n\nerr2 = [ 22.0 ] ++ \"42\"\n\nerr3 = 42 + \"42\"\n\n"
     let trickyFregeCode = "module FaultyFregeTest where\n\nsimplyString s = s\n\nerr1 = (simplyString 42) ++ \"test\""
-    gl                 <- compile trickyFregeCode standardCompileGlobal
+    global             <- standardCompileGlobal 
+    gl                 <- compile trickyFregeCode global
     println             $ CharSequence.toString gl.sub.code
     for gl.sub.messages println
     let positions      = map (Message.pos) gl.sub.messages

src/main/frege/ch/fhnw/thga/fregelanguageserver/diagnostic/DiagnosticLSP.fr

@@ -1,9 +1,10 @@
 module ch.fhnw.thga.fregelanguageserver.diagnostic.DiagnosticLSP where
 
 import ch.fhnw.thga.fregelanguageserver.diagnostic.Diagnostic (
-    DiagnosticSeverity, Diagnostic, compileAndGetDiagnostics)
-
+    DiagnosticSeverity, Diagnostic, getDiagnostics)
 import ch.fhnw.thga.fregelanguageserver.lsp4j.RangeLSP4J (RangeLSP)
+import Compiler.types.Global (Global)
+import Control.monad.State (evalState)
 
 data DiagnosticSeverityLSP = pure native org.eclipse.lsp4j.DiagnosticSeverity where
     pure native error       "org.eclipse.lsp4j.DiagnosticSeverity.Error"       :: DiagnosticSeverityLSP
@@ -38,8 +39,10 @@ data ArrayList a = native java.util.ArrayList where
     go [] list     = return list
     go (x:xs) list = ArrayList.add list x >> go xs list
 
-compileAndGetDiagnosticsLSP :: String -> IOMutable (ArrayList DiagnosticLSP)
-compileAndGetDiagnosticsLSP fregeCode = do
-    diagnostics   <- compileAndGetDiagnostics fregeCode
+getDiagnosticsLSP :: Global -> STMutable s (ArrayList DiagnosticLSP)
+getDiagnosticsLSP global = do
+    diagnostics    = getDiagnostics global
     diagnosticsLSP = DiagnosticLSP.fromDiagnostic <$> diagnostics
     ArrayList.fromFregeList diagnosticsLSP
+
+main = println "hello DiagnosticLSP"

src/main/frege/ch/fhnw/thga/fregelanguageserver/hover/Hover.fr

@@ -34,14 +34,14 @@ derive Show Hover
 
 getSymbolType:: Symbol -> StateT Global Maybe String
 getSymbolType sym = do
-    gl <- StateT.get
-    pure $ label gl sym
+    global <- StateT.get
+    pure   $ label global sym
 
 findToken :: Position -> StateT Global Maybe Token
 findToken pos = do
-    gl <- StateT.get
-    tokens = listFromArray gl.sub.toks
-    lift $ find isHoverOverToken tokens where
+    global <- StateT.get
+    tokens = listFromArray global.sub.toks
+    lift   $ find isHoverOverToken tokens where
         isHoverOverToken :: Token -> Bool
         isHoverOverToken t = 
             pos.line      == t.line && 
@@ -50,20 +50,17 @@ findToken pos = do
 
 findSymbol :: QName -> StateT Global Maybe Symbol
 findSymbol qname = do
-    gl  <- StateT.get
-    lift $ Global.find gl qname
+    global  <- StateT.get
+    lift     $ Global.find global qname
 
 tokenToQName :: Token -> StateT Global Maybe QName
 tokenToQName t = do
-    g <- StateT.get
-    namespaceOrVariable <- lift $ Global.resolved g t
-    lift $ either (const Nothing) Just namespaceOrVariable
+    global              <- StateT.get
+    namespaceOrVariable <- lift $ Global.resolved global t
+    lift                 $ either (const Nothing) Just namespaceOrVariable
 
-compileAndGetTypeSignatureOnHover :: String -> Position -> IO (Maybe Hover)
-compileAndGetTypeSignatureOnHover fregeCode pos = do
-    startGlobal <- standardCompileGlobal
-    gl          <- compile fregeCode standardCompileGlobal
-    pure         $ evalStateT (getTypeOnHover pos) gl
+getTypeSignatureOnHover :: Position -> Global -> Maybe Hover
+getTypeSignatureOnHover pos = evalStateT $ getTypeOnHover pos
 
 getTypeOnHover :: Position -> StateT Global Maybe Hover
 getTypeOnHover pos = do
@@ -72,90 +69,111 @@ getTypeOnHover pos = do
     qname      <- tokenToQName token
     symbol     <- findSymbol qname
     symbolType <- getSymbolType symbol
-    pure        $ Hover { 
-        range   = tokenToRange token, 
-        content = FregeCodeBlock symbolType
-    }
+    pure        $ Hover 
+        { 
+            range   = tokenToRange token, 
+            content = FregeCodeBlock symbolType
+        }
 
 shouldShowLocalVaridTypeSignature :: Property
 shouldShowLocalVaridTypeSignature = once $ morallyDubiousIOProperty do
-    fregeHoverCode = "module HoverTest where\n\n" ++ "simplyString = \"Hello\""
-    expected = Just Hover { 
-        range   = Range { start = Position 3 1, end = Position 3 13 },
-        content = FregeCodeBlock "simplyString :: String"
-    }
-    actual <- compileAndGetTypeSignatureOnHover fregeHoverCode (Position 3 3)
-    pure    $ expected == actual
+    fregeHoverCode  = "module HoverTest where\n\n" ++ "simplyString = \"Hello\""
+    global         <- standardCompileGlobal
+    compiledGlobal <- compile fregeHoverCode global
+    expected       = Just Hover 
+        { 
+            range   = Range { start = Position 3 1, end = Position 3 13 },
+            content = FregeCodeBlock "simplyString :: String"
+        }
+    actual         = getTypeSignatureOnHover (Position 3 3) compiledGlobal
+    pure           $ expected == actual
 
 shouldShowImportedVaridTypeSignature :: Property
 shouldShowImportedVaridTypeSignature = once $ morallyDubiousIOProperty do
     fregeHoverCode = "module HoverTest where\n\n" ++ "main = println \"Hello\""
-    expected = Just Hover { 
-        range   = Range { start = Position 3 8, end = Position 3 15 },
-        content = FregeCodeBlock "println :: Show 𝖆 => 𝖆 -> IO ()"
-    }
-    actual <- compileAndGetTypeSignatureOnHover fregeHoverCode (Position 3 9)
-    pure    $ expected == actual
+    global         <- standardCompileGlobal
+    compiledGlobal <- compile fregeHoverCode global
+    expected       = Just Hover 
+        { 
+            range   = Range { start = Position 3 8, end = Position 3 15 },
+            content = FregeCodeBlock "println :: Show 𝖆 => 𝖆 -> IO ()"
+        }
+    actual          = getTypeSignatureOnHover (Position 3 9) compiledGlobal
+    pure            $ expected == actual
 
 shouldShowLocalConidTypeSignature :: Property
 shouldShowLocalConidTypeSignature = once $ morallyDubiousIOProperty do
     fregeHoverCode = "module HoverTest where\n\n"
-        ++ "data MyMaybe a = MyNothing | MyJust a\n"
-    expected = Just Hover { 
-        range   = Range { start = Position 3 6, end = Position 3 13 },
-        content = FregeCodeBlock "MyMaybe :: *->*"
-    }
-    actual <- compileAndGetTypeSignatureOnHover fregeHoverCode (Position 3 7)
-    pure    $ expected == actual
+                  ++ "data MyMaybe a = MyNothing | MyJust a\n"
+    global         <- standardCompileGlobal
+    compiledGlobal <- compile fregeHoverCode global
+    expected       = Just Hover 
+        { 
+            range   = Range { start = Position 3 6, end = Position 3 13 },
+            content = FregeCodeBlock "MyMaybe :: *->*"
+        }
+    actual          = getTypeSignatureOnHover (Position 3 7) compiledGlobal
+    pure            $ expected == actual
 
 shouldShowImportedConidTypeSignature :: Property
 shouldShowImportedConidTypeSignature = once $ morallyDubiousIOProperty do
     fregeHoverCode = "module HoverTest where\n\n"
-        ++ "import frege.data.Maybe(Maybe)"
-    expected = Just Hover { 
-        range   = Range { start = Position 3 25, end = Position 3 30 },
-        content = FregeCodeBlock "Maybe :: *->*"
-    }
-    actual <- compileAndGetTypeSignatureOnHover fregeHoverCode (Position 3 27)
-    pure    $ expected == actual
+                  ++ "import frege.data.Maybe(Maybe)"
+    global         <- standardCompileGlobal
+    compiledGlobal <- compile fregeHoverCode global
+    expected       = Just Hover 
+        { 
+            range   = Range { start = Position 3 25, end = Position 3 30 },
+            content = FregeCodeBlock "Maybe :: *->*"
+        }
+    actual          = getTypeSignatureOnHover (Position 3 27) compiledGlobal
+    pure           $  expected == actual
 
 shouldShowLocalConidDataConstructor :: Property
 shouldShowLocalConidDataConstructor = once $ morallyDubiousIOProperty do
     fregeHoverCode = "module HoverTest where\n\n"
-        ++ "data MyMaybe a = MyNothing | MyJust a\n"
-        ++ "res = MyJust 42"
-    expected = Just Hover { 
-        range   = Range { start = Position 4 7, end = Position 4 13 },
-        content = FregeCodeBlock "MyJust :: a -> MyMaybe a"
-    }
-    actual <- compileAndGetTypeSignatureOnHover fregeHoverCode (Position 4 8)
-    pure    $ expected == actual
+                  ++ "data MyMaybe a = MyNothing | MyJust a\n"
+                  ++ "res = MyJust 42"
+    global         <- standardCompileGlobal
+    compiledGlobal <- compile fregeHoverCode global
+    expected       = Just Hover 
+        { 
+            range   = Range { start = Position 4 7, end = Position 4 13 },
+            content = FregeCodeBlock "MyJust :: a -> MyMaybe a"
+        }
+    actual          = getTypeSignatureOnHover (Position 4 8) compiledGlobal
+    pure            $ expected == actual
 
 shouldShowImportedConidDataConstructor :: Property
 shouldShowImportedConidDataConstructor = once $ morallyDubiousIOProperty do
     fregeHoverCode = "module HoverTest where\n\n"
-        ++ "import frege.data.Maybe(Maybe, Just)\n"
-        ++ "res = Just 42"
-    expected = Just Hover { 
-        range   = Range { start = Position 4 7, end = Position 4 11 },
-        content = FregeCodeBlock "Just :: a -> Maybe a"
-    }
-    actual <- compileAndGetTypeSignatureOnHover fregeHoverCode (Position 4 10)
-    pure    $ expected == actual
+                  ++ "import frege.data.Maybe(Maybe, Just)\n"
+                  ++ "res = Just 42"
+    global         <- standardCompileGlobal
+    compiledGlobal <- compile fregeHoverCode global
+    expected       = Just Hover 
+        { 
+            range   = Range { start = Position 4 7, end = Position 4 11 },
+            content = FregeCodeBlock "Just :: a -> Maybe a"
+        }
+    actual          = getTypeSignatureOnHover (Position 4 10) compiledGlobal
+    pure            $ expected == actual
 
 main :: IO ()
 main = do
-    let fregeCode = "module HoverTest where\n\n" 
-            ++ "import frege.compiler.Main(runpass)\n\n"
-            ++ "pass = runpass\n" ++ "me = 42\n\n"
-            ++ "main = do\n  a = \"Hello\"\n  println a"
+    let fregeCode       = "module HoverTest where\n\n" 
+                       ++ "import frege.compiler.Main(runpass)\n\n"
+                       ++ "pass = runpass\n" ++ "me = 42\n\n"
+                       ++ "main = do\n  a = \"Hello\"\n  println a"
+
     let simpleFregeCode = "module HoverTest where\n\n" 
-            ++ "data MyMaybe a = MyNothing | MyJust a\n"
-            ++ "res = MyJust 42"
-    gl            <- compile fregeCode standardCompileGlobal
-    println $ CharSequence.toString gl.sub.code
-    tokens = listFromArray gl.sub.toks
+                       ++ "data MyMaybe a = MyNothing | MyJust a\n"
+                       ++ "res = MyJust 42"
+    global             <- standardCompileGlobal
+    compiledGlobal     <- compile fregeCode global
+    println             $ CharSequence.toString compiledGlobal.sub.code
+    tokens              = listFromArray compiledGlobal.sub.toks
     for tokens println
-    hover <- compileAndGetTypeSignatureOnHover fregeCode (Position 5 9)
+    hover               = getTypeSignatureOnHover (Position 5 9) compiledGlobal
     println hover
     println "end"

src/main/frege/ch/fhnw/thga/fregelanguageserver/hover/HoverLSP.fr

@@ -2,7 +2,9 @@ module ch.fhnw.thga.fregelanguageserver.hover.HoverLSP where
 
 import ch.fhnw.thga.fregelanguageserver.lsp4j.PositionLSP4J (PositionLSP)
 import ch.fhnw.thga.fregelanguageserver.lsp4j.RangeLSP4J (RangeLSP)
-import ch.fhnw.thga.fregelanguageserver.hover.Hover (Hover, compileAndGetTypeSignatureOnHover)
+import ch.fhnw.thga.fregelanguageserver.hover.Hover (Hover, getTypeSignatureOnHover)
+import Compiler.types.Global (Global)
+import Control.monad.State (evalState)
 
 data MarkupContentLSP = pure native org.eclipse.lsp4j.MarkupContent where
     pure native new :: String -> String -> MarkupContentLSP
@@ -14,15 +16,15 @@ data MarkupKindLSP = pure native org.eclipse.lsp4j.MarkupKind where
 data HoverLSP = pure native org.eclipse.lsp4j.Hover where
     pure native new :: MarkupContentLSP -> RangeLSP -> HoverLSP
 
-    hoverToHoverLSP :: Hover -> HoverLSP
-    hoverToHoverLSP Hover { range, content } =
+    fromHover :: Hover -> HoverLSP
+    fromHover Hover { range, content } =
         HoverLSP.new 
             (MarkupContentLSP.new MarkupKindLSP.markdown (show content))
             (RangeLSP.fromRange range)
 
-compileAndGetTypeSignatureOnHoverLSP :: String -> PositionLSP -> IO (Maybe HoverLSP)
-compileAndGetTypeSignatureOnHoverLSP fregeCode posLSP = do
-    hover <- compileAndGetTypeSignatureOnHover fregeCode (PositionLSP.toPosition posLSP)
-    pure $ fmap HoverLSP.hoverToHoverLSP hover
+getTypeSignatureOnHoverLSP :: PositionLSP -> Global -> Maybe HoverLSP
+getTypeSignatureOnHoverLSP posLSP global = do
+    hover <- getTypeSignatureOnHover (PositionLSP.toPosition posLSP) global
+    pure   $ HoverLSP.fromHover hover
 
-main = println "hello"
+main = println "hello HoverLSP"