fix #8 (#9)

Author: klntsky

src/Docs/Search/IndexBuilder.purs

@@ -16,11 +16,12 @@ import Data.Argonaut.Encode (encodeJson)
 import Data.Argonaut.Parser (jsonParser)
 import Data.Array as Array
 import Data.Either (Either(..))
+import Data.Foldable (sum)
 import Data.List (List)
 import Data.List as List
 import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Newtype (unwrap)
 import Data.Search.Trie as Trie
 import Data.Set as Set
@@ -29,7 +30,7 @@ import Data.String.CodeUnits (singleton) as String
 import Data.String.Common (replace) as String
 import Data.String.Pattern (Pattern(..), Replacement(..))
 import Data.Traversable (for, for_)
-import Data.Tuple (Tuple(..), fst, snd)
+import Data.Tuple (Tuple(..), fst)
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_, parallel, sequential)
 import Effect.Class (liftEffect)
@@ -60,7 +61,7 @@ run' cfg = do
     log $ "Found " <> show (Array.length docsJsons) <> " modules."
 
   let index = mkDeclarations docsJsons
-      typeIndex = mkTypeIndex index
+      typeIndex = mkTypeIndex docsJsons
 
   createDirectories cfg
 
@@ -70,12 +71,16 @@ run' cfg = do
            <*> parallel (patchDocs cfg)
            <*> parallel (copyAppFile cfg)
 
+  let countOfDefinitions = Trie.size $ unwrap index
+      countOfTypeDefinitions =
+        sum $ fromMaybe 0 <$> map Array.length <$> Map.values (unwrap typeIndex)
+
   liftEffect do
     log $
       "Added " <>
-      show (Trie.size $ unwrap index) <>
+      show countOfDefinitions <>
       " definitions and " <>
-      show (List.length $ join $ map snd $ Trie.entriesUnordered (unwrap index)) <>
+      show countOfTypeDefinitions <>
       " type definitions to the search index."
 
   where ignore _ _ _ _ = unit

src/Docs/Search/Interactive.purs

@@ -10,21 +10,20 @@ import Docs.Search.IndexBuilder as IndexBuilder
 import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))
 import Docs.Search.Terminal (bold, cyan, green, yellow)
 import Docs.Search.TypeDecoder (Constraint, FunDeps, Kind, QualifiedName, Type, TypeArgument)
-import Docs.Search.TypeIndex (mkTypeIndex)
+import Docs.Search.TypeIndex (resultsWithTypes)
 import Docs.Search.TypePrinter (keyword, showConstraint, showFunDeps, showKind, showType, showTypeArgument, space, syntax)
 import Docs.Search.TypeQuery (parseTypeQuery)
 
 import Data.Array as Array
 import Data.Either (hush)
 import Data.List as List
-import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Newtype (unwrap, wrap)
 import Data.Search.Trie as Trie
 import Data.String (length) as String
 import Data.String.CodeUnits (fromCharArray, toCharArray) as String
 import Data.String.Common (split, toLower, trim) as String
-import Data.Tuple (snd, fst)
+import Data.Tuple (fst)
 import Effect (Effect)
 import Effect.Aff (launchAff_)
 import Effect.Class (liftEffect)
@@ -42,17 +41,19 @@ run cfg = launchAff_ $ do
   docsJsons <- IndexBuilder.decodeDocsJsons cfg
 
   let index = mkDeclarations docsJsons
-      typeIndex = Array.concat $ Array.fromFoldable (
-        Map.values (unwrap (mkTypeIndex index)) <#> fromMaybe []
-      ) :: Array SearchResult
+      typeIndex = docsJsons >>= resultsWithTypes
+
+  let countOfDefinitions = Trie.size $ unwrap index
+      countOfTypeDefinitions =
+        Array.length typeIndex
 
   liftEffect do
     log $
       "Loaded " <>
-      show (Trie.size $ unwrap index) <>
+      show countOfDefinitions <>
       " definitions and " <>
-      show (List.length $ join $ map snd $ Trie.entriesUnordered (unwrap index)) <>
-      " type definitions"
+      show countOfTypeDefinitions <>
+      " type definitions."
 
   liftEffect do
     let

src/Docs/Search/TypeIndex.purs

@@ -3,8 +3,10 @@ module Docs.Search.TypeIndex where
 import Prelude
 
 import Docs.Search.Config (config)
