From 046929181155ee078cd507c7b908cbb5f5cd4c17 Mon Sep 17 00:00:00 2001 From: Amitai Burstein Date: Tue, 23 Jul 2024 17:26:02 +0300 Subject: [PATCH] Add News record --- Application/Helper/Elasticsearch.hs | 59 +++++++++++++++++++++++++++++ Application/Schema.sql | 5 ++- Web/Controller/News.hs | 55 +++++++++++++++++++++++++++ Web/FrontController.hs | 2 + Web/Routes.hs | 3 ++ Web/Types.hs | 10 +++++ Web/View/News/Edit.hs | 23 +++++++++++ Web/View/News/Index.hs | 39 +++++++++++++++++++ Web/View/News/New.hs | 23 +++++++++++ Web/View/News/Show.hs | 17 +++++++++ 10 files changed, 234 insertions(+), 2 deletions(-) create mode 100644 Application/Helper/Elasticsearch.hs create mode 100644 Web/Controller/News.hs create mode 100644 Web/View/News/Edit.hs create mode 100644 Web/View/News/Index.hs create mode 100644 Web/View/News/New.hs create mode 100644 Web/View/News/Show.hs diff --git a/Application/Helper/Elasticsearch.hs b/Application/Helper/Elasticsearch.hs new file mode 100644 index 0000000..ea40206 --- /dev/null +++ b/Application/Helper/Elasticsearch.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Application.Helper.Elasticsearch where + +import IHP.Prelude +import IHP.ModelSupport +import Database.Bloodhound +import Network.HTTP.Client +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Aeson +import IHP.ControllerPrelude + +import Generated.Types + +-- Make News an instance of ToJSON to allow serialization +instance ToJSON News where + toJSON news = object + [ "id" .= (show news.id) + , "title" .= news.title + , "body" .= news.body + -- Add other fields as necessary + ] + +-- Initialize Elasticsearch connection +initES :: (?context :: ControllerContext) => IO BHEnv +initES = do + let server = ?context.frameworkConfig.esServer + manager <- newManager defaultManagerSettings + return $ mkBHEnv server manager + +-- Index a news item in Elasticsearch +indexNews :: (?modelContext :: ModelContext, ?context :: ControllerContext) => News -> IO (Either BHError IndexResponse) +indexNews news = do + bhenv <- initES + let indexName = IndexName "news_index" + docId = DocId $ T.pack $ "news_" <> show news.id + runBH bhenv $ indexDocument indexName (MappingName "document") (toJSON news) docId + +-- Search for news +searchNews :: (?modelContext :: ModelContext, ?context :: ControllerContext) => Text -> IO [SearchResult Value] +searchNews query = do + bhenv <- initES + let indexName = IndexName "news_index" + searchQuery = MultiMatchQuery ["title", "body"] (TE.encodeUtf8 query) + search = mkSearch (Just searchQuery) Nothing + result <- runBH bhenv $ searchByIndex indexName search + case result of + Left err -> do + putStrLn $ "Error: " ++ show err + return [] + Right searchResult -> return $ hits $ searchHits searchResult + +-- Helper function to use in your controllers +searchNewsHandler :: (?modelContext :: ModelContext, ?context :: ControllerContext) => Text -> IO [News] +searchNewsHandler query = do + results <- searchNews query + return $ mapMaybe (decode . encode . sourceAsJSON) results \ No newline at end of file diff --git a/Application/Schema.sql b/Application/Schema.sql index fa96c87..54f26c1 100644 --- a/Application/Schema.sql +++ b/Application/Schema.sql @@ -5,7 +5,6 @@ BEGIN END; $$ language plpgsql; -- Your database schema. Use the Schema Designer at http://localhost:8001/ to add some tables. - CREATE TABLE users ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, email TEXT NOT NULL, @@ -13,7 +12,6 @@ CREATE TABLE users ( locked_at TIMESTAMP WITH TIME ZONE DEFAULT NULL, failed_login_attempts INT DEFAULT 0 NOT NULL ); - CREATE TABLE landing_pages ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, @@ -40,6 +38,9 @@ CREATE TABLE paragraph_ctas ( ); CREATE INDEX paragraph_quotes_landing_page_id_index ON paragraph_quotes (landing_page_id); CREATE INDEX paragraph_ctas_landing_page_id_index ON paragraph_ctas (landing_page_id); +CREATE TABLE news ( + id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL +); ALTER TABLE paragraph_ctas ADD CONSTRAINT paragraph_ctas_ref_landing_page_id FOREIGN KEY (landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION; ALTER TABLE paragraph_ctas ADD CONSTRAINT paragraph_ctas_ref_ref_landing_page_id FOREIGN KEY (ref_landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION; ALTER TABLE paragraph_quotes ADD CONSTRAINT paragraph_quotes_ref_landing_page_id FOREIGN KEY (landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION; diff --git a/Web/Controller/News.hs b/Web/Controller/News.hs new file mode 100644 index 0000000..8509bfc --- /dev/null +++ b/Web/Controller/News.hs @@ -0,0 +1,55 @@ +module Web.Controller.News where + +import Web.Controller.Prelude +import Web.View.News.Index +import Web.View.News.New +import Web.View.News.Edit +import Web.View.News.Show + +instance Controller NewsController where + action NewsAction = do + news <- query @News |> fetch + render IndexView { .. } + + action NewNewsAction = do + let news = newRecord + render NewView { .. } + + action ShowNewsAction { newsId } = do + news <- fetch newsId + render ShowView { .. } + + action EditNewsAction { newsId } = do + news <- fetch newsId + render EditView { .. } + + action UpdateNewsAction { newsId } = do + news <- fetch newsId + news + |> buildNews + |> ifValid \case + Left news -> render EditView { .. } + Right news -> do + news <- news |> updateRecord + setSuccessMessage "News updated" + redirectTo EditNewsAction { .. } + + action CreateNewsAction = do + let news = newRecord @News + news + |> buildNews + |> ifValid \case + Left news -> render NewView { .. } + Right news -> do + news <- news |> createRecord + setSuccessMessage "News created" + redirectTo NewsAction + + action DeleteNewsAction { newsId } = do + news <- fetch newsId + deleteRecord news + setSuccessMessage "News deleted" + redirectTo NewsAction + +buildNews news = news + |> fill @'[] diff --git a/Web/FrontController.hs b/Web/FrontController.hs index 41ec05f..05afd4b 100644 --- a/Web/FrontController.hs +++ b/Web/FrontController.hs @@ -6,6 +6,7 @@ import Web.View.Layout (defaultLayout) -- Controller Imports +import Web.Controller.News import Web.Controller.StyleGuide import Web.Controller.Users import Web.Controller.ImageStyle @@ -20,6 +21,7 @@ instance FrontController WebApplication where controllers = [ startPage LandingPagesAction -- Generator Marker + , parseRoute @NewsController , parseRoute @StyleGuideController , parseRoute @UsersController , parseRoute @ImageStyleController diff --git a/Web/Routes.hs b/Web/Routes.hs index 0bd133d..e8936a0 100644 --- a/Web/Routes.hs +++ b/Web/Routes.hs @@ -23,3 +23,6 @@ instance AutoRoute UsersController instance AutoRoute StyleGuideController + +instance AutoRoute NewsController + diff --git a/Web/Types.hs b/Web/Types.hs index 5878b64..6360adc 100644 --- a/Web/Types.hs +++ b/Web/Types.hs @@ -93,3 +93,13 @@ data UsersController data StyleGuideController = StyleGuideAction deriving (Eq, Show, Data) + +data NewsController + = NewsAction + | NewNewsAction + | ShowNewsAction { newsId :: !(Id News) } + | CreateNewsAction + | EditNewsAction { newsId :: !(Id News) } + | UpdateNewsAction { newsId :: !(Id News) } + | DeleteNewsAction { newsId :: !(Id News) } + deriving (Eq, Show, Data) diff --git a/Web/View/News/Edit.hs b/Web/View/News/Edit.hs new file mode 100644 index 0000000..874bac4 --- /dev/null +++ b/Web/View/News/Edit.hs @@ -0,0 +1,23 @@ +module Web.View.News.Edit where +import Web.View.Prelude + +data EditView = EditView { news :: News } + +instance View EditView where + html EditView { .. } = [hsx| + {breadcrumb} +

