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.Category qualified as Cat
import Control.Monad.Catch.Pure (runCatch) 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 qualified as Logger
import Control.Monad.Logger.CallStack import Control.Monad.Logger.CallStack
import Control.Monad.Reader import Control.Monad.Reader
@ -42,7 +40,6 @@ import Json.Enc qualified as Enc
import Label import Label
import Multipart2 qualified as Multipart import Multipart2 qualified as Multipart
import Network.HTTP.Client.Conduit qualified as Http 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.Simple qualified as Http
import Network.HTTP.Types import Network.HTTP.Types
import Network.HTTP.Types qualified as Http import Network.HTTP.Types qualified as Http
@ -86,7 +83,7 @@ main =
<&> first showToError <&> first showToError
>>= expectIOError "could not start whatcd-resolver" >>= expectIOError "could not start whatcd-resolver"
htmlUi :: App () htmlUi :: AppT IO ()
htmlUi = do htmlUi = do
let debug = True let debug = True
withRunInIO $ \runInIO -> Warp.run 9092 $ \req respond -> do 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>|] 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 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 bestTorrentsTable <- getBestTorrentsTable
-- transmissionTorrentsTable <- lift @Transaction getTransmissionTorrentsTable -- transmissionTorrentsTable <- lift @Transaction getTransmissionTorrentsTable
pure $ pure $
@ -243,7 +240,7 @@ htmlUi = do
</style> </style>
</head> </head>
<body> <body>
{jsonld} {""::Text {-jsonld-}}
<form <form
hx-post="/snips/redacted/search" hx-post="/snips/redacted/search"
hx-target="#redacted-search-results"> hx-target="#redacted-search-results">
@ -1512,8 +1509,6 @@ data Context = Context
newtype AppT m a = AppT {unAppT :: ReaderT Context m a} newtype AppT m a = AppT {unAppT :: ReaderT Context m a}
deriving newtype (Functor, Applicative, Monad, MonadIO, MonadUnliftIO, MonadThrow) deriving newtype (Functor, Applicative, Monad, MonadIO, MonadUnliftIO, MonadThrow)
type App a = AppT IO a
data AppException = AppException Text data AppException = AppException Text
deriving stock (Show) deriving stock (Show)
deriving anyclass (Exception) deriving anyclass (Exception)
@ -1594,8 +1589,3 @@ runPGTransaction (Transaction transaction) = do
withRunInIO $ \unliftIO -> withRunInIO $ \unliftIO ->
withPGTransaction pool $ \conn -> do withPGTransaction pool $ \conn -> do
unliftIO $ runReaderT transaction conn unliftIO $ runReaderT transaction conn
data HasQueryParams param
= HasNoParams
| HasSingleParam param
| HasMultiParams [param]