From fa0b7d08040771ef7079f423c024fa446b62a230 Mon Sep 17 00:00:00 2001 From: Profpatsch Date: Thu, 29 Jun 2023 14:33:26 +0200 Subject: feat(users/Profpatsch/whatcd-resolver): Remove dynatable In favor of all-server-side rendering. Change-Id: I439c31cc6184cd1f6f77843819eebfb396e0ace8 Reviewed-on: https://cl.tvl.fyi/c/depot/+/8872 Reviewed-by: Profpatsch Tested-by: BuildkiteCI --- .../whatcd-resolver/src/WhatcdResolver.hs | 91 +++++----------------- 1 file changed, 20 insertions(+), 71 deletions(-) (limited to 'users/Profpatsch/whatcd-resolver') diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs index c33ddd62d6ca..d3b02e2280a6 100644 --- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs +++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs @@ -46,10 +46,9 @@ import System.Directory qualified as Dir import System.Directory qualified as Xdg import System.FilePath (()) import System.IO qualified as IO -import Text.Blaze.Html (Html, (!)) +import Text.Blaze.Html (Html) import Text.Blaze.Html.Renderer.Utf8 qualified as Html import Text.Blaze.Html5 qualified as Html -import Text.Blaze.Html5.Attributes qualified as Attr import UnliftIO htmlUi :: App () @@ -84,71 +83,17 @@ htmlUi = do mkVal <$> (runTransaction $ getTorrentById dat) _ -> h mainHtml where - tableData = - ( [ "Group ID", - "Torrent ID", - "Artist", - "Name", - "Weight", - "Torrent" - ], - \t -> - [ Enc.int t.groupId, - Enc.int t.torrentId, - Enc.text t.torrentGroupJson.artist, - Enc.text t.torrentGroupJson.groupName, - Enc.int t.seedingWeight, - Enc.value t.torrentJson - ] - ) - - mkTable :: ([Text], t -> [Enc]) -> [t] -> Html - mkTable f ts = do - let headers = Html.thead (fst f <&> Html.toHtml @Text <&> Html.th & mconcat) - let keys = fst f <&> Text.toLower <&> Text.replace " " "_" - let json = Enc.list (\t -> Enc.object (zip keys (t & snd f))) ts - let tableDataScript = - Html.script - ! Attr.type_ "application/json" - ! Attr.id "table-data" - $ (json & Enc.encToBytesUtf8 & bytesToTextUtf8Unsafe & Html.text) - [hsx| - {tableDataScript} - - {headers} - - -

- - |] - mainHtml = runTransaction $ do - bestTorrents <- getBestTorrents + bestTorrentsTable <- getBestTorrentsTable pure $ Html.docTypeHtml [hsx| - - - + - -

- {mkTable tableData bestTorrents} +

+ {bestTorrentsTable} +

|] snipsSong = todo @@ -170,9 +116,9 @@ htmlUi = do snipsRedactedSearch :: ( MonadLogger m, MonadIO m, - MonadThrow m, MonadPostgres m, - HasField "searchstr" r ByteString + HasField "searchstr" r ByteString, + MonadThrow m ) => r -> m Html @@ -181,9 +127,13 @@ snipsRedactedSearch dat = do redactedSearchAndInsert [ ("searchstr", dat.searchstr) ] - best :: [TorrentData] <- runTransaction $ do + runTransaction $ do t - getBestTorrents + getBestTorrentsTable + +getBestTorrentsTable :: (MonadPostgres m) => Transaction m Html +getBestTorrentsTable = do + best :: [TorrentData] <- getBestTorrents let bestRows = best & foldMap @@ -194,7 +144,7 @@ snipsRedactedSearch dat = do {Html.toHtml @Text b.torrentGroupJson.artist} {Html.toHtml @Text b.torrentGroupJson.groupName} {Html.toHtml @Int b.seedingWeight} -

|] ) @@ -410,14 +360,13 @@ bla = do pure (t1 >> t2 >> t3) redactedSearchAndInsert :: - ( MonadLogger m1, - MonadIO m1, - MonadThrow m1, - MonadPostgres m2, - MonadThrow m2 + ( MonadLogger m, + MonadIO m, + MonadPostgres m, + MonadThrow m ) => [(ByteString, ByteString)] -> - m1 (Transaction m2 ()) + m (Transaction m ()) redactedSearchAndInsert x = redactedSearch x -- cgit 1.4.1