Configure Frege Compiler Classpath with Environment Variable (#28)

* 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

build.gradle

@@ -11,7 +11,6 @@ dependencies {
     implementation group: 'org.eclipse.lsp4j', name: 'org.eclipse.lsp4j', version: '0.12.0'
     frege          group: 'org.eclipse.lsp4j', name: 'org.eclipse.lsp4j', version: '0.12.0'
     implementation files(compileFrege.fregeCompilerJar)
-
 }
 
 application {
@@ -31,6 +30,7 @@ frege
     mainSourceDir = layout.projectDirectory.dir('src/main/frege')
     testModules   = 
     [
+        'ch.fhnw.thga.fregelanguageserver.compile.CompileExecutor',
         'ch.fhnw.thga.fregelanguageserver.diagnostic.Diagnostic',
         'ch.fhnw.thga.fregelanguageserver.hover.Hover'
     ]

gradle.properties

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

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

@@ -1,12 +1,13 @@
-module ch.fhnw.thga.fregelanguageserver.compiler.CompilerHelper where
+module ch.fhnw.thga.fregelanguageserver.compile.CompileExecutor where
 
-import frege.compiler.types.Targets public(thisTarget)
+import ch.fhnw.thga.fregelanguageserver.compile.CompileGlobal
+import ch.fhnw.thga.fregelanguageserver.compile.CompileOptions(standardCompileOptions)
 import Compiler.types.Global (
-    Global, StIO, Options, Message, StG, SubSt,
+    Global, StIO, Message, StG, SubSt,
     liftIO, liftStG,getSTT, getST, forsome, stio, changeST
     )
 import Compiler.common.CompilerOptions (standardGlobal, theClassLoader)
-import Control.monad.State (StateT)
+import Control.monad.State (StateT, execStateT)
 import Compiler.passes.Fix()
 import Compiler.passes.Imp()
 import Compiler.passes.Enter()
@@ -28,34 +29,11 @@ import Compiler.common.Desugar
 import Compiler.types.Tokens
 import Compiler.enums.TokenID
 import Compiler.types.Packs
+import Test.QuickCheck (Property, once, morallyDubiousIOProperty)
 
 instance Show Message where
   show msg = substr (show msg.level) 0 1 ++ " " ++ show msg.pos.first.tokid ++ show msg.pos.end ++ ": " ++ msg.text
 
-lspOptions :: Options
-lspOptions = Options 
-    { 
-        source       = "-",
-        sourcePath   = [ "." ],
-        dir          = ".",
-        path         = [],
-        prefix       = "",
-        encoding     = Just "UTF-8",
-        tRanges      = [],
-        target       = thisTarget,
-        extending    = Nothing,
-        implementing = [],
-        code         = [],
-        flags        = Flags.fromList
-                     [
-                       WARNINGS,
-                       HINTS,
-                       VERBOSE,
-                       IDEMODE,
-                       IDETOKENS
-                     ]
-    }
-
 passes = 
     [
         (liftStG Fix.pass,              "join definitions"),
@@ -76,32 +54,23 @@ passes =
         (liftStG FI.cleanSymtab,        "clean up")
     ]
 
-lspGlobal :: IO Global
-lspGlobal = do
-    initialLoader <- theClassLoader lspOptions
-    initialGlobal <- standardGlobal
-    pure initialGlobal. {
-        options  = lspOptions,
-        sub     <- SubSt. { loader = initialLoader }
-    }
-
 switchState :: Global -> StG Global
 switchState new = do
     old <- getST
     StG.put new
     return old
 
-lexParseLSP :: String -> StG Global
-lexParseLSP fregeCode = do
+lexParseSourceCode :: String -> StG Global
+lexParseSourceCode fregeCode = do
     g  <- getST
-    lexPassLSP fregeCode
+    lexPassSourceCode fregeCode
     parsePass
     gc <- switchState g
     changeST _.{ sub <- _.{ numErrors <- (gc.errors +) } }
     return gc
 
-lexPassLSP :: String -> StG (String, Int)
-lexPassLSP fregeCode = do
+lexPassSourceCode :: String -> StG (String, Int)
+lexPassSourceCode fregeCode = do
     tokens <- L.passCS $ CharSequence.fromString fregeCode
     return ("tokens", length tokens)
 
@@ -131,17 +100,35 @@ parsePass = do
             | otherwise                        = t : ideClean ts
         ideClean []                            = []
 
-compileFregeFile :: String -> StIO Global
-compileFregeFile fregeCode = do
-    lexParseState <- liftStG $ lexParseLSP fregeCode
+private compileSourceCode :: String -> StIO Global
+private compileSourceCode fregeCode = do
+    lexParseState <- liftStG $ lexParseSourceCode fregeCode
     StateT.put lexParseState
     forsome passes runpass
     g <- getSTT
     return g
 
+compile :: String -> IO Global -> IO Global
+compile fregeCode global = do
+    startGlobal <- global
+    execStateT (compileSourceCode fregeCode) startGlobal
+
 runpass :: (StIO (String, Int), String) -> StIO ()
 runpass (pass, description) = do
     state <- getSTT
     when (state.errors == 0) do
         (itemnm, items) <- pass
         return ()
+
+shouldCorrectlyConfigureExtraClasspath :: Property
+shouldCorrectlyConfigureExtraClasspath = once $ morallyDubiousIOProperty do
+    fregeCodeWithDependency = 
+        "module FregeFxDep where\n\n"++ 
+        "import fregefx.JavaFxType\n\n" ++ 
+        "main = println \"Hello FregeFX\""
+    fregefxGlobal = CompileGlobal.fromOptions standardCompileOptions.
+        {
+            path = [ "./src/main/resources/fregefx-0.8.2-SNAPSHOT.jar" ]
+        }
+    actual <- compile fregeCodeWithDependency fregefxGlobal
+    pure    $ actual.errors == 0

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

@@ -0,0 +1,18 @@
+module ch.fhnw.thga.fregelanguageserver.compile.CompileGlobal where
+
+import ch.fhnw.thga.fregelanguageserver.compile.CompileOptions(standardCompileOptions)
+
+import Compiler.types.Global (Global, Options, SubSt)
+import Compiler.common.CompilerOptions (standardGlobal, theClassLoader)
+
+fromOptions :: Options -> IO Global
+fromOptions opts = do
+    initialLoader <- theClassLoader opts
+    initialGlobal <- standardGlobal
+    pure initialGlobal. {
+        options  = opts,
+        sub     <- SubSt. { loader = initialLoader }
+    }
+
+standardCompileGlobal :: IO Global
+standardCompileGlobal = fromOptions standardCompileOptions

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

@@ -0,0 +1,31 @@
+module ch.fhnw.thga.fregelanguageserver.compile.CompileOptions where
+import Compiler.types.Global (Options)
+import frege.compiler.types.Targets public(thisTarget)
+import Compiler.enums.Flags
+
+getEnvDefault :: String -> String -> String
+getEnvDefault defaultValue envName = maybe defaultValue id $ System.getenv envName
+
+standardCompileOptions :: Options
+standardCompileOptions = Options 
+    { 
+        source       = "-",
+        sourcePath   = [ getEnvDefault "." "FREGE_LS_SOURCE_DIR" ],
+        dir          = ".",
+        path         = [ getEnvDefault "" "FREGE_LS_EXTRA_CLASSPATH" ],
+        prefix       = "",
+        encoding     = Just "UTF-8",
+        tRanges      = [],
+        target       = thisTarget,
+        extending    = Nothing,
+        implementing = [],
+        code         = [],
+        flags        = Flags.fromList
+                     [
+                       WARNINGS,
+                       HINTS,
+                       VERBOSE,
+                       IDEMODE,
+                       IDETOKENS
+                     ]
+    }

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

@@ -1,6 +1,7 @@
 module ch.fhnw.thga.fregelanguageserver.diagnostic.Diagnostic where
 
-import ch.fhnw.thga.fregelanguageserver.compiler.CompilerHelper (compileFregeFile, lspGlobal)
+import ch.fhnw.thga.fregelanguageserver.compile.CompileGlobal (standardCompileGlobal)
+import ch.fhnw.thga.fregelanguageserver.compile.CompileExecutor (compile)
 import ch.fhnw.thga.fregelanguageserver.types.Position (Position)
 import ch.fhnw.thga.fregelanguageserver.types.Range (Range, tokenToRange)
 import Compiler.types.Global (StG, StIO, Message, Global, Severity(), tokens, getST, liftStG, liftIO)
@@ -68,8 +69,7 @@ extractDiagnostics = do
 
 compileAndGetDiagnostics :: String -> IO [ Diagnostic ]
 compileAndGetDiagnostics fregeCode = do
-    startGlobal <- lspGlobal
-    gl          <- execStateT (compileFregeFile fregeCode) startGlobal
+    gl          <- compile fregeCode standardCompileGlobal
     pure         $ evalState (extractDiagnostics) gl
 
 fregeLSPServerShouldMapNoCompilerMessagesToEmptyArray :: Property
@@ -92,7 +92,7 @@ fregeLSPServerShouldMapSingleCompilerMessageToDiagnostics = once $ morallyDubiou
                 message  = "Could not import module frege.does.not.Exist\n(java.lang.ClassNotFoundException: frege.does.not.Exist)" 
             } 
         ]
