tricu

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

06e81c8b62b8f26ba20faa3280b381ddd55ecf246876a21b028175bbeb87f896.tri (1950B)

      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 -- not strings. The service has no implicit formatting or serialization policy.
     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 = case B.checkContract eventC event of
     35   ((t t), (checked, t)) = sink checked
     36   (t, (message, _)) = H.fail "invalid-request" "logging" "emit" message
     37   _ = H.fail "invalid-request-contract" "logging" "emit" event
     38 sinkHandler _ operation payload = H.forward "logging" operation payload
     39 withSink sink action = H.handle "logging" (sinkHandler sink) action
     40 capture action = H.collect "logging" "emit" eventC (B.ok t t) action
     41 discard action = withSink (_ : H.pure (B.ok t t)) action