Merge pull request #52 from nek0/search2

search is working again!

Application.hs

@@ -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

Foundation.hs

@@ -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|
+    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
 

Handler/Search.hs

@@ -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 Database.Persist.Sql (rawSql)
--- 
+
--- import Import
+import System.FilePath (splitDirectories)
--- import Handler.Commons
+
--- import Data.Time.Clock
+getSearchR :: Handler Html
--- import Data.Aeson
+getSearchR = do
--- import Data.Maybe
+  ((res, widget), _) <- runFormGet $ renderBootstrap3 BootstrapBasicForm $
--- import qualified Data.Text as T
+    searchForm
--- import Database.Bloodhound
+  case res of
--- import Network.HTTP.Client (responseBody)
+    FormSuccess query -> do
--- import System.FilePath.Posix
+      mediumList <- runDB $
--- 
+        rawSql "select ?? from medium where title % ?" [PersistText query]
--- import Debug.Trace
+      userList <- runDB $
--- 
+        rawSql "select ?? from \"user\" where name % ?" [PersistText query]
--- getSearchR :: Handler Html
+      albumList <- runDB $
--- getSearchR = do
+        rawSql "select ?? from album where title % ?" [PersistText query]
---   ((res, widget), _) <- runFormGet searchForm
+      let allEmpty = null mediumList && null userList && null albumList
---   case res of
+      defaultLayout $ do
---     FormSuccess query -> do
+        setTitle $ toHtml $ "Eidolon :: Search results for " ++ (T.unpack query)
---       (ru, ra, rm, rc) <- getResults query
+        $(widgetFile "result")
---       liftIO $ traceIO $ show (ru, ra, rm, rc)
+    _ ->
---       let a = decode (responseBody ru) :: Maybe (SearchResult SearchUser)
+      defaultLayout $ do
---       let b = decode (responseBody ra) :: Maybe (SearchResult SearchAlbum)
+        setTitle "Eidolon :: Search"
---       let c = decode (responseBody rm) :: Maybe (SearchResult SearchMedium)
+        $(widgetFile "search")
---       let d = decode (responseBody rc) :: Maybe (SearchResult SearchComment)
+
---       liftIO $ traceIO $ show (a,b,c,d)
+searchForm :: AForm Handler T.Text
---       let hitListA = case a of {
+searchForm = areq (searchField True) "Search" Nothing
---           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

config/routes

@@ -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

eidolon.cabal

@@ -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)

templates/default-layout.hamlet

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

templates/result.hamlet

@@ -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}