Sort search results by popularity

CHANGELOG.md

@@ -9,7 +9,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 New features:
 - Render docs as markdown (#15)
-- Show help for each CLI command.
+- Show help for each CLI command (#17)
+- Add packages to the search index (#16)
+- Sort search results by popularity (based on number of package reverse dependencies).
+
+Bugfixes:
+- Fix decoding of kind annotations in `forall`s (#17)
+- Fix rendering for variable-parametrized records (e.g. `Record a`) and type-level strings.
 
 ## [0.0.4] - 2019-07-25
 

src/Docs/Search/App.purs

@@ -6,6 +6,7 @@ import Prelude
 import Docs.Search.App.SearchField as SearchField
 import Docs.Search.App.SearchResults as SearchResults
 import Docs.Search.Extra (whenJust)
+import Docs.Search.PackageIndex as PackageIndex
 
 import Control.Coroutine as Coroutine
 import Data.Maybe (Maybe(..))
@@ -38,8 +39,12 @@ main = do
 
   whenJust mbContainers \ { searchField, searchResults, pageContents } -> do
     HA.runHalogenAff do
+      packageIndex <- PackageIndex.loadPackageIndex
+
+      let initialSearchEngineState = { packageIndex: packageIndex, index: mempty, typeIndex: mempty }
+
       sfio <- runUI SearchField.component unit searchField
-      srio <- runUI (SearchResults.mkComponent pageContents markdownIt) unit searchResults
+      srio <- runUI (SearchResults.mkComponent initialSearchEngineState pageContents markdownIt) unit searchResults
       sfio.subscribe $
         Coroutine.consumer (srio.query <<< H.tell <<< SearchResults.MessageFromSearchField)
 

src/Docs/Search/App/SearchField.purs

@@ -20,7 +20,7 @@ import Web.DOM.ParentNode as ParentNode
 import Web.HTML (window) as Web
 import Web.HTML as HTML
 import Web.HTML.HTMLDocument as HTMLDocument
-import Web.HTML.HTMLElement (blur) as Web
+import Web.HTML.HTMLElement (blur, focus) as Web
 import Web.HTML.HTMLInputElement as HTMLInputElement
 import Web.HTML.Window (document) as Web
 import Web.HTML.Window as Window
@@ -74,6 +74,7 @@ handleAction = case _ of
       when (not state.focused) do
         H.liftEffect do
           withSearchField HTMLInputElement.select
+          withSearchField (HTMLInputElement.toHTMLElement >>> Web.focus)
 
     when (KE.code ev == "Escape") do
       state <- H.get

src/Docs/Search/App/SearchResults.purs

@@ -1,22 +1,25 @@
 -- | This module contains a Halogen component for search results.
 module Docs.Search.App.SearchResults where
 
-import Prelude
-
 import Docs.Search.App.SearchField (SearchFieldMessage(..))
+import Docs.Search.BrowserEngine (PartialIndex, browserSearchEngine)
 import Docs.Search.Config (config)
 import Docs.Search.Declarations (DeclLevel(..), declLevelToHashAnchor)
 import Docs.Search.DocsJson (DataDeclType(..))
-import Docs.Search.Extra ((>#>), homePageFromRepository)
+import Docs.Search.Extra (homePageFromRepository, (>#>))
+import Docs.Search.PackageIndex (PackageResult)
+import Docs.Search.Engine (Result(..))
+import Docs.Search.Engine as Engine
 import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))
 import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
-import Docs.Search.Engine as SearchEngine
-import Docs.Search.Engine (ResultsType(..))
+import Docs.Search.TypeIndex (TypeIndex)
+
+import Prelude
 
 import Data.Array ((!!))
 import Data.Array as Array
 import Data.List as List
-import Data.Maybe (Maybe(..), isJust)
+import Data.Maybe (Maybe(..), isJust, fromMaybe)
 import Data.Newtype (wrap)
 import Data.String.CodeUnits (stripSuffix) as String
 import Data.String.Common (null, trim) as String
@@ -40,9 +43,12 @@ data Mode = Off | Loading | Active
 derive instance eqMode :: Eq Mode
 
 
-type State = { searchEngineState :: SearchEngine.State
-             , results :: Array SearchResult
-             , resultsType :: ResultsType
+type EngineState =
+  Engine.EngineState PartialIndex TypeIndex
+
+
+type State = { engineState :: EngineState
+             , results :: Array Result
              , input :: String
              , contents :: Element
              , resultsCount :: Int
@@ -62,14 +68,14 @@ data Action
 
 mkComponent
   :: forall o i
-  .  Element
+  .  EngineState
+  -> Element
   -> MD.MarkdownIt
   -> H.Component HH.HTML Query i o Aff
-mkComponent contents markdownIt =
+mkComponent initialEngineState contents markdownIt =
   H.mkComponent
-    { initialState: const { searchEngineState: mempty
+    { initialState: const { engineState: initialEngineState
                           , results: []
-                          , resultsType: DeclResults
                           , input: ""
                           , contents
                           , resultsCount: config.resultsCount
@@ -107,12 +113,14 @@ handleQuery (MessageFromSearchField (InputUpdated input_) next) = do
     H.modify_ (_ { mode = Loading, resultsCount = config.resultsCount })
 
     void $ H.fork do
-      { searchEngineState, results, resultsType } <- H.liftAff $
-        SearchEngine.query state.searchEngineState state.input
+      { index, results } <- H.liftAff $
+        Engine.query browserSearchEngine state.engineState state.input
+
       H.modify_ (_ { results = results
                    , mode = Active
-                   , searchEngineState = searchEngineState
-                   , resultsType = resultsType })
+                   , engineState = index
+                   }
+                )
 
     hidePageContents
 
@@ -186,15 +194,6 @@ render state@{ mode: Active } =
   renderContainer $
   [ HH.h1_ [ HH.text "Search results" ]
 
-  , HH.div [ HP.classes [ wrap "result" ] ] $
-    [ HH.text "Found "
-    , HH.strong_ [ HH.text $ show $ Array.length state.results ]
-    , HH.text $
-        case state.resultsType of
-          DeclResults   -> " definitions."
-          TypeResults _ -> " definitions with similar types."
-    ]
-
   , HH.div_ $
     Array.concat $ shownResults <#> renderResult state.markdownIt
 
@@ -227,11 +226,49 @@ renderSummary text =
 
 
 renderResult
+  :: forall a
+  .  MD.MarkdownIt
+  -> Result
+  -> Array (HH.HTML a Action)
+renderResult markdownIt (DeclResult sr) = renderSearchResult markdownIt sr
+renderResult markdownIt (TypeResult sr) = renderSearchResult markdownIt sr
+renderResult markdownIt (PackResult sr) = renderPackageResult sr
+
+
+renderPackageResult
+  :: forall a
+  .  PackageResult
+  -> Array (HH.HTML a Action)
+renderPackageResult { name, description, repository } =
+  [ HH.div [ HP.class_ (wrap "result") ]
+    [ HH.h3 [ HP.class_ (wrap "result__title") ]
+      [ HH.span [ HP.classes [ wrap "result__badge"
+                             , wrap "badge"
+                             , wrap "badge--package" ]
+                , HP.title "Package"
+                ]
+        [ HH.text "P" ]
+
+      , HH.a [ HP.class_ (wrap "result__link")
+             , HP.href $ fromMaybe "" repository # homePageFromRepository
+             ]
+        [ HH.text name ]
+      ]
+    ]
+  ] <>
+
+  description >#> \descriptionText ->
+  [ HH.div [ HP.class_ (wrap "result__body") ]
+    [ HH.text descriptionText ]
+  ]
+
+
+renderSearchResult
   :: forall a
   .  MD.MarkdownIt
   -> SearchResult
   -> Array (HH.HTML a Action)
-renderResult markdownIt (SearchResult result) =
+renderSearchResult markdownIt (SearchResult result) =
   -- class names here and below are from Pursuit.
   [ HH.div [ HP.class_ (wrap "result") ]
     [ HH.h3 [ HP.class_ (wrap "result__title") ]
@@ -274,30 +311,6 @@ renderResult markdownIt (SearchResult result) =
     ]
   ]
 
-renderResult _markdownIt (PackageResult { name, description, repository }) =
-  [ HH.div [ HP.class_ (wrap "result") ]
-    [ HH.h3 [ HP.class_ (wrap "result__title") ]
-      [ HH.span [ HP.classes [ wrap "result__badge"
-                             , wrap "badge"
-                             , wrap "badge--package" ]
-                , HP.title "Package"
-                ]
-        [ HH.text "P" ]
-
-      , HH.a [ HP.class_ (wrap "result__link")
-             , HP.href $ homePageFromRepository repository
-             ]
-        [ HH.text name ]
-      ]
-    ]
-  ] <> (
-    description >#>
-    \descriptionText ->
-    [ HH.div [ HP.class_ (wrap "result__body") ]
-      [ HH.text descriptionText ]
-    ]
-  )
-
 
 renderResultType
   :: forall a rest
@@ -476,7 +489,7 @@ renderType
   -> HH.HTML a Action
 renderType = case _ of
   TypeVar str -> HH.text str
-  TypeLevelString str -> HH.text $ "(Text \"" <> str <> "\")" -- TODO: add escaping
+  TypeLevelString str -> HH.text $ "\"" <> str <> "\"" -- TODO: add escaping
   TypeWildcard -> HH.text "_"
   TypeConstructor qname -> renderQualifiedName false TypeLevel qname
   TypeOp qname -> renderQualifiedName true TypeLevel qname
@@ -569,7 +582,17 @@ renderRow asRow =
 
   if List.null rows
   then
-    [ HH.text $ if asRow then "()" else "{}" ]
+    [ if asRow
+      then HH.text "()"
+      else
+        fromMaybe (HH.text "{}") $
+        ty <#> \ty' ->
+        HH.span_
+        [ renderQualifiedName false TypeLevel primRecord
+        , HH.text " "
+        , renderType ty'
+        ]
+    ]
   else
     [ HH.text opening ] <>
 
@@ -579,9 +602,9 @@ renderRow asRow =
                  , renderType entry.ty ] ]
     ) <>
 
-    case ty of
-      Just ty' -> [ HH.text " | ", renderType ty', HH.text closing ]
-      Nothing  -> [ HH.text closing ]
+    (ty >#> \ty' -> [ HH.text " | ", renderType ty' ]) <>
+
+    [ HH.text closing ]
 
     where
       opening = if asRow then "( " else "{ "
@@ -643,6 +666,10 @@ makeHref level isInfix moduleName name =
   if isInfix then "type (" <> name <> ")" else name
 
 
+primRecord :: QualifiedName
+primRecord = QualifiedName { moduleName: [ "Prim" ], name: "Record" }
+
+
 keyword
   :: forall a
   .  String

src/Docs/Search/Index.purs → src/Docs/Search/BrowserEngine.purs

@@ -1,17 +1,20 @@
--- | Contains `Index` that can be loaded on demand, transparently
--- | to the user.
-module Docs.Search.Index where
-
-import Prelude
+-- | A search engine that is used in the browser.
+module Docs.Search.BrowserEngine where
 
 import Docs.Search.Config (config)
+import Docs.Search.PackageIndex (queryPackageIndex)
+import Docs.Search.Engine (Engine, EngineState, Index)
 import Docs.Search.SearchResult (SearchResult)
+import Docs.Search.TypeIndex (TypeIndex)
+import Docs.Search.TypeIndex as TypeIndex
+
+import Prelude
 
+import Data.Char as Char
 import Control.Promise (Promise, toAffE)
 import Data.Argonaut.Core (Json)
 import Data.Argonaut.Decode (decodeJson)
 import Data.Array as Array
-import Data.Char as Char
 import Data.Either (hush)
 import Data.List (List, (:))
 import Data.List as List
@@ -26,22 +29,27 @@ import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Aff (Aff, try)
 
-newtype Index
-  = Index (Map Int (Trie Char (List SearchResult)))
 
-derive instance newtypeIndex :: Newtype Index _
-derive newtype instance semigroupIndex :: Semigroup Index
-derive newtype instance monoidIndex :: Monoid Index
+newtype PartialIndex
+  = PartialIndex (Map Int Index)
+
+derive instance newtypePartialIndex :: Newtype PartialIndex _
+derive newtype instance semigroupPartialIndex :: Semigroup PartialIndex
+derive newtype instance monoidPartialIndex :: Monoid PartialIndex
+
+
+type BrowserEngineState = EngineState PartialIndex TypeIndex
+
 
 -- | This function dynamically injects a script with the required index part and returns
--- | a new `Index` that contains newly loaded definitions.
+-- | a new `PartialIndex` that contains newly loaded definitions.
 -- |
 -- | We split the index because of its size, and also to speed up queries.
 query
-  :: Index
+  :: PartialIndex
   -> String
-  -> Aff { index :: Index, results :: Array SearchResult }
-query index@(Index indexMap) input = do
+  -> Aff { index :: PartialIndex, results :: Array SearchResult }
+query index@(PartialIndex indexMap) input = do
   let
     path :: List Char
     path =
@@ -70,7 +78,7 @@ query index@(Index indexMap) input = do
 
       case mbNewTrie of
         Just newTrie -> do
-          pure { index: Index $ Map.insert partId newTrie indexMap
+          pure { index: PartialIndex $ Map.insert partId newTrie indexMap
                , results: flatten $ Trie.queryValues path newTrie
                }
         Nothing -> do
@@ -79,6 +87,7 @@ query index@(Index indexMap) input = do
   where
     flatten = Array.concat <<< Array.fromFoldable <<< map Array.fromFoldable
 
+
 insertResults
   :: Tuple String (Array SearchResult)
   -> Trie Char (List SearchResult)
@@ -96,6 +105,17 @@ insertResults (Tuple path newResults) =
         Nothing  -> Just $ List.fromFoldable newResults
         Just old -> Just $ List.fromFoldable newResults <> old
 
+
+browserSearchEngine
+  :: Engine Aff PartialIndex TypeIndex
+browserSearchEngine =
+  { queryIndex: query
+  , queryTypeIndex: TypeIndex.query
+  , queryPackageIndex
+  }
+
+
+
 -- | Find in which part of the index this path can be found.
 getPartId :: List Char -> Int
 getPartId (a : b : _) =
@@ -104,6 +124,7 @@ getPartId (a : _) =
   Char.toCharCode a `mod` config.numberOfIndexParts
 getPartId _ = 0
 
+
 -- | Load a part of the index by injecting a <script> tag into the DOM.
 foreign import loadIndex_
  :: Int