Extracted out initModelContext so it's callable from apps

Author: mpscholten

IHP/FrameworkConfig.hs

@@ -21,6 +21,7 @@ import qualified Network.Wai.Parse as WaiParse
 import qualified System.Posix.Env.ByteString as Posix
 import Data.String.Interpolate.IsString (i)
 import qualified Control.Exception as Exception
+import IHP.ModelSupport
 
 newtype AppHostname = AppHostname Text
 newtype AppPort = AppPort Int
@@ -532,4 +533,11 @@ defaultCorsResourcePolicy = Nothing
 -- >     -- Do something with the FrameworkConfig here
 --
 withFrameworkConfig :: ConfigBuilder -> (FrameworkConfig -> IO result) -> IO result
-withFrameworkConfig configBuilder = Exception.bracket (buildFrameworkConfig configBuilder) (\frameworkConfig -> frameworkConfig |> get #logger |> get #cleanup)
+withFrameworkConfig configBuilder = Exception.bracket (buildFrameworkConfig configBuilder) (\frameworkConfig -> frameworkConfig |> get #logger |> get #cleanup)
+
+initModelContext :: FrameworkConfig -> IO ModelContext
+initModelContext FrameworkConfig { environment, dbPoolIdleTime, dbPoolMaxConnections, databaseUrl, logger } = do
+    let isDevelopment = environment == Development
+    modelContext <- createModelContext dbPoolIdleTime dbPoolMaxConnections databaseUrl logger
+    pure modelContext
+

IHP/Server.hs

@@ -44,7 +44,7 @@ run configBuilder = do
     IO.setLocaleEncoding IO.utf8
 
     withFrameworkConfig configBuilder \frameworkConfig -> do
-        modelContext <- initModelContext frameworkConfig
+        modelContext <- IHP.FrameworkConfig.initModelContext frameworkConfig
         let withPGListener = Exception.bracket (PGListener.init modelContext) PGListener.stop
 
         withPGListener \pgListener -> do
@@ -152,12 +152,6 @@ initCorsMiddleware FrameworkConfig { corsResourcePolicy } = case corsResourcePol
         Just corsResourcePolicy -> Cors.cors (const (Just corsResourcePolicy))
         Nothing -> id
 
-initModelContext :: FrameworkConfig -> IO ModelContext
-initModelContext FrameworkConfig { environment, dbPoolIdleTime, dbPoolMaxConnections, databaseUrl, logger } = do
-    let isDevelopment = environment == Env.Development
-    modelContext <- createModelContext dbPoolIdleTime dbPoolMaxConnections databaseUrl logger
-    pure modelContext
-
 application :: (FrontController RootApplication, ?applicationContext :: ApplicationContext) => Application
 application request respond = do
         requestContext <- ControllerSupport.createRequestContext ?applicationContext request respond