diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs index 040aa5340..ab4e2a4d9 100644 --- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs +++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs @@ -7,6 +7,8 @@ import AppT import Arg import Builder import Comparison +import Conduit (ConduitT) +import Conduit qualified import Control.Category qualified as Cat import Control.Monad.Catch.Pure (runCatch) import Control.Monad.Logger.CallStack @@ -15,6 +17,7 @@ import Data.Aeson qualified as Json import Data.Aeson.BetterErrors qualified as Json import Data.Aeson.KeyMap qualified as KeyMap import Data.CaseInsensitive (CI) +import Data.Conduit ((.|)) import Data.Error.Tree import Data.HashMap.Strict qualified as HashMap import Data.List qualified as List @@ -68,6 +71,8 @@ import Text.Blaze.Html5 qualified as Html import Tool (readTool, readTools) import Transmission import UnliftIO hiding (Handler) +import UnliftIO.Async qualified as Async +import UnliftIO.Concurrent (threadDelay) import Prelude hiding (span) main :: IO () @@ -93,6 +98,8 @@ htmlUi = do () (Dec.fromField @Text) + (counterHtmlM, counterHandler, _counterAsync) <- testCounter (label @"endpoint" "counter") + withRunInIO $ \runInIO -> Warp.run 9093 $ \req respondOrig -> do let catchAppException act = try act >>= \case @@ -123,7 +130,11 @@ htmlUi = do let handlers :: Handlers (AppT IO) handlers = Map.fromList - [ ("", Html (mainHtml uniqueRunId)), + [ ( "", + Html $ \span -> do + counterHtml <- counterHtmlM + mainHtml counterHtml uniqueRunId span + ), ( "snips/redacted/search", Html $ \span -> do @@ -237,6 +248,7 @@ htmlUi = do pure $ renderJsonld jsonld ) ), + ("counter", counterHandler), ( "settings", PostAndRedirect ( do @@ -301,7 +313,10 @@ htmlUi = do ] runInIO $ runHandlers - (Html $ mainHtml uniqueRunId) + ( Html $ \span -> do + counterHtml <- counterHtmlM + mainHtml counterHtml uniqueRunId span + ) handlers req respondOrig @@ -309,8 +324,8 @@ htmlUi = do everySecond :: Text -> Enc -> Html -> Html everySecond call extraData innerHtml = [hsx|