Bundle HTTP.app related configuration in HTTP.AppConfig

Author: sol

cabal.project

@@ -1,6 +1,6 @@
 packages: .
 
 program-options
-  ghc-options: -Werror
+  ghc-options: -Werror -fhide-source-paths
 
 tests: True

src/HTTP.hs

@@ -1,10 +1,8 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 module HTTP (
-  withServer
-, socketName
-, newSocket
-, socketAddr
+  AppConfig(..)
+, withServer
 
 #ifdef TEST
 , app
@@ -25,8 +23,6 @@ import           Network.Socket
 
 import           Util
 import qualified Trigger
-import           Config (Config)
-import qualified Config
 import qualified Config.DeepSeek as Config
 import qualified DeepSeek
 import           GHC.Diagnostic
@@ -35,14 +31,21 @@ import           HTTP.Util
 import           Sensei.API (QuickFixRequest(..), DeepFixRequest(..))
 import qualified Sensei.API as API
 
+data AppConfig = AppConfig {
+  putStrLn :: String -> IO ()
+, deepSeek :: Maybe Config.DeepSeek
+, dir :: FilePath
+, getLastResult :: IO (Trigger.Result, String, [Diagnostic])
+}
+
 socketAddr :: FilePath -> SockAddr
 socketAddr = SockAddrUnix . socketName
 
 withSocket :: (Socket -> IO a) -> IO a
 withSocket = bracket newSocket close
 
-withServer :: (String -> IO ()) -> Config -> FilePath -> IO (Trigger.Result, String, [Diagnostic]) -> IO a -> IO a
-withServer putStrLn config dir = withApplication dir . app putStrLn config dir
+withServer :: AppConfig -> IO a -> IO a
+withServer config = withApplication config.dir $ app config
 
 withApplication :: FilePath -> Application -> IO a -> IO a
 withApplication dir application action = do
@@ -65,8 +68,8 @@ withThread asyncAction action = do
   takeMVar mvar
   return r
 
-app :: (String -> IO ()) -> Config -> FilePath -> IO (Trigger.Result, String, [Diagnostic]) -> Application
-app putStrLn config dir getLastResult request respond = case pathInfo request of
+app :: AppConfig -> Application
+app config@AppConfig { putStrLn, dir, getLastResult } request respond = case pathInfo request of
 
   [] -> requireMethod "GET" $ do
     getLastResult >>= textPlain

src/Run.hs

@@ -71,7 +71,7 @@ run args = do
       cleanupAction.add $ Prelude.putStrLn message
       cleanupAction.run
 
-  HTTP.withServer putStrLn config dir (readMVar lastOutput) $ do
+  HTTP.withServer (HTTP.AppConfig putStrLn config.deepSeek dir (readMVar lastOutput)) $ do
     watchFiles dir queue $ do
       mode <- newIORef Lenient
       Input.watch stdin (dispatch mode queue) (emitEvent queue Done)
@@ -182,7 +182,7 @@ runWeb args = do
   Session.withSession defaultSessionConfig args $ \ session -> do
     _ <- trigger session defaultHooks
     lock <- newMVar ()
-    HTTP.withServer Prelude.putStrLn config "" (withMVar lock $ \() -> trigger session defaultHooks) $ do
+    HTTP.withServer (HTTP.AppConfig Prelude.putStrLn config.deepSeek "" (withMVar lock $ \ () -> trigger session defaultHooks)) $ do
       waitForever
 
 defaultSessionConfig :: Session.Config

test/ClientSpec.hs

@@ -2,9 +2,8 @@ module ClientSpec (spec) where
 
 import           Helper
 
-import           Config
-import           HTTP (socketName)
 import qualified HTTP
+import           HTTP.Util (socketName)
 import           Client
 import qualified Trigger
 
@@ -17,7 +16,7 @@ withFailure = withServer Trigger.Failure (withColor Red "failure")
 withServer :: Trigger.Result -> String -> (FilePath -> IO a) -> IO a
 withServer result text action = do
   withTempDirectory $ \ dir -> do
-    HTTP.withServer (\ _ -> pass) defaultConfig dir (return (result, text, [])) $ do
+    HTTP.withServer (HTTP.AppConfig (\ _ -> pass) Nothing dir (return (result, text, []))) $ do
       action dir
 
 spec :: Spec

test/HTTPSpec.hs

@@ -35,7 +35,7 @@ spec = do
 
       withApp :: (Trigger.Result, String, [Diagnostic]) -> SpecWith (FilePath, Application) -> Spec
       withApp lastResult = around \ item -> withTempDirectory \ dir -> do
-        item (dir, HTTP.app putStrLn defaultConfig dir $ return lastResult)
+        item (dir, HTTP.app (HTTP.AppConfig putStrLn Nothing dir (return lastResult)))
 
       withAppWithFailure :: FilePath -> SpecWith (FilePath, Application) -> Spec
       withAppWithFailure name = around \ item -> withTempDirectory \ dir -> do
@@ -58,7 +58,7 @@ spec = do
           deepSeek = config.deepSeek <|> Just (DeepSeek $ BearerToken "")
 
           app :: Application
-          app = HTTP.app putStrLn defaultConfig { deepSeek } dir (return $ (Trigger.Failure, "", [err]))
+          app = HTTP.app (HTTP.AppConfig putStrLn deepSeek dir (return $ (Trigger.Failure, "", [err])))
 
         item (dir, app)
         where

test/Helper.hs

@@ -51,6 +51,8 @@ import           Language.Haskell.GhciWrapper
 
 import           GHC.Diagnostic
 
+import qualified HTTP
+
 timeout :: IO a -> IO (Maybe a)
 timeout action = lookupEnv "CI" >>= \ case
   Nothing -> System.Timeout.timeout  5_000_000 action
@@ -67,6 +69,14 @@ ghciConfig = Config {
 , configEcho = silent
 }
 
+_appConfig :: HTTP.AppConfig
+_appConfig = HTTP.AppConfig {
+  putStrLn = \ _ -> pass
+, deepSeek = Nothing
+, dir = ""
+, getLastResult = undefined
+}
+
 withTempDirectory :: (FilePath -> IO a) -> IO a
 withTempDirectory = withSystemTempDirectory "hspec"