commit
1394cc7582
7 changed files with 48 additions and 200 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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}
|
||||
|
|
|
@ -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}
|
||||
|
|
Loading…
Reference in a new issue