search repopulation also not needed
This commit is contained in:
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.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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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-->
|
||||||
|
|
|
@ -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}
|
||||||
|
|
Loading…
Reference in a new issue