diff --git a/src/Docs/Search/IndexBuilder.purs b/src/Docs/Search/IndexBuilder.purs index b1f2a6c..6c647a4 100644 --- a/src/Docs/Search/IndexBuilder.purs +++ b/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 diff --git a/src/Docs/Search/Interactive.purs b/src/Docs/Search/Interactive.purs index 94cd7fb..ac49dbe 100644 --- a/src/Docs/Search/Interactive.purs +++ b/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 diff --git a/src/Docs/Search/TypeIndex.purs b/src/Docs/Search/TypeIndex.purs index e10543e..c7de391 100644 --- a/src/Docs/Search/TypeIndex.purs +++ b/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