tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

51c0495cfaa57ed9c879e6e4f5b14a656e97845e9062fe9cc0ae8b3ba9c1ecf8.tri (1806B)

      1 !import base as B
      2 !import handlers as H
      3 !export emit
      4 !export info
      5 !export warn
      6 !export withContext
      7 !export withSink
      8 !export capture
      9 !export discard
     10 
     11 -- Events are [level ordered-context-fields payload]. Payload/fields are trees;
     12 -- sinks choose their formatting and serialization.
     13 eventC value{[level fields payload]} rest = case B.listOf B.anyC fields rest of
     14   ((t t), _) = B.contractOk value rest
     15   _ = B.contractErr "log context must be a proper list" rest
     16 eventC _ rest = B.contractErr "expected [level context payload]" rest
     17 
     18 -- Log sinks return ordinary Result unit; errors remain application-visible.
     19 replyC value{((t t), (t, t))}   rest = B.contractOk value rest
     20 replyC value{(t, (message, t))} rest = B.contractOk value rest
     21 replyC _                        rest = B.contractErr "expected log Result with empty remainder" rest
     22 
     23 emit level payload = H.checkedRequest "logging" "emit" eventC replyC [level [] payload]
     24 info payload       = emit "info" payload
     25 warn payload       = emit "warn" payload
     26 
     27 contextHandler fields "emit" event{[level inner payload]} =
     28   H.forward "logging" "emit" [level (B.append fields inner) payload]
     29 contextHandler _ operation payload = H.forward "logging" operation payload
     30 withContext fields action = case B.checkContract (B.listOf B.anyC) fields of
     31   ((t t), (checked, t)) = H.handle "logging" (contextHandler checked) action
     32   _ = H.fail "invalid-request" "logging" "context" "context must be a proper list"
     33 
     34 sinkHandler sink "emit"    event   = H.checkRequest "logging" "emit" eventC event sink
     35 sinkHandler _    operation payload = H.forward "logging" operation payload
     36 withSink sink action = H.handle "logging" (sinkHandler sink) action
     37 capture action = H.collect "logging" "emit" eventC (B.ok t t) action
     38 discard action = withSink (_ : H.pure (B.ok t t)) action