From 19a3b50e86fcea402e658fca8dcd66759e90c294 Mon Sep 17 00:00:00 2001 From: klntsky Date: Wed, 7 Aug 2019 14:06:54 +0300 Subject: [PATCH 01/10] added: helpers to commands updated: package-set added: `build-dev` script to package.json for faster builds --- package.json | 1 + packages.dhall | 18 ++------ spago.dhall | 68 ++++++++++++++++--------------- src/Docs/Search/Extra.js | 9 ---- src/Docs/Search/Extra.purs | 2 - src/Docs/Search/IndexBuilder.js | 7 ++++ src/Docs/Search/IndexBuilder.purs | 4 +- src/Docs/Search/Main.purs | 6 +-- 8 files changed, 53 insertions(+), 62 deletions(-) delete mode 100644 src/Docs/Search/Extra.js diff --git a/package.json b/package.json index ebf2061..9a15a9d 100644 --- a/package.json +++ b/package.json @@ -25,6 +25,7 @@ "chmod-main": "chmod +x dist/purescript-docs-search", "build-main": "npm run bundle-main && npm run parcel-main && npm run add-shebang && rm dist/main.js && npm run chmod-main", "build": "npm run build-app && npm run build-main", + "build-dev": "npm run bundle-main && npm run add-shebang && rm dist/main.js && npm run chmod-main && npm run bundle-app", "clean": "rm -rf dist", "check-version": "[ \"$(./dist/purescript-docs-search version)\" = \"$npm_package_version\" ]", "test": "spago test && npm run check-version" diff --git a/packages.dhall b/packages.dhall index 6d40ce1..89a9e21 100644 --- a/packages.dhall +++ b/packages.dhall @@ -1,23 +1,13 @@ let mkPackage = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.0-20190602/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 + https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2-20190725/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 let upstream = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.0-20190602/src/packages.dhall sha256:5da1578dd297709265715a92eda5f42989dce92e121fcc889cff669a3b997c3d + https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2-20190725/src/packages.dhall sha256:60cc03d2c3a99a0e5eeebb16a22aac219fa76fe6a1686e8c2bd7a11872527ea3 -let overrides = {=} +let overrides = { metadata = upstream.metadata ⫽ { version = "v0.13.0" } } let additions = - { search-trie = - mkPackage - [ "prelude" - , "arrays" - , "ordered-collections" - , "lists" - , "foldable-traversable" - ] - "https://github.com/klntsky/purescript-search-trie.git" - "fd37a12" - , halogen = + { halogen = mkPackage [ "aff" , "avar" diff --git a/spago.dhall b/spago.dhall index 72bee33..66f3dcc 100644 --- a/spago.dhall +++ b/spago.dhall @@ -1,36 +1,38 @@ -{ name = - "docs-search" +{ sources = + [ "src/**/*.purs", "test/**/*.purs" ] +, name = + "docs-search" , dependencies = - [ "aff-promise" - , "argonaut-codecs" - , "argonaut-core" - , "argonaut-generic" - , "arrays" - , "console" - , "control" - , "coroutines" - , "effect" - , "foldable-traversable" - , "generics-rep" - , "halogen" - , "halogen-css" - , "lists" - , "maybe" - , "newtype" - , "node-buffer" - , "node-fs" - , "node-fs-aff" - , "node-process" - , "node-readline" - , "optparse" - , "profunctor" - , "search-trie" - , "string-parsers" - , "strings" - , "test-unit" - , "web-dom" - , "web-html" - ] + [ "aff-promise" + , "argonaut-codecs" + , "argonaut-core" + , "argonaut-generic" + , "arrays" + , "console" + , "control" + , "coroutines" + , "effect" + , "foldable-traversable" + , "generics-rep" + , "halogen" + , "halogen-css" + , "lists" + , "maybe" + , "newtype" + , "node-buffer" + , "node-fs" + , "node-fs-aff" + , "node-process" + , "node-readline" + , "optparse" + , "profunctor" + , "search-trie" + , "string-parsers" + , "strings" + , "test-unit" + , "web-dom" + , "web-html" + ] , packages = - ./packages.dhall + ./packages.dhall } diff --git a/src/Docs/Search/Extra.js b/src/Docs/Search/Extra.js deleted file mode 100644 index 5d32f33..0000000 --- a/src/Docs/Search/Extra.js +++ /dev/null @@ -1,9 +0,0 @@ -/* global exports require */ - -var glob = require('glob'); - -exports.glob = function (pattern) { - return function () { - return glob.sync(pattern); - }; -}; diff --git a/src/Docs/Search/Extra.purs b/src/Docs/Search/Extra.purs index 7027fff..ff7b251 100644 --- a/src/Docs/Search/Extra.purs +++ b/src/Docs/Search/Extra.purs @@ -18,8 +18,6 @@ foldMapFlipped = flip foldMap infixr 7 foldMapFlipped as >#> -foreign import glob :: String -> Effect (Array String) - foldl1 :: forall a. (a -> a -> a) -> NonEmptyList a -> a foldl1 f as = case uncons as of diff --git a/src/Docs/Search/IndexBuilder.js b/src/Docs/Search/IndexBuilder.js index 3b225c5..65f01d1 100644 --- a/src/Docs/Search/IndexBuilder.js +++ b/src/Docs/Search/IndexBuilder.js @@ -1,7 +1,14 @@ /* global __dirname require exports */ var path = require('path'); +var glob = require('glob'); exports.getDirname = function () { return __dirname; }; + +exports.glob = function (pattern) { + return function () { + return glob.sync(pattern); + }; +}; diff --git a/src/Docs/Search/IndexBuilder.purs b/src/Docs/Search/IndexBuilder.purs index 6c647a4..491a993 100644 --- a/src/Docs/Search/IndexBuilder.purs +++ b/src/Docs/Search/IndexBuilder.purs @@ -5,7 +5,7 @@ import Prelude import Docs.Search.Config (config) import Docs.Search.Declarations (Declarations(..), mkDeclarations) import Docs.Search.DocsJson (DocsJson) -import Docs.Search.Extra ((>#>), glob) +import Docs.Search.Extra ((>#>)) import Docs.Search.Index (getPartId) import Docs.Search.SearchResult (SearchResult) import Docs.Search.TypeIndex (TypeIndex, mkTypeIndex) @@ -285,3 +285,5 @@ showGlobs = Array.intercalate ", " -- | Get __dirname. foreign import getDirname :: Effect String + +foreign import glob :: String -> Effect (Array String) diff --git a/src/Docs/Search/Main.purs b/src/Docs/Search/Main.purs index 6204589..d720550 100644 --- a/src/Docs/Search/Main.purs +++ b/src/Docs/Search/Main.purs @@ -51,17 +51,17 @@ instance showCommands :: Show Commands where commands :: Parser (Maybe Commands) commands = optional $ subparser ( command "build-index" - ( info buildIndex + ( info (buildIndex <**> helper) ( progDesc "Build the index used to search for definitions and patch the generated docs so that they include a search field." ) ) <> command "search" - ( info startInteractive + ( info (startInteractive <**> helper) ( progDesc "Run the search engine." ) ) <> command "version" - ( info (pure Version) + ( info (pure Version <**> helper) ( progDesc "Show purescript-docs-search version." ) ) From 8653867c7263d49b7a614a604faaa310d05edd7a Mon Sep 17 00:00:00 2001 From: klntsky Date: Wed, 7 Aug 2019 18:32:16 +0300 Subject: [PATCH 02/10] added: rendering comments as markdown --- CHANGELOG.md | 6 ++++++ package.json | 8 ++++---- packages.dhall | 15 +++++++++++++++ spago.dhall | 2 ++ src/Docs/Search/App.purs | 6 +++++- src/Docs/Search/App/SearchResults.purs | 22 +++++++++++----------- 6 files changed, 43 insertions(+), 16 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9af155e..fdfe92c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,12 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [Unreleased] + +New features: +- Render docs as markdown (#15) +- Show help for each CLI command. + ## [0.0.4] - 2019-07-25 New features: diff --git a/package.json b/package.json index 9a15a9d..cf1c8f7 100644 --- a/package.json +++ b/package.json @@ -15,7 +15,7 @@ "CHANGELOG.md" ], "scripts": { - "test": "spago test", + "test": "spago test && npm run check-version", "bundle-app": "spago bundle-app -m Docs.Search.App --to dist/docs-search-app.js", "parcel-app": "parcel build --no-source-maps --target browser --out-file dist/docs-search-app.js dist/docs-search-app.js", "build-app": "npm run bundle-app && npm run parcel-app", @@ -25,10 +25,9 @@ "chmod-main": "chmod +x dist/purescript-docs-search", "build-main": "npm run bundle-main && npm run parcel-main && npm run add-shebang && rm dist/main.js && npm run chmod-main", "build": "npm run build-app && npm run build-main", - "build-dev": "npm run bundle-main && npm run add-shebang && rm dist/main.js && npm run chmod-main && npm run bundle-app", + "build-dev": "npm run build-app && npm run bundle-main && npm run add-shebang && rm dist/main.js && npm run chmod-main", "clean": "rm -rf dist", - "check-version": "[ \"$(./dist/purescript-docs-search version)\" = \"$npm_package_version\" ]", - "test": "spago test && npm run check-version" + "check-version": "[ \"$(./dist/purescript-docs-search version)\" = \"$npm_package_version\" ]" }, "repository": { "type": "git", @@ -46,6 +45,7 @@ "dependencies": {}, "devDependencies": { "glob": "^7.1.4", + "markdown-it": "^9.0.1", "parcel": "^1.12.3", "spago": "^0.8.5" } diff --git a/packages.dhall b/packages.dhall index 89a9e21..cee2ca0 100644 --- a/packages.dhall +++ b/packages.dhall @@ -59,6 +59,21 @@ let additions = [ "enums" ] "https://github.com/Risto-Stevcev/purescript-exitcodes.git" "v4.0.0" + , markdown-it = + mkPackage + [ "prelude", "effect", "options" ] + "https://github.com/nonbili/purescript-markdown-it.git" + "v0.2.0" + , html-parser-halogen = + mkPackage + [ "string-parsers", "generics-rep", "halogen" ] + "https://github.com/rnons/purescript-html-parser-halogen.git" + "1bdccb1f9801f671dbfd59d42ef0429fdce44e54" + , markdown-it-halogen = + mkPackage + [ "markdown-it", "html-parser-halogen" ] + "https://github.com/nonbili/purescript-markdown-it-halogen.git" + "16f3ee4c1d1120da9c80102f846245294da3438d" } in upstream ⫽ overrides ⫽ additions diff --git a/spago.dhall b/spago.dhall index 66f3dcc..4e1b85e 100644 --- a/spago.dhall +++ b/spago.dhall @@ -17,6 +17,8 @@ , "halogen" , "halogen-css" , "lists" + , "markdown-it" + , "markdown-it-halogen" , "maybe" , "newtype" , "node-buffer" diff --git a/src/Docs/Search/App.purs b/src/Docs/Search/App.purs index 17f57c1..bab121e 100644 --- a/src/Docs/Search/App.purs +++ b/src/Docs/Search/App.purs @@ -13,6 +13,7 @@ import Effect (Effect) import Halogen as H import Halogen.Aff as HA import Halogen.VDom.Driver (runUI) +import MarkdownIt as MD import Web.DOM.Document as Document import Web.DOM.Element as Element import Web.DOM.Node as Node @@ -31,10 +32,13 @@ main = do insertStyle doc mbContainers <- getContainers doc + -- Initialize a `markdown-it` instance (we need it to render the docs as markdown) + markdownIt <- MD.newMarkdownIt MD.Default mempty + whenJust mbContainers \ { searchField, searchResults, pageContents } -> do HA.runHalogenAff do sfio <- runUI SearchField.component unit searchField - srio <- runUI (SearchResults.mkComponent pageContents) unit searchResults + srio <- runUI (SearchResults.mkComponent pageContents markdownIt) unit searchResults sfio.subscribe $ Coroutine.consumer (srio.query <<< H.tell <<< SearchResults.MessageFromSearchField) diff --git a/src/Docs/Search/App/SearchResults.purs b/src/Docs/Search/App/SearchResults.purs index 04c9221..52b3f69 100644 --- a/src/Docs/Search/App/SearchResults.purs +++ b/src/Docs/Search/App/SearchResults.purs @@ -12,7 +12,6 @@ import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(.. import Docs.Search.Engine as SearchEngine import Docs.Search.Engine (ResultsType(..)) -import CSS (textWhitespace, whitespacePreWrap) import Data.Array ((!!)) import Data.Array as Array import Data.List as List @@ -24,9 +23,10 @@ import Data.String.Pattern (Pattern(..)) as String import Effect.Aff (Aff) import Halogen as H import Halogen.HTML as HH -import Halogen.HTML.CSS as HS import Halogen.HTML.Events as HE import Halogen.HTML.Properties as HP +import MarkdownIt as MD +import MarkdownIt.Renderer.Halogen as MDH import Web.DOM.Element (Element) import Web.DOM.Element as Element import Web.HTML as HTML @@ -44,6 +44,7 @@ type State = { searchEngineState :: SearchEngine.State , contents :: Element , resultsCount :: Int , mode :: Mode + , markdownIt :: MD.MarkdownIt } data Query a @@ -56,8 +57,9 @@ data Action mkComponent :: forall o i . Element + -> MD.MarkdownIt -> H.Component HH.HTML Query i o Aff -mkComponent contents = +mkComponent contents markdownIt = H.mkComponent { initialState: const { searchEngineState: mempty , results: [] @@ -66,6 +68,7 @@ mkComponent contents = , contents , resultsCount: config.resultsCount , mode: Off + , markdownIt } , render , eval: H.mkEval $ H.defaultEval { handleQuery = handleQuery @@ -179,7 +182,7 @@ render state@{ mode: Active } = ] , HH.div_ $ - Array.concat $ shownResults <#> renderResult + Array.concat $ shownResults <#> renderResult state.markdownIt , HH.div [ HP.class_ (wrap "load_more"), HP.id_ "load-more" ] [ if Array.length shownResults < Array.length state.results @@ -208,9 +211,10 @@ renderSummary text = renderResult :: forall a - . SearchResult + . MD.MarkdownIt + -> SearchResult -> Array (HH.HTML a Action) -renderResult = unwrap >>> \result -> +renderResult markdownIt = unwrap >>> \result -> [ HH.div [ HP.class_ (wrap "result") ] [ HH.h3 [ HP.class_ (wrap "result__title") ] [ HH.a [ HP.class_ (wrap "result__link") @@ -226,11 +230,7 @@ renderResult = unwrap >>> \result -> , HH.div [ HP.class_ (wrap "result__body") ] $ renderResultType result <> - result.comments >#> - \comments -> [ HH.pre [ HS.style do - textWhitespace whitespacePreWrap ] - [ HH.text comments ] - ] + result.comments >#> pure <<< MDH.render markdownIt , HH.div [ HP.class_ (wrap "result__actions") ] From 533c5451a4f67e1639596f3efb857f559934070b Mon Sep 17 00:00:00 2001 From: klntsky Date: Wed, 7 Aug 2019 20:57:14 +0300 Subject: [PATCH 03/10] added: more docs --- src/Docs/Search/App.purs | 11 ++++++++--- src/Docs/Search/App/SearchField.purs | 2 ++ src/Docs/Search/App/SearchResults.purs | 5 +++++ src/Docs/Search/Config.purs | 1 + src/Docs/Search/Declarations.purs | 16 ++++++++++------ src/Docs/Search/DocsJson.purs | 1 + src/Docs/Search/Engine.purs | 2 ++ src/Docs/Search/Extra.purs | 1 - src/Docs/Search/Index.purs | 6 ++++++ src/Docs/Search/IndexBuilder.purs | 4 ++++ src/Docs/Search/Interactive.purs | 1 + src/Docs/Search/Main.purs | 1 + src/Docs/Search/SearchResult.purs | 3 +++ src/Docs/Search/TypeIndex.purs | 10 +++------- src/Docs/Search/TypePrinter.purs | 1 + src/Docs/Search/TypeQuery.purs | 6 ++++++ src/Docs/Search/TypeShape.purs | 3 +++ 17 files changed, 57 insertions(+), 17 deletions(-) diff --git a/src/Docs/Search/App.purs b/src/Docs/Search/App.purs index bab121e..ea41fa8 100644 --- a/src/Docs/Search/App.purs +++ b/src/Docs/Search/App.purs @@ -1,3 +1,4 @@ +-- | This is the main module of the client-side Halogen app. module Docs.Search.App where import Prelude @@ -72,6 +73,7 @@ insertStyle doc = do margin-right: 0.25em; } """ + mbHead <- ParentNode.querySelector (wrap "head") (Document.toParentNode doc) @@ -82,9 +84,12 @@ insertStyle doc = do void $ Node.appendChild (Text.toNode contents) (Element.toNode style) void $ Node.appendChild (Element.toNode style) (Element.toNode head) -getContainers :: Document.Document -> Effect (Maybe { searchField :: HTML.HTMLElement - , searchResults :: HTML.HTMLElement - , pageContents :: Element.Element }) +-- | Query the DOM for specific elements that should always be present. +getContainers + :: Document.Document + -> Effect (Maybe { searchField :: HTML.HTMLElement + , searchResults :: HTML.HTMLElement + , pageContents :: Element.Element }) getContainers doc = do let docPN = Document.toParentNode doc mbBanner <- diff --git a/src/Docs/Search/App/SearchField.purs b/src/Docs/Search/App/SearchField.purs index 2ad3a15..1a37fed 100644 --- a/src/Docs/Search/App/SearchField.purs +++ b/src/Docs/Search/App/SearchField.purs @@ -1,3 +1,5 @@ +-- | This module contains a Halogen component for search field, that emits +-- | `SearchFieldMessage`s for various events. module Docs.Search.App.SearchField where import Prelude diff --git a/src/Docs/Search/App/SearchResults.purs b/src/Docs/Search/App/SearchResults.purs index 52b3f69..50122bc 100644 --- a/src/Docs/Search/App/SearchResults.purs +++ b/src/Docs/Search/App/SearchResults.purs @@ -1,3 +1,4 @@ +-- | This module contains a Halogen component for search results. module Docs.Search.App.SearchResults where import Prelude @@ -134,6 +135,7 @@ handleAction = case _ of showPageContents H.modify_ (_ { input = "", mode = Off }) +-- | Inverse of `hidePageContents` showPageContents :: forall o . H.HalogenM State Action () o Aff Unit @@ -142,6 +144,7 @@ showPageContents = do H.liftEffect do Element.removeAttribute "style" state.contents +-- | When search UI is active, we want to hide the main page contents. hidePageContents :: forall o . H.HalogenM State Action () o Aff Unit @@ -215,6 +218,7 @@ renderResult -> SearchResult -> Array (HH.HTML a Action) renderResult markdownIt = unwrap >>> \result -> + -- class names here and below are from Pursuit. [ HH.div [ HP.class_ (wrap "result") ] [ HH.h3 [ HP.class_ (wrap "result__title") ] [ HH.a [ HP.class_ (wrap "result__link") @@ -568,6 +572,7 @@ renderKind = case _ of FunKind k1 k2 -> HH.span_ [ renderKind k1, syntax " -> ", renderKind k2 ] NamedKind qname -> renderQualifiedName false KindLevel qname +-- | Construct a `href` property value w.r.t. `DeclLevel`. makeHref :: forall t rest . DeclLevel diff --git a/src/Docs/Search/Config.purs b/src/Docs/Search/Config.purs index ad7ea39..2f3a8d5 100644 --- a/src/Docs/Search/Config.purs +++ b/src/Docs/Search/Config.purs @@ -2,6 +2,7 @@ module Docs.Search.Config where import Prelude +-- | Some magic constants. config = { outputDirectory: "output" , requiredDirectories: diff --git a/src/Docs/Search/Declarations.purs b/src/Docs/Search/Declarations.purs index 843a918..8173825 100644 --- a/src/Docs/Search/Declarations.purs +++ b/src/Docs/Search/Declarations.purs @@ -31,9 +31,7 @@ derive newtype instance semigroupDeclarations :: Semigroup Declarations derive newtype instance monoidDeclarations :: Monoid Declarations mkDeclarations :: Array DocsJson -> Declarations -mkDeclarations docsJson = Declarations trie - where - trie = foldr insertDocsJson mempty docsJson +mkDeclarations = Declarations <<< foldr insertDocsJson mempty insertDocsJson :: DocsJson @@ -48,7 +46,7 @@ insertDeclaration -> Trie Char (List SearchResult) -> Trie Char (List SearchResult) insertDeclaration moduleName entry@(Declaration { title }) trie - = foldr insertSearchResult trie (resultsForEntry moduleName entry) + = foldr insertSearchResult trie (resultsForDeclaration moduleName entry) insertSearchResult :: { path :: String @@ -67,13 +65,15 @@ insertSearchResult { path, result } trie = Nothing -> Just $ List.singleton result -resultsForEntry +-- | For each declaration, extract its own `SearchResult` and `SearchResult`s +-- | corresponding to its children (e.g. a class declaration contains class members). +resultsForDeclaration :: ModuleName -> Declaration -> List { path :: String , result :: SearchResult } -resultsForEntry moduleName indexEntry@(Declaration entry) = +resultsForDeclaration moduleName indexEntry@(Declaration entry) = let { info, title, sourceSpan, comments, children } = entry { name, declLevel } = getLevelAndName info.declType title packageName = extractPackageName sourceSpan.name @@ -192,6 +192,7 @@ extractPackageName name = Nothing -> Just "" +-- | Extract `SearchResults` from a `ChildDeclaration`. resultsForChildDeclaration :: PackageName -> ModuleName @@ -262,6 +263,9 @@ mkChildInfo parentResult (ChildDeclaration { info } ) = (\arg -> compose (\type'' -> ForAll arg type'' Nothing)) identity allArguments + -- Finally, we have a restored type. It allows us to search for type members the same way + -- we search for functions. And types of class member results appear with the correct + -- class constraints. restoredType = restoreType $ ConstrainedType (Constraint { constraintClass , constraintArgs: typeClassArguments <#> TypeVar diff --git a/src/Docs/Search/DocsJson.purs b/src/Docs/Search/DocsJson.purs index a98d91f..5a9fa74 100644 --- a/src/Docs/Search/DocsJson.purs +++ b/src/Docs/Search/DocsJson.purs @@ -1,3 +1,4 @@ +-- | A module containing everything that is necessary to decode `docs.json` files. module Docs.Search.DocsJson where import Prelude diff --git a/src/Docs/Search/Engine.purs b/src/Docs/Search/Engine.purs index 93fba11..af931f8 100644 --- a/src/Docs/Search/Engine.purs +++ b/src/Docs/Search/Engine.purs @@ -1,3 +1,5 @@ +-- | A "search engine" that determines if a query is a declaration query or a type query, and +-- | searches for it in the corresponding index. module Docs.Search.Engine where import Prelude diff --git a/src/Docs/Search/Extra.purs b/src/Docs/Search/Extra.purs index ff7b251..8b1c16d 100644 --- a/src/Docs/Search/Extra.purs +++ b/src/Docs/Search/Extra.purs @@ -5,7 +5,6 @@ import Prelude import Data.Foldable (class Foldable, foldMap, foldl) import Data.List.NonEmpty (NonEmptyList, cons', uncons) import Data.Maybe (Maybe(..)) -import Effect (Effect) import Data.List as List import Data.List ((:)) diff --git a/src/Docs/Search/Index.purs b/src/Docs/Search/Index.purs index df384a4..93d0297 100644 --- a/src/Docs/Search/Index.purs +++ b/src/Docs/Search/Index.purs @@ -1,3 +1,5 @@ +-- | Contains `Index` that can be loaded on demand, transparently +-- | to the user. module Docs.Search.Index where import Prelude @@ -31,6 +33,10 @@ derive instance newtypeIndex :: Newtype Index _ derive newtype instance semigroupIndex :: Semigroup Index derive newtype instance monoidIndex :: Monoid Index +-- | This function dynamically injects a script with the required index part and returns +-- | a new `Index` that contains newly loaded definitions. +-- | +-- | We split the index because of its size, and also to speed up queries. query :: Index -> String diff --git a/src/Docs/Search/IndexBuilder.purs b/src/Docs/Search/IndexBuilder.purs index 491a993..c0ba2e6 100644 --- a/src/Docs/Search/IndexBuilder.purs +++ b/src/Docs/Search/IndexBuilder.purs @@ -213,6 +213,8 @@ patchHTML html = then Tuple true $ String.replace pattern (Replacement patch) html else Tuple false html +-- | Iterate through the HTML files generated by the PureScript compiler, and +-- | modify them using `patchHTML`. patchDocs :: Config -> Aff Unit patchDocs cfg = do let dirname = cfg.generatedDocs @@ -229,6 +231,8 @@ patchDocs cfg = do writeTextFile UTF8 path patchedContents _ -> pure unit +-- | Create directories for two indices, or fail with a message +-- | in case the docs were not generated. createDirectories :: Config -> Aff Unit createDirectories { generatedDocs } = do let indexDir = generatedDocs <> "/index" diff --git a/src/Docs/Search/Interactive.purs b/src/Docs/Search/Interactive.purs index ac49dbe..f66db22 100644 --- a/src/Docs/Search/Interactive.purs +++ b/src/Docs/Search/Interactive.purs @@ -1,3 +1,4 @@ +-- | Definitions for the "search REPL". module Docs.Search.Interactive where import Prelude diff --git a/src/Docs/Search/Main.purs b/src/Docs/Search/Main.purs index d720550..d1792a6 100644 --- a/src/Docs/Search/Main.purs +++ b/src/Docs/Search/Main.purs @@ -1,3 +1,4 @@ +-- | The main module of the CLI interface app. module Docs.Search.Main where import Prelude diff --git a/src/Docs/Search/SearchResult.purs b/src/Docs/Search/SearchResult.purs index f111200..2f74e96 100644 --- a/src/Docs/Search/SearchResult.purs +++ b/src/Docs/Search/SearchResult.purs @@ -11,6 +11,7 @@ import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) +-- | Metadata that makes sense only for certain types of search results. data ResultInfo = DataResult { typeArguments :: Array TypeArgument , dataDeclType :: DataDeclType } @@ -37,6 +38,7 @@ instance encodeJsonResultInfo :: EncodeJson ResultInfo where instance decodeJsonResultInfo :: DecodeJson ResultInfo where decodeJson = genericDecodeJson +-- | Extract the type field. typeOf :: ResultInfo -> Maybe Type typeOf (TypeSynonymResult { type: res }) = Just res @@ -46,6 +48,7 @@ typeOf (ValueResult { type: res }) = Just res typeOf _ = Nothing +-- | Common metadata for all types of search results. newtype SearchResult = SearchResult { name :: String , comments :: Maybe String diff --git a/src/Docs/Search/TypeIndex.purs b/src/Docs/Search/TypeIndex.purs index c7de391..95f4c91 100644 --- a/src/Docs/Search/TypeIndex.purs +++ b/src/Docs/Search/TypeIndex.purs @@ -3,7 +3,7 @@ module Docs.Search.TypeIndex where import Prelude import Docs.Search.Config (config) -import Docs.Search.Declarations (resultsForEntry) +import Docs.Search.Declarations (resultsForDeclaration) import Docs.Search.DocsJson (DocsJson(..)) import Docs.Search.SearchResult (ResultInfo(..), SearchResult) import Docs.Search.TypeDecoder (Type) @@ -43,7 +43,7 @@ mkTypeIndex docsJsons = allResults :: DocsJson -> Array SearchResult allResults (DocsJson { name, declarations }) = - declarations >>= (resultsForEntry name >>> map (_.result) >>> Array.fromFoldable) + declarations >>= (resultsForDeclaration name >>> map (_.result) >>> Array.fromFoldable) resultsWithTypes :: DocsJson -> Array SearchResult resultsWithTypes docsJson = Array.filter (getType >>> isJust) $ allResults docsJson @@ -92,11 +92,7 @@ query -> Aff { typeIndex :: TypeIndex, results :: Array SearchResult } query typeIndex typeQuery = do res <- lookup (stringifyShape $ shapeOfTypeQuery typeQuery) typeIndex - pure $ res { results = sortByRelevance typeQuery res.results } - --- | TODO -sortByRelevance :: TypeQuery -> Array SearchResult -> Array SearchResult -sortByRelevance typeQuery = identity + pure $ res { results = res.results } foreign import lookup_ :: String diff --git a/src/Docs/Search/TypePrinter.purs b/src/Docs/Search/TypePrinter.purs index c25ce09..8e2fc9d 100644 --- a/src/Docs/Search/TypePrinter.purs +++ b/src/Docs/Search/TypePrinter.purs @@ -9,6 +9,7 @@ import Data.Maybe (Maybe(..)) import Data.Array as Array import Data.List as List +-- | A pretty-printer for types, for TTY with colors. showType :: Type -> String showType = case _ of TypeVar str -> str diff --git a/src/Docs/Search/TypeQuery.purs b/src/Docs/Search/TypeQuery.purs index 618009c..078cb57 100644 --- a/src/Docs/Search/TypeQuery.purs +++ b/src/Docs/Search/TypeQuery.purs @@ -37,6 +37,8 @@ import Text.Parsing.StringParser (ParseError, Parser, runParser, try) import Text.Parsing.StringParser.CodePoints (alphaNum, anyLetter, char, eof, lowerCaseChar, skipSpaces, string, upperCaseChar) import Text.Parsing.StringParser.Combinators (fix, sepBy, sepBy1, sepEndBy, sepEndBy1) +-- | We need type queries because we don't have a full-featured type parser +-- | available. data TypeQuery = QVar String | QConst String @@ -185,6 +187,9 @@ derive instance genericSubstitution :: Generic Substitution _ instance showSubstitution :: Show Substitution where show x = genericShow x +-- | A mock-up of unification algorithm, that does not unify anything, actually. +-- | We use it to estimate how far a type is from a type query, by looking into +-- | the resulting list. unify :: TypeQuery -> Type -> List Substitution unify query type_ = go Nil (List.singleton { q: query, t: type_ }) where @@ -284,6 +289,7 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ }) go acc ({ q, t: REmpty } : rest) = go (QueryMismatch q : acc) rest +-- | Sum various penalties. penalty :: TypeQuery -> Type -> Int penalty typeQuery ty = let substs = unify typeQuery ty in diff --git a/src/Docs/Search/TypeShape.purs b/src/Docs/Search/TypeShape.purs index b808540..a97b6fb 100644 --- a/src/Docs/Search/TypeShape.purs +++ b/src/Docs/Search/TypeShape.purs @@ -1,3 +1,6 @@ +-- | We need `TypeShape`s as a way to "semantically hash" types. +-- | This allows us to split type index in parts and load +-- | it on demand. module Docs.Search.TypeShape where import Prelude From 62b034c710796883fadd341a47203f681536be53 Mon Sep 17 00:00:00 2001 From: klntsky Date: Thu, 8 Aug 2019 10:21:39 +0300 Subject: [PATCH 04/10] update library versions --- packages.dhall | 6 +++--- src/Docs/Search/App/SearchResults.purs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/packages.dhall b/packages.dhall index cee2ca0..858ab61 100644 --- a/packages.dhall +++ b/packages.dhall @@ -63,17 +63,17 @@ let additions = mkPackage [ "prelude", "effect", "options" ] "https://github.com/nonbili/purescript-markdown-it.git" - "v0.2.0" + "v0.4.0" , html-parser-halogen = mkPackage [ "string-parsers", "generics-rep", "halogen" ] "https://github.com/rnons/purescript-html-parser-halogen.git" - "1bdccb1f9801f671dbfd59d42ef0429fdce44e54" + "890da763cdd2a1049ab8837e477c5ba1fcf6d4ce" , markdown-it-halogen = mkPackage [ "markdown-it", "html-parser-halogen" ] "https://github.com/nonbili/purescript-markdown-it-halogen.git" - "16f3ee4c1d1120da9c80102f846245294da3438d" + "08c9625015bf04214be14e45230e8ce12f3fa2bf" } in upstream ⫽ overrides ⫽ additions diff --git a/src/Docs/Search/App/SearchResults.purs b/src/Docs/Search/App/SearchResults.purs index 50122bc..25a28d5 100644 --- a/src/Docs/Search/App/SearchResults.purs +++ b/src/Docs/Search/App/SearchResults.purs @@ -234,7 +234,7 @@ renderResult markdownIt = unwrap >>> \result -> , HH.div [ HP.class_ (wrap "result__body") ] $ renderResultType result <> - result.comments >#> pure <<< MDH.render markdownIt + result.comments >#> pure <<< MDH.render_ markdownIt , HH.div [ HP.class_ (wrap "result__actions") ] From 6649e07881b70daf2db56d304399152c2bb9d1a5 Mon Sep 17 00:00:00 2001 From: klntsky Date: Wed, 28 Aug 2019 23:44:35 +0300 Subject: [PATCH 05/10] Minor refactoring --- package.json | 8 ++--- src/Docs/Search/App.purs | 9 +++--- src/Docs/Search/Declarations.purs | 51 +++++++++++++++---------------- 3 files changed, 33 insertions(+), 35 deletions(-) diff --git a/package.json b/package.json index cf1c8f7..19526e9 100644 --- a/package.json +++ b/package.json @@ -16,16 +16,16 @@ ], "scripts": { "test": "spago test && npm run check-version", - "bundle-app": "spago bundle-app -m Docs.Search.App --to dist/docs-search-app.js", + "bundle-app": "spago bundle-app --no-build --no-install -m Docs.Search.App --to dist/docs-search-app.js", "parcel-app": "parcel build --no-source-maps --target browser --out-file dist/docs-search-app.js dist/docs-search-app.js", "build-app": "npm run bundle-app && npm run parcel-app", - "bundle-main": "spago bundle-app -m Docs.Search.Main --to dist/main.js", + "bundle-main": "spago bundle-app --no-build --no-install -m Docs.Search.Main --to dist/main.js", "parcel-main": "parcel build --no-source-maps --target node --bundle-node-modules --out-file dist/main.js dist/main.js", "add-shebang": "echo \"#!/usr/bin/env node\" > dist/purescript-docs-search && cat dist/main.js >> dist/purescript-docs-search", "chmod-main": "chmod +x dist/purescript-docs-search", "build-main": "npm run bundle-main && npm run parcel-main && npm run add-shebang && rm dist/main.js && npm run chmod-main", - "build": "npm run build-app && npm run build-main", - "build-dev": "npm run build-app && npm run bundle-main && npm run add-shebang && rm dist/main.js && npm run chmod-main", + "build": "spago build && npm run build-app && npm run build-main", + "build-dev": "spago build && npm run build-app && npm run bundle-main && npm run add-shebang && rm dist/main.js && npm run chmod-main", "clean": "rm -rf dist", "check-version": "[ \"$(./dist/purescript-docs-search version)\" = \"$npm_package_version\" ]" }, diff --git a/src/Docs/Search/App.purs b/src/Docs/Search/App.purs index ea41fa8..d402ee5 100644 --- a/src/Docs/Search/App.purs +++ b/src/Docs/Search/App.purs @@ -98,12 +98,13 @@ getContainers doc = do ParentNode.querySelector (wrap ".everything-except-footer") docPN mbContainer <- ParentNode.querySelector (wrap ".everything-except-footer > .container") docPN - case mbBanner, mbEverything, mbContainer of - Just banner, Just everything, Just pageContents -> do + case unit of + _ | Just banner <- mbBanner + , Just everything <- mbEverything + , Just pageContents <- mbContainer -> do search <- Document.createElement "div" doc void $ Node.appendChild (Element.toNode search) (Element.toNode banner) pure $ fromElement search >>= \searchField -> fromElement everything >>= \searchResults -> pure { searchField, searchResults, pageContents } - _, _, _ -> - pure Nothing + | otherwise -> pure Nothing diff --git a/src/Docs/Search/Declarations.purs b/src/Docs/Search/Declarations.purs index 8173825..056018c 100644 --- a/src/Docs/Search/Declarations.purs +++ b/src/Docs/Search/Declarations.purs @@ -56,14 +56,13 @@ insertSearchResult -> Trie Char (List SearchResult) insertSearchResult { path, result } trie = let path' = List.fromFoldable $ toCharArray $ toLower path in - alter path' updateResults trie + alter path' (Just <<< updateResults) trie where - updateResults mbOldResults = - case mbOldResults of - Just oldResults -> - Just $ result : oldResults - Nothing -> - Just $ List.singleton result + updateResults mbOldResults + | Just oldResults <- mbOldResults = + result : oldResults + | otherwise = + List.singleton result -- | For each declaration, extract its own `SearchResult` and `SearchResult`s -- | corresponding to its children (e.g. a class declaration contains class members). @@ -103,29 +102,28 @@ mkInfo declLevel (Declaration { info, title }) = case info.declType of DeclValue -> - info.type <#> - \ty -> ValueResult { type: ty } + info."type" <#> \ty -> ValueResult { type: ty } DeclData -> - make <$> info.typeArguments <*> info.dataDeclType - where - make typeArguments dataDeclType = - DataResult { typeArguments, dataDeclType } + make <$> info.typeArguments <*> info.dataDeclType + where + make typeArguments dataDeclType = + DataResult { typeArguments, dataDeclType } DeclExternData -> - info.kind <#> - \kind -> ExternDataResult { kind } + info.kind <#> \kind -> ExternDataResult { kind } DeclTypeSynonym -> - make <$> info.type <*> info.arguments + make <$> info."type" <*> info.arguments where - make ty args = TypeSynonymResult { type: ty, arguments: args } + make ty args = TypeSynonymResult { "type": ty, arguments: args } - DeclTypeClass -> - case info.fundeps, info.arguments, info.superclasses of - Just fundeps, Just arguments, Just superclasses -> - Just $ TypeClassResult { fundeps, arguments, superclasses } - _, _, _ -> Nothing + DeclTypeClass + | Just fundeps <- info.fundeps + , Just arguments <- info.arguments + , Just superclasses <- info.superclasses -> + Just $ TypeClassResult { fundeps, arguments, superclasses } + | otherwise -> Nothing DeclAlias -> case declLevel of @@ -200,10 +198,8 @@ resultsForChildDeclaration -> ChildDeclaration -> List { path :: String, result :: SearchResult } resultsForChildDeclaration packageName moduleName parentResult - child@(ChildDeclaration { title, info, comments, mbSourceSpan }) = - case mkChildInfo parentResult child of - Nothing -> mempty - Just resultInfo -> + child@(ChildDeclaration { title, info, comments, mbSourceSpan }) + | Just resultInfo <- mkChildInfo parentResult child = { path: title , result: SearchResult { name: title , comments @@ -218,6 +214,7 @@ resultsForChildDeclaration packageName moduleName parentResult , info: resultInfo } } # List.singleton + | otherwise = mempty mkChildInfo :: SearchResult @@ -234,7 +231,7 @@ mkChildInfo parentResult (ChildDeclaration { info } ) = -- We need to reconstruct a "real" type of a type class member. -- For example, if `unconstrainedType` is the type of `pure`, i.e. `forall a. a -> m a`, -- `restoredType` should be `forall m a. Control.Applicative.Applicative m => a -> m a`. - info.type <#> + info."type" <#> \(unconstrainedType :: Type) -> let -- First, we get a list of nested `forall` quantifiers for `unconstrainedType` From 65fd09fe0b06070541628afa528a2b04f31a7b55 Mon Sep 17 00:00:00 2001 From: klntsky Date: Wed, 28 Aug 2019 23:50:37 +0300 Subject: [PATCH 06/10] Upgrade package set --- packages.dhall | 144 ++++++++++++++++++++++++------------------------- 1 file changed, 72 insertions(+), 72 deletions(-) diff --git a/packages.dhall b/packages.dhall index 858ab61..bb12492 100644 --- a/packages.dhall +++ b/packages.dhall @@ -1,79 +1,79 @@ let mkPackage = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2-20190725/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 + https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2-20190725/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 let upstream = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2-20190725/src/packages.dhall sha256:60cc03d2c3a99a0e5eeebb16a22aac219fa76fe6a1686e8c2bd7a11872527ea3 + https://github.com/purescript/package-sets/releases/download/psc-0.13.3-20190827/packages.dhall sha256:93f6b11068b42eac6632d56dab659a151c231381e53a16de621ae6d0dab475ce -let overrides = { metadata = upstream.metadata ⫽ { version = "v0.13.0" } } +let overrides = { metadata = upstream.metadata // { version = "v0.13.0" } } let additions = - { halogen = - mkPackage - [ "aff" - , "avar" - , "console" - , "const" - , "coroutines" - , "dom-indexed" - , "foreign" - , "fork" - , "free" - , "freeap" - , "halogen-vdom" - , "media-types" - , "nullable" - , "ordered-collections" - , "parallel" - , "profunctor" - , "transformers" - , "unsafe-coerce" - , "unsafe-reference" - , "web-uievents" - ] - "https://github.com/slamdata/purescript-halogen.git" - "v5.0.0-rc.5" - , halogen-css = - mkPackage - [ "css", "halogen" ] - "https://github.com/slamdata/purescript-halogen-css.git" - "v8.0.0" - , optparse = - mkPackage - [ "prelude" - , "effect" - , "exitcodes" - , "strings" - , "ordered-collections" - , "arrays" - , "console" - , "memoize" - , "transformers" - , "exists" - , "node-process" - , "free" - ] - "https://github.com/f-o-a-m/purescript-optparse.git" - "v3.0.1" - , exitcodes = - mkPackage - [ "enums" ] - "https://github.com/Risto-Stevcev/purescript-exitcodes.git" - "v4.0.0" - , markdown-it = - mkPackage - [ "prelude", "effect", "options" ] - "https://github.com/nonbili/purescript-markdown-it.git" - "v0.4.0" - , html-parser-halogen = - mkPackage - [ "string-parsers", "generics-rep", "halogen" ] - "https://github.com/rnons/purescript-html-parser-halogen.git" - "890da763cdd2a1049ab8837e477c5ba1fcf6d4ce" - , markdown-it-halogen = - mkPackage - [ "markdown-it", "html-parser-halogen" ] - "https://github.com/nonbili/purescript-markdown-it-halogen.git" - "08c9625015bf04214be14e45230e8ce12f3fa2bf" - } + { halogen = + mkPackage + [ "aff" + , "avar" + , "console" + , "const" + , "coroutines" + , "dom-indexed" + , "foreign" + , "fork" + , "free" + , "freeap" + , "halogen-vdom" + , "media-types" + , "nullable" + , "ordered-collections" + , "parallel" + , "profunctor" + , "transformers" + , "unsafe-coerce" + , "unsafe-reference" + , "web-uievents" + ] + "https://github.com/slamdata/purescript-halogen.git" + "v5.0.0-rc.6" + , halogen-css = + mkPackage + [ "css", "halogen" ] + "https://github.com/slamdata/purescript-halogen-css.git" + "v8.0.0" + , optparse = + mkPackage + [ "prelude" + , "effect" + , "exitcodes" + , "strings" + , "ordered-collections" + , "arrays" + , "console" + , "memoize" + , "transformers" + , "exists" + , "node-process" + , "free" + ] + "https://github.com/f-o-a-m/purescript-optparse.git" + "v3.0.1" + , exitcodes = + mkPackage + [ "enums" ] + "https://github.com/Risto-Stevcev/purescript-exitcodes.git" + "v4.0.0" + , markdown-it = + mkPackage + [ "prelude", "effect", "options" ] + "https://github.com/nonbili/purescript-markdown-it.git" + "v0.4.0" + , html-parser-halogen = + mkPackage + [ "string-parsers", "generics-rep", "halogen" ] + "https://github.com/rnons/purescript-html-parser-halogen.git" + "890da763cdd2a1049ab8837e477c5ba1fcf6d4ce" + , markdown-it-halogen = + mkPackage + [ "markdown-it", "html-parser-halogen" ] + "https://github.com/nonbili/purescript-markdown-it-halogen.git" + "08c9625015bf04214be14e45230e8ce12f3fa2bf" + } -in upstream ⫽ overrides ⫽ additions +in upstream // overrides // additions From 9db8d5a49ab6d5cbb07b1be4e1a7db90500d0078 Mon Sep 17 00:00:00 2001 From: klntsky Date: Thu, 29 Aug 2019 13:38:41 +0300 Subject: [PATCH 07/10] Bump compiler version --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 4febb76..d21fae5 100644 --- a/.travis.yml +++ b/.travis.yml @@ -14,7 +14,7 @@ env: - PATH=$HOME/purescript:$PATH install: -- export PURS_VERSION=v0.13.2 +- export PURS_VERSION=v0.13.3 - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$PURS_VERSION/linux64.tar.gz - tar -xvf $HOME/purescript.tar.gz -C $HOME/ - chmod a+x $HOME/purescript From 3e8974fa01131d4640b892d9b5347ffae2e15cec Mon Sep 17 00:00:00 2001 From: klntsky Date: Fri, 30 Aug 2019 11:27:37 +0300 Subject: [PATCH 08/10] Fix decoding errors for kind annotations in foralls. https://travis-ci.com/spacchetti/starsuit/jobs/229423445#L2489 Fix missing kind annotations in foralls for type class members E.g. Before: reifyKeyAndValueSymbols' :: forall f l. ReifyKeyAndValueSymbols l => f l -> List (Tuple String String) After: reifyKeyAndValueSymbols' :: forall (f :: RowList -> Type) l. ReifyKeyAndValueSymbols l => f l -> List (Tuple String String) Swap arguments in ForAll constructor of Type --- src/Docs/Search/Declarations.purs | 9 +- src/Docs/Search/TypeDecoder.purs | 42 +++++++- src/Docs/Search/TypeQuery.purs | 4 +- test/Main.purs | 158 +++++++++++++++++++++++++++++- 4 files changed, 200 insertions(+), 13 deletions(-) diff --git a/src/Docs/Search/Declarations.purs b/src/Docs/Search/Declarations.purs index 056018c..416a665 100644 --- a/src/Docs/Search/Declarations.purs +++ b/src/Docs/Search/Declarations.purs @@ -4,7 +4,7 @@ import Prelude import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..)) import Docs.Search.DocsJson (ChildDeclType(..), ChildDeclaration(..), DeclType(..), Declaration(..), DocsJson(..)) -import Docs.Search.TypeDecoder (Constraint(..), QualifiedName(..), Type(..), joinForAlls) +import Docs.Search.TypeDecoder (Constraint(..), QualifiedName(..), Type(..), Kind (..), joinForAlls) import Control.Alt ((<|>)) import Data.Array ((!!)) @@ -250,14 +250,15 @@ mkChildInfo parentResult (ChildDeclaration { info } ) = -- We concatenate two lists: -- * list of type parameters of the type class, and -- * list of quantified variables of the unconstrained type - allArguments :: Array String + allArguments :: Array { var :: String, mbKind :: Maybe Kind } allArguments = - typeClassArguments <> (List.toUnfoldable binders <#> (_.var)) + (typeClassArguments <#> \var -> { var, mbKind: Nothing }) <> + (List.toUnfoldable binders) restoreType :: Type -> Type restoreType = foldr - (\arg -> compose (\type'' -> ForAll arg type'' Nothing)) + (\arg -> compose (\type'' -> ForAll arg.var arg.mbKind type'')) identity allArguments -- Finally, we have a restored type. It allows us to search for type members the same way diff --git a/src/Docs/Search/TypeDecoder.purs b/src/Docs/Search/TypeDecoder.purs index 58504a7..b0aa7c7 100644 --- a/src/Docs/Search/TypeDecoder.purs +++ b/src/Docs/Search/TypeDecoder.purs @@ -2,6 +2,7 @@ module Docs.Search.TypeDecoder where import Prelude +import Control.Alt ((<|>)) import Data.Argonaut.Core (Json, caseJsonObject, fromArray, fromObject, jsonEmptyObject, stringify, toArray) import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:)) import Data.Argonaut.Encode (class EncodeJson, encodeJson) @@ -138,7 +139,7 @@ data Type -- | A type application | TypeApp Type Type -- | Forall quantifier - | ForAll String Type (Maybe Kind) + | ForAll String (Maybe Kind) Type -- | A type withset of type class constraints | ConstrainedType Constraint Type {- @@ -179,7 +180,20 @@ instance decodeJsonType :: DecodeJson Type where decodeContents (decodeTuple TypeApp (const err)) (Left err) json where err = mkJsonError' "TypeApp" json "ForAll" -> - decodeContents (decodeTriple ForAll err) (Left $ err unit) json + decodeContents + (decodeTriple + (\(v :: String) (t :: Type) (_ :: Maybe Int) -> + ForAll v Nothing t) err) + (Left $ err unit) + json + <|> + decodeContents + (decodeQuadriple + (\f (k :: Kind) a (_ :: Maybe Int) -> + ForAll f (Just k) a) + err) + (Left $ err unit) + json where err = mkJsonError "ForAll" json "ConstrainedType" -> decodeContents (decodeTuple ConstrainedType err) (Left $ err unit) json @@ -305,6 +319,28 @@ decodeTriple cont err json = pure $ cont fst sec trd _ -> Left $ err unit +-- | Decode a heterogeneous quadriple. +decodeQuadriple + :: forall fst sec trd frt res + . DecodeJson fst + => DecodeJson sec + => DecodeJson trd + => DecodeJson frt + => (fst -> sec -> trd -> frt -> res) + -> (forall a. a -> String) + -> Json + -> Either String res +decodeQuadriple cont err json = + case toArray json of + Just [ json1, json2, json3, json4 ] -> do + fst <- decodeJson json1 + sec <- decodeJson json2 + trd <- decodeJson json3 + frt <- decodeJson json4 + pure $ cont fst sec trd frt + _ -> Left $ err unit + + -- | Decode a `.contents` property. decodeContents :: forall r. (Json -> r) -> r -> Json -> r decodeContents go err json = @@ -354,7 +390,7 @@ joinForAlls } joinForAlls ty = go Nil ty where - go acc (ForAll var ty' mbKind) = + go acc (ForAll var mbKind ty') = go ({ var, mbKind } : acc) ty' go acc ty' = { binders: acc, ty: ty' } diff --git a/src/Docs/Search/TypeQuery.purs b/src/Docs/Search/TypeQuery.purs index 078cb57..9cd9ffe 100644 --- a/src/Docs/Search/TypeQuery.purs +++ b/src/Docs/Search/TypeQuery.purs @@ -199,7 +199,7 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ }) go acc ({ q, t } : rest) -- * ForAll - go acc ({ q, t: ForAll _ t _ } : rest) = + go acc ({ q, t: ForAll _ _ t } : rest) = go acc ({ q, t } : rest) go acc ({ q: (QForAll _ q), t } : rest) = go acc ({ q, t } : rest) @@ -399,7 +399,7 @@ typeSize = go 0 <<< List.singleton go (n + 1) (t1 : t2 : rest) go n (TypeApp q1 q2 : rest) = go (n + 1) (q1 : q2 : rest) - go n (ForAll _ t _ : rest) = + go n (ForAll _ _ t : rest) = go (n + 1) (t : rest) go n (ConstrainedType _ t : rest) = go (n + 1) (t : rest) diff --git a/test/Main.purs b/test/Main.purs index f4fda11..b38f824 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -389,14 +389,164 @@ mainTest = do (TypeVar "t")) REmpty - test "ForAll" do + test "ForAll #1" do let forallJson = mkJson """ {"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]} """ assertRight (decodeJson forallJson) $ - ForAll "a" (TypeApp (TypeApp (TypeConstructor $ qualified ["Prim"] "Function") + ForAll "a" Nothing (TypeApp (TypeApp (TypeConstructor $ qualified ["Prim"] "Function") (TypeConstructor $ qualified ["Prim"] "String")) - (TypeVar "a")) Nothing + (TypeVar "a")) + + test "ForAll #2" do + let forallJson = mkJson """ +{ + "annotation": [], + "tag": "ForAll", + "contents": [ + "f", + { + "annotation": [], + "tag": "FunKind", + "contents": [ + { + "annotation": [], + "tag": "NamedKind", + "contents": [ + [ + "Prim", + "RowList" + ], + "RowList" + ] + }, + { + "annotation": [], + "tag": "NamedKind", + "contents": [ + [ + "Prim" + ], + "Type" + ] + } + ] + }, + { + "annotation": [], + "tag": "TypeApp", + "contents": [ + { + "annotation": [], + "tag": "TypeApp", + "contents": [ + { + "annotation": [], + "tag": "TypeConstructor", + "contents": [ + [ + "Prim" + ], + "Function" + ] + }, + { + "annotation": [], + "tag": "TypeApp", + "contents": [ + { + "annotation": [], + "tag": "TypeVar", + "contents": "f" + }, + { + "annotation": [], + "tag": "TypeVar", + "contents": "l" + } + ] + } + ] + }, + { + "annotation": [], + "tag": "TypeApp", + "contents": [ + { + "annotation": [], + "tag": "TypeConstructor", + "contents": [ + [ + "Data", + "List", + "Types" + ], + "List" + ] + }, + { + "annotation": [], + "tag": "ParensInType", + "contents": { + "annotation": [], + "tag": "TypeApp", + "contents": [ + { + "annotation": [], + "tag": "TypeApp", + "contents": [ + { + "annotation": [], + "tag": "TypeConstructor", + "contents": [ + [ + "Data", + "Tuple" + ], + "Tuple" + ] + }, + { + "annotation": [], + "tag": "TypeConstructor", + "contents": [ + [ + "Prim" + ], + "String" + ] + } + ] + }, + { + "annotation": [], + "tag": "TypeConstructor", + "contents": [ + [ + "Prim" + ], + "String" + ] + } + ] + } + } + ] + } + ] + }, + null + ] +} + """ + assertRight (decodeJson forallJson) $ + ForAll "f" + (Just (FunKind (NamedKind (QualifiedName { moduleName: ["Prim","RowList"], name: "RowList" })) (NamedKind (QualifiedName { moduleName: ["Prim"], name: "Type" })))) + (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "Function" })) (TypeApp (TypeVar "f") (TypeVar "l"))) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Data","List","Types"], name: "List" })) (ParensInType (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Data","Tuple"], name: "Tuple" })) (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "String" }))) (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "String" })))))) + + + + suite "jsons" do test "jsons #1" do @@ -404,7 +554,7 @@ mainTest = do {"annotation":[],"tag":"ForAll","contents":["o",{"annotation":[],"tag":"ForAll","contents":["r",{"annotation":[],"tag":"ForAll","contents":["l",{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["Type","Data","Boolean"],"And"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"l"},{"annotation":[],"tag":"TypeVar","contents":"r"},{"annotation":[],"tag":"TypeVar","contents":"o"}],"constraintData":null},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Type","Data","Boolean"],"BProxy"]},{"annotation":[],"tag":"TypeVar","contents":"l"}]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Type","Data","Boolean"],"BProxy"]},{"annotation":[],"tag":"TypeVar","contents":"r"}]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Type","Data","Boolean"],"BProxy"]},{"annotation":[],"tag":"TypeVar","contents":"o"}]}]}]}]},null]},null]},null]} """ - assertRight (decodeJson json) $ (ForAll "o" (ForAll "r" (ForAll "l" (ConstrainedType (Constraint { constraintArgs: [(TypeVar "l"),(TypeVar "r"),(TypeVar "o")], constraintClass: (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "And" }) }) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "l"))) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "r"))) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "o"))))) Nothing) Nothing) Nothing) + assertRight (decodeJson json) $ (ForAll "o" Nothing (ForAll "r" Nothing (ForAll "l" Nothing (ConstrainedType (Constraint { constraintArgs: [(TypeVar "l"),(TypeVar "r"),(TypeVar "o")], constraintClass: (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "And" }) }) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "l"))) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Prim"], name: "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "r"))) (TypeApp (TypeConstructor (QualifiedName { moduleName: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "o")))))))) suite "Kind encoder" do test "FunKind" do From 1f5f566b521d2c1b9402c4ff080d4595b20dec9d Mon Sep 17 00:00:00 2001 From: klntsky Date: Fri, 30 Aug 2019 11:59:55 +0300 Subject: [PATCH 09/10] Update EncodeJson instance for Type --- src/Docs/Search/TypeDecoder.purs | 52 +++++++++++++++++++++----------- 1 file changed, 35 insertions(+), 17 deletions(-) diff --git a/src/Docs/Search/TypeDecoder.purs b/src/Docs/Search/TypeDecoder.purs index b0aa7c7..47054e4 100644 --- a/src/Docs/Search/TypeDecoder.purs +++ b/src/Docs/Search/TypeDecoder.purs @@ -84,11 +84,11 @@ instance decodeJsonKind :: DecodeJson Kind where instance encodeJsonKind :: EncodeJson Kind where encodeJson = case _ of Row k -> - encodeTaggedContents "Row" (encodeJson k) + tagged "Row" (encodeJson k) FunKind k1 k2 -> - encodeTaggedContents "FunKind" (encodeTuple k1 k2) + tagged "FunKind" (encodeTuple k1 k2) NamedKind qname -> - encodeTaggedContents "NamedKind" (encodeJson qname) + tagged "NamedKind" (encodeJson qname) -- | A typeclass constraint newtype Constraint = Constraint @@ -214,19 +214,23 @@ instance decodeJsonType :: DecodeJson Type where instance encodeJsonType :: EncodeJson Type where encodeJson = case _ of - TypeVar val -> encodeTaggedContents "TypeVar" (encodeJson val) - TypeLevelString val -> encodeTaggedContents "TypeLevelString" (encodeJson val) - TypeConstructor val -> encodeTaggedContents "TypeConstructor" (encodeJson val) - TypeOp val -> encodeTaggedContents "TypeOp" (encodeJson val) - TypeApp t1 t2 -> encodeTaggedContents "TypeApp" (encodeTuple t1 t2) - ForAll str ty mbk -> encodeTaggedContents "ForAll" (encodeTriple str ty mbk) - ConstrainedType c t -> encodeTaggedContents "ConstrainedType" (encodeTuple c t) - REmpty -> encodeTaggedContents "REmpty" jsonEmptyObject - RCons s t1 t2 -> encodeTaggedContents "RCons" (encodeTriple s t1 t2) + TypeVar val -> tagged "TypeVar" (encodeJson val) + TypeLevelString val -> tagged "TypeLevelString" (encodeJson val) + TypeConstructor val -> tagged "TypeConstructor" (encodeJson val) + TypeOp val -> tagged "TypeOp" (encodeJson val) + TypeApp t1 t2 -> tagged "TypeApp" (encodeTuple t1 t2) + ForAll str Nothing ty -> tagged "ForAll" (encodeTriple str ty emptySkolemScope) + ForAll str (Just k) ty -> tagged "ForAll" (encodeQuadriple str k ty emptySkolemScope) + ConstrainedType c t -> tagged "ConstrainedType" (encodeTuple c t) + REmpty -> tagged "REmpty" jsonEmptyObject + RCons s t1 t2 -> tagged "RCons" (encodeTriple s t1 t2) + ParensInType t -> tagged "ParensInType" (encodeJson t) + TypeWildcard -> tagged "TypeWildcard" jsonEmptyObject BinaryNoParensType t1 t2 t3 -> - encodeTaggedContents "BinaryNoParensType" (encodeTriple t1 t2 t3) - ParensInType t -> encodeTaggedContents "ParensInType" (encodeJson t) - TypeWildcard -> encodeTaggedContents "TypeWildcard" jsonEmptyObject + tagged "BinaryNoParensType" (encodeTriple t1 t2 t3) + +emptySkolemScope :: Maybe Int +emptySkolemScope = Nothing newtype FunDep = FunDep @@ -374,8 +378,22 @@ encodeTriple encodeTriple fst sec trd = fromArray [ encodeJson fst, encodeJson sec, encodeJson trd ] -encodeTaggedContents :: String -> Json -> Json -encodeTaggedContents tag contents = +encodeQuadriple + :: forall fst sec trd frt + . EncodeJson fst + => EncodeJson sec + => EncodeJson trd + => EncodeJson frt + => fst + -> sec + -> trd + -> frt + -> Json +encodeQuadriple fst sec trd frt = + fromArray [ encodeJson fst, encodeJson sec, encodeJson trd, encodeJson frt ] + +tagged :: String -> Json -> Json +tagged tag contents = fromObject $ Object.fromFoldable [ Tuple "tag" (encodeJson tag) , Tuple "contents" contents From 0bf65d4aa1951ecc8604e92835310d555df3b88f Mon Sep 17 00:00:00 2001 From: klntsky Date: Fri, 30 Aug 2019 23:36:28 +0300 Subject: [PATCH 10/10] Add packages to the search index --- packages.dhall | 159 ++++++++++++++----------- spago.dhall | 1 + src/Docs/Search/App/SearchResults.purs | 77 ++++++++++-- src/Docs/Search/Config.purs | 21 ++++ src/Docs/Search/Declarations.purs | 120 ++++++++++--------- src/Docs/Search/Engine.purs | 5 +- src/Docs/Search/Extra.purs | 15 ++- src/Docs/Search/IndexBuilder.purs | 124 +++++++++++++++++-- src/Docs/Search/Interactive.purs | 48 ++++++-- src/Docs/Search/Main.purs | 75 ++++++++---- src/Docs/Search/SearchResult.purs | 40 ++++--- src/Docs/Search/TypeDecoder.purs | 6 +- src/Docs/Search/TypeIndex.purs | 7 +- src/Docs/Search/TypePrinter.purs | 6 +- 14 files changed, 488 insertions(+), 216 deletions(-) diff --git a/packages.dhall b/packages.dhall index bb12492..b445ebe 100644 --- a/packages.dhall +++ b/packages.dhall @@ -1,79 +1,94 @@ let mkPackage = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2-20190725/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 + https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2-20190725/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 let upstream = - https://github.com/purescript/package-sets/releases/download/psc-0.13.3-20190827/packages.dhall sha256:93f6b11068b42eac6632d56dab659a151c231381e53a16de621ae6d0dab475ce + https://github.com/purescript/package-sets/releases/download/psc-0.13.3-20190827/packages.dhall sha256:93f6b11068b42eac6632d56dab659a151c231381e53a16de621ae6d0dab475ce -let overrides = { metadata = upstream.metadata // { version = "v0.13.0" } } +let overrides = { metadata = upstream.metadata ⫽ { version = "v0.13.0" } } let additions = - { halogen = - mkPackage - [ "aff" - , "avar" - , "console" - , "const" - , "coroutines" - , "dom-indexed" - , "foreign" - , "fork" - , "free" - , "freeap" - , "halogen-vdom" - , "media-types" - , "nullable" - , "ordered-collections" - , "parallel" - , "profunctor" - , "transformers" - , "unsafe-coerce" - , "unsafe-reference" - , "web-uievents" - ] - "https://github.com/slamdata/purescript-halogen.git" - "v5.0.0-rc.6" - , halogen-css = - mkPackage - [ "css", "halogen" ] - "https://github.com/slamdata/purescript-halogen-css.git" - "v8.0.0" - , optparse = - mkPackage - [ "prelude" - , "effect" - , "exitcodes" - , "strings" - , "ordered-collections" - , "arrays" - , "console" - , "memoize" - , "transformers" - , "exists" - , "node-process" - , "free" - ] - "https://github.com/f-o-a-m/purescript-optparse.git" - "v3.0.1" - , exitcodes = - mkPackage - [ "enums" ] - "https://github.com/Risto-Stevcev/purescript-exitcodes.git" - "v4.0.0" - , markdown-it = - mkPackage - [ "prelude", "effect", "options" ] - "https://github.com/nonbili/purescript-markdown-it.git" - "v0.4.0" - , html-parser-halogen = - mkPackage - [ "string-parsers", "generics-rep", "halogen" ] - "https://github.com/rnons/purescript-html-parser-halogen.git" - "890da763cdd2a1049ab8837e477c5ba1fcf6d4ce" - , markdown-it-halogen = - mkPackage - [ "markdown-it", "html-parser-halogen" ] - "https://github.com/nonbili/purescript-markdown-it-halogen.git" - "08c9625015bf04214be14e45230e8ce12f3fa2bf" - } + { halogen = + mkPackage + [ "aff" + , "avar" + , "console" + , "const" + , "coroutines" + , "dom-indexed" + , "foreign" + , "fork" + , "free" + , "freeap" + , "halogen-vdom" + , "media-types" + , "nullable" + , "ordered-collections" + , "parallel" + , "profunctor" + , "transformers" + , "unsafe-coerce" + , "unsafe-reference" + , "web-uievents" + ] + "https://github.com/slamdata/purescript-halogen.git" + "v5.0.0-rc.6" + , halogen-css = + mkPackage + [ "css", "halogen" ] + "https://github.com/slamdata/purescript-halogen-css.git" + "v8.0.0" + , optparse = + mkPackage + [ "prelude" + , "effect" + , "exitcodes" + , "strings" + , "ordered-collections" + , "arrays" + , "console" + , "memoize" + , "transformers" + , "exists" + , "node-process" + , "free" + ] + "https://github.com/f-o-a-m/purescript-optparse.git" + "v3.0.1" + , exitcodes = + mkPackage + [ "enums" ] + "https://github.com/Risto-Stevcev/purescript-exitcodes.git" + "v4.0.0" + , markdown-it = + mkPackage + [ "prelude", "effect", "options" ] + "https://github.com/nonbili/purescript-markdown-it.git" + "v0.4.0" + , html-parser-halogen = + mkPackage + [ "string-parsers", "generics-rep", "halogen" ] + "https://github.com/rnons/purescript-html-parser-halogen.git" + "890da763cdd2a1049ab8837e477c5ba1fcf6d4ce" + , markdown-it-halogen = + mkPackage + [ "markdown-it", "html-parser-halogen" ] + "https://github.com/nonbili/purescript-markdown-it-halogen.git" + "08c9625015bf04214be14e45230e8ce12f3fa2bf" + , bower-json = + mkPackage + [ "prelude" + , "generics-rep" + , "maybe" + , "arrays" + , "either" + , "newtype" + , "tuples" + , "foldable-traversable" + , "argonaut-codecs" + , "foreign-object" + ] + "https://github.com/klntsky/purescript-bower-json.git" + "v1.0.0" + } -in upstream // overrides // additions +in upstream ⫽ overrides ⫽ additions diff --git a/spago.dhall b/spago.dhall index 4e1b85e..28ed1b6 100644 --- a/spago.dhall +++ b/spago.dhall @@ -8,6 +8,7 @@ , "argonaut-core" , "argonaut-generic" , "arrays" + , "bower-json" , "console" , "control" , "coroutines" diff --git a/src/Docs/Search/App/SearchResults.purs b/src/Docs/Search/App/SearchResults.purs index 25a28d5..150642b 100644 --- a/src/Docs/Search/App/SearchResults.purs +++ b/src/Docs/Search/App/SearchResults.purs @@ -7,8 +7,8 @@ import Docs.Search.App.SearchField (SearchFieldMessage(..)) import Docs.Search.Config (config) import Docs.Search.Declarations (DeclLevel(..), declLevelToHashAnchor) import Docs.Search.DocsJson (DataDeclType(..)) -import Docs.Search.Extra ((>#>)) -import Docs.Search.SearchResult (ResultInfo(..), SearchResult) +import Docs.Search.Extra ((>#>), homePageFromRepository) +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(..)) @@ -17,7 +17,7 @@ import Data.Array ((!!)) import Data.Array as Array import Data.List as List import Data.Maybe (Maybe(..), isJust) -import Data.Newtype (unwrap, wrap) +import Data.Newtype (wrap) import Data.String.CodeUnits (stripSuffix) as String import Data.String.Common (null, trim) as String import Data.String.Pattern (Pattern(..)) as String @@ -34,10 +34,12 @@ import Web.HTML as HTML import Web.HTML.Location as Location import Web.HTML.Window as Window + data Mode = Off | Loading | Active derive instance eqMode :: Eq Mode + type State = { searchEngineState :: SearchEngine.State , results :: Array SearchResult , resultsType :: ResultsType @@ -48,13 +50,16 @@ type State = { searchEngineState :: SearchEngine.State , markdownIt :: MD.MarkdownIt } + data Query a = MessageFromSearchField SearchFieldMessage a + data Action = SearchResultClicked String | MoreResultsRequested + mkComponent :: forall o i . Element @@ -76,6 +81,7 @@ mkComponent contents markdownIt = , handleAction = handleAction } } + handleQuery :: forall o a . Query a @@ -112,6 +118,7 @@ handleQuery (MessageFromSearchField (InputUpdated input_) next) = do pure Nothing + handleAction :: forall o . Action @@ -135,6 +142,7 @@ handleAction = case _ of showPageContents H.modify_ (_ { input = "", mode = Off }) + -- | Inverse of `hidePageContents` showPageContents :: forall o @@ -144,6 +152,7 @@ showPageContents = do H.liftEffect do Element.removeAttribute "style" state.contents + -- | When search UI is active, we want to hide the main page contents. hidePageContents :: forall o @@ -153,6 +162,7 @@ hidePageContents = do H.liftEffect do Element.setAttribute "style" "display: none" state.contents + render :: forall m . State @@ -171,6 +181,7 @@ render state@{ mode: Active, results: [] } = , HH.text " did not yield any results." ] ] + render state@{ mode: Active } = renderContainer $ [ HH.h1_ [ HH.text "Search results" ] @@ -199,12 +210,14 @@ render state@{ mode: Active } = where shownResults = Array.take state.resultsCount state.results + renderContainer :: forall a b. Array (HH.HTML b a) -> HH.HTML b a renderContainer = HH.div [ HP.classes [ wrap "container", wrap "clearfix" ] ] <<< pure <<< HH.div [ HP.classes [ wrap "col", wrap "col--main" ] ] + renderSummary :: forall a b . String @@ -212,12 +225,13 @@ renderSummary renderSummary text = HH.div_ [ HH.text text ] + renderResult :: forall a . MD.MarkdownIt -> SearchResult -> Array (HH.HTML a Action) -renderResult markdownIt = unwrap >>> \result -> +renderResult markdownIt (SearchResult result) = -- class names here and below are from Pursuit. [ HH.div [ HP.class_ (wrap "result") ] [ HH.h3 [ HP.class_ (wrap "result__title") ] @@ -260,6 +274,31 @@ renderResult markdownIt = unwrap >>> \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 . { info :: ResultInfo @@ -269,6 +308,7 @@ renderResultType } -> Array (HH.HTML a Action) renderResultType result = + case result.info of ValueResult { type: ty } -> wrapSignature $ renderValueSignature result ty @@ -285,10 +325,12 @@ renderResultType result = TypeSynonymResult info -> wrapSignature $ renderTypeSynonymSignature info result _ -> [] + where wrapSignature signature = [ HH.pre [ HP.class_ (wrap "result__signature") ] [ HH.code_ signature ] ] + renderValueSignature :: forall a rest . { moduleName :: String @@ -304,6 +346,7 @@ renderValueSignature result ty = , HH.text " :: " , renderType ty ] + renderTypeClassSignature :: forall a rest . { fundeps :: FunDeps @@ -341,6 +384,7 @@ renderTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName renderFunDeps fundeps ) + renderFunDeps :: forall a. FunDeps -> Array (HH.HTML a Action) renderFunDeps (FunDeps []) = [] renderFunDeps (FunDeps deps) = @@ -353,19 +397,22 @@ renderFunDeps (FunDeps deps) = [ syntax " -> " ] <> Array.intercalate [ space ] (pure <<< HH.text <$> rhs) + -- | Insert type class name and arguments renderTypeClassMemberSignature :: forall a rest . { type :: Type , typeClass :: QualifiedName - , typeClassArguments :: Array String + , typeClassArguments :: Array TypeArgument } -> { name :: String | rest } -> Array (HH.HTML a Action) renderTypeClassMemberSignature { type: ty, typeClass, typeClassArguments } result = [ HH.text result.name , HH.text " :: " - , renderType ty ] + , renderType ty + ] + renderDataSignature :: forall a rest @@ -386,6 +433,7 @@ renderDataSignature { typeArguments, dataDeclType } { name } = typeArguments <#> renderTypeArgument ] + renderTypeSynonymSignature :: forall a rest . { type :: Type @@ -407,6 +455,7 @@ renderTypeSynonymSignature { type: ty, arguments } { name } = , renderType ty ] + renderTypeArgument :: forall a. TypeArgument -> Array (HH.HTML a Action) renderTypeArgument (TypeArgument { name, mbKind }) = case mbKind of @@ -420,6 +469,7 @@ renderTypeArgument (TypeArgument { name, mbKind }) = , HH.text ")" ] + renderType :: forall a . Type @@ -479,6 +529,7 @@ renderType = case _ of , HH.text ")" ] + renderForAll :: forall a . Type @@ -489,11 +540,11 @@ renderForAll ty = [ keyword "forall" ] <> ( Array.fromFoldable foralls.binders <#> - \ { var, mbKind } -> + \ { name, mbKind } -> case mbKind of - Nothing -> HH.text (" " <> var) + Nothing -> HH.text (" " <> name) Just kind -> - HH.span_ [ HH.text $ " (" <> var <> " " + HH.span_ [ HH.text $ " (" <> name <> " " , syntax "::" , space , renderKind kind @@ -505,6 +556,7 @@ renderForAll ty = where foralls = joinForAlls ty + renderRow :: forall a . Boolean @@ -535,6 +587,7 @@ renderRow asRow = opening = if asRow then "( " else "{ " closing = if asRow then " )" else " }" + renderConstraint :: forall a . Constraint @@ -544,6 +597,7 @@ renderConstraint (Constraint { constraintClass, constraintArgs }) = [ renderQualifiedName false TypeLevel constraintClass, space ] <> Array.intercalate [ space ] (constraintArgs <#> \ty -> [ renderType ty ]) + renderQualifiedName :: forall a . Boolean @@ -563,6 +617,7 @@ renderQualifiedName isInfix level (QualifiedName { moduleName, name }) moduleNameString = Array.intercalate "." moduleName isBuiltIn = moduleName !! 0 == Just "Prim" + renderKind :: forall a . Kind @@ -572,6 +627,7 @@ renderKind = case _ of FunKind k1 k2 -> HH.span_ [ renderKind k1, syntax " -> ", renderKind k2 ] NamedKind qname -> renderQualifiedName false KindLevel qname + -- | Construct a `href` property value w.r.t. `DeclLevel`. makeHref :: forall t rest @@ -586,17 +642,20 @@ makeHref level isInfix moduleName name = declLevelToHashAnchor level <> ":" <> if isInfix then "type (" <> name <> ")" else name + keyword :: forall a . String -> HH.HTML a Action keyword str = HH.span [ HP.class_ (wrap "keyword") ] [ HH.text str ] + syntax :: forall a . String -> HH.HTML a Action syntax str = HH.span [ HP.class_ (wrap "syntax") ] [ HH.text str ] + space :: forall a b. HH.HTML a b space = HH.text " " diff --git a/src/Docs/Search/Config.purs b/src/Docs/Search/Config.purs index 2f3a8d5..bc9043d 100644 --- a/src/Docs/Search/Config.purs +++ b/src/Docs/Search/Config.purs @@ -3,6 +3,27 @@ module Docs.Search.Config where import Prelude -- | Some magic constants. +config :: + { declIndexDirectory :: String + , indexDirectory :: String + , mkIndexPartLoadPath :: Int -> String + , mkIndexPartPath :: Int -> String + , mkShapeScriptPath :: String -> String + , numberOfIndexParts :: Int + , outputDirectory :: String + , penalties :: { excessiveConstraint :: Int + , generalize :: Int + , instantiate :: Int + , match :: Int + , matchConstraint :: Int + , missingConstraint :: Int + , rowsMismatch :: Int + , typeVars :: Int + } + , requiredDirectories :: Array String + , resultsCount :: Int + , typeIndexDirectory :: String + } config = { outputDirectory: "output" , requiredDirectories: diff --git a/src/Docs/Search/Declarations.purs b/src/Docs/Search/Declarations.purs index 416a665..0090ba5 100644 --- a/src/Docs/Search/Declarations.purs +++ b/src/Docs/Search/Declarations.purs @@ -4,7 +4,7 @@ import Prelude import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..)) import Docs.Search.DocsJson (ChildDeclType(..), ChildDeclaration(..), DeclType(..), Declaration(..), DocsJson(..)) -import Docs.Search.TypeDecoder (Constraint(..), QualifiedName(..), Type(..), Kind (..), joinForAlls) +import Docs.Search.TypeDecoder (Constraint(..), QualifiedName(..), Type(..), Kind, joinForAlls) import Control.Alt ((<|>)) import Data.Array ((!!)) @@ -220,60 +220,64 @@ mkChildInfo :: SearchResult -> ChildDeclaration -> Maybe ResultInfo -mkChildInfo parentResult (ChildDeclaration { info } ) = - case info.declType of - ChildDeclDataConstructor -> - info.arguments <#> - \arguments -> DataConstructorResult { arguments } - ChildDeclTypeClassMember -> - case (unwrap parentResult).info of - TypeClassResult { arguments } -> - -- We need to reconstruct a "real" type of a type class member. - -- For example, if `unconstrainedType` is the type of `pure`, i.e. `forall a. a -> m a`, - -- `restoredType` should be `forall m a. Control.Applicative.Applicative m => a -> m a`. - info."type" <#> - \(unconstrainedType :: Type) -> - let - -- First, we get a list of nested `forall` quantifiers for `unconstrainedType` - -- and a version of `unconstrainedType` without them (`ty`). - { ty, binders } = joinForAlls unconstrainedType - - -- Then we construct a qualified name of the type class. - constraintClass = - QualifiedName { moduleName: - String.split (wrap ".") - (unwrap parentResult).moduleName - , name: (unwrap parentResult).name } - - typeClassArguments = arguments <#> unwrap >>> _.name - - -- We concatenate two lists: - -- * list of type parameters of the type class, and - -- * list of quantified variables of the unconstrained type - allArguments :: Array { var :: String, mbKind :: Maybe Kind } - allArguments = - (typeClassArguments <#> \var -> { var, mbKind: Nothing }) <> - (List.toUnfoldable binders) - - restoreType :: Type -> Type - restoreType = - foldr - (\arg -> compose (\type'' -> ForAll arg.var arg.mbKind type'')) - identity allArguments - - -- Finally, we have a restored type. It allows us to search for type members the same way - -- we search for functions. And types of class member results appear with the correct - -- class constraints. - restoredType = restoreType $ - ConstrainedType (Constraint { constraintClass - , constraintArgs: typeClassArguments <#> TypeVar - }) ty - - in TypeClassMemberResult - { type: restoredType - , typeClass: constraintClass - , typeClassArguments - } - - _ -> Nothing - ChildDeclInstance -> Nothing +mkChildInfo + (SearchResult { info: parentInfo, moduleName, name: resultName }) + (ChildDeclaration { info } ) + + | ChildDeclDataConstructor <- info.declType = + info.arguments <#> \arguments -> DataConstructorResult { arguments } + + | ChildDeclTypeClassMember <- info.declType + , TypeClassResult { arguments } <- parentInfo = + -- We need to reconstruct a "real" type of a type class member. + -- For example, if `unconstrainedType` is the type of `pure`, i.e. + -- `forall a. a -> m a`, then `restoredType` should be: + -- `forall m a. Control.Applicative.Applicative m => a -> m a`. + + info."type" <#> + \(unconstrainedType :: Type) -> + let + -- First, we get a list of nested `forall` quantifiers for + -- `unconstrainedType` and a version of `unconstrainedType` without + -- them (`ty`). + ({ ty, binders }) = joinForAlls unconstrainedType + + -- Then we construct a qualified name of the type class. + constraintClass = + QualifiedName { moduleName: String.split (wrap ".") moduleName + , name: resultName } + + -- We concatenate two lists: + -- * a list of type parameters of the type class, and + -- * a list of quantified variables of the unconstrained type + allArguments :: Array { name :: String, mbKind :: Maybe Kind } + allArguments = + (arguments <#> unwrap) <> List.toUnfoldable binders + + restoreType :: Type -> Type + restoreType = + foldr + (\({ name, mbKind }) -> compose (\type'' -> ForAll name mbKind type'')) + identity + allArguments + + -- Finally, we have a restored type. It allows us to search for + -- type members the same way we search for functions. And types + -- of class member results appear with the correct + -- class constraints. + restoredType = + restoreType $ + ConstrainedType + (Constraint { constraintClass + , constraintArgs: arguments <#> unwrap >>> (_.name) >>> TypeVar + }) ty + + in TypeClassMemberResult + { type: restoredType + , typeClass: constraintClass + , typeClassArguments: arguments + } + + | otherwise = Nothing + +mkChildInfo _ _ = Nothing diff --git a/src/Docs/Search/Engine.purs b/src/Docs/Search/Engine.purs index af931f8..45ce188 100644 --- a/src/Docs/Search/Engine.purs +++ b/src/Docs/Search/Engine.purs @@ -5,7 +5,7 @@ module Docs.Search.Engine where import Prelude import Docs.Search.TypeQuery (TypeQuery(..), parseTypeQuery, penalty) -import Docs.Search.SearchResult (SearchResult, typeOf) +import Docs.Search.SearchResult (SearchResult, typeOfResult) import Docs.Search.Index as Index import Docs.Search.Index (Index) import Docs.Search.TypeIndex as TypeIndex @@ -14,7 +14,6 @@ import Docs.Search.TypeIndex (TypeIndex) import Data.Array as Array import Data.Either (hush) import Data.Maybe (Maybe(..)) -import Data.Newtype (unwrap) import Data.String.Common as String import Effect.Aff (Aff) @@ -57,5 +56,5 @@ sortByDistance typeQuery results = comparePenalties r1 r2 = compare r1.penalty r2.penalty resultsWithPenalties = results <#> - \result -> { penalty: typeOf (unwrap result).info <#> penalty typeQuery + \result -> { penalty: typeOfResult result <#> penalty typeQuery , result } diff --git a/src/Docs/Search/Extra.purs b/src/Docs/Search/Extra.purs index 8b1c16d..d04ec8d 100644 --- a/src/Docs/Search/Extra.purs +++ b/src/Docs/Search/Extra.purs @@ -3,10 +3,12 @@ module Docs.Search.Extra where import Prelude import Data.Foldable (class Foldable, foldMap, foldl) -import Data.List.NonEmpty (NonEmptyList, cons', uncons) -import Data.Maybe (Maybe(..)) -import Data.List as List import Data.List ((:)) +import Data.List as List +import Data.List.NonEmpty (NonEmptyList, cons', uncons) +import Data.String.CodeUnits as String +import Data.Newtype (wrap) +import Data.Maybe (Maybe(..), fromMaybe) whenJust :: forall a m. Monad m => Maybe a -> (a -> m Unit) -> m Unit whenJust (Just a) f = f a @@ -30,3 +32,10 @@ foldr1 f = go List.Nil Nothing -> List.foldl (flip f) head acc Just { head: head1, tail: tail1 } -> go (head : acc) (cons' head1 tail1) + + +-- | Try to guess repository main page on github from git URL. +homePageFromRepository :: String -> String +homePageFromRepository repo = + fromMaybe repo $ String.stripSuffix (wrap ".git") $ + fromMaybe repo $ String.stripPrefix (wrap "git:") repo <#> ("https:" <> _) diff --git a/src/Docs/Search/IndexBuilder.purs b/src/Docs/Search/IndexBuilder.purs index c0ba2e6..4d1bcbc 100644 --- a/src/Docs/Search/IndexBuilder.purs +++ b/src/Docs/Search/IndexBuilder.purs @@ -6,8 +6,8 @@ import Docs.Search.Config (config) import Docs.Search.Declarations (Declarations(..), mkDeclarations) import Docs.Search.DocsJson (DocsJson) import Docs.Search.Extra ((>#>)) -import Docs.Search.Index (getPartId) -import Docs.Search.SearchResult (SearchResult) +import Docs.Search.Index (getPartId, insertResults) +import Docs.Search.SearchResult (SearchResult(..)) import Docs.Search.TypeIndex (TypeIndex, mkTypeIndex) import Data.Argonaut.Core (stringify) @@ -15,18 +15,19 @@ import Data.Argonaut.Decode (decodeJson) 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.Either (Either(..), either) +import Data.Foldable (sum, foldr) 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.Newtype (unwrap) +import Data.Newtype (wrap, unwrap) +import Data.Profunctor.Strong (second) import Data.Search.Trie as Trie import Data.Set as Set import Data.String.CodePoints (contains) as String -import Data.String.CodeUnits (singleton) as String +import Data.String.CodeUnits (singleton, stripPrefix) as String import Data.String.Common (replace) as String import Data.String.Pattern (Pattern(..), Replacement(..)) import Data.Traversable (for, for_) @@ -39,14 +40,39 @@ import Node.Encoding (Encoding(UTF8)) import Node.FS.Aff (exists, mkdir, readFile, readTextFile, readdir, stat, writeFile, writeTextFile) import Node.FS.Stats (isDirectory, isFile) import Node.Process as Process +import Web.Bower.PackageMeta (PackageMeta(..)) + type Config = { docsFiles :: Array String + , bowerFiles :: Array String , generatedDocs :: String } + run :: Config -> Effect Unit run = launchAff_ <<< run' + +insertPackages + :: Array PackageMeta + -> Declarations + -> Declarations +insertPackages packageMetas (Declarations decls) = + Declarations $ + foldr (insertResults <<< second pure) decls $ + map resultFromPackageMeta packageMetas + + +resultFromPackageMeta :: PackageMeta -> Tuple String SearchResult +resultFromPackageMeta (PackageMeta { name, description, repository }) = + Tuple shortName $ PackageResult { name: shortName + , description + , repository: fromMaybe "" (repository <#> (_.url)) + } + + where + shortName = fromMaybe name $ String.stripPrefix (wrap "purescript-") name + run' :: Config -> Aff Unit run' cfg = do @@ -55,12 +81,18 @@ run' cfg = do liftEffect do log "Building the search index..." - docsJsons <- decodeDocsJsons cfg + docsJsons <- decodeDocsJsons cfg + packageMetas <- decodeBowerJsons cfg liftEffect do - log $ "Found " <> show (Array.length docsJsons) <> " modules." + log $ + "Indexing " <> + show (Array.length docsJsons) <> + " modules from " <> + show (Array.length packageMetas) <> + " packages..." - let index = mkDeclarations docsJsons + let index = insertPackages packageMetas $ mkDeclarations docsJsons typeIndex = mkTypeIndex docsJsons createDirectories cfg @@ -85,6 +117,7 @@ run' cfg = do where ignore _ _ _ _ = unit + -- | Exit early if something is missing. checkDirectories :: Config -> Aff Unit checkDirectories cfg = do @@ -98,15 +131,15 @@ checkDirectories cfg = do liftEffect do logAndExit "Build the documentation first!" + -- | Read and decode given `docs.json` files. decodeDocsJsons :: forall rest . { docsFiles :: Array String | rest } -> Aff (Array DocsJson) -decodeDocsJsons cfg = do +decodeDocsJsons cfg@{ docsFiles } = do - paths <- Array.concat <$> for cfg.docsFiles \str -> do - liftEffect $ glob str + paths <- getPathsByGlobs docsFiles when (Array.null paths) do liftEffect do @@ -125,7 +158,7 @@ decodeDocsJsons cfg = do case eiResult of Left error -> do liftEffect $ log $ - "\"docs.json\" decoding failed failed for " <> jsonFile <> ": " <> show error + "\"docs.json\" decoding failed failed for " <> jsonFile <> ": " <> error pure Nothing Right result -> pure result @@ -141,6 +174,39 @@ decodeDocsJsons cfg = do pure docsJsons + +decodeBowerJsons + :: forall rest + . { bowerFiles :: Array String | rest } + -> Aff (Array PackageMeta) +decodeBowerJsons { bowerFiles } = do + paths <- getPathsByGlobs bowerFiles + + when (Array.null paths) do + liftEffect do + logAndExit $ + "The following globs do not match any files: " <> showGlobs bowerFiles <> + ".\nAre you in a project directory?" + + Array.nubBy compareNames <$> + Array.catMaybes <$> + for paths \jsonFileName -> + join <$> withExisting jsonFileName + \contents -> + either (logError jsonFileName) pure + (jsonParser contents >>= decodeJson) + + where + compareNames + (PackageMeta { name: name1 }) + (PackageMeta { name: name2 }) = compare name1 name2 + + logError fileName error = do + liftEffect $ log $ + "\"bower.json\" decoding failed failed for " <> fileName <> ": " <> error + pure Nothing + + -- | Write type index parts to files. writeTypeIndex :: Config -> TypeIndex -> Aff Unit writeTypeIndex { generatedDocs } typeIndex = @@ -154,6 +220,7 @@ writeTypeIndex { generatedDocs } typeIndex = entries :: Array _ entries = Map.toUnfoldableUnordered (unwrap typeIndex) + -- | Get a mapping from index parts to index contents. getIndex :: Declarations -> Map Int (Array (Tuple String (Array SearchResult))) getIndex (Declarations trie) = @@ -187,6 +254,7 @@ getIndex (Declarations trie) = List.foldr (\path -> Set.insert (List.take 2 path)) mempty $ fst <$> Trie.entriesUnordered trie + writeIndex :: Config -> Declarations -> Aff Unit writeIndex { generatedDocs } = getIndex >>> \resultsMap -> do for_ (Map.toUnfoldableUnordered resultsMap :: Array _) @@ -198,6 +266,7 @@ writeIndex { generatedDocs } = getIndex >>> \resultsMap -> do writeTextFile UTF8 (generatedDocs <> config.mkIndexPartPath indexPartId) $ header <> stringify (encodeJson results) + patchHTML :: String -> Tuple Boolean String patchHTML html = let @@ -213,6 +282,7 @@ patchHTML html = then Tuple true $ String.replace pattern (Replacement patch) html else Tuple false html + -- | Iterate through the HTML files generated by the PureScript compiler, and -- | modify them using `patchHTML`. patchDocs :: Config -> Aff Unit @@ -231,6 +301,7 @@ patchDocs cfg = do writeTextFile UTF8 path patchedContents _ -> pure unit + -- | Create directories for two indices, or fail with a message -- | in case the docs were not generated. createDirectories :: Config -> Aff Unit @@ -251,6 +322,7 @@ createDirectories { generatedDocs } = do whenM (not <$> directoryExists typeIndexDir) do mkdir typeIndexDir + -- | Copy the client-side application, responsible for handling user input and rendering -- | the results, to the destination path. copyAppFile :: Config -> Aff Unit @@ -265,6 +337,7 @@ copyAppFile { generatedDocs } = do buffer <- readFile appFile writeFile (generatedDocs <> "/docs-search-app.js") buffer + directoryExists :: String -> Aff Boolean directoryExists path = do doesExist <- exists path @@ -272,6 +345,7 @@ directoryExists path = do false -> pure false true -> isDirectory <$> stat path + fileExists :: String -> Aff Boolean fileExists path = do doesExist <- exists path @@ -279,14 +353,38 @@ fileExists path = do false -> pure false true -> isFile <$> stat path + +withExisting :: forall a. String -> (String -> Aff a) -> Aff (Maybe a) +withExisting file f = do + doesExist <- fileExists file + + if doesExist + then do + contents <- readTextFile UTF8 file + res <- f contents + pure $ Just res + else do + liftEffect $ do + log $ + "File does not exist: " <> file + pure Nothing + + logAndExit :: forall a. String -> Effect a logAndExit message = do log message Process.exit 1 + showGlobs :: Array String -> String showGlobs = Array.intercalate ", " + +getPathsByGlobs :: Array String -> Aff (Array String) +getPathsByGlobs globs = + liftEffect $ Array.concat <$> for globs glob + + -- | Get __dirname. foreign import getDirname :: Effect String diff --git a/src/Docs/Search/Interactive.purs b/src/Docs/Search/Interactive.purs index f66db22..b6ba764 100644 --- a/src/Docs/Search/Interactive.purs +++ b/src/Docs/Search/Interactive.purs @@ -7,6 +7,7 @@ import Docs.Search.Declarations (Declarations, mkDeclarations) import Docs.Search.DocsJson (DataDeclType(..)) import Docs.Search.Engine (isValuableTypeQuery) import Docs.Search.Engine as SearchEngine +import Docs.Search.Extra (homePageFromRepository) import Docs.Search.IndexBuilder as IndexBuilder import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..)) import Docs.Search.Terminal (bold, cyan, green, yellow) @@ -31,7 +32,10 @@ import Effect.Class (liftEffect) import Effect.Console (log) import Node.ReadLine (createConsoleInterface, question) -type Config = { docsFiles :: Array String } +type Config = + { docsFiles :: Array String + , bowerFiles :: Array String + } run :: Config -> Effect Unit run cfg = launchAff_ $ do @@ -39,9 +43,12 @@ run cfg = launchAff_ $ do liftEffect do log "Loading search index..." - docsJsons <- IndexBuilder.decodeDocsJsons cfg + docsJsons <- IndexBuilder.decodeDocsJsons cfg + packageMetas <- IndexBuilder.decodeBowerJsons cfg - let index = mkDeclarations docsJsons + let index = + IndexBuilder.insertPackages packageMetas $ + mkDeclarations docsJsons typeIndex = docsJsons >>= resultsWithTypes let countOfDefinitions = Trie.size $ unwrap index @@ -111,7 +118,7 @@ mkCompleter index input = do , matched: input } showResult :: SearchResult -> String -showResult result@(SearchResult { name, comments, moduleName, packageName, info }) = +showResult (SearchResult result@{ name, comments, moduleName, packageName }) = showSignature result <> "\n" <> (fromMaybe "\n" $ @@ -119,27 +126,42 @@ showResult result@(SearchResult { name, comments, moduleName, packageName, info "\n" <> leftShift 3 (String.trim comment) <> "\n\n") <> bold (cyan (rightPad 40 packageName)) <> space <> bold (green moduleName) - -showSignature :: SearchResult -> String -showSignature result@(SearchResult { name, info }) = +showResult (PackageResult { name, description, repository }) = + cyan "package" <> " " <> yellow name <> "\n" <> + (fromMaybe "\n" $ + description <#> \text -> + "\n" <> leftShift 3 text <> "\n\n") <> + leftShift 3 (homePageFromRepository repository) + + +showSignature :: + forall rest. + { name :: String + , moduleName :: String + , packageName :: String + , info :: ResultInfo + | rest + } + -> String +showSignature result@{ name, info } = case info of ValueResult { type: ty } -> yellow name <> syntax " :: " <> showType ty TypeClassResult info' -> - showTypeClassSignature info' (unwrap result) + showTypeClassSignature info' result TypeClassMemberResult info' -> - showTypeClassMemberSignature info' (unwrap result) + showTypeClassMemberSignature info' result DataResult info' -> - showDataSignature info' (unwrap result) + showDataSignature info' result TypeSynonymResult info' -> - showTypeSynonymSignature info' (unwrap result) + showTypeSynonymSignature info' result ExternDataResult info' -> - showExternDataSignature info' (unwrap result) + showExternDataSignature info' result ValueAliasResult -> yellow ("(" <> name <> ")") @@ -183,7 +205,7 @@ showTypeClassMemberSignature :: forall rest . { type :: Type , typeClass :: QualifiedName - , typeClassArguments :: Array String + , typeClassArguments :: Array TypeArgument } -> { name :: String | rest } -> String diff --git a/src/Docs/Search/Main.purs b/src/Docs/Search/Main.purs index d1792a6..637ef67 100644 --- a/src/Docs/Search/Main.purs +++ b/src/Docs/Search/Main.purs @@ -17,17 +17,19 @@ import Effect.Console (log) import Options.Applicative (Parser, command, execParser, fullDesc, helper, info, long, metavar, progDesc, strOption, subparser, value, (<**>)) import Options.Applicative as CA + main :: Effect Unit main = do args <- getArgs - let defaultCommands = Search { docsFiles: defaultDocsFiles } + let defaultCommands = Search { docsFiles: defaultDocsFiles, bowerFiles: defaultBowerFiles } case fromMaybe defaultCommands args of BuildIndex cfg -> IndexBuilder.run cfg Search cfg -> Interactive.run cfg Version -> log "0.0.4" + getArgs :: Effect (Maybe Commands) getArgs = execParser opts where @@ -37,18 +39,26 @@ getArgs = execParser opts <> progDesc "Search frontend for the documentation generated by the PureScript compiler." ) + data Commands - = BuildIndex { docsFiles :: Array String - , generatedDocs :: String - } - | Search { docsFiles :: Array String } + = BuildIndex + { docsFiles :: Array String + , bowerFiles :: Array String + , generatedDocs :: String + } + | Search + { docsFiles :: Array String + , bowerFiles :: Array String + } | Version + derive instance genericCommands :: Generic Commands _ instance showCommands :: Show Commands where show = genericShow + commands :: Parser (Maybe Commands) commands = optional $ subparser ( command "build-index" @@ -68,17 +78,13 @@ commands = optional $ subparser ) ) + buildIndex :: Parser Commands buildIndex = ado - docsFiles <- fromMaybe defaultDocsFiles <$> - optional ( - some ( strOption - ( long "docs-files" - <> metavar "GLOB" - ) - ) - ) + docsFiles <- docsFilesOption + + bowerFiles <- bowerFilesOption generatedDocs <- strOption ( long "generated-docs" @@ -86,27 +92,54 @@ buildIndex = ado <> value "./generated-docs/" ) - in BuildIndex { docsFiles, generatedDocs } + in BuildIndex { docsFiles, bowerFiles, generatedDocs } + startInteractive :: Parser Commands startInteractive = ado - docsFiles <- fromMaybe defaultDocsFiles <$> - optional ( - some ( strOption - ( long "docs-files" - <> metavar "GLOB" - ) + docsFiles <- docsFilesOption + + bowerFiles <- bowerFilesOption + + in Search { docsFiles, bowerFiles } + + +docsFilesOption :: Parser (Array String) +docsFilesOption = fromMaybe defaultDocsFiles <$> + optional + ( some + ( strOption + ( long "docs-files" + <> metavar "GLOB" + ) + ) + ) + + +bowerFilesOption :: Parser (Array String) +bowerFilesOption = fromMaybe defaultBowerFiles <$> + optional + ( some + ( strOption + ( long "bower-jsons" + <> metavar "GLOB" + ) ) ) - in Search { docsFiles } defaultDocsFiles :: Array String defaultDocsFiles = [ "output/**/docs.json" ] + +defaultBowerFiles :: Array String +defaultBowerFiles = [ ".spago/*/*/bower.json", "bower_components/purescript-*/bower.json" ] + + many :: forall a f. Unfoldable f => Parser a -> Parser (f a) many x = CA.many x <#> List.toUnfoldable + some :: forall a f. Unfoldable f => Parser a -> Parser (f a) some x = CA.some x <#> NonEmpty.toUnfoldable diff --git a/src/Docs/Search/SearchResult.purs b/src/Docs/Search/SearchResult.purs index 2f74e96..5decc47 100644 --- a/src/Docs/Search/SearchResult.purs +++ b/src/Docs/Search/SearchResult.purs @@ -1,6 +1,7 @@ module Docs.Search.SearchResult where import Docs.Search.DocsJson (DataDeclType) +import Docs.Search.Extra (homePageFromRepository) import Docs.Search.TypeDecoder (Constraint, FunDeps, Kind, QualifiedName, Type, TypeArgument) import Data.Argonaut.Decode (class DecodeJson) @@ -9,7 +10,7 @@ import Data.Argonaut.Encode (class EncodeJson) import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson) import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype) + -- | Metadata that makes sense only for certain types of search results. data ResultInfo @@ -21,7 +22,7 @@ data ResultInfo | DataConstructorResult { arguments :: Array Type } | TypeClassMemberResult { type :: Type , typeClass :: QualifiedName - , typeClassArguments :: Array String } + , typeClassArguments :: Array TypeArgument } | TypeClassResult { fundeps :: FunDeps , arguments :: Array TypeArgument , superclasses :: Array Constraint } @@ -49,20 +50,25 @@ typeOf (ValueResult { type: res }) = typeOf _ = Nothing -- | Common metadata for all types of search results. -newtype SearchResult - = SearchResult { name :: String - , comments :: Maybe String - , hashAnchor :: String - , moduleName :: String - , packageName :: String - , sourceSpan :: Maybe { start :: Array Int - , end :: Array Int - , name :: String - } - , info :: ResultInfo - } +data SearchResult + = SearchResult + { name :: String + , comments :: Maybe String + , hashAnchor :: String + , moduleName :: String + , packageName :: String + , sourceSpan :: Maybe { start :: Array Int + , end :: Array Int + , name :: String + } + , info :: ResultInfo + } + | PackageResult + { name :: String + , description :: Maybe String + , repository :: String + } -derive instance newtypeSearchResult :: Newtype SearchResult _ derive instance genericSearchResult :: Generic SearchResult _ instance encodeJsonSearchResult :: EncodeJson SearchResult where @@ -70,3 +76,7 @@ instance encodeJsonSearchResult :: EncodeJson SearchResult where instance decodeJsonSearchResult :: DecodeJson SearchResult where decodeJson = genericDecodeJson + +typeOfResult :: SearchResult -> Maybe Type +typeOfResult (SearchResult { info }) = typeOf info +typeOfResult _ = Nothing diff --git a/src/Docs/Search/TypeDecoder.purs b/src/Docs/Search/TypeDecoder.purs index 47054e4..f7c7ff1 100644 --- a/src/Docs/Search/TypeDecoder.purs +++ b/src/Docs/Search/TypeDecoder.purs @@ -402,14 +402,14 @@ tagged tag contents = joinForAlls :: Type - -> { binders :: List { var :: String + -> { binders :: List { name :: String , mbKind :: Maybe Kind } , ty :: Type } joinForAlls ty = go Nil ty where - go acc (ForAll var mbKind ty') = - go ({ var, mbKind } : acc) ty' + go acc (ForAll name mbKind ty') = + go ({ name, mbKind } : acc) ty' go acc ty' = { binders: acc, ty: ty' } joinRows :: Type -> { rows :: List { row :: String diff --git a/src/Docs/Search/TypeIndex.purs b/src/Docs/Search/TypeIndex.purs index 95f4c91..d007588 100644 --- a/src/Docs/Search/TypeIndex.purs +++ b/src/Docs/Search/TypeIndex.purs @@ -5,7 +5,7 @@ import Prelude import Docs.Search.Config (config) import Docs.Search.Declarations (resultsForDeclaration) import Docs.Search.DocsJson (DocsJson(..)) -import Docs.Search.SearchResult (ResultInfo(..), SearchResult) +import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..)) import Docs.Search.TypeDecoder (Type) import Docs.Search.TypeQuery (TypeQuery) import Docs.Search.TypeShape (shapeOfType, shapeOfTypeQuery, stringifyShape) @@ -49,8 +49,8 @@ resultsWithTypes :: DocsJson -> Array SearchResult resultsWithTypes docsJson = Array.filter (getType >>> isJust) $ allResults docsJson getType :: SearchResult -> Maybe Type -getType sr = - case (unwrap sr).info of +getType (SearchResult { info }) = + case info of ValueResult dict -> Just dict.type @@ -61,6 +61,7 @@ getType sr = Just dict.type _ -> Nothing +getType _ = Nothing lookup :: String diff --git a/src/Docs/Search/TypePrinter.purs b/src/Docs/Search/TypePrinter.purs index 8e2fc9d..bc82551 100644 --- a/src/Docs/Search/TypePrinter.purs +++ b/src/Docs/Search/TypePrinter.purs @@ -115,11 +115,11 @@ showForAll ty = keyword "forall" <> ( Array.fold $ foralls.binders <#> - \ { var, mbKind } -> + \ { name, mbKind } -> case mbKind of - Nothing -> " " <> var + Nothing -> " " <> name Just kind -> - " (" <> var <> " " + " (" <> name <> " " <> syntax "::" <> space <> showKind kind