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.Tag
import Handler.RootFeed
import Handler.Search
-- import Handler.Search
-- 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

View file

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

View file

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

View file

@ -14,165 +14,169 @@
-- 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/>.
module Handler.Search where
import Import
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
-- MODULE DISABLED DUE TO UNFUNCTIONALITY! REWRITE IMMINENT!!!
import Debug.Trace
getSearchR :: Handler Html
getSearchR = do
((res, widget), _) <- runFormGet searchForm
case res of
FormSuccess query -> do
(ru, ra, rm, rc) <- getResults query
liftIO $ traceIO $ show (ru, ra, rm, rc)
let a = decode (responseBody ru) :: Maybe (SearchResult SearchUser)
let b = decode (responseBody ra) :: Maybe (SearchResult SearchAlbum)
let c = decode (responseBody rm) :: Maybe (SearchResult SearchMedium)
let d = decode (responseBody rc) :: Maybe (SearchResult SearchComment)
liftIO $ traceIO $ show (a,b,c,d)
let hitListA = case a of {
Just as -> hits $ searchHits as;
Nothing -> []}
let hitListB = case b of {
Just bs -> hits $ searchHits bs;
Nothing -> []}
let hitListC = case c of {
Just cs -> hits $ searchHits cs;
Nothing -> []}
let hitListD = case d of {
Just ds -> hits $ searchHits ds;
Nothing -> []}
userIdList <- return $ mapMaybe (\h -> do
if
hitIndex h == IndexName "user"
then do
DocId theId <- return $ hitDocId h
Just $ (packKey theId :: UserId)
else
Nothing
) hitListA
albumIdList <- return $ mapMaybe (\h -> do
if
hitIndex h == IndexName "album"
then do
DocId theId <- return $ hitDocId h
Just $ (packKey theId :: AlbumId)
else
Nothing
) hitListB
mediumIdList <- return $ mapMaybe (\h -> do
if
hitIndex h == IndexName "medium"
then do
DocId theId <- return $ hitDocId h
Just $ (packKey theId :: MediumId)
else
Nothing
) hitListC
commentIdList <- return $ mapMaybe (\h -> do
if
hitIndex h == IndexName "comment"
then do
DocId theId <- return $ hitDocId h
Just $ (packKey theId :: CommentId)
else
Nothing
) hitListD
liftIO $ traceIO $ show (userIdList, albumIdList, mediumIdList, commentIdList)
userList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [UserId ==. i] []) userIdList
albumList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [AlbumId ==. i] []) albumIdList
mediumList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [MediumId ==. i] []) mediumIdList
commentList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [CommentId ==. i] []) commentIdList
let allEmpty = (null userList) && (null albumList) && (null mediumList) && (null commentList)
defaultLayout $ do
setTitle $ toHtml $ "Eidolon :: Search results for " ++ (T.unpack query)
$(widgetFile "result")
_ ->
defaultLayout $ do
setTitle "Eidolon :: Search"
$(widgetFile "search")
searchForm :: Form T.Text
searchForm = renderDivs $ areq (searchField True) "Search" Nothing
getResults :: Text -> Handler (Reply, Reply, Reply, Reply)
getResults query = do
-- esQuery <- return $ QueryFuzzyLikeThisQuery $ FuzzyLikeThisQuery
-- { fuzzyLikeFields = [FieldName "_all"]
-- , fuzzyLikeText = query
-- , fuzzyLikeMaxQueryTerms = MaxQueryTerms 25
-- , fuzzyLikeIgnoreTermFrequency = IgnoreTermFrequency False
-- , fuzzyLikeFuzziness = Fuzziness 0.6
-- , fuzzyLikePrefixLength = PrefixLength 0
-- , fuzzyLikeBoost = Boost 1.0
-- , fuzzyLikeAnalyzer = Nothing
-- }
esQuery <- return $ QueryFuzzyQuery $ FuzzyQuery
{ fuzzyQueryField = FieldName "_all"
, fuzzyQueryValue = query
, fuzzyQueryPrefixLength = PrefixLength 0
, fuzzyQueryMaxExpansions = MaxExpansions 50
, fuzzyQueryFuzziness = Fuzziness 0.6
, fuzzyQueryBoost = Just (Boost 1.0)
}
su <- runBH' $ searchByIndex (IndexName "user") $ mkSearch (Just esQuery) Nothing
sa <- runBH' $ searchByIndex (IndexName "album") $ mkSearch (Just esQuery) Nothing
sm <- runBH' $ searchByIndex (IndexName "medium") $ mkSearch (Just esQuery) Nothing
sc <- runBH' $ searchByIndex (IndexName "comment") $ mkSearch (Just esQuery) Nothing
return (su, sa, sm, sc)
data SearchUser = SearchUser
{ suName :: T.Text
, suSlug :: T.Text
} deriving Show
instance FromJSON SearchUser where
parseJSON (Object o) = SearchUser
<$> o .: "name"
<*> o .: "slug"
parseJSON _ = mempty
data SearchAlbum = SearchAlbum
{ saName :: T.Text } deriving Show
instance FromJSON SearchAlbum where
parseJSON (Object o) = SearchAlbum <$> o .: "name"
parseJSON _ = mempty
data SearchMedium = SearchMedium
{ smName :: Text
, smTime :: UTCTime
, smDescription :: Textarea
, smTags :: [T.Text]
} deriving Show
instance FromJSON SearchMedium where
parseJSON (Object o) = SearchMedium
<$> o .: "name"
<*> o .: "time"
<*> o .: "description"
<*> 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
-- module Handler.Search where
--
-- import Import
-- 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
-- getSearchR = do
-- ((res, widget), _) <- runFormGet searchForm
-- case res of
-- FormSuccess query -> do
-- (ru, ra, rm, rc) <- getResults query
-- liftIO $ traceIO $ show (ru, ra, rm, rc)
-- let a = decode (responseBody ru) :: Maybe (SearchResult SearchUser)
-- let b = decode (responseBody ra) :: Maybe (SearchResult SearchAlbum)
-- let c = decode (responseBody rm) :: Maybe (SearchResult SearchMedium)
-- let d = decode (responseBody rc) :: Maybe (SearchResult SearchComment)
-- liftIO $ traceIO $ show (a,b,c,d)
-- let hitListA = case a of {
-- Just as -> hits $ searchHits as;
-- Nothing -> []}
-- let hitListB = case b of {
-- Just bs -> hits $ searchHits bs;
-- Nothing -> []}
-- let hitListC = case c of {
-- Just cs -> hits $ searchHits cs;
-- Nothing -> []}
-- let hitListD = case d of {
-- Just ds -> hits $ searchHits ds;
-- Nothing -> []}
-- userIdList <- return $ mapMaybe (\h -> do
-- if
-- hitIndex h == IndexName "user"
-- then do
-- DocId theId <- return $ hitDocId h
-- Just $ (packKey theId :: UserId)
-- else
-- Nothing
-- ) hitListA
-- albumIdList <- return $ mapMaybe (\h -> do
-- if
-- hitIndex h == IndexName "album"
-- then do
-- DocId theId <- return $ hitDocId h
-- Just $ (packKey theId :: AlbumId)
-- else
-- Nothing
-- ) hitListB
-- mediumIdList <- return $ mapMaybe (\h -> do
-- if
-- hitIndex h == IndexName "medium"
-- then do
-- DocId theId <- return $ hitDocId h
-- Just $ (packKey theId :: MediumId)
-- else
-- Nothing
-- ) hitListC
-- commentIdList <- return $ mapMaybe (\h -> do
-- if
-- hitIndex h == IndexName "comment"
-- then do
-- DocId theId <- return $ hitDocId h
-- Just $ (packKey theId :: CommentId)
-- else
-- Nothing
-- ) hitListD
-- liftIO $ traceIO $ show (userIdList, albumIdList, mediumIdList, commentIdList)
-- userList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [UserId ==. i] []) userIdList
-- albumList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [AlbumId ==. i] []) albumIdList
-- mediumList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [MediumId ==. i] []) mediumIdList
-- commentList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [CommentId ==. i] []) commentIdList
-- let allEmpty = (null userList) && (null albumList) && (null mediumList) && (null commentList)
-- defaultLayout $ do
-- setTitle $ toHtml $ "Eidolon :: Search results for " ++ (T.unpack query)
-- $(widgetFile "result")
-- _ ->
-- defaultLayout $ do
-- setTitle "Eidolon :: Search"
-- $(widgetFile "search")
--
-- searchForm :: Form T.Text
-- searchForm = renderDivs $ areq (searchField True) "Search" Nothing
--
-- getResults :: Text -> Handler (Reply, Reply, Reply, Reply)
-- getResults query = do
-- -- esQuery <- return $ QueryFuzzyLikeThisQuery $ FuzzyLikeThisQuery
-- -- { fuzzyLikeFields = [FieldName "_all"]
-- -- , fuzzyLikeText = query
-- -- , fuzzyLikeMaxQueryTerms = MaxQueryTerms 25
-- -- , fuzzyLikeIgnoreTermFrequency = IgnoreTermFrequency False
-- -- , fuzzyLikeFuzziness = Fuzziness 0.6
-- -- , fuzzyLikePrefixLength = PrefixLength 0
-- -- , fuzzyLikeBoost = Boost 1.0
-- -- , fuzzyLikeAnalyzer = Nothing
-- -- }
-- esQuery <- return $ QueryFuzzyQuery $ FuzzyQuery
-- { fuzzyQueryField = FieldName "_all"
-- , fuzzyQueryValue = query
-- , fuzzyQueryPrefixLength = PrefixLength 0
-- , fuzzyQueryMaxExpansions = MaxExpansions 50
-- , fuzzyQueryFuzziness = Fuzziness 0.6
-- , fuzzyQueryBoost = Just (Boost 1.0)
-- }
-- su <- runBH' $ searchByIndex (IndexName "user") $ mkSearch (Just esQuery) Nothing
-- sa <- runBH' $ searchByIndex (IndexName "album") $ mkSearch (Just esQuery) Nothing
-- sm <- runBH' $ searchByIndex (IndexName "medium") $ mkSearch (Just esQuery) Nothing
-- sc <- runBH' $ searchByIndex (IndexName "comment") $ mkSearch (Just esQuery) Nothing
-- return (su, sa, sm, sc)
--
-- data SearchUser = SearchUser
-- { suName :: T.Text
-- , suSlug :: T.Text
-- } deriving Show
--
-- instance FromJSON SearchUser where
-- parseJSON (Object o) = SearchUser
-- <$> o .: "name"
-- <*> o .: "slug"
-- parseJSON _ = mempty
--
-- data SearchAlbum = SearchAlbum
-- { saName :: T.Text } deriving Show
--
-- instance FromJSON SearchAlbum where
-- parseJSON (Object o) = SearchAlbum <$> o .: "name"
-- parseJSON _ = mempty
--
-- data SearchMedium = SearchMedium
-- { smName :: Text
-- , smTime :: UTCTime
-- , smDescription :: Textarea
-- , smTags :: [T.Text]
-- } deriving Show
--
-- instance FromJSON SearchMedium where
-- parseJSON (Object o) = SearchMedium
-- <$> o .: "name"
-- <*> o .: "time"
-- <*> o .: "description"
-- <*> 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/comment AdminCommentR GET
/admin/comment/#CommentId AdminCommentDeleteR GET
/admin/repop-search AdminSearchReloadR GET
-- /admin/repop-search AdminSearchReloadR GET
/tag/#T.Text TagR GET
@ -72,4 +72,4 @@
!/feed/user/#T.Text/atom.xml NameFeedAtomR 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.RootFeed
Handler.Commons
Handler.Search
-- Handler.Search
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT

View file

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

View file

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