Skip to content

Commit

Permalink
Added mainInParentDirectory for easier IHP development
Browse files Browse the repository at this point in the history
  • Loading branch information
mpscholten committed Aug 13, 2024
1 parent 80143c7 commit 27a696a
Show file tree
Hide file tree
Showing 3 changed files with 30 additions and 6 deletions.
2 changes: 1 addition & 1 deletion ihp-ide/IHP/IDE/Postgres.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
7 changes: 7 additions & 0 deletions ihp-ide/IHP/IDE/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 ()
Expand Down
27 changes: 22 additions & 5 deletions ihp-ide/exe/IHP/IDE/DevServer.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module Main (main) where
module Main (main, mainInParentDirectory) where

import ClassyPrelude
import qualified System.Process as Process
Expand Down Expand Up @@ -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
Expand All @@ -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))
Expand Down Expand Up @@ -215,7 +231,7 @@ startOrWaitPostgres = do
startPostgres
pure ()

startGHCI :: IO ManagedProcess
startGHCI :: (?context :: Context) => IO ManagedProcess
startGHCI = do
let args =
[ "-threaded"
Expand All @@ -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
Expand Down

0 comments on commit 27a696a

Please sign in to comment.