-import Docs.Search.Declarations (Declarations(..))
+import Docs.Search.Declarations (resultsForEntry)
+import Docs.Search.DocsJson (DocsJson(..))
 import Docs.Search.SearchResult (ResultInfo(..), SearchResult)
+import Docs.Search.TypeDecoder (Type)
 import Docs.Search.TypeQuery (TypeQuery)
 import Docs.Search.TypeShape (shapeOfType, shapeOfTypeQuery, stringifyShape)
 
@@ -13,14 +15,10 @@ import Data.Argonaut.Core (Json)
 import Data.Argonaut.Decode (decodeJson)
 import Data.Array as Array
 import Data.Either (hush)
-import Data.List (List)
-import Data.List as List
 import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe(..), fromMaybe')
+import Data.Maybe (Maybe(..), fromMaybe', isJust)
 import Data.Newtype (class Newtype, unwrap, wrap)
-import Data.Search.Trie as Trie
-import Data.Tuple (Tuple(..), snd)
 import Effect (Effect)
 import Effect.Aff (Aff, try)
 
@@ -30,41 +28,39 @@ derive newtype instance semigroupTypeIndex :: Semigroup TypeIndex
 derive newtype instance monoidTypeIndex :: Monoid TypeIndex
 derive instance newtypeTypeIndex :: Newtype TypeIndex _
 
-insert
- :: String
- -> Maybe (Array SearchResult)
- -> TypeIndex
- -> TypeIndex
-insert key value = unwrap >>> Map.insert key value >>> wrap
-
-mkTypeIndex :: Declarations -> TypeIndex
-mkTypeIndex (Declarations trie) = TypeIndex $ map (Array.fromFoldable >>> Just) types
+mkTypeIndex :: Array DocsJson -> TypeIndex
+mkTypeIndex docsJsons =
+  TypeIndex $ map Just $ Array.foldr insert mempty docsJsons
   where
-    insertTypes
-      :: Tuple String SearchResult
-      -> Map String (List SearchResult)
-      -> Map String (List SearchResult)
-    insertTypes (Tuple shape result) =
-      Map.insertWith append shape (List.singleton result)
+    insert :: DocsJson -> Map String (Array SearchResult) -> Map String (Array SearchResult)
+    insert docsJson mp =
+      Array.foldr (\result ->
+                    case getType result of
+                      Just ty ->
+                        Map.insertWith append (stringifyShape $ shapeOfType ty) (pure result)
+                      Nothing -> identity
+                  ) mp (allResults docsJson)
 
-    types = List.foldr insertTypes mempty do
+allResults :: DocsJson -> Array SearchResult
+allResults (DocsJson { name, declarations }) =
+  declarations >>= (resultsForEntry name >>> map (_.result) >>> Array.fromFoldable)
 
-      results <- Trie.entriesUnordered trie >>= snd
+resultsWithTypes :: DocsJson -> Array SearchResult
+resultsWithTypes docsJson = Array.filter (getType >>> isJust) $ allResults docsJson
 
-      case (unwrap results).info of
-        ValueResult dict ->
-          insertTypeResultsFor dict.type results
+getType :: SearchResult -> Maybe Type
+getType sr =
+  case (unwrap sr).info of
+    ValueResult dict ->
+      Just dict.type
 
-        TypeClassMemberResult dict ->
-          insertTypeResultsFor dict.type results
+    TypeClassMemberResult dict ->
+      Just dict.type
 
-        TypeSynonymResult dict ->
-          insertTypeResultsFor dict.type results
-        _ -> mempty
+    TypeSynonymResult dict ->
+      Just dict.type
 
-    insertTypeResultsFor ty results =
-      let path = stringifyShape (shapeOfType ty) in
-      pure $ Tuple path results
+    _ -> Nothing
 
 lookup
   :: String
@@ -82,6 +78,14 @@ lookup key typeIndex@(TypeIndex map) =
           results <- hush (decodeJson json)
           pure { typeIndex: insert key (Just results) typeIndex, results }
 
+  where
+    insert
+      :: String
+      -> Maybe (Array SearchResult)
+      -> TypeIndex
+      -> TypeIndex
+    insert k v = unwrap >>> Map.insert k v >>> wrap
+
 query
   :: TypeIndex
   -> TypeQuery