aboutsummaryrefslogtreecommitdiff
path: root/hsm-log
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-log')
-rw-r--r--hsm-log/Hsm/Log.hs31
1 files changed, 20 insertions, 11 deletions
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