mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

chore(users/Profpatsch/whatcd-resolver): slight changes

Browse source 
Change-Id: I57b0fcf9bd3953951dd0cffbee1fbfab5abbeb47
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11089
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2024-03-03 14:19:52 +01:00
parent de5790aba8
commit 9a7246ea1d
1 changed files with 51 additions and 61 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
View file

@ -7,8 +7,6 @@ module WhatcdResolver where
import Control.Category qualified as Cat
import Control.Monad.Catch.Pure (runCatch)
import Control.Monad.Error (catchError)
import Control.Monad.Except (runExcept)
import Control.Monad.Logger qualified as Logger
import Control.Monad.Logger.CallStack
import Control.Monad.Reader
@ -42,7 +40,6 @@ import Json.Enc qualified as Enc
import Label
import Multipart2 qualified as Multipart
import Network.HTTP.Client.Conduit qualified as Http
import Network.HTTP.Conduit qualified as Http
import Network.HTTP.Simple qualified as Http
import Network.HTTP.Types
import Network.HTTP.Types qualified as Http
@ -86,7 +83,7 @@ main =
<&> first showToError
>>= expectIOError "could not start whatcd-resolver"
htmlUi :: App ()
htmlUi :: AppT IO ()
htmlUi = do
let debug = True
withRunInIO $ \runInIO -> Warp.run 9092 $ \req respond -> do
@ -222,7 +219,7 @@ htmlUi = do
everySecond call extraData innerHtml = [hsx|<div hx-trigger="every 1s" hx-swap="outerHTML" hx-post={call} hx-vals={Enc.encToBytesUtf8 extraData}>{innerHtml}</div>|]
mainHtml span = runTransaction $ do
jsonld <- httpGetJsonLd span "https://musicbrainz.org/work/92000fd4-d304-406d-aeb4-6bdbeed318ec" <&> renderJsonld
-- jsonld <- httpGetJsonLd span "https://musicbrainz.org/work/92000fd4-d304-406d-aeb4-6bdbeed318ec" <&> renderJsonld
bestTorrentsTable <- getBestTorrentsTable
-- transmissionTorrentsTable <- lift @Transaction getTransmissionTorrentsTable
pure $
@ -243,7 +240,7 @@ htmlUi = do
</style>
</head>
<body>
{jsonld}
{""::Text {-jsonld-}}
<form
hx-post="/snips/redacted/search"
hx-target="#redacted-search-results">
@ -1512,8 +1509,6 @@ data Context = Context
newtype AppT m a = AppT {unAppT :: ReaderT Context m a}
deriving newtype (Functor, Applicative, Monad, MonadIO, MonadUnliftIO, MonadThrow)
type App a = AppT IO a
data AppException = AppException Text
deriving stock (Show)
deriving anyclass (Exception)
@ -1594,8 +1589,3 @@ runPGTransaction (Transaction transaction) = do
withRunInIO $ \unliftIO ->
withPGTransaction pool $ \conn -> do
unliftIO $ runReaderT transaction conn
data HasQueryParams param
= HasNoParams
| HasSingleParam param
| HasMultiParams [param]