search repopulation also not needed
This commit is contained in:
nek0
parent
c95a77e644
commit
e42d5aa465
8 changed files with 201 additions and 197 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
-- 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)
|
||||
-- }
|
||||
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
|
||||
-- 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@ library
|
|||
Handler.Tag
|
||||
Handler.RootFeed
|
||||
Handler.Commons
|
||||
Handler.Search
|
||||
-- Handler.Search
|
||||
|
||||
if flag(dev) || flag(library-only)
|
||||
cpp-options: -DDEVELOPMENT
|
||||
|
|
|
|||
|
|
@ -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-->
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
|
|||
Loading…
Reference in a new issue