diff --git a/app/Common b/app/Common index b01e4e2..62a2358 160000 --- a/app/Common +++ b/app/Common @@ -1 +1 @@ -Subproject commit b01e4e269613fc0a69c9728a18a0bcdf1a0562a9 +Subproject commit 62a23581e786f8564653406845c4b2a07d73deb6 diff --git a/app/DataClient.hs b/app/DataClient.hs new file mode 100644 index 0000000..009c1f1 --- /dev/null +++ b/app/DataClient.hs @@ -0,0 +1,20 @@ +module DataClient +( fetchLatest +) +where + +import Common.Network.ClientTypes (Model (..)) +import Common.Network.HttpClient +( post +, HttpError +) + +fetchLatest :: Model -> UTCTime -> IO IO (Either HttpError [ CatalogPost ]) +fetchLatest m t iface = do + post settings "/rpc/fetch_catalog" payload False >>= return . eitherDecodeResponse + + where + payload = encode FetchCatalogArgs + { max_time = t + , max_row_read = fetchCount m + } diff --git a/app/Main.hs b/app/Main.hs index c831fef..20d0b15 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -19,11 +19,11 @@ import qualified Common.FrontEnd.Routes as FE import qualified Common.FrontEnd.Action as FE import qualified Common.FrontEnd.Model as FE -newtype HtmlPage a = HtmlPage a +newtype HtmlPage a = HtmlPage (FE.Model, a) instance (L.ToHtml a) => L.ToHtml (HtmlPage a) where toHtmlRaw = L.toHtml - toHtml (HtmlPage x) = L.toHtml x + toHtml (HtmlPage (_, x)) = L.toHtml x -- toHtml (HtmlPage x) = do -- L.doctype_ -- L.head_ $ do @@ -47,23 +47,7 @@ catalogView :: Handler (HtmlPage (View FE.Action)) catalogView = do liftIO $ putStrLn "Hello World" - pure $ HtmlPage $ h1_ [] [ text "Hello World" ] - -{- - return $ HtmlPage $ do - L.doctype_ - L.head_ $ do - L.title_ "Chandlr" - L.meta_ [L.charset_ "utf-8"] - - L.with (L.script_ mempty) - [ L.makeAttribute "src" "/static/all.js" - , L.makeAttribute "async" mempty - , L.makeAttribute "defer" mempty - ] - - L.body_ (L.h1_ "Hello World") --} + pure $ HtmlPage (undefined, h1_ [] [ text "Hello World" ]) threadView :: Text -> Text -> FE.BoardThreadId -> Handler (HtmlPage (View FE.Action)) threadView = undefined @@ -71,9 +55,6 @@ threadView = undefined searchView :: Maybe Text -> Handler (HtmlPage (View FE.Action)) searchView = undefined -viewPage :: FE.Model -> View FE.Action -viewPage = undefined - app :: Wai.Application app = serve (Proxy @FrontEndRoutes) handlers diff --git a/chandlr-server.cabal b/chandlr-server.cabal index bd466a3..b5759e2 100644 --- a/chandlr-server.cabal +++ b/chandlr-server.cabal @@ -66,6 +66,7 @@ executable chandlr-server Common.Component.Search.SearchTypes Common.FrontEnd.Action Common.FrontEnd.Routes + Common.FrontEnd.Model Common.Network.CatalogPostType Common.Network.ClientTypes Common.Network.HttpTypes @@ -88,6 +89,8 @@ executable chandlr-server Common.Parsing.PostPartType Common.Parsing.QuoteLinkParser Parsing.BodyParser + DataClient + Common.Server.JSONSettings -- LANGUAGE extensions used by modules in this package. -- other-extensions: @@ -106,7 +109,12 @@ executable chandlr-server containers, servant, servant-server, - lucid + lucid, + safe-exceptions, + bytestring, + http-conduit, + http-client, + http-types -- Directories containing source files. hs-source-dirs: app diff --git a/default.nix b/default.nix index c9019bc..714c2e8 100644 --- a/default.nix +++ b/default.nix @@ -1,7 +1,11 @@ { nixpkgs ? import {} }: let - drv = nixpkgs.haskell.packages.ghc96.callCabal2nix "chandlr-server" ./. {}; + http-conduit = import ./app/Common/nix-support/http-conduit.nix { inherit nixpkgs; }; + + drv = nixpkgs.haskellPackages.callCabal2nix "chandlr-server" ./. { + http-conduit = http-conduit.http-conduit; + }; env = drv.env.overrideAttrs (oldAttrs: { buildInputs = oldAttrs.buildInputs ++ [