Various small fixes (#240)

* Case insensitive search * Render comments in search results, fix API
purescript · Aug 13, 2016 · b29fb85 · b29fb85
1 parent a49303c
commit b29fb85
Show file tree

Hide file tree

Showing 4 changed files with 18 additions and 7 deletions.
diff --git a/src/Foundation.hs b/src/Foundation.hs
@@ -59,7 +59,7 @@ instance PathPiece VerificationKey where
 data SearchResult = SearchResult
   { hrPkgName    :: PackageName
   , hrPkgVersion :: Version
-  , hrDetails    :: String
+  , hrComments    :: String
   , hrInfo       :: SearchResultInfo
   }
   deriving (Show, Eq, Generic)

diff --git a/src/Handler/Database.hs b/src/Handler/Database.hs
@@ -52,7 +52,7 @@ createDatabase = do
   return . fromListWithDuplicates $ do
     D.Package{..} <- pkgs
     let packageEntry =
-          ( fromString (tryStripPrefix "purescript-" (runPackageName (bowerName pkgMeta)))
+          ( fromString (tryStripPrefix "purescript-" (toLower (runPackageName (bowerName pkgMeta))))
           , SearchResult (bowerName pkgMeta)
                          pkgVersion
                          (fromMaybe "" (bowerDescription pkgMeta))
@@ -61,7 +61,7 @@ createDatabase = do
     packageEntry : do
       D.Module{..} <- pkgModules
       let moduleEntry =
-            ( fromString (P.runModuleName modName)
+            ( fromString (toLower (P.runModuleName modName))
             , SearchResult (bowerName pkgMeta)
                            pkgVersion
                            (fromMaybe "" modComments)
@@ -74,7 +74,7 @@ createDatabase = do
                 D.ValueDeclaration{} -> Value
                 D.AliasDeclaration{} -> Value
                 _ -> Type
-        return ( fromString declTitle
+        return ( fromString (toLower declTitle)
                , SearchResult (bowerName pkgMeta)
                               pkgVersion
                               (fromMaybe "" declComments)

diff --git a/src/Handler/Search.hs b/src/Handler/Search.hs
@@ -12,13 +12,17 @@ import qualified Web.Bower.PackageMeta as Bower
 import Model.DocsAsHtml (makeFragment)
 import TemplateHelpers (getFragmentRender)
 
+import Cheapskate (allowRawHtml, markdown)
+import qualified Text.Blaze as Blaze
+import qualified Text.Blaze.Renderer.Text as Blaze
+
 getSearchR :: Handler TypedContent
 getSearchR = do
   mquery <- (map . map) unpack $ lookupGetParam "q"
   case mquery of
     Nothing -> redirect HomeR
     Just query -> do
-      results <- searchForName query
+      results <- searchForName (toLower query)
       selectRep $ do
         provideRep (htmlOutput query results)
         provideRep (jsonOutput results)
@@ -34,10 +38,12 @@ getSearchR = do
 searchResultToJSON :: SearchResult -> Handler Value
 searchResultToJSON result@SearchResult{..} = do
   url <- getFragmentRender <*> pure (routeResult result)
+  let html = renderComments hrComments
   return $
     object [ "package" .= hrPkgName
            , "version" .= showVersion hrPkgVersion
-           , "details" .= hrDetails
+           , "markup" .= Blaze.renderMarkup html
+           , "text" .= Blaze.renderMarkup (Blaze.contents html)
            , "info" .= toJSON hrInfo
            , "url" .= url
            ]
@@ -65,3 +71,8 @@ searchForName :: String -> Handler [SearchResult]
 searchForName query = do
   db <- atomically . readTVar =<< (appDatabase <$> getYesod)
   return (take 50 (concat (elems (submap (fromString query) db))))
+
+renderComments :: String -> Html
+renderComments = Blaze.toMarkup . markdown opts . pack
+  where
+    opts = def { allowRawHtml = False }
diff --git a/templates/search.hamlet b/templates/search.hamlet
@@ -13,7 +13,7 @@
             <p>#{name}
 
         <p>
-          <small>#{hrDetails r}
+          <small>#{renderComments $ hrComments r}
 
         $case hrInfo r
           $of PackageResult