tags now searchable

Handler/Search.hs

@@ -22,6 +22,8 @@ import qualified Data.Text as T
 import Data.Maybe (fromJust)
 import Data.List (sortBy, nub)
 
+import Text.Fuzzy (test)
+
 import Database.Persist.Sql (rawSql)
 
 import System.FilePath (splitDirectories)
@@ -37,7 +39,7 @@ getSearchR = do
           [PersistText query]
         b <- rawSql "select ?? from medium where ? % any(string_to_array(description, ' '))"
           [PersistText query]
-        return $ nub $ sortBy (\ sa sb -> compare
+        return $ nub $ sortBy (\sa sb -> compare
           (T.unpack $ mediumTitle $ entityVal sa)
           (T.unpack $ mediumTitle $ entityVal sb))
           $ a ++ b
@@ -45,6 +47,13 @@ getSearchR = do
         rawSql "select ?? from \"user\" where name % ?" [PersistText query]
       albumList <- runDB $
         rawSql "select ?? from album where title % ?" [PersistText query]
+      tagList <- runDB $ do
+        media <- selectList [] [Asc MediumTitle]
+        let tags = sortBy
+              (\sa sb -> compare sa sb)
+              (nub (concatMap mediumTags (map entityVal media)))
+            ret = filter (\a -> query `test` a) tags
+        return ret
       let allEmpty = null mediumList && null userList && null albumList
       defaultLayout $ do
         setTitle $ toHtml $ "Eidolon :: Search results for " ++ (T.unpack query)

Handler/Tag.hs

@@ -18,17 +18,19 @@ module Handler.Tag where
 
 import Import
 import qualified Data.Text as T
+import Data.Maybe (catMaybes)
 import System.FilePath
 
 getTagR :: Text -> Handler Html
 getTagR tag = do
-  tempMedia <- runDB $ selectList [] [Asc MediumTitle]
+  media <- runDB $ do
-  almostMedia <- mapM (\a ->
+    almostMedia <- selectList [] [Asc MediumTitle]
-    if tag `elem` mediumTags (entityVal a)
+    ret <- catMaybes <$> mapM (\a ->
-      then return (Just a)
+      if tag `elem` mediumTags (entityVal a)
-      else return Nothing
+        then return (Just a)
-      ) tempMedia
+        else return Nothing
-  let media = removeItem Nothing almostMedia
+        ) almostMedia
+    return ret
   defaultLayout $ do
     setTitle $ toHtml ("Eidolon :: Tag " `T.append` tag)
     $(widgetFile "tagMedia")

eidolon.cabal

@@ -1,5 +1,5 @@
 name:                eidolon
-version:             0.1.11.5
+version:             0.1.11.6
 synopsis:            Image gallery in Yesod
 homepage:            https://eidolon.nek0.eu
 license:             AGPL-3
@@ -144,6 +144,7 @@ library
                  , yesod-form                    >= 1.4.7
                  , magic
                  , texmath
+                 , fuzzy
                  , yesod-auth
                  , yesod-auth-hmac-keccak
 

templates/result.hamlet

@@ -38,3 +38,11 @@ $else
           <figure>
             <img src=@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumThumb medium) []} title=#{mediumTitle medium}>
             <figcaption>#{mediumTitle medium}
+  $if not $ null tagList
+    <article .subheader .item>
+      <h2>
+        Results in Tags:
+    $forall tag <- tagList
+      <div .item>
+        <a href=@{TagR tag}>
+          #{tag}

templates/tagMedia.hamlet

@@ -5,7 +5,7 @@ $newline always
     <p>
       There are no media tagged with #{tag}
 
-$forall Just (Entity mId m) <- media
+$forall (Entity mId m) <- media
   <div .item>
     <a href=@{MediumR mId}>
       <figure>