From a0f0f6985e67ddbce929bf3da6832c443db5293d Mon Sep 17 00:00:00 2001 From: Paul Oliver Date: Fri, 2 Jan 2026 00:48:59 +0000 Subject: Adds libcamera to WebRTC streaming service --- hsm-log/Hsm/Log.hs | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) (limited to 'hsm-log/Hsm/Log.hs') diff --git a/hsm-log/Hsm/Log.hs b/hsm-log/Hsm/Log.hs index bd8c73f..09d4c2d 100644 --- a/hsm-log/Hsm/Log.hs +++ b/hsm-log/Hsm/Log.hs @@ -105,6 +105,18 @@ runLog -> Eff es a runLog = evalStaticRep . Log +class LogsClass (ds :: [Symbol]) (es :: [Effect]) where + type Insert ds es :: [Effect] + runLogs :: Severity -> Eff (Insert ds es) a -> Eff es a + +instance LogsClass ('[] :: [Symbol]) (es :: [Effect]) where + type Insert '[] es = es + runLogs = const id + +instance (IOE :> Insert ds es, KnownSymbol d, LogsClass ds es) => LogsClass (d : ds :: [Symbol]) (es :: [Effect]) where + type Insert (d : ds) es = Log d : Insert ds es + runLogs level = runLogs @ds level . runLog @d level + runLogOpt :: forall d f o es a . (AppendSymbol LogOptionPrefix d ~ f, HasField f o Severity, IOE :> es) @@ -113,20 +125,17 @@ runLogOpt -> Eff es a runLogOpt = runLog . getField @f -class LogsClass (o :: *) (ds :: [Symbol]) (es :: [Effect]) where - type Insert ds es :: [Effect] - runLogs :: Severity -> Eff (Insert ds es) a -> Eff es a - runLogsOpt :: o -> Eff (Insert ds es) a -> Eff es a +class LogsOptClass (o :: *) (ds :: [Symbol]) (es :: [Effect]) where + type InsertOpt ds es :: [Effect] + runLogsOpt :: o -> Eff (InsertOpt ds es) a -> Eff es a -instance LogsClass (o :: *) ('[] :: [Symbol]) (es :: [Effect]) where - type Insert '[] es = es - runLogs = const id +instance LogsOptClass (o :: *) ('[] :: [Symbol]) (es :: [Effect]) where + type InsertOpt '[] es = es runLogsOpt = const id instance - (AppendSymbol LogOptionPrefix d ~ f, HasField f o Severity, IOE :> Insert ds es, KnownSymbol d, LogsClass o ds es) - => LogsClass (o :: *) (d : ds :: [Symbol]) (es :: [Effect]) + (AppendSymbol LogOptionPrefix d ~ f, HasField f o Severity, IOE :> InsertOpt ds es, KnownSymbol d, LogsOptClass o ds es) + => LogsOptClass (o :: *) (d : ds :: [Symbol]) (es :: [Effect]) where - type Insert (d : ds) es = Log d : Insert ds es - runLogs level = runLogs @o @ds level . runLog @d level + type InsertOpt (d : ds) es = Log d : InsertOpt ds es runLogsOpt opts = runLogsOpt @o @ds opts . runLogOpt @d @f @o opts -- cgit v1.2.1