aboutsummaryrefslogtreecommitdiff
path: root/hsm-cam/Hsm/Cam.hs
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-cam/Hsm/Cam.hs')
-rw-r--r--hsm-cam/Hsm/Cam.hs33
1 files changed, 22 insertions, 11 deletions
diff --git a/hsm-cam/Hsm/Cam.hs b/hsm-cam/Hsm/Cam.hs
index fe17057..e5b30c2 100644
--- a/hsm-cam/Hsm/Cam.hs
+++ b/hsm-cam/Hsm/Cam.hs
@@ -12,8 +12,8 @@ import Codec.Picture (Image(Image), encodePng)
import Codec.Picture.Types (PixelRGB8)
import Control.Concurrent (MVar, forkIO, newEmptyMVar, putMVar, takeMVar)
import Control.Exception (mask_)
-import Control.Monad (forever)
-import Control.Monad.Loops (whileM_)
+import Control.Monad.Extra (whenM)
+import Control.Monad.Loops (iterateM_)
import Data.Bits ((.|.))
import Data.ByteString.Lazy (ByteString)
import Data.List ((!?))
@@ -106,14 +106,18 @@ data LibCameraSeverity
deriving (Read, Show)
toLibCameraSeverity :: Severity -> LibCameraSeverity
-toLibCameraSeverity Trace = DEBUG
-toLibCameraSeverity Info = INFO
-toLibCameraSeverity Attention = WARN
+toLibCameraSeverity =
+ \case
+ Trace -> DEBUG
+ Info -> INFO
+ Attention -> WARN
fromLibCameraSeverity :: LibCameraSeverity -> Severity
-fromLibCameraSeverity DEBUG = Trace
-fromLibCameraSeverity INFO = Info
-fromLibCameraSeverity _ = Attention
+fromLibCameraSeverity =
+ \case
+ DEBUG -> Trace
+ INFO -> Info
+ _ -> Attention
runCam :: (IOE :> es, Log "cam" :> es, Log "libcamera" :> es) => Eff (Cam : es) a -> Eff es a
runCam action = do
@@ -152,11 +156,10 @@ runCam action = do
-- A dedicated thread reads from the FIFO, parses log severity levels, and
-- forwards messages to the application's logger with proper level mapping.
logCaptureFifo = "/tmp/hsm-cam-libcamera.fifo"
- logCaptureClear = liftIO . whileM_ (doesFileExist logCaptureFifo) $ removeFile logCaptureFifo
+ logCaptureClear = liftIO . whenM (doesFileExist logCaptureFifo) $ removeFile logCaptureFifo
logCaptureSetEnvVar key value = do
logMsg @"cam" Info $ "Setting env variable: " <> key <> "=" <> value
liftIO $ setEnv key value
- logCaptureLineSeverity logLine = maybe Trace fromLibCameraSeverity $ words logLine !? 2 >>= readMaybe
logCaptureAlloc = do
logCaptureClear
logMsg @"cam" Info $ "Creating libcamera log capture FIFO at: " <> logCaptureFifo
@@ -166,7 +169,15 @@ runCam action = do
logCaptureSetEnvVar "LIBCAMERA_LOG_LEVELS" $ "*:" <> show libCameraSeverity
loggerIO <- makeLoggerIO @"libcamera"
logMsg @"cam" Info "Starting libcamera log capture"
- liftIO . forkIO . withFile logCaptureFifo ReadWriteMode $ \handle -> forever $ hGetLine handle >>= \logLine -> loggerIO (logCaptureLineSeverity logLine) logLine
+ -- Thread handles multiline logs by maintaining severity state between lines.
+ -- When a new line doesn't contain a parsable severity level, the previous
+ -- line's level is reused to ensure continuous log context.
+ liftIO . forkIO . withFile logCaptureFifo ReadWriteMode $ \handle ->
+ flip iterateM_ DEBUG $ \previousSeverity -> do
+ logLine <- hGetLine handle
+ flip (maybe $ return previousSeverity) (words logLine !? 2 >>= readMaybe) $ \severity -> do
+ loggerIO (fromLibCameraSeverity severity) logLine
+ return severity
logCaptureDealloc = do
logMsg @"cam" Info "Removing libcamera log capture FIFO"
logCaptureClear