-    gl     <- lspGlobal
+    gl     <- standardCompileGlobal
     actual <- compileAndGetDiagnostics fregeCodeWithError
     pure    $ expected == actual
 
@@ -123,7 +123,7 @@ fregeLSPServerShouldMapMultipleCompilerMessageToDiagnostics = once $ morallyDubi
                 message  = "last statement in a monadic do block must not\nbe let decls" 
             }
         ]
-    gl     <- lspGlobal
+    gl     <- standardCompileGlobal
     actual <- compileAndGetDiagnostics fregeCodeWithErrors
     pure    $ expected == actual
 
@@ -133,10 +133,9 @@ posToTokens (p:ps) gl = tokens p gl ++ posToTokens ps gl
 
 main :: IO ()
 main = do
-    lspGlobal          <- lspGlobal
     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                 <- execStateT (compileFregeFile trickyFregeCode) lspGlobal
+    gl                 <- compile trickyFregeCode standardCompileGlobal
     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,11 +1,8 @@
 module ch.fhnw.thga.fregelanguageserver.diagnostic.DiagnosticLSP where
 
-import ch.fhnw.thga.fregelanguageserver.types.Position (Position)
-import ch.fhnw.thga.fregelanguageserver.types.Range (Range)
 import ch.fhnw.thga.fregelanguageserver.diagnostic.Diagnostic (
     DiagnosticSeverity, Diagnostic, compileAndGetDiagnostics)
 
