-
Notifications
You must be signed in to change notification settings - Fork 2
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
10 changed files
with
234 additions
and
2 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 @'[] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -23,3 +23,6 @@ instance AutoRoute UsersController | |
|
||
instance AutoRoute StyleGuideController | ||
|
||
|
||
instance AutoRoute NewsController | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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} | ||
<h1>Edit News</h1> | ||
{renderForm news} | ||
|] | ||
where | ||
breadcrumb = renderBreadcrumb | ||
[ breadcrumbLink "News" NewsAction | ||
, breadcrumbText "Edit News" | ||
] | ||
|
||
renderForm :: News -> Html | ||
renderForm news = formFor news [hsx| | ||
|
||
{submitButton} | ||
|
||
|] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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} | ||
|
||
<h1>Index<a href={pathTo NewNewsAction} class="btn btn-primary ms-4">+ New</a></h1> | ||
<div class="table-responsive"> | ||
<table class="table"> | ||
<thead> | ||
<tr> | ||
<th>News</th> | ||
<th></th> | ||
<th></th> | ||
<th></th> | ||
</tr> | ||
</thead> | ||
<tbody>{forEach news renderNews}</tbody> | ||
</table> | ||
|
||
</div> | ||
|] | ||
where | ||
breadcrumb = renderBreadcrumb | ||
[ breadcrumbLink "News" NewsAction | ||
] | ||
|
||
renderNews :: News -> Html | ||
renderNews news = [hsx| | ||
<tr> | ||
<td>{news}</td> | ||
<td><a href={ShowNewsAction news.id}>Show</a></td> | ||
<td><a href={EditNewsAction news.id} class="text-muted">Edit</a></td> | ||
<td><a href={DeleteNewsAction news.id} class="js-delete text-muted">Delete</a></td> | ||
</tr> | ||
|] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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} | ||
<h1>New News</h1> | ||
{renderForm news} | ||
|] | ||
where | ||
breadcrumb = renderBreadcrumb | ||
[ breadcrumbLink "News" NewsAction | ||
, breadcrumbText "New News" | ||
] | ||
|
||
renderForm :: News -> Html | ||
renderForm news = formFor news [hsx| | ||
|
||
{submitButton} | ||
|
||
|] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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} | ||
<h1>Show News</h1> | ||
<p>{news}</p> | ||
|
||
|] | ||
where | ||
breadcrumb = renderBreadcrumb | ||
[ breadcrumbLink "News" NewsAction | ||
, breadcrumbText "Show News" | ||
] |