Use bytestring builder for efficiently building postgres logs

digitallyinduced · Nov 10, 2021 · 27eb7c6 · 27eb7c6
1 parent a72303d
commit 27eb7c6
Show file tree

Hide file tree

Showing 4 changed files with 15 additions and 12 deletions.
diff --git a/IHP/IDE/Logs/Controller.hs b/IHP/IDE/Logs/Controller.hs
@@ -6,6 +6,7 @@ import IHP.IDE.ToolServer.Types
 import IHP.IDE.Logs.View.Logs
 import qualified IHP.IDE.Types as DevServer
 import qualified Data.ByteString.Char8 as ByteString
+import qualified Data.ByteString.Builder as ByteString
 
 instance Controller LogsController where
     action AppLogsAction = do
@@ -15,12 +16,12 @@ instance Controller LogsController where
         (standardOutput, errorOutput) <- case statusServerState of
                 DevServer.StatusServerNotStarted -> pure ("", "")
                 DevServer.StatusServerStarted { standardOutput, errorOutput } -> do
-                    std <- ByteString.unlines <$> readIORef standardOutput
-                    err <- ByteString.unlines <$> readIORef errorOutput
+                    std <- cs . ByteString.unlines <$> readIORef standardOutput
+                    err <- cs . ByteString.unlines <$> readIORef errorOutput
                     pure (std, err)
                 DevServer.StatusServerPaused { standardOutput, errorOutput } -> do
-                    std <- ByteString.unlines <$> readIORef standardOutput
-                    err <- ByteString.unlines <$> readIORef errorOutput
+                    std <- cs . ByteString.unlines <$> readIORef standardOutput
+                    err <- cs . ByteString.unlines <$> readIORef errorOutput
                     pure (std, err)
 
         render LogsView { .. }
@@ -31,8 +32,8 @@ instance Controller LogsController where
 
         (standardOutput, errorOutput) <- case postgresState of
                 DevServer.PostgresStarted { standardOutput, errorOutput } -> do
-                    err <- readIORef errorOutput
-                    std <- readIORef standardOutput
+                    err <- ByteString.toLazyByteString <$> readIORef errorOutput
+                    std <- ByteString.toLazyByteString <$> readIORef standardOutput
                     pure (std, err)
                 _ -> pure ("", "")
 

diff --git a/IHP/IDE/Logs/View/Logs.hs b/IHP/IDE/Logs/View/Logs.hs
@@ -4,7 +4,7 @@ import IHP.ViewPrelude
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout ()
 
-data LogsView = LogsView { standardOutput :: ByteString, errorOutput :: ByteString }
+data LogsView = LogsView { standardOutput :: LByteString, errorOutput :: LByteString }
 
 instance View LogsView where
     html LogsView { .. } = [hsx|

diff --git a/IHP/IDE/Postgres.hs b/IHP/IDE/Postgres.hs
@@ -5,6 +5,7 @@ import IHP.Prelude
 import qualified System.Process as Process
 import qualified System.Directory as Directory
 import qualified Data.ByteString.Char8 as ByteString
+import qualified Data.ByteString.Builder as ByteString
 import GHC.IO.Handle
 
 import qualified IHP.Log as Log
@@ -43,8 +44,8 @@ startPostgres = do
     let handleDatabaseReady onReady line = when ("database system is ready to accept connections" `ByteString.isInfixOf` line) onReady
 
 
-    standardOutput <- newIORef ""
-    errorOutput <- newIORef ""
+    standardOutput <- newIORef mempty
+    errorOutput <- newIORef mempty
 
     let databaseIsReady = dispatch (UpdatePostgresState (PostgresStarted { .. }))
 
@@ -57,12 +58,12 @@ stopPostgres :: PostgresState -> IO ()
 stopPostgres PostgresStarted { .. } = cleanupManagedProcess process
 stopPostgres _ = pure ()
 
-redirectHandleToVariable :: IORef ByteString -> Handle -> (ByteString -> IO ()) -> IO (Async ())
+redirectHandleToVariable :: IORef ByteString.Builder -> Handle -> (ByteString -> IO ()) -> IO (Async ())
 redirectHandleToVariable !ref !handle !onLine = do
     async $ forever $ do
         line <- ByteString.hGetLine handle
         onLine line
-        modifyIORef ref (\log -> log <> "\n" <> line)
+        modifyIORef ref (\log -> log <> "\n" <> ByteString.byteString line)
 
 ensureNoOtherPostgresIsRunning :: IO ()
 ensureNoOtherPostgresIsRunning = do

diff --git a/IHP/IDE/Types.hs b/IHP/IDE/Types.hs
@@ -11,6 +11,7 @@ import Data.String.Conversions (cs)
 import Data.UUID
 import qualified IHP.Log.Types as Log
 import qualified IHP.Log as Log
+import qualified Data.ByteString.Builder as ByteString
 
 data ManagedProcess = ManagedProcess
     { inputHandle :: !Handle
@@ -56,7 +57,7 @@ data Action =
 data PostgresState
     = PostgresNotStarted
     | StartingPostgres
-    | PostgresStarted { process :: !ManagedProcess, standardOutput :: !(IORef ByteString), errorOutput :: !(IORef ByteString) }
+    | PostgresStarted { process :: !ManagedProcess, standardOutput :: !(IORef ByteString.Builder), errorOutput :: !(IORef ByteString.Builder) }
 
 instance Show PostgresState where
     show PostgresNotStarted = "NotStarted"