refined search and made it globally accessible

This commit is contained in:
nek0 2015-10-17 20:03:29 +02:00
parent ee0ca0bf94
commit 77d6089588
7 changed files with 52 additions and 17 deletions

View file

@ -94,6 +94,17 @@ renderLayout widget = do
copyrightWidget <- widgetToPageContent $ copyrightWidget <- widgetToPageContent $
$(widgetFile "copyrightFooter") $(widgetFile "copyrightFooter")
searchWidget <- widgetToPageContent $ [whamlet|
<form action=@{SearchR} method=GET>
<input type="hidden" name="_hasdata">
<div .required>
<label for="hident2">
<input #hident2 type="search" autofocus="" required="" name="f1">
<script>
if (!('autofocus' in document.createElement('input'))) {document.getElementById('hident2').focus();}
<input value="Search" type="submit">
|]
wc <- widgetToPageContent widget wc <- widgetToPageContent widget
pc <- widgetToPageContent $ do pc <- widgetToPageContent $ do

View file

@ -7,6 +7,7 @@ import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import Database.Bloodhound import Database.Bloodhound
import Network.HTTP.Client (responseBody) import Network.HTTP.Client (responseBody)
import System.FilePath.Posix
getSearchR :: Handler Html getSearchR :: Handler Html
getSearchR = do getSearchR = do
@ -14,11 +15,11 @@ getSearchR = do
results <- results <-
case res of case res of
FormSuccess query -> do FormSuccess query -> do
r <- getResults query (ru, ra, rm, rc) <- getResults query
a <- return $ (decode (responseBody r) :: Maybe (SearchResult SearchUser)) a <- return $ (decode (responseBody ru) :: Maybe (SearchResult SearchUser))
b <- return $ (decode (responseBody r) :: Maybe (SearchResult SearchAlbum)) b <- return $ (decode (responseBody ra) :: Maybe (SearchResult SearchAlbum))
c <- return $ (decode (responseBody r) :: Maybe (SearchResult SearchMedium)) c <- return $ (decode (responseBody rm) :: Maybe (SearchResult SearchMedium))
d <- return $ (decode (responseBody r) :: Maybe (SearchResult SearchComment)) d <- return $ (decode (responseBody rc) :: Maybe (SearchResult SearchComment))
return $ Just (a, b, c, d) return $ Just (a, b, c, d)
_ -> return $ Nothing _ -> return $ Nothing
case results of case results of
@ -85,9 +86,14 @@ getSearchR = do
searchForm :: Form T.Text searchForm :: Form T.Text
searchForm = renderDivs $ areq (searchField True) "Search" Nothing searchForm = renderDivs $ areq (searchField True) "Search" Nothing
getResults :: Text -> Handler (Reply, Reply, Reply, Reply)
getResults query = do getResults query = do
let esQuery = QuerySimpleQueryStringQuery (SimpleQueryStringQuery (QueryString query) Nothing Nothing Nothing Nothing Nothing Nothing) let esQuery = QuerySimpleQueryStringQuery (SimpleQueryStringQuery (QueryString query) Nothing Nothing Nothing Nothing Nothing Nothing)
liftIO $ runBH' $ searchAll $ mkSearch (Just esQuery) Nothing su <- liftIO $ runBH' $ searchByIndex (IndexName "user") $ mkSearch (Just esQuery) Nothing
sa <- liftIO $ runBH' $ searchByIndex (IndexName "album") $ mkSearch (Just esQuery) Nothing
sm <- liftIO $ runBH' $ searchByIndex (IndexName "medium") $ mkSearch (Just esQuery) Nothing
sc <- liftIO $ runBH' $ searchByIndex (IndexName "comment") $ mkSearch (Just esQuery) Nothing
return (su, sa, sm, sc)
data SearchUser = SearchUser data SearchUser = SearchUser
{ suName :: T.Text { suName :: T.Text

View file

@ -262,7 +262,7 @@ deleteIndexES input = do
runBH' $ deleteDocument (IndexName "comment") (MappingName "comment") (DocId $ extractKey cId) runBH' $ deleteDocument (IndexName "comment") (MappingName "comment") (DocId $ extractKey cId)
case statusCode (responseStatus resp) of case statusCode (responseStatus resp) of
201 -> return () 201 -> return ()
-- 200 -> return () 200 -> return ()
_ -> error $ C.unpack $ BL.toStrict $ responseBody resp _ -> error $ C.unpack $ BL.toStrict $ responseBody resp
runBH' action = do runBH' action = do

View file

@ -219,11 +219,22 @@
padding: 1em 2em; padding: 1em 2em;
} }
#user-nav
{
display: inline-block;
}
nav li nav li
{ {
display: inline-block; display: inline-block;
} }
#search
{
display: inline-block;
float: right;
}
.comment .comment
{ {
border: 5px solid rgb(255, 255, 255); border: 5px solid rgb(255, 255, 255);

View file

@ -17,6 +17,8 @@
$if block == False $if block == False
<li> <li>
<a href=@{SignupR}>Signup <a href=@{SignupR}>Signup
<div #search .right>
^{pageBody searchWidget}
$maybe msg <- mmsg $maybe msg <- mmsg
<div #message>#{msg} <div #message>#{msg}

View file

@ -18,7 +18,7 @@ $forall (Entity albumId album) <- userAlbs
<a href=@{AlbumR albumId}> <a href=@{AlbumR albumId}>
<figure class="thumbnail"> <figure class="thumbnail">
$if (albumSamplePic album) == Nothing $if (albumSamplePic album) == Nothing
<img src=@{StaticR img_album_jpg}> <img src=@{StaticR img_album_jpg} title=#{albumTitle album}>
$else $else
<img src=@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ fromJust $ albumSamplePic album) []} title=#{albumTitle album}> <img src=@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ fromJust $ albumSamplePic album) []} title=#{albumTitle album}>
<figcaption>#{albumTitle album} <figcaption>#{albumTitle album}

View file

@ -26,20 +26,25 @@ $else
<h1> <h1>
Results in Albums: Results in Albums:
$forall (Entity aId album) <- albumList $forall (Entity aId album) <- albumList
<div #header .item data-width="400"> <article .item data-width="#{albumSampleWidth album}">
<div .inner> <a href=@{AlbumR aId}>
<a href=@{AlbumR aId}> <figure .thumbnail>
#{albumTitle album} $if (albumSamplePic album) == Nothing
<img src=@{StaticR img_album_jpg} title=#{albumTitle album}>
$else
<img src=@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ fromJust $ albumSamplePic album) []} title=#{albumTitle album}>
<figcaption>#{albumTitle album}
$if not $ null mediumList $if not $ null mediumList
<div #header .item data-width="400"> <article #header .item data-width="400">
<div .inner> <div .inner>
<h1> <h1>
Results in Media: Results in Media:
$forall (Entity mId medium) <- mediumList $forall (Entity mId medium) <- mediumList
<div #header .item data-width="400"> <article .item data-width="#{mediumThumbWidth medium}">
<div .inner> <a href=@{MediumR mId}>
<a href=@{MediumR mId}> <figure .thumbnail>
#{mediumTitle medium} <img src=@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumThumb medium) []} title=#{mediumTitle medium}>
<figcaption>#{mediumTitle medium}
$if not $ null commentList $if not $ null commentList
<div #header .item data-width="400"> <div #header .item data-width="400">
<div .inner> <div .inner>