search repopulation also not needed

This commit is contained in:
nek0 2016-09-04 19:56:36 +02:00
parent c95a77e644
commit e42d5aa465
8 changed files with 201 additions and 197 deletions

View file

@ -68,7 +68,7 @@ import Handler.AdminMediumSettings
import Handler.AdminComments import Handler.AdminComments
import Handler.Tag import Handler.Tag
import Handler.RootFeed import Handler.RootFeed
import Handler.Search -- import Handler.Search
-- This line actually creates our YesodDispatch instance. It is the second half -- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

View file

@ -101,16 +101,16 @@ renderLayout widget = do
copyrightWidget <- widgetToPageContent $ copyrightWidget <- widgetToPageContent $
$(widgetFile "copyrightFooter") $(widgetFile "copyrightFooter")
searchWidget <- widgetToPageContent $ [whamlet| -- searchWidget <- widgetToPageContent $ [whamlet|
<form action=@{SearchR} method=GET> -- <form action=@{SearchR} method=GET>
<input type="hidden" name="_hasdata"> -- <input type="hidden" name="_hasdata">
<div .input-group .required> -- <div .input-group .required>
<input #hident2 .form-control type="text" autofocus="" required="" name="f1" placeholder="Search for ..."> -- <input #hident2 .form-control type="text" autofocus="" required="" name="f1" placeholder="Search for ...">
<span .input-group-btn> -- <span .input-group-btn>
<button .btn .btn-default type="submit">Go! -- <button .btn .btn-default type="submit">Go!
<script> -- <script>
if (!('autofocus' in document.createElement('input'))) {document.getElementById('hident2').focus();} -- if (!('autofocus' in document.createElement('input'))) {document.getElementById('hident2').focus();}
|] -- |]
wc <- widgetToPageContent widget wc <- widgetToPageContent widget

View file

@ -18,7 +18,7 @@ module Handler.Admin where
import Import import Import
import Handler.Commons import Handler.Commons
import Database.Bloodhound -- import Database.Bloodhound
getAdminR :: Handler Html getAdminR :: Handler Html
getAdminR = do getAdminR = do
@ -32,22 +32,22 @@ getAdminR = do
setMessage errorMsg setMessage errorMsg
redirect route redirect route
getAdminSearchReloadR :: Handler Html -- getAdminSearchReloadR :: Handler Html
getAdminSearchReloadR = do -- getAdminSearchReloadR = do
adminCheck <- loginIsAdmin -- adminCheck <- loginIsAdmin
case adminCheck of -- case adminCheck of
Right _ -> do -- Right _ -> do
_ <- runBH' $ deleteIndex $ IndexName "_all" -- _ <- runBH' $ deleteIndex $ IndexName "_all"
users <- runDB $ selectList [] [Asc UserId] -- users <- runDB $ selectList [] [Asc UserId]
albums <- runDB $ selectList [] [Asc AlbumId] -- albums <- runDB $ selectList [] [Asc AlbumId]
media <- runDB $ selectList [] [Asc MediumId] -- media <- runDB $ selectList [] [Asc MediumId]
comments <- runDB $ selectList [] [Asc CommentId] -- comments <- runDB $ selectList [] [Asc CommentId]
mapM_ (\ u -> putIndexES $ ESUser (entityKey u) (entityVal u)) users -- mapM_ (\ u -> putIndexES $ ESUser (entityKey u) (entityVal u)) users
mapM_ (\ u -> putIndexES $ ESAlbum (entityKey u) (entityVal u)) albums -- mapM_ (\ u -> putIndexES $ ESAlbum (entityKey u) (entityVal u)) albums
mapM_ (\ u -> putIndexES $ ESMedium (entityKey u) (entityVal u)) media -- mapM_ (\ u -> putIndexES $ ESMedium (entityKey u) (entityVal u)) media
mapM_ (\ u -> putIndexES $ ESComment (entityKey u) (entityVal u)) comments -- mapM_ (\ u -> putIndexES $ ESComment (entityKey u) (entityVal u)) comments
setMessage "search indices repopulated" -- setMessage "search indices repopulated"
redirect AdminR -- redirect AdminR
Left (msg, route) -> do -- Left (msg, route) -> do
setMessage msg -- setMessage msg
redirect route -- redirect route

View file

