[WIP] Pass the backend as a regular function parameter instead of usi…

…ng `Sem.Reader`

While wiring everything up, Polysemy became very, very unhappy. I spent some time trying to figure out what I was doing wrong, but with no luck. Eventually, I ended up removing `Sem.Reader (Backend backendEffs)` altogether in favor of just passing `Backend backendEffs` around as a parameter.

I've since been running into what I think is a variation of polysemy-research/polysemy#280 (which I opened yesterday after finding an MVCE).

src/Axel/Haskell/File.hs

@@ -23,7 +23,7 @@ import qualified Axel.Eff.Resource as Effs (Resource)
 import qualified Axel.Eff.Restartable as Effs (Restartable)
 import Axel.Haskell.Convert (convertFile)
 import Axel.Macros
-  ( HaskellBackendEffs
+  ( Backend
   , handleFunctionApplication
   , haskellBackend
   , processProgram
@@ -97,27 +97,27 @@ readModuleInfo axelFiles = do
   pure $ M.fromList $ catMaybes modules
 
 transpileSource ::
-     forall effs fileExpanderEffs funAppExpanderEffs.
+     forall effs fileExpanderEffs funAppExpanderEffs backendEffs.
      ( fileExpanderEffs ~ '[ Effs.Console, Sem.Error Error, Effs.FileSystem, Effs.Ghci, Effs.Log, Effs.Process, Effs.Resource, Sem.Reader Ghci.Ghci, Sem.State ModuleInfo]
      , funAppExpanderEffs ~ (Sem.Reader FilePath ': Effs.Restartable SM.Expression ': Sem.State [SMStatement] ': fileExpanderEffs)
      , Sem.Members '[ Sem.Error Error, Effs.Ghci, Sem.Reader Ghci.Ghci, Sem.State ModuleInfo] effs
      , Sem.Members fileExpanderEffs effs
+     , Sem.Members backendEffs effs
      )
-  => FilePath
+  => Backend backendEffs
+  -> FilePath
   -> Text
   -> Sem.Sem effs SM.Output
-transpileSource filePath source =
+transpileSource backend filePath source =
   toHaskell . statementsToProgram <$>
-  Sem.runReader
-    haskellBackend
-    (parseSource (Just filePath) source >>=
-     processProgram
-       @fileExpanderEffs
-       @funAppExpanderEffs
-       @HaskellBackendEffs
-       handleFunctionApplication
-       (void . transpileFileInPlace)
-       filePath)
+  (parseSource (Just filePath) source >>=
+   processProgram
+     @fileExpanderEffs
+     @funAppExpanderEffs
+     backend
+     handleFunctionApplication
+     (\backend -> void . transpileFileInPlace backend)
+     filePath)
 
 convertFileInPlace ::
      (Sem.Members '[ Effs.Console, Effs.FileSystem, Sem.Error Error, Effs.FileSystem] effs)
@@ -130,28 +130,30 @@ convertFileInPlace path = do
 
 transpileFile ::
      (Sem.Members '[ Effs.Console, Sem.Error Error, Effs.FileSystem, Effs.Ghci, Effs.Log, Effs.Process, Effs.Resource, Sem.Reader Ghci.Ghci, Sem.State ModuleInfo] effs)
-  => FilePath
+  => Backend backendEffs
+  -> FilePath
   -> FilePath
   -> Sem.Sem effs ()
-transpileFile path newPath = do
+transpileFile backend path newPath = do
   fileContents <- FS.readFile path
-  newContents <- transpileSource path fileContents
+  newContents <- transpileSource backend path fileContents
   putStrLn $ op FilePath path <> " => " <> op FilePath newPath
   FS.writeFile newPath (SM.raw newContents)
   Sem.modify $ M.adjust (_2 ?~ newContents) path
 
 transpileFileInPlace ::
      (Sem.Members '[ Effs.Console, Sem.Error Error, Effs.FileSystem, Effs.Ghci, Effs.Log, Effs.Process, Effs.Resource, Sem.Reader Ghci.Ghci, Sem.State ModuleInfo] effs)
-  => FilePath
+  => Backend backendEffs
+  -> FilePath
   -> Sem.Sem effs FilePath
-transpileFileInPlace path = do
+transpileFileInPlace backend path = do
   moduleInfo <- Sem.gets $ M.lookup path
   let alreadyCompiled =
         case moduleInfo of
           Just (_, Just _) -> True
           _ -> False
   let newPath = replaceExtension path "hs"
-  unless alreadyCompiled $ transpileFile path newPath
+  unless alreadyCompiled $ transpileFile backend path newPath
   pure newPath
 
 formatFileInPlace ::

src/Axel/Haskell/Project.hs

@@ -33,6 +33,7 @@ import Axel.Haskell.Stack
   , createStackProject
   , runStackProject
   )
+import Axel.Macros (Backend)
 import Axel.Sourcemap (ModuleInfo)
 import Axel.Utils.FilePath ((<.>), (</>))
 
@@ -71,8 +72,8 @@ newProject projectName = do
     ]
 
 data ProjectFileType
-  = Axel
-  | Backend
+  = AxelFile
+  | BackendFile
 
 getProjectFiles ::
      (Sem.Member Effs.FileSystem effs)
@@ -85,33 +86,37 @@ getProjectFiles fileType = do
       [FilePath "app", FilePath "src", FilePath "test"]
   let ext =
         case fileType of
-          Axel -> ".axel"
-          Backend -> ".hs"
+          AxelFile -> ".axel"
+          BackendFile -> ".hs"
   pure $ filter (\filePath -> ext `T.isSuffixOf` op FilePath filePath) files
 
 transpileProject ::
      (Sem.Members '[ Effs.Console, Sem.Error Error, Effs.FileSystem, Effs.Ghci, Effs.Log, Effs.Process, Effs.Resource] effs)
-  => Sem.Sem effs ModuleInfo
-transpileProject =
+  => Backend backendEffs
+  -> Sem.Sem effs ModuleInfo
+transpileProject backend =
   Ghci.withStackGhci $ do
-    axelFiles <- getProjectFiles Axel
+    axelFiles <- getProjectFiles AxelFile
     initialModuleInfo <- readModuleInfo axelFiles
     (moduleInfo, _) <-
-      Sem.runState initialModuleInfo $ mapM transpileFileInPlace axelFiles
+      Sem.runState initialModuleInfo $
+      mapM (transpileFileInPlace backend) axelFiles
     pure moduleInfo
 
 buildProject ::
      (Sem.Members '[ Effs.Console, Sem.Error Error, Effs.FileSystem, Effs.Ghci, Effs.Log, Effs.Process, Effs.Resource] effs)
-  => Sem.Sem effs ()
-buildProject = do
+  => Backend backendEffs
+  -> Sem.Sem effs ()
+buildProject backend = do
   projectPath <- getCurrentDirectory
-  transpiledFiles <- transpileProject
+  transpiledFiles <- transpileProject backend
   buildStackProject transpiledFiles projectPath
 
 convertProject ::
      (Sem.Members '[ Effs.Console, Effs.FileSystem, Sem.Error Error, Effs.FileSystem, Effs.Process] effs)
   => Sem.Sem effs ()
-convertProject = getProjectFiles Backend >>= void . traverse convertFileInPlace
+convertProject =
+  getProjectFiles BackendFile >>= void . traverse convertFileInPlace
 
 runProject ::
      (Sem.Members '[ Effs.Console, Sem.Error Error, Effs.FileSystem, Effs.Process] effs)
@@ -121,4 +126,4 @@ runProject = getCurrentDirectory >>= runStackProject
 formatProject ::
      (Sem.Members '[ Effs.Console, Effs.FileSystem, Sem.Error Error] effs)
   => Sem.Sem effs ()
-formatProject = getProjectFiles Axel >>= void . traverse formatFileInPlace
+formatProject = getProjectFiles AxelFile >>= void . traverse formatFileInPlace