From 27a696af90efcd0f84260d84805dd2dc753e818c Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Tue, 13 Aug 2024 16:49:44 -0400
Subject: [PATCH] Added mainInParentDirectory for easier IHP development

---
 ihp-ide/IHP/IDE/Postgres.hs      |  2 +-
 ihp-ide/IHP/IDE/Types.hs         |  7 +++++++
 ihp-ide/exe/IHP/IDE/DevServer.hs | 27 ++++++++++++++++++++++-----
 3 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/ihp-ide/IHP/IDE/Postgres.hs b/ihp-ide/IHP/IDE/Postgres.hs
index 72d3b39d7..6c287c66e 100644
--- a/ihp-ide/IHP/IDE/Postgres.hs
+++ b/ihp-ide/IHP/IDE/Postgres.hs
@@ -19,7 +19,7 @@ startPostgres = do
     shouldInit <- needsDatabaseInit
     when shouldInit initDatabase
     let args = ["-D", "build/db/state", "-k", currentDir <> "/build/db", "-c", "listen_addresses="]
-    let params = (Process.proc "postgres" args)
+    let params = (procDirenvAware "postgres" args)
                 { Process.std_in = Process.CreatePipe
                 , Process.std_out = Process.CreatePipe
                 , Process.std_err = Process.CreatePipe
diff --git a/ihp-ide/IHP/IDE/Types.hs b/ihp-ide/IHP/IDE/Types.hs
index efc287240..ee248aa02 100644
--- a/ihp-ide/IHP/IDE/Types.hs
+++ b/ihp-ide/IHP/IDE/Types.hs
@@ -21,6 +21,12 @@ data ManagedProcess = ManagedProcess
     , processHandle :: !ProcessHandle
     } deriving (Show)
 
+procDirenvAware :: (?context :: Context) => FilePath -> [String] -> Process.CreateProcess
+procDirenvAware command args =
+    if ?context.wrapWithDirenv
+        then Process.proc "direnv" (["exec", ".", command] <> args)
+        else Process.proc command args
+
 createManagedProcess :: CreateProcess -> IO ManagedProcess
 createManagedProcess config = do
     process <- Process.createProcess config
@@ -128,6 +134,7 @@ data Context = Context
     , ghciInChan :: !(Queue.InChan OutputLine) -- ^ Output of the app ghci is written here
     , ghciOutChan :: !(Queue.OutChan OutputLine) -- ^ Output of the app ghci is consumed here
     , liveReloadClients :: !(IORef (Map UUID Websocket.Connection))
+    , wrapWithDirenv :: !Bool
     }
 
 dispatch :: (?context :: Context) => Action -> IO ()
diff --git a/ihp-ide/exe/IHP/IDE/DevServer.hs b/ihp-ide/exe/IHP/IDE/DevServer.hs
index a5ccb5cc2..9293650af 100644
--- a/ihp-ide/exe/IHP/IDE/DevServer.hs
+++ b/ihp-ide/exe/IHP/IDE/DevServer.hs
@@ -1,4 +1,4 @@
-module Main (main) where
+module Main (main, mainInParentDirectory) where
 
 import ClassyPrelude
 import qualified System.Process as Process
@@ -30,9 +30,25 @@ import qualified IHP.FrameworkConfig as FrameworkConfig
 import qualified Control.Concurrent.Chan.Unagi as Queue
 import IHP.IDE.FileWatcher
 import qualified System.Environment as Env
+import qualified System.Directory as Directory
+
+mainInParentDirectory :: IO ()
+mainInParentDirectory = do
+    cwd <- Directory.getCurrentDirectory
+    let projectDir = cwd <> "/../"
+    Directory.setCurrentDirectory projectDir
+
+    Env.setEnv "IHP_LIB" (cwd <> "/ihp-ide/lib/IHP")
+    Env.setEnv "TOOLSERVER_STATIC" (cwd <> "/ihp-ide/lib/IHP/static")
+    Env.setEnv "IHP_STATIC" (cwd <> "/lib/IHP/static")
+
+    mainWithOptions True
 
 main :: IO ()
-main = withUtf8 do
+main = mainWithOptions False
+
+mainWithOptions :: Bool -> IO ()
+mainWithOptions wrapWithDirenv = withUtf8 do
     actionVar <- newEmptyMVar
     appStateRef <- emptyAppState >>= newIORef
     portConfig <- findAvailablePortConfig
@@ -45,7 +61,7 @@ main = withUtf8 do
     logger <- Log.newLogger def
     (ghciInChan, ghciOutChan) <- Queue.newChan
     liveReloadClients <- newIORef mempty
-    let ?context = Context { actionVar, portConfig, appStateRef, isDebugMode, logger, ghciInChan, ghciOutChan, liveReloadClients }
+    let ?context = Context { actionVar, portConfig, appStateRef, isDebugMode, logger, ghciInChan, ghciOutChan, liveReloadClients, wrapWithDirenv }
 
     -- Print IHP Version when in debug mode
     when isDebugMode (Log.debug ("IHP Version: " <> Version.ihpVersion))
@@ -215,7 +231,7 @@ startOrWaitPostgres = do
         startPostgres
         pure ()
 
-startGHCI :: IO ManagedProcess
+startGHCI :: (?context :: Context) => IO ManagedProcess
 startGHCI = do
     let args =
             [ "-threaded"
@@ -227,7 +243,8 @@ startGHCI = do
             , "-ghci-script", ".ghci" -- Because the previous line ignored default ghci config file locations, we have to manual load our .ghci
             , "+RTS", "-A128m", "-n2m", "-H2m", "--nonmoving-gc", "-N"
             ]
-    createManagedProcess (Process.proc "ghci" args)
+
+    createManagedProcess (procDirenvAware "ghci" args)
             { Process.std_in = Process.CreatePipe
             , Process.std_out = Process.CreatePipe
             , Process.std_err = Process.CreatePipe