-import ch.fhnw.thga.fregelanguageserver.lsp4j.PositionLSP4J (PositionLSP)
 import ch.fhnw.thga.fregelanguageserver.lsp4j.RangeLSP4J (RangeLSP)
 
 data DiagnosticSeverityLSP = pure native org.eclipse.lsp4j.DiagnosticSeverity where

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

@@ -1,6 +1,7 @@
 module ch.fhnw.thga.fregelanguageserver.hover.Hover where
 
-import ch.fhnw.thga.fregelanguageserver.compiler.CompilerHelper (compileFregeFile, lspGlobal)
+import ch.fhnw.thga.fregelanguageserver.compile.CompileGlobal (standardCompileGlobal)
+import ch.fhnw.thga.fregelanguageserver.compile.CompileExecutor (compile)
 import ch.fhnw.thga.fregelanguageserver.types.Position (Position)
 import ch.fhnw.thga.fregelanguageserver.types.Range (Range, tokenToRange)
 
@@ -60,8 +61,8 @@ tokenToQName t = do
 
 compileAndGetTypeSignatureOnHover :: String -> Position -> IO (Maybe Hover)
 compileAndGetTypeSignatureOnHover fregeCode pos = do
-    startGlobal <- lspGlobal
-    gl          <- execStateT (compileFregeFile fregeCode) startGlobal
+    startGlobal <- standardCompileGlobal
+    gl          <- compile fregeCode standardCompileGlobal
     pure         $ evalStateT (getTypeOnHover pos) gl
 
 getTypeOnHover :: Position -> StateT Global Maybe Hover
@@ -144,15 +145,14 @@ shouldShowImportedConidDataConstructor = once $ morallyDubiousIOProperty do
 
 main :: IO ()
 main = do
-    lspGlobal     <- lspGlobal
     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            <- execStateT (compileFregeFile fregeCode) lspGlobal
+    gl            <- compile fregeCode standardCompileGlobal
     println $ CharSequence.toString gl.sub.code
     tokens = listFromArray gl.sub.toks
     for tokens println

src/main/java/ch/fhnw/thga/fregelanguageserver/FregeLanguageServer.java

@@ -14,16 +14,20 @@
 
 public class FregeLanguageServer implements LanguageServer, LanguageClientAware 
 {
-	private TextDocumentService textService;
-	private WorkspaceService workspaceService;
-	LanguageClient client;
-
+	private final TextDocumentService textService;
+	private final WorkspaceService workspaceService;
+	private LanguageClient client;
 	public FregeLanguageServer()
     {
 		textService      = new FregeTextDocumentService(this);
 		workspaceService = new FregeWorkspaceService();
 	}
 
+    public LanguageClient getClient()
+    {
+        return client;
+    }
+
 	@Override
 	public CompletableFuture<InitializeResult> initialize(InitializeParams params)
     {

src/main/java/ch/fhnw/thga/fregelanguageserver/FregeTextDocumentService.java

@@ -46,7 +46,7 @@ public void didOpen(DidOpenTextDocumentParams params)
             .collect(Collectors.toList());
 
 		DiagnosticService.publishCompilerDiagnostics(
-            simpleLanguageServer.client,
+            simpleLanguageServer.getClient(),
             currentOpenFileContents,
             params.getTextDocument().getUri()
         );
@@ -74,7 +74,7 @@ public void didClose(DidCloseTextDocumentParams params)
 	public void didSave(DidSaveTextDocumentParams params)
     {
 		DiagnosticService.publishCompilerDiagnostics(
-            simpleLanguageServer.client,
+            simpleLanguageServer.getClient(),
             currentOpenFileContents,
             params.getTextDocument().getUri()
         );