Add html key for catalog fetch count

This commit is contained in:
towards-a-new-leftypol 2024-01-14 21:54:52 -05:00
parent 9b72d2fbe4
commit 77a319fa8e
3 changed files with 22 additions and 7 deletions

View File

@ -2,7 +2,8 @@
<html>
<head>
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<meta name="postgrest-root" content="http://localhost:3000">
<meta name="postgrest-root" content="http://10.4.0.96:3000">
<meta name="postgrest-fetch-count" content="1000">
<title>Chandlr</title>
<script language="javascript" src="./dist/build/chandlr/chandlr.jsexe/rts.js"></script>
<script language="javascript" src="./dist/build/chandlr/chandlr.jsexe/lib.js"></script>

View File

@ -28,7 +28,7 @@ import Miso
--, MisoString (..)
)
import GHCJS.DOM (currentDocument)
import GHCJS.DOM.Types (toJSString, Element, JSString)
import GHCJS.DOM.Types (toJSString, fromJSString, Element, JSString)
import GHCJS.DOM.ParentNode (querySelector)
import GHCJS.DOM.Element (getAttribute)
import Servant.API
@ -60,10 +60,16 @@ initialActionFromRoute model uri = either (const NoAction) id routing_result
h_thread board website board_thread_id _ = GetThread {..}
initialModel :: JSString -> Model
initialModel pgroot = Model
initialModel
:: JSString
-> Int
-> Model
initialModel pgroot client_fetch_count = Model
{ gridModel = Grid.initialModel
, clientModel = Client.Model { Client.pgApiRoot = pgroot }
, clientModel = Client.Model
{ Client.pgApiRoot = pgroot
, Client.fetchCount = client_fetch_count
}
}
getMetadata :: String -> IO (Maybe JSString)
@ -90,7 +96,10 @@ main = do
return . maybe "http://localhost:2000" id
consoleLog pg_api_root
let initial_model = initialModel pg_api_root
pg_fetch_count <- getMetadata "postgrest-fetch-count" >>=
return . maybe 1000 (read . fromJSString)
let initial_model = initialModel pg_api_root pg_fetch_count
startApp App
{ model = initial_model

View File

@ -39,6 +39,7 @@ data Interface a = Interface
data Model = Model
{ pgApiRoot :: JSString
, fetchCount :: Int
} deriving Eq
@ -65,5 +66,9 @@ fetchLatest m iface = do
((pgApiRoot m) <> ("/rpc/fetch_catalog" :: JSString))
Http.POST
[("Content-Type", "application/json")]
(Just $ FetchCatalogArgs { max_time = ct, max_row_read = 1000 })
( Just $ FetchCatalogArgs
{ max_time = ct
, max_row_read = fetchCount m
}
)
>>= return . (passAction iface) . Connect