diff options
Diffstat (limited to 'hsm-cam/Hsm/Cam.hs')
-rw-r--r-- | hsm-cam/Hsm/Cam.hs | 33 |
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 |