From e42d5aa46592d42fa87f8c46d109bed6f75522e9 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@chelnok.de>
Date: Sun, 4 Sep 2016 19:56:36 +0200
Subject: [PATCH] search repopulation also not needed

---
 Application.hs                  |   2 +-
 Foundation.hs                   |  20 +-
 Handler/Admin.hs                |  40 ++--
 Handler/Search.hs               | 322 ++++++++++++++++----------------
 config/routes                   |   4 +-
 eidolon.cabal                   |   2 +-
 templates/adminBase.hamlet      |   4 +-
 templates/default-layout.hamlet |   4 +-
 8 files changed, 201 insertions(+), 197 deletions(-)

diff --git a/Application.hs b/Application.hs
index 9579b56..c12c3dc 100755
--- a/Application.hs
+++ b/Application.hs
@@ -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
diff --git a/Foundation.hs b/Foundation.hs
index ff134a2..7e55b5f 100755
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -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
 
diff --git a/Handler/Admin.hs b/Handler/Admin.hs
index c70b585..1335ce6 100755
--- a/Handler/Admin.hs
+++ b/Handler/Admin.hs
@@ -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
diff --git a/Handler/Search.hs b/Handler/Search.hs
index e757439..1ef186d 100755
--- a/Handler/Search.hs
+++ b/Handler/Search.hs
@@ -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
-  --   }
-  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
+-- 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
diff --git a/config/routes b/config/routes
index 75f4e09..c508f8d 100755
--- a/config/routes
+++ b/config/routes
@@ -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
diff --git a/eidolon.cabal b/eidolon.cabal
index 202e21e..3bd5dff 100755
--- a/eidolon.cabal
+++ b/eidolon.cabal
@@ -50,7 +50,7 @@ library
                      Handler.Tag
                      Handler.RootFeed
                      Handler.Commons
-                     Handler.Search
+                     -- Handler.Search
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT
diff --git a/templates/adminBase.hamlet b/templates/adminBase.hamlet
index c1c1cc7..2a1820f 100755
--- a/templates/adminBase.hamlet
+++ b/templates/adminBase.hamlet
@@ -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-->
diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet
index b8d84bd..cf8b175 100755
--- a/templates/default-layout.hamlet
+++ b/templates/default-layout.hamlet
@@ -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}