Edit News

+ {renderForm news} + |] + where + breadcrumb = renderBreadcrumb + [ breadcrumbLink "News" NewsAction + , breadcrumbText "Edit News" + ] + +renderForm :: News -> Html +renderForm news = formFor news [hsx| + + {submitButton} + +|] \ No newline at end of file diff --git a/Web/View/News/Index.hs b/Web/View/News/Index.hs new file mode 100644 index 0000000..db45d38 --- /dev/null +++ b/Web/View/News/Index.hs @@ -0,0 +1,39 @@ +module Web.View.News.Index where +import Web.View.Prelude + +data IndexView = IndexView { news :: [News] } + +instance View IndexView where + html IndexView { .. } = [hsx| + {breadcrumb} + +

Index+ New

+
+ + + + + + + + + + {forEach news renderNews} +
News
+ +
+ |] + where + breadcrumb = renderBreadcrumb + [ breadcrumbLink "News" NewsAction + ] + +renderNews :: News -> Html +renderNews news = [hsx| + + {news} + Show + Edit + Delete + +|] \ No newline at end of file diff --git a/Web/View/News/New.hs b/Web/View/News/New.hs new file mode 100644 index 0000000..8c8b630 --- /dev/null +++ b/Web/View/News/New.hs @@ -0,0 +1,23 @@ +module Web.View.News.New where +import Web.View.Prelude + +data NewView = NewView { news :: News } + +instance View NewView where + html NewView { .. } = [hsx| + {breadcrumb} +

New News

+ {renderForm news} + |] + where + breadcrumb = renderBreadcrumb + [ breadcrumbLink "News" NewsAction + , breadcrumbText "New News" + ] + +renderForm :: News -> Html +renderForm news = formFor news [hsx| + + {submitButton} + +|] \ No newline at end of file diff --git a/Web/View/News/Show.hs b/Web/View/News/Show.hs new file mode 100644 index 0000000..3b44537 --- /dev/null +++ b/Web/View/News/Show.hs @@ -0,0 +1,17 @@ +module Web.View.News.Show where +import Web.View.Prelude + +data ShowView = ShowView { news :: News } + +instance View ShowView where + html ShowView { .. } = [hsx| + {breadcrumb} +

Show News

+

{news}

+ + |] + where + breadcrumb = renderBreadcrumb + [ breadcrumbLink "News" NewsAction + , breadcrumbText "Show News" + ] \ No newline at end of file