@ -14,165 +14,169 @@
-- You should have received a copy of the GNU Affero General Public License -- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>. -- along with this program. If not, see <http://www.gnu.org/licenses/>.
module Handler.Search where
import Import -- MODULE DISABLED DUE TO UNFUNCTIONALITY! REWRITE IMMINENT!!!
import Handler.Commons
import Data.Time.Clock
import Data.Aeson
import Data.Maybe
import qualified Data.Text as T
import Database.Bloodhound
import Network.HTTP.Client (responseBody)
import System.FilePath.Posix
import Debug.Trace
getSearchR :: Handler Html -- module Handler.Search where
getSearchR = do --
((res, widget), _) <- runFormGet searchForm -- import Import
case res of -- import Handler.Commons
FormSuccess query -> do -- import Data.Time.Clock
(ru, ra, rm, rc) <- getResults query -- import Data.Aeson
liftIO $ traceIO $ show (ru, ra, rm, rc) -- import Data.Maybe
let a = decode (responseBody ru) :: Maybe (SearchResult SearchUser) -- import qualified Data.Text as T
let b = decode (responseBody ra) :: Maybe (SearchResult SearchAlbum) -- import Database.Bloodhound
let c = decode (responseBody rm) :: Maybe (SearchResult SearchMedium) -- import Network.HTTP.Client (responseBody)
let d = decode (responseBody rc) :: Maybe (SearchResult SearchComment) -- import System.FilePath.Posix
liftIO $ traceIO $ show (a,b,c,d) --
let hitListA = case a of { -- import Debug.Trace
Just as -> hits $ searchHits as; --
Nothing -> []} -- getSearchR :: Handler Html
let hitListB = case b of { -- getSearchR = do
Just bs -> hits $ searchHits bs; -- ((res, widget), _) <- runFormGet searchForm
Nothing -> []} -- case res of
let hitListC = case c of { -- FormSuccess query -> do
Just cs -> hits $ searchHits cs; -- (ru, ra, rm, rc) <- getResults query
Nothing -> []} -- liftIO $ traceIO $ show (ru, ra, rm, rc)
let hitListD = case d of { -- let a = decode (responseBody ru) :: Maybe (SearchResult SearchUser)
Just ds -> hits $ searchHits ds; -- let b = decode (responseBody ra) :: Maybe (SearchResult SearchAlbum)
Nothing -> []} -- let c = decode (responseBody rm) :: Maybe (SearchResult SearchMedium)
userIdList <- return $ mapMaybe (\h -> do -- let d = decode (responseBody rc) :: Maybe (SearchResult SearchComment)
if -- liftIO $ traceIO $ show (a,b,c,d)
hitIndex h == IndexName "user" -- let hitListA = case a of {
then do -- Just as -> hits $ searchHits as;
DocId theId <- return $ hitDocId h -- Nothing -> []}
Just $ (packKey theId :: UserId) -- let hitListB = case b of {
else -- Just bs -> hits $ searchHits bs;
Nothing -- Nothing -> []}
) hitListA -- let hitListC = case c of {
albumIdList <- return $ mapMaybe (\h -> do -- Just cs -> hits $ searchHits cs;
if -- Nothing -> []}
hitIndex h == IndexName "album" -- let hitListD = case d of {
then do -- Just ds -> hits $ searchHits ds;
DocId theId <- return $ hitDocId h -- Nothing -> []}
Just $ (packKey theId :: AlbumId) -- userIdList <- return $ mapMaybe (\h -> do
else -- if
Nothing -- hitIndex h == IndexName "user"
) hitListB -- then do
mediumIdList <- return $ mapMaybe (\h -> do -- DocId theId <- return $ hitDocId h
if -- Just $ (packKey theId :: UserId)
hitIndex h == IndexName "medium" -- else
then do -- Nothing
DocId theId <- return $ hitDocId h -- ) hitListA
Just $ (packKey theId :: MediumId) -- albumIdList <- return $ mapMaybe (\h -> do
else -- if
Nothing -- hitIndex h == IndexName "album"
) hitListC -- then do
commentIdList <- return $ mapMaybe (\h -> do -- DocId theId <- return $ hitDocId h
if -- Just $ (packKey theId :: AlbumId)
hitIndex h == IndexName "comment" -- else
then do -- Nothing
DocId theId <- return $ hitDocId h -- ) hitListB
Just $ (packKey theId :: CommentId) -- mediumIdList <- return $ mapMaybe (\h -> do
else -- if
Nothing -- hitIndex h == IndexName "medium"
) hitListD -- then do
liftIO $ traceIO $ show (userIdList, albumIdList, mediumIdList, commentIdList) -- DocId theId <- return $ hitDocId h
userList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [UserId ==. i] []) userIdList -- Just $ (packKey theId :: MediumId)
albumList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [AlbumId ==. i] []) albumIdList -- else
mediumList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [MediumId ==. i] []) mediumIdList -- Nothing
commentList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [CommentId ==. i] []) commentIdList -- ) hitListC
let allEmpty = (null userList) && (null albumList) && (null mediumList) && (null commentList) -- commentIdList <- return $ mapMaybe (\h -> do
defaultLayout $ do -- if
setTitle $ toHtml $ "Eidolon :: Search results for " ++ (T.unpack query) -- hitIndex h == IndexName "comment"
$(widgetFile "result") -- then do
_ -> -- DocId theId <- return $ hitDocId h
defaultLayout $ do -- Just $ (packKey theId :: CommentId)
setTitle "Eidolon :: Search" -- else
$(widgetFile "search") -- Nothing
-- ) hitListD
searchForm :: Form T.Text -- liftIO $ traceIO $ show (userIdList, albumIdList, mediumIdList, commentIdList)
searchForm = renderDivs $ areq (searchField True) "Search" Nothing -- userList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [UserId ==. i] []) userIdList
-- albumList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [AlbumId ==. i] []) albumIdList
getResults :: Text -> Handler (Reply, Reply, Reply, Reply) -- mediumList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [MediumId ==. i] []) mediumIdList
getResults query = do -- commentList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [CommentId ==. i] []) commentIdList
-- esQuery <- return $ QueryFuzzyLikeThisQuery $ FuzzyLikeThisQuery -- let allEmpty = (null userList) && (null albumList) && (null mediumList) && (null commentList)
-- { fuzzyLikeFields = [FieldName "_all"] -- defaultLayout $ do
-- , fuzzyLikeText = query -- setTitle $ toHtml $ "Eidolon :: Search results for " ++ (T.unpack query)
-- , fuzzyLikeMaxQueryTerms = MaxQueryTerms 25 -- $(widgetFile "result")
-- , fuzzyLikeIgnoreTermFrequency = IgnoreTermFrequency False -- _ ->
-- , fuzzyLikeFuzziness = Fuzziness 0.6 -- defaultLayout $ do
-- , fuzzyLikePrefixLength = PrefixLength 0 -- setTitle "Eidolon :: Search"
-- , fuzzyLikeBoost = Boost 1.0 -- $(widgetFile "search")
-- , fuzzyLikeAnalyzer = Nothing --
-- } -- searchForm :: Form T.Text
esQuery <- return $ QueryFuzzyQuery $ FuzzyQuery -- searchForm = renderDivs $ areq (searchField True) "Search" Nothing
{ fuzzyQueryField = FieldName "_all" --
, fuzzyQueryValue = query -- getResults :: Text -> Handler (Reply, Reply, Reply, Reply)
, fuzzyQueryPrefixLength = PrefixLength 0 -- getResults query = do
, fuzzyQueryMaxExpansions = MaxExpansions 50 -- -- esQuery <- return $ QueryFuzzyLikeThisQuery $ FuzzyLikeThisQuery
, fuzzyQueryFuzziness = Fuzziness 0.6 -- -- { fuzzyLikeFields = [FieldName "_all"]
, fuzzyQueryBoost = Just (Boost 1.0) -- -- , fuzzyLikeText = query
} -- -- , fuzzyLikeMaxQueryTerms = MaxQueryTerms 25
su <- runBH' $ searchByIndex (IndexName "user") $ mkSearch (Just esQuery) Nothing -- -- , fuzzyLikeIgnoreTermFrequency = IgnoreTermFrequency False
sa <- runBH' $ searchByIndex (IndexName "album") $ mkSearch (Just esQuery) Nothing -- -- , fuzzyLikeFuzziness = Fuzziness 0.6
sm <- runBH' $ searchByIndex (IndexName "medium") $ mkSearch (Just esQuery) Nothing -- -- , fuzzyLikePrefixLength = PrefixLength 0
sc <- runBH' $ searchByIndex (IndexName "comment") $ mkSearch (Just esQuery) Nothing -- -- , fuzzyLikeBoost = Boost 1.0
return (su, sa, sm, sc) -- -- , fuzzyLikeAnalyzer = Nothing
-- -- }
data SearchUser = SearchUser -- esQuery <- return $ QueryFuzzyQuery $ FuzzyQuery
{ suName :: T.Text -- { fuzzyQueryField = FieldName "_all"
, suSlug :: T.Text -- , fuzzyQueryValue = query
} deriving Show -- , fuzzyQueryPrefixLength = PrefixLength 0
-- , fuzzyQueryMaxExpansions = MaxExpansions 50
instance FromJSON SearchUser where -- , fuzzyQueryFuzziness = Fuzziness 0.6
parseJSON (Object o) = SearchUser -- , fuzzyQueryBoost = Just (Boost 1.0)
<$> o .: "name" -- }
<*> o .: "slug" -- su <- runBH' $ searchByIndex (IndexName "user") $ mkSearch (Just esQuery) Nothing
parseJSON _ = mempty -- sa <- runBH' $ searchByIndex (IndexName "album") $ mkSearch (Just esQuery) Nothing
-- sm <- runBH' $ searchByIndex (IndexName "medium") $ mkSearch (Just esQuery) Nothing
data SearchAlbum = SearchAlbum -- sc <- runBH' $ searchByIndex (IndexName "comment") $ mkSearch (Just esQuery) Nothing
{ saName :: T.Text } deriving Show -- return (su, sa, sm, sc)
--
instance FromJSON SearchAlbum where -- data SearchUser = SearchUser
parseJSON (Object o) = SearchAlbum <$> o .: "name" -- { suName :: T.Text
parseJSON _ = mempty -- , suSlug :: T.Text
-- } deriving Show
data SearchMedium = SearchMedium --
{ smName :: Text -- instance FromJSON SearchUser where
, smTime :: UTCTime -- parseJSON (Object o) = SearchUser
, smDescription :: Textarea -- <$> o .: "name"
, smTags :: [T.Text] -- <*> o .: "slug"
} deriving Show -- parseJSON _ = mempty
--
instance FromJSON SearchMedium where -- data SearchAlbum = SearchAlbum
parseJSON (Object o) = SearchMedium -- { saName :: T.Text } deriving Show
<$> o .: "name" --
<*> o .: "time" -- instance FromJSON SearchAlbum where
<*> o .: "description" -- parseJSON (Object o) = SearchAlbum <$> o .: "name"
<*> o .: "tags" -- parseJSON _ = mempty
parseJSON _ = mempty --
-- data SearchMedium = SearchMedium
data SearchComment = SearchComment -- { smName :: Text
{ scAuthor :: Text -- , smTime :: UTCTime
, scTime :: UTCTime -- , smDescription :: Textarea
, scContent :: Text -- , smTags :: [T.Text]
} deriving Show -- } deriving Show
--
instance FromJSON SearchComment where -- instance FromJSON SearchMedium where
parseJSON (Object o) = SearchComment -- parseJSON (Object o) = SearchMedium
<$> o .: "author" -- <$> o .: "name"
<*> o .: "time" -- <*> o .: "time"
<*> o .: "content" -- <*> o .: "description"
parseJSON _ = mempty -- <*> o .: "tags"
-- parseJSON _ = mempty
--
-- data SearchComment = SearchComment
-- { scAuthor :: Text
-- , scTime :: UTCTime
-- , scContent :: Text
-- } deriving Show
--
-- instance FromJSON SearchComment where
-- parseJSON (Object o) = SearchComment
-- <$> o .: "author"
-- <*> o .: "time"
-- <*> o .: "content"
-- parseJSON _ = mempty

