eventuo11y-json 0.2.0.0 → 0.3.0.0

raw patch · 3 files changed

+26/−22 lines, 3 filesdep ~eventuo11yPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: eventuo11y

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• eventuo11y-json.cabal +2/−2
• src/Observe/Event/Render/JSON/Handle.hs +20/−20

@@ -1,5 +1,9 @@ # Revision history for eventuo11y-json +## 0.3.0.0 -- 2023-01-13++- Update for eventuo11y 0.7+ ## 0.2.0.0 -- 2022-12-23  - Update for eventuo11y 0.6

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               eventuo11y-json-version:            0.2.0.0+version:            0.3.0.0 synopsis:           aeson-based rendering for eventuo11y description:   Render [eventuo11y](https://hackage.haskell.org/package/eventuo11y) 'Observe.Event.Event's@@ -42,7 +42,7 @@     , base              ^>= { 4.14, 4.16, 4.17 }     , aeson             ^>= { 2.0, 2.1 }     , bytestring        ^>= { 0.10, 0.11 }-    , eventuo11y        ^>= 0.6+    , eventuo11y        ^>= { 0.7 }     , eventuo11y-dsl    ^>= 0.2     , template-haskell  ^>= { 2.16, 2.18, 2.19 }     , text              ^>= { 1.2, 2.0 }

@@ -4,6 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-}  -- |@@ -24,7 +25,7 @@ import Control.Concurrent.MVar import Control.Exception import Data.Aeson-import Data.Aeson.KeyMap (insert)+import Data.Aeson.KeyMap (fromList, insert) import Data.ByteString.Lazy.Char8 (hPutStrLn) import Data.Coerce import Data.IORef@@ -49,13 +50,17 @@   (Object -> IO ()) ->   RenderExJSON stex ->   RenderFieldJSON f ->+  -- | Parent+  Maybe JSONRef ->+  -- | Causes+  [JSONRef] ->+  -- | Initial fields+  [f] ->   IO (Event IO JSONRef f)-newJSONEvent emit renderEx renderField = do+newJSONEvent emit renderEx renderField parent causes initialFields = do   eventRef <- coerce nextRandom   start <- getCurrentTime-  fieldsRef <- newIORef mempty-  parentsRef <- newIORef mempty-  proximatesRef <- newIORef mempty+  fieldsRef <- newIORef . fromList $ map renderField initialFields   finishOnce <- newEmptyMVar   let finish r =         tryPutMVar finishOnce () >>= \case@@ -63,16 +68,14 @@           True -> do             end <- getCurrentTime             fields <- readIORef fieldsRef-            parents <- readIORef parentsRef-            proximates <- readIORef proximatesRef             emit               ( "event-id" .= eventRef                   <> "start" .= start                   <> "end" .= end                   <> "duration" .= diffUTCTime end start                   <> ifNotNull "fields" fields-                  <> ifNotNull "parents" parents-                  <> ifNotNull "proximate-causes" proximates+                  <> ifNotNull "parent" parent+                  <> ifNotNull "proximate-causes" causes                   <> case r of                     StructuredFail e -> "structured-exception" .= renderEx e                     UnstructuredFail e -> "unstructured-exception" .= show e@@ -84,11 +87,6 @@         addField = \field ->           atomicModifyIORef' fieldsRef \fields ->             (uncurry insert (renderField field) fields, ()),-        addReference = \(Reference ty r) ->-          let refsRef = case ty of-                Parent -> parentsRef-                Proximate -> proximatesRef-           in atomicModifyIORef' refsRef \refs -> (r : refs, ()),         finalize = \me -> finish $ case me of           Just e -> case fromException e of             Just se -> StructuredFail se@@ -119,12 +117,14 @@   let emit :: Object -> IO ()       emit o = withMVar outputLock \() ->         hPutStrLn h $ encode o-  pure $-    EventBackend-      { newEvent = \sel -> do-          let (k, renderField) = renderSel sel-          newJSONEvent (emit . (k .=)) renderEx renderField-      }+      eb =+        EventBackend+          { newEvent = \(NewEventArgs {..}) -> do+              let (k, renderField) = renderSel newEventSelector+              newJSONEvent (emit . (k .=)) renderEx renderField newEventParent newEventCauses newEventInitialFields,+            emitImmediateEvent = fmap reference . newEvent eb+          }+  pure eb  -- | An 'EventBackend' which posts events to @stderr@ as JSON. --