refactor: split compilerHelper into compileOptions, compileGlobal and

compileExecutor modules
tricktron · Jul 22, 2022 · 9da9136 · 9da9136
1 parent 10a1f06
commit 9da9136
Show file tree

Hide file tree

Showing 7 changed files with 78 additions and 76 deletions.
diff --git a/build.gradle b/build.gradle
@@ -30,7 +30,7 @@ frege
     mainSourceDir = layout.projectDirectory.dir('src/main/frege')
     testModules   = 
     [
-        'ch.fhnw.thga.fregelanguageserver.compiler.CompilerHelper',
+        'ch.fhnw.thga.fregelanguageserver.compile.CompileExecutor',
         'ch.fhnw.thga.fregelanguageserver.diagnostic.Diagnostic',
         'ch.fhnw.thga.fregelanguageserver.hover.Hover'
     ]

diff --git a/...languageserver/compiler/CompilerHelper.fr → ...languageserver/compile/CompileExecutor.fr b/...languageserver/compiler/CompilerHelper.fr → ...languageserver/compile/CompileExecutor.fr
@@ -1,8 +1,9 @@
-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)
@@ -33,31 +34,6 @@ 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
 
-standardLSPOptions :: Options
-standardLSPOptions = 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,
-                       MAKE
-                     ]
-    }
-
 passes = 
     [
         (liftStG Fix.pass,              "join definitions"),
@@ -78,43 +54,23 @@ passes =
         (liftStG FI.cleanSymtab,        "clean up")
     ]
 
-createLSPGlobal :: Options -> IO Global
-createLSPGlobal opts = do
-    initialLoader <- theClassLoader opts
-    initialGlobal <- standardGlobal
-    pure initialGlobal. {
-        options  = opts,
-        sub     <- SubSt. { loader = initialLoader }
-    }
-
-standardLSPGlobal :: IO Global
-standardLSPGlobal = 
-    let
-        fregeSourceDir = maybe "." id $ System.getenv "FREGE_LSP_SOURCE_DIR"
-        extraClasspath = maybe ""  id $ System.getenv "FREGE_LSP_EXTRA_CLASSPATH" 
-    in
-        createLSPGlobal standardLSPOptions.{
-            sourcePath = [ fregeSourceDir ],
-            path       = [ extraClasspath ]
-    }
-
 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)
 
@@ -144,9 +100,9 @@ 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
@@ -155,7 +111,7 @@ compileFregeFile fregeCode = do
 compile :: String -> IO Global -> IO Global
 compile fregeCode global = do
     startGlobal <- global
-    execStateT (compileFregeFile fregeCode) startGlobal
+    execStateT (compileSourceCode fregeCode) startGlobal
 
 runpass :: (StIO (String, Int), String) -> StIO ()
 runpass (pass, description) = do
@@ -170,8 +126,9 @@ shouldCorrectlyConfigureExtraClasspath = once $ morallyDubiousIOProperty do
         "module FregeFxDep where\n\n"++ 
         "import fregefx.JavaFxType\n\n" ++ 
         "main = println \"Hello FregeFX\""
-    fregefxGlobal = createLSPGlobal standardLSPOptions. {
-        path = [ "./src/main/resources/fregefx-0.8.2-SNAPSHOT.jar" ]
-    }
+    fregefxGlobal = CompileGlobal.fromOptions standardCompileOptions.
+        {
+            path = [ "./src/main/resources/fregefx-0.8.2-SNAPSHOT.jar" ]
+        }
     actual <- compile fregeCodeWithDependency fregefxGlobal
     pure    $ actual.errors == 0
diff --git a/src/main/frege/ch/fhnw/thga/fregelanguageserver/compile/CompileGlobal.fr b/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
diff --git a/src/main/frege/ch/fhnw/thga/fregelanguageserver/compile/CompileOptions.fr b/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
+                     ]
+    }
diff --git a/src/main/frege/ch/fhnw/thga/fregelanguageserver/diagnostic/Diagnostic.fr b/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, standardLSPGlobal, compile)
+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,7 +69,7 @@ extractDiagnostics = do
 
 compileAndGetDiagnostics :: String -> IO [ Diagnostic ]
 compileAndGetDiagnostics fregeCode = do
-    gl          <- compile fregeCode standardLSPGlobal
+    gl          <- compile fregeCode standardCompileGlobal
     pure         $ evalState (extractDiagnostics) gl
 
 fregeLSPServerShouldMapNoCompilerMessagesToEmptyArray :: Property
@@ -91,7 +92,7 @@ fregeLSPServerShouldMapSingleCompilerMessageToDiagnostics = once $ morallyDubiou
                 message  = "Could not import module frege.does.not.Exist\n(java.lang.ClassNotFoundException: frege.does.not.Exist)" 
             } 
         ]
-    gl     <- standardLSPGlobal
+    gl     <- standardCompileGlobal
     actual <- compileAndGetDiagnostics fregeCodeWithError
     pure    $ expected == actual
 
@@ -122,7 +123,7 @@ fregeLSPServerShouldMapMultipleCompilerMessageToDiagnostics = once $ morallyDubi
                 message  = "last statement in a monadic do block must not\nbe let decls" 
             }
         ]
-    gl     <- standardLSPGlobal
+    gl     <- standardCompileGlobal
     actual <- compileAndGetDiagnostics fregeCodeWithErrors
     pure    $ expected == actual
 
@@ -132,10 +133,9 @@ posToTokens (p:ps) gl = tokens p gl ++ posToTokens ps gl
 
 main :: IO ()
 main = do
-    lspGlobal          <- standardLSPGlobal
     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

diff --git a/src/main/frege/ch/fhnw/thga/fregelanguageserver/diagnostic/DiagnosticLSP.fr b/src/main/frege/ch/fhnw/thga/fregelanguageserver/diagnostic/DiagnosticLSP.fr
@@ -1,12 +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.compiler.CompilerHelper(standardLSPGlobal)
 
-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

diff --git a/src/main/frege/ch/fhnw/thga/fregelanguageserver/hover/Hover.fr b/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, standardLSPGlobal)
+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 <- standardLSPGlobal
-    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     <- standardLSPGlobal
     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