search is working again!

This commit is contained in:
nek0 2017-10-20 18:49:37 +02:00
parent 523db60ebf
commit dc3e38bd26
7 changed files with 48 additions and 200 deletions

View File

@ -48,10 +48,7 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger),
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
import Handler.Home
-- import Handler.Signup
import Handler.Login
-- import Handler.Activate
-- import Handler.Reactivate
import Handler.Profile
import Handler.Upload
import Handler.NewAlbum
@ -68,7 +65,7 @@ import Handler.AdminMediumSettings
import Handler.AdminComments
import Handler.Tag
import Handler.RootFeed
-- import Handler.Search
import Handler.Search
import Handler.About
-- This line actually creates our YesodDispatch instance. It is the second half

View File

@ -97,16 +97,16 @@ renderLayout widget = do
-- value passed to hamletToRepHtml cannot be a widget, this allows
-- you to use normal widget features in default-layout.
-- 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

@ -14,169 +14,37 @@
-- 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
-- MODULE DISABLED DUE TO UNFUNCTIONALITY! REWRITE IMMINENT!!!
import Import
import qualified Data.Text as T
import Data.Maybe (fromJust)
-- 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
import Database.Persist.Sql (rawSql)
import System.FilePath (splitDirectories)
getSearchR :: Handler Html
getSearchR = do
((res, widget), _) <- runFormGet $ renderBootstrap3 BootstrapBasicForm $
searchForm
case res of
FormSuccess query -> do
mediumList <- runDB $
rawSql "select ?? from medium where title % ?" [PersistText query]
userList <- runDB $
rawSql "select ?? from \"user\" where name % ?" [PersistText query]
albumList <- runDB $
rawSql "select ?? from album where title % ?" [PersistText query]
let allEmpty = null mediumList && null userList && null albumList
defaultLayout $ do
setTitle $ toHtml $ "Eidolon :: Search results for " ++ (T.unpack query)
$(widgetFile "result")
_ ->
defaultLayout $ do
setTitle "Eidolon :: Search"
$(widgetFile "search")
searchForm :: AForm Handler T.Text
searchForm = areq (searchField True) "Search" Nothing

View File

@ -22,13 +22,7 @@
/ HomeR GET
/page/#Int PageR GET
-- /signup SignupR GET POST
-- /login LoginR GET POST
/loginraw LoginRawR GET POST
-- /logout LogoutR GET
-- /activate/#T.Text ActivateR GET POST
-- /activateraw/#T.Text ActivateRawR POST
-- /reactivate ReactivateR GET POST
/profile/#UserId ProfileR GET
/user/#T.Text UserR GET
/user/#T.Text/album/#T.Text BeautyAlbumR GET
@ -78,7 +72,7 @@
!/feed/user/#T.Text/atom.xml NameFeedAtomR GET
!/feed/user/#T.Text/rss.xml NameFeedRssR GET
-- /search SearchR GET
/search SearchR GET
/about AboutR GET
/about/threat ThreatR GET

View File

@ -1,5 +1,5 @@
name: eidolon
version: 0.1.11.2
version: 0.1.11.3
synopsis: Image gallery in Yesod
homepage: https://eidolon.nek0.eu
license: AGPL-3
@ -34,10 +34,7 @@ library
Settings.StaticFiles
Settings.Development
Handler.Home
-- Handler.Signup
Handler.Login
-- Handler.Activate
-- Handler.Reactivate
Handler.Profile
Handler.Upload
Handler.NewAlbum
@ -55,7 +52,7 @@ library
Handler.Tag
Handler.RootFeed
Handler.Commons
-- Handler.Search
Handler.Search
Handler.About
if flag(dev) || flag(library-only)

View File

@ -36,8 +36,8 @@
<li>
<a href=@{AuthR newAccountR}>
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}

View File

@ -20,7 +20,7 @@ $else
<h2>
Results in Albums:
$forall (Entity aId album) <- albumList
<div .item data-width="#{albumSampleWidth album}">
<div .item>
<a href=@{AlbumR aId}>
<figure>
$if (albumSamplePic album) == Nothing
@ -38,11 +38,3 @@ $else
<figure>
<img src=@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumThumb medium) []} title=#{mediumTitle medium}>
<figcaption>#{mediumTitle medium}
$if not $ null commentList
<div .subheader .item>
<h2>
Results in Comments:
$forall (Entity _ comment) <- commentList
<div .item>
<a href=@{MediumR $ commentOrigin comment}>
#{commentContent comment}