View file

@ -57,7 +57,7 @@
/admin/medium/#MediumId/delete AdminMediumDeleteR GET /admin/medium/#MediumId/delete AdminMediumDeleteR GET
/admin/comment AdminCommentR GET /admin/comment AdminCommentR GET
/admin/comment/#CommentId AdminCommentDeleteR GET /admin/comment/#CommentId AdminCommentDeleteR GET
/admin/repop-search AdminSearchReloadR GET -- /admin/repop-search AdminSearchReloadR GET
/tag/#T.Text TagR GET /tag/#T.Text TagR GET
@ -72,4 +72,4 @@
!/feed/user/#T.Text/atom.xml NameFeedAtomR GET !/feed/user/#T.Text/atom.xml NameFeedAtomR GET
!/feed/user/#T.Text/rss.xml NameFeedRssR GET !/feed/user/#T.Text/rss.xml NameFeedRssR GET
/search SearchR GET -- /search SearchR GET

View file

@ -50,7 +50,7 @@ library
Handler.Tag Handler.Tag
Handler.RootFeed Handler.RootFeed
Handler.Commons Handler.Commons
Handler.Search -- Handler.Search
if flag(dev) || flag(library-only) if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT cpp-options: -DDEVELOPMENT

View file

@ -21,6 +21,6 @@ $newline always
<p> <p>
<a href=@{AdminCommentR}>Comments <a href=@{AdminCommentR}>Comments
<div .item> <!--<div .item>
<p> <p>
<a href=@{AdminSearchReloadR}>Repopulate search index <a href=@{AdminSearchReloadR}>Repopulate search index-->

View file

@ -37,8 +37,8 @@
<li> <li>
<a href=@{SignupR}> <a href=@{SignupR}>
Signup Signup
<div .col-md-3 .col-sm-6 #search> <!--<div .col-md-3 .col-sm-6 #search>
^{pageBody searchWidget} ^{pageBody searchWidget}-->
$maybe msg <- mmsg $maybe msg <- mmsg
<div #message>#{msg} <div #message>#{msg}