mirror of
https://github.com/rowtype-yoga/purescript-docs-search.git
synced 2024-09-11 12:35:37 +03:00
added: CLI interface; added: search REPL (#5)
* added: CLI interface added: search REPL * added: shebang to the executable file * added: automatic deployments * better heuristics for package name detection * added: previews
This commit is contained in:
parent
e69e81379a
commit
4ce20e3251
1
.gitignore
vendored
1
.gitignore
vendored
@ -8,3 +8,4 @@
|
|||||||
/.purs*
|
/.purs*
|
||||||
/.psa*
|
/.psa*
|
||||||
/.spago/
|
/.spago/
|
||||||
|
/dist/
|
||||||
|
17
.travis.yml
17
.travis.yml
@ -19,24 +19,31 @@ install:
|
|||||||
- tar -xvf $HOME/purescript.tar.gz -C $HOME/
|
- tar -xvf $HOME/purescript.tar.gz -C $HOME/
|
||||||
- chmod a+x $HOME/purescript
|
- chmod a+x $HOME/purescript
|
||||||
- npm install -g spago
|
- npm install -g spago
|
||||||
|
- npm install
|
||||||
- spago install
|
- spago install
|
||||||
|
|
||||||
script:
|
script:
|
||||||
- spago build
|
- spago build
|
||||||
- spago test
|
- spago test
|
||||||
- spago docs
|
- spago docs
|
||||||
- spago bundle-app -m Docs.Search.App --to docs-search-app.js
|
- npm run build
|
||||||
- spago bundle-app -m Docs.Search.IndexBuilder --to index-builder.js
|
- node dist/main.js build-index
|
||||||
- node index-builder.js
|
|
||||||
|
|
||||||
deploy:
|
deploy:
|
||||||
- provider: releases
|
- provider: releases
|
||||||
api_key: $API_KEY
|
api_key: $API_KEY
|
||||||
file:
|
file:
|
||||||
- docs-search-app.js
|
- dist/docs-search-app.js
|
||||||
- index-builder.js
|
- dist/main.js
|
||||||
skip_cleanup: true
|
skip_cleanup: true
|
||||||
on:
|
on:
|
||||||
tags: true
|
tags: true
|
||||||
script:
|
script:
|
||||||
- echo 'done'
|
- echo 'done'
|
||||||
|
- provider: npm
|
||||||
|
api_key: $NPM_API_KEY
|
||||||
|
email: klntsky@gmail.com
|
||||||
|
skip_cleanup: true
|
||||||
|
on:
|
||||||
|
tags: true
|
||||||
|
branch: master
|
||||||
|
33
README.md
33
README.md
@ -4,21 +4,34 @@
|
|||||||
|
|
||||||
An app that adds search capabilities to generated documentation for purescript code.
|
An app that adds search capabilities to generated documentation for purescript code.
|
||||||
|
|
||||||
The goal is to replicate all functionality of pursuit, including querying by type.
|
It supports nearly-all functionality of [Pursuit](https://github.com/purescript/pursuit), including querying by type.
|
||||||
|
|
||||||
See [#89](https://github.com/spacchetti/spago/issues/89).
|
## Installing
|
||||||
|
|
||||||
To see it in action, run the following:
|
Run `npm install purescript-docs-search`.
|
||||||
|
|
||||||
```
|
## Usage
|
||||||
spago build
|
|
||||||
spago docs
|
|
||||||
spago bundle-app -m Docs.Search.App --to generated-docs/docs-search-app.js
|
|
||||||
spago run -m Docs.Search.IndexBuilder
|
|
||||||
```
|
|
||||||
|
|
||||||
## UI
|
There are two usage scenarios:
|
||||||
|
|
||||||
|
### Patching static documentation
|
||||||
|
|
||||||
|
Use `purescript-docs-search build-index` command to patch HTML files located in `generated-docs/html`. You then will be able to search for declarations or types:
|
||||||
|
|
||||||
|
![Preview](preview.png)
|
||||||
|
|
||||||
The user interface of the app is optimised for keyboard-only use.
|
The user interface of the app is optimised for keyboard-only use.
|
||||||
|
|
||||||
**S** hotkey can be used to focus on the search field, **Escape** can be used to leave it. Pressing **Escape** twice will close the search results listing.
|
**S** hotkey can be used to focus on the search field, **Escape** can be used to leave it. Pressing **Escape** twice will close the search results listing.
|
||||||
|
|
||||||
|
### Using the CLI
|
||||||
|
|
||||||
|
Running `purescript-docs-search` within a project directory will open an interactive command-line session.
|
||||||
|
|
||||||
|
Note that unlike in Pursuit, most relevant results will appear last.
|
||||||
|
|
||||||
|
A quick demo:
|
||||||
|
|
||||||
|
[![asciicast](https://asciinema.org/a/Hexie5JoWjlAqLqv2IgafIdb9.svg)](https://asciinema.org/a/Hexie5JoWjlAqLqv2IgafIdb9)
|
||||||
|
|
||||||
|
You may notice that the CLI offers slightly better results than the web interface. This is a performance tradeoff.
|
||||||
|
43
package.json
Normal file
43
package.json
Normal file
@ -0,0 +1,43 @@
|
|||||||
|
{
|
||||||
|
"name": "purescript-docs-search",
|
||||||
|
"version": "0.0.1",
|
||||||
|
"description": "Search frontend for the documentation generated by the PureScript compiler.",
|
||||||
|
"main": "dist/main.js",
|
||||||
|
"directories": {
|
||||||
|
"test": "test"
|
||||||
|
},
|
||||||
|
"bin": {
|
||||||
|
"purescript-docs-search": "dist/main.js"
|
||||||
|
},
|
||||||
|
"files": [
|
||||||
|
"dist/main.js",
|
||||||
|
"dist/docs-search-app.js",
|
||||||
|
"README.md"
|
||||||
|
],
|
||||||
|
"scripts": {
|
||||||
|
"test": "spago test",
|
||||||
|
"bundle-app": "spago bundle-app -m Docs.Search.App --to dist/docs-search-app.js",
|
||||||
|
"bundle-main": "spago bundle-app -m Docs.Search.Main --to dist/main.js && browserify --no-builtins --no-commondir --no-detect-globals --node dist/main.js --outfile dist/main-bundled.js && echo \"#!/usr/bin/env node\" > dist/main.js && cat dist/main-bundled.js >> dist/main.js && rm dist/main-bundled.js",
|
||||||
|
"build": "npm run bundle-app && npm run bundle-main",
|
||||||
|
"clean": "rm -rf dist"
|
||||||
|
},
|
||||||
|
"repository": {
|
||||||
|
"type": "git",
|
||||||
|
"url": "git+https://github.com/spacchetti/purescript-docs-search.git"
|
||||||
|
},
|
||||||
|
"keywords": [
|
||||||
|
"purescript"
|
||||||
|
],
|
||||||
|
"author": "Kalnitsky Vladimir <klntsky@gmail.com>",
|
||||||
|
"license": "BSD-3-Clause",
|
||||||
|
"bugs": {
|
||||||
|
"url": "https://github.com/spacchetti/purescript-docs-search/issues"
|
||||||
|
},
|
||||||
|
"homepage": "https://github.com/spacchetti/purescript-docs-search#readme",
|
||||||
|
"dependencies": {},
|
||||||
|
"devDependencies": {
|
||||||
|
"browserify": "^16.3.0",
|
||||||
|
"glob": "^7.1.4",
|
||||||
|
"spago": "^0.8.5"
|
||||||
|
}
|
||||||
|
}
|
@ -47,6 +47,28 @@ let additions =
|
|||||||
[ "css", "halogen" ]
|
[ "css", "halogen" ]
|
||||||
"https://github.com/slamdata/purescript-halogen-css.git"
|
"https://github.com/slamdata/purescript-halogen-css.git"
|
||||||
"v8.0.0"
|
"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"
|
||||||
}
|
}
|
||||||
|
|
||||||
in upstream ⫽ overrides ⫽ additions
|
in upstream ⫽ overrides ⫽ additions
|
||||||
|
BIN
preview.png
Normal file
BIN
preview.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 57 KiB |
@ -21,6 +21,8 @@
|
|||||||
, "node-fs"
|
, "node-fs"
|
||||||
, "node-fs-aff"
|
, "node-fs-aff"
|
||||||
, "node-process"
|
, "node-process"
|
||||||
|
, "node-readline"
|
||||||
|
, "optparse"
|
||||||
, "profunctor"
|
, "profunctor"
|
||||||
, "search-trie"
|
, "search-trie"
|
||||||
, "string-parsers"
|
, "string-parsers"
|
||||||
|
@ -7,24 +7,19 @@ import Docs.Search.Config (config)
|
|||||||
import Docs.Search.Declarations (DeclLevel(..), declLevelToHashAnchor)
|
import Docs.Search.Declarations (DeclLevel(..), declLevelToHashAnchor)
|
||||||
import Docs.Search.DocsJson (DataDeclType(..))
|
import Docs.Search.DocsJson (DataDeclType(..))
|
||||||
import Docs.Search.Extra ((>#>))
|
import Docs.Search.Extra ((>#>))
|
||||||
import Docs.Search.Index (Index)
|
import Docs.Search.SearchResult (ResultInfo(..), SearchResult)
|
||||||
import Docs.Search.Index as Index
|
|
||||||
import Docs.Search.SearchResult (ResultInfo(..), SearchResult, typeOf)
|
|
||||||
import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
|
import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
|
||||||
import Docs.Search.TypeIndex (TypeIndex)
|
import Docs.Search.Engine as SearchEngine
|
||||||
import Docs.Search.TypeIndex as TypeIndex
|
import Docs.Search.Engine (ResultsType(..))
|
||||||
import Docs.Search.TypeQuery (TypeQuery(..), parseTypeQuery, penalty)
|
|
||||||
|
|
||||||
import CSS (textWhitespace, whitespacePreWrap)
|
import CSS (textWhitespace, whitespacePreWrap)
|
||||||
import Data.Array ((!!))
|
import Data.Array ((!!))
|
||||||
import Data.Array as Array
|
import Data.Array as Array
|
||||||
import Data.Either (hush)
|
|
||||||
import Data.List as List
|
import Data.List as List
|
||||||
import Data.Maybe (Maybe(..), isJust, maybe)
|
import Data.Maybe (Maybe(..), isJust)
|
||||||
import Data.Newtype (unwrap, wrap)
|
import Data.Newtype (unwrap, wrap)
|
||||||
import Data.String (length) as String
|
|
||||||
import Data.String.CodeUnits (stripSuffix) as String
|
import Data.String.CodeUnits (stripSuffix) as String
|
||||||
import Data.String.Common (toLower, trim) as String
|
import Data.String.Common (null, trim) as String
|
||||||
import Data.String.Pattern (Pattern(..)) as String
|
import Data.String.Pattern (Pattern(..)) as String
|
||||||
import Effect.Aff (Aff)
|
import Effect.Aff (Aff)
|
||||||
import Halogen as H
|
import Halogen as H
|
||||||
@ -38,15 +33,11 @@ import Web.HTML as HTML
|
|||||||
import Web.HTML.Location as Location
|
import Web.HTML.Location as Location
|
||||||
import Web.HTML.Window as Window
|
import Web.HTML.Window as Window
|
||||||
|
|
||||||
data Mode = Off | Loading | Active | InputTooShort
|
data Mode = Off | Loading | Active
|
||||||
|
|
||||||
derive instance eqMode :: Eq Mode
|
derive instance eqMode :: Eq Mode
|
||||||
|
|
||||||
-- | Is it a search by type or by name?
|
type State = { searchEngineState :: SearchEngine.State
|
||||||
data ResultsType = TypeResults TypeQuery | DeclResults
|
|
||||||
|
|
||||||
type State = { index :: Index
|
|
||||||
, typeIndex :: TypeIndex
|
|
||||||
, results :: Array SearchResult
|
, results :: Array SearchResult
|
||||||
, resultsType :: ResultsType
|
, resultsType :: ResultsType
|
||||||
, input :: String
|
, input :: String
|
||||||
@ -68,8 +59,7 @@ mkComponent
|
|||||||
-> H.Component HH.HTML Query i o Aff
|
-> H.Component HH.HTML Query i o Aff
|
||||||
mkComponent contents =
|
mkComponent contents =
|
||||||
H.mkComponent
|
H.mkComponent
|
||||||
{ initialState: const { index: mempty
|
{ initialState: const { searchEngineState: mempty
|
||||||
, typeIndex: mempty
|
|
||||||
, results: []
|
, results: []
|
||||||
, resultsType: DeclResults
|
, resultsType: DeclResults
|
||||||
, input: ""
|
, input: ""
|
||||||
@ -99,36 +89,20 @@ handleQuery (MessageFromSearchField (InputUpdated input_) next) = do
|
|||||||
|
|
||||||
state <- H.modify (_ { input = input })
|
state <- H.modify (_ { input = input })
|
||||||
|
|
||||||
if String.length input < 2
|
if String.null input
|
||||||
then do
|
then do
|
||||||
if input == ""
|
|
||||||
then do
|
|
||||||
H.modify_ (_ { mode = Off })
|
H.modify_ (_ { mode = Off })
|
||||||
showPageContents
|
showPageContents
|
||||||
else do
|
|
||||||
H.modify_ (_ { mode = InputTooShort })
|
|
||||||
hidePageContents
|
|
||||||
else do
|
else do
|
||||||
H.modify_ (_ { mode = Loading, resultsCount = config.resultsCount })
|
H.modify_ (_ { mode = Loading, resultsCount = config.resultsCount })
|
||||||
|
|
||||||
void $ H.fork do
|
void $ H.fork do
|
||||||
let resultsType =
|
{ searchEngineState, results, resultsType } <- H.liftAff $
|
||||||
maybe DeclResults TypeResults (hush (parseTypeQuery state.input)
|
SearchEngine.query state.searchEngineState state.input
|
||||||
>>= isValuableTypeQuery)
|
H.modify_ (_ { results = results
|
||||||
|
, mode = Active
|
||||||
case resultsType of
|
, searchEngineState = searchEngineState
|
||||||
|
, resultsType = resultsType })
|
||||||
DeclResults -> do
|
|
||||||
{ index, results } <- H.liftAff $ Index.query state.index (String.toLower state.input)
|
|
||||||
H.modify_ (_ { results = results
|
|
||||||
, mode = Active
|
|
||||||
, index = index })
|
|
||||||
|
|
||||||
TypeResults query -> do
|
|
||||||
{ index, results } <- H.liftAff $ TypeIndex.query state.typeIndex query
|
|
||||||
H.modify_ (_ { results = sortByDistance query results
|
|
||||||
, mode = Active
|
|
||||||
, typeIndex = index })
|
|
||||||
|
|
||||||
hidePageContents
|
hidePageContents
|
||||||
|
|
||||||
@ -181,12 +155,6 @@ render { mode: Off } = HH.div_ []
|
|||||||
render { mode: Loading } =
|
render { mode: Loading } =
|
||||||
renderContainer $
|
renderContainer $
|
||||||
[ HH.h1_ [ HH.text "Loading..." ] ]
|
[ HH.h1_ [ HH.text "Loading..." ] ]
|
||||||
render { mode: InputTooShort } =
|
|
||||||
renderContainer $
|
|
||||||
[ HH.h1_ [ HH.text "Error" ] ] <>
|
|
||||||
[ HH.div [ HP.classes [ wrap "result", wrap "result--empty" ] ]
|
|
||||||
[ HH.text "Search query is too short." ]
|
|
||||||
]
|
|
||||||
render state@{ mode: Active, results: [] } =
|
render state@{ mode: Active, results: [] } =
|
||||||
renderContainer $
|
renderContainer $
|
||||||
|
|
||||||
@ -299,11 +267,7 @@ renderResultType
|
|||||||
renderResultType result =
|
renderResultType result =
|
||||||
case result.info of
|
case result.info of
|
||||||
ValueResult { type: ty } ->
|
ValueResult { type: ty } ->
|
||||||
wrapSignature [ HH.a [ makeHref ValueLevel false result.moduleName result.name
|
wrapSignature $ renderValueSignature result ty
|
||||||
, HE.onClick $ const $ Just $ SearchResultClicked result.moduleName ]
|
|
||||||
[ HH.text result.name ]
|
|
||||||
, HH.text " :: "
|
|
||||||
, renderType ty ]
|
|
||||||
|
|
||||||
TypeClassResult info ->
|
TypeClassResult info ->
|
||||||
wrapSignature $ renderTypeClassSignature info result
|
wrapSignature $ renderTypeClassSignature info result
|
||||||
@ -321,6 +285,21 @@ renderResultType result =
|
|||||||
wrapSignature signature =
|
wrapSignature signature =
|
||||||
[ HH.pre [ HP.class_ (wrap "result__signature") ] [ HH.code_ signature ] ]
|
[ HH.pre [ HP.class_ (wrap "result__signature") ] [ HH.code_ signature ] ]
|
||||||
|
|
||||||
|
renderValueSignature
|
||||||
|
:: forall a rest
|
||||||
|
. { moduleName :: String
|
||||||
|
, name :: String
|
||||||
|
| rest
|
||||||
|
}
|
||||||
|
-> Type
|
||||||
|
-> Array (HH.HTML a Action)
|
||||||
|
renderValueSignature result ty =
|
||||||
|
[ HH.a [ makeHref ValueLevel false result.moduleName result.name
|
||||||
|
, HE.onClick $ const $ Just $ SearchResultClicked result.moduleName ]
|
||||||
|
[ HH.text result.name ]
|
||||||
|
, HH.text " :: "
|
||||||
|
, renderType ty ]
|
||||||
|
|
||||||
renderTypeClassSignature
|
renderTypeClassSignature
|
||||||
:: forall a rest
|
:: forall a rest
|
||||||
. { fundeps :: FunDeps
|
. { fundeps :: FunDeps
|
||||||
@ -582,8 +561,8 @@ renderQualifiedName isInfix level (QualifiedName { moduleName, name })
|
|||||||
|
|
||||||
renderKind
|
renderKind
|
||||||
:: forall a
|
:: forall a
|
||||||
. Kind ->
|
. Kind
|
||||||
HH.HTML a Action
|
-> HH.HTML a Action
|
||||||
renderKind = case _ of
|
renderKind = case _ of
|
||||||
Row k1 -> HH.span_ [ HH.text "# ", renderKind k1 ]
|
Row k1 -> HH.span_ [ HH.text "# ", renderKind k1 ]
|
||||||
FunKind k1 k2 -> HH.span_ [ renderKind k1, syntax " -> ", renderKind k2 ]
|
FunKind k1 k2 -> HH.span_ [ renderKind k1, syntax " -> ", renderKind k2 ]
|
||||||
@ -616,17 +595,3 @@ syntax str = HH.span [ HP.class_ (wrap "syntax") ] [ HH.text str ]
|
|||||||
|
|
||||||
space :: forall a b. HH.HTML a b
|
space :: forall a b. HH.HTML a b
|
||||||
space = HH.text " "
|
space = HH.text " "
|
||||||
|
|
||||||
isValuableTypeQuery :: TypeQuery -> Maybe TypeQuery
|
|
||||||
isValuableTypeQuery (QVar _) = Nothing
|
|
||||||
isValuableTypeQuery (QConst _) = Nothing
|
|
||||||
isValuableTypeQuery query = Just query
|
|
||||||
|
|
||||||
sortByDistance :: TypeQuery -> Array SearchResult -> Array SearchResult
|
|
||||||
sortByDistance typeQuery results =
|
|
||||||
_.result <$> Array.sortBy comparePenalties resultsWithPenalties
|
|
||||||
where
|
|
||||||
comparePenalties r1 r2 = compare r1.penalty r2.penalty
|
|
||||||
resultsWithPenalties = results <#>
|
|
||||||
\result -> { penalty: typeOf (unwrap result).info <#> penalty typeQuery
|
|
||||||
, result }
|
|
||||||
|
@ -17,19 +17,20 @@ config =
|
|||||||
, numberOfIndexParts: 50
|
, numberOfIndexParts: 50
|
||||||
-- ^ In how many parts the index should be splitted?
|
-- ^ In how many parts the index should be splitted?
|
||||||
, mkIndexPartPath:
|
, mkIndexPartPath:
|
||||||
\(partId :: Int) -> "generated-docs/index/declarations/" <> show partId <> ".js"
|
\(partId :: Int) -> "/index/declarations/" <> show partId <> ".js"
|
||||||
, mkIndexPartLoadPath:
|
, mkIndexPartLoadPath:
|
||||||
\(partId :: Int) -> "../index/declarations/" <> show partId <> ".js"
|
\(partId :: Int) -> "../index/declarations/" <> show partId <> ".js"
|
||||||
, resultsCount: 25
|
, resultsCount: 25
|
||||||
-- ^ How many results to show by default?
|
-- ^ How many results to show by default?
|
||||||
, penalties: { typeVars: 6
|
, penalties: { typeVars: 2
|
||||||
, match: 2
|
, match: 2
|
||||||
, matchConstraint: 1
|
, matchConstraint: 1
|
||||||
, instantiate: 1
|
, instantiate: 2
|
||||||
, generalize: 4
|
, generalize: 2
|
||||||
, rowsMismatch: 6
|
, rowsMismatch: 3
|
||||||
, mismatch: 10
|
|
||||||
, missingConstraint: 1
|
, missingConstraint: 1
|
||||||
, excessiveConstraint: 1
|
, excessiveConstraint: 1
|
||||||
}
|
}
|
||||||
|
-- ^ Penalties used to determine how "far" a type query is from a given type.
|
||||||
|
-- See Docs.Search.TypeQuery
|
||||||
}
|
}
|
||||||
|
@ -8,6 +8,7 @@ import Docs.Search.TypeDecoder (Constraint(..), QualifiedName(..), Type(..), joi
|
|||||||
|
|
||||||
import Control.Alt ((<|>))
|
import Control.Alt ((<|>))
|
||||||
import Data.Array ((!!))
|
import Data.Array ((!!))
|
||||||
|
import Data.Array as Array
|
||||||
import Data.Foldable (foldr)
|
import Data.Foldable (foldr)
|
||||||
import Data.List (List, (:))
|
import Data.List (List, (:))
|
||||||
import Data.List as List
|
import Data.List as List
|
||||||
@ -15,8 +16,8 @@ import Data.Maybe (Maybe(..), fromMaybe)
|
|||||||
import Data.Newtype (class Newtype, unwrap, wrap)
|
import Data.Newtype (class Newtype, unwrap, wrap)
|
||||||
import Data.Search.Trie (Trie, alter)
|
import Data.Search.Trie (Trie, alter)
|
||||||
import Data.String.CodeUnits (stripPrefix, stripSuffix, toCharArray)
|
import Data.String.CodeUnits (stripPrefix, stripSuffix, toCharArray)
|
||||||
import Data.String.Common (toLower)
|
|
||||||
import Data.String.Common (split) as String
|
import Data.String.Common (split) as String
|
||||||
|
import Data.String.Common (toLower)
|
||||||
import Data.String.Pattern (Pattern(..))
|
import Data.String.Pattern (Pattern(..))
|
||||||
|
|
||||||
type ModuleName = String
|
type ModuleName = String
|
||||||
@ -178,11 +179,18 @@ extractPackageName name =
|
|||||||
let chunks = String.split (Pattern "/") name in
|
let chunks = String.split (Pattern "/") name in
|
||||||
fromMaybe "<unknown>" $
|
fromMaybe "<unknown>" $
|
||||||
chunks !! 0 >>= \dir ->
|
chunks !! 0 >>= \dir ->
|
||||||
-- TODO: is it safe to assume that directory name is ".spago"?
|
|
||||||
if dir == ".spago" then
|
if dir == ".spago" then
|
||||||
chunks !! 1
|
chunks !! 1
|
||||||
else
|
else
|
||||||
Just "<local package>"
|
let
|
||||||
|
bowerComponentsIndex =
|
||||||
|
Array.findIndex (_ == "bower_components") chunks
|
||||||
|
in
|
||||||
|
case bowerComponentsIndex of
|
||||||
|
Just n ->
|
||||||
|
chunks !! (n + 1)
|
||||||
|
Nothing ->
|
||||||
|
Just "<local package>"
|
||||||
|
|
||||||
resultsForChildDeclaration
|
resultsForChildDeclaration
|
||||||
:: PackageName
|
:: PackageName
|
||||||
|
@ -2,10 +2,9 @@ module Docs.Search.DocsJson where
|
|||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Docs.Search.TypeDecoder
|
import Docs.Search.TypeDecoder (Constraint, FunDeps, Kind, Type, TypeArgument)
|
||||||
|
|
||||||
import Control.Promise (Promise, toAffE)
|
import Data.Argonaut.Core (fromString, stringify, toString)
|
||||||
import Data.Argonaut.Core (Json, fromString, stringify, toString)
|
|
||||||
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:?))
|
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:?))
|
||||||
import Data.Argonaut.Encode (class EncodeJson, encodeJson)
|
import Data.Argonaut.Encode (class EncodeJson, encodeJson)
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..))
|
||||||
@ -13,8 +12,6 @@ import Data.Generic.Rep (class Generic)
|
|||||||
import Data.Generic.Rep.Show (genericShow)
|
import Data.Generic.Rep.Show (genericShow)
|
||||||
import Data.Maybe (Maybe(..))
|
import Data.Maybe (Maybe(..))
|
||||||
import Data.Newtype (class Newtype, unwrap)
|
import Data.Newtype (class Newtype, unwrap)
|
||||||
import Effect (Effect)
|
|
||||||
import Effect.Aff (Aff)
|
|
||||||
|
|
||||||
newtype DocsJson
|
newtype DocsJson
|
||||||
= DocsJson { name :: String
|
= DocsJson { name :: String
|
||||||
|
59
src/Docs/Search/Engine.purs
Normal file
59
src/Docs/Search/Engine.purs
Normal file
@ -0,0 +1,59 @@
|
|||||||
|
module Docs.Search.Engine where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Docs.Search.TypeQuery (TypeQuery(..), parseTypeQuery, penalty)
|
||||||
|
import Docs.Search.SearchResult (SearchResult, typeOf)
|
||||||
|
import Docs.Search.Index as Index
|
||||||
|
import Docs.Search.Index (Index)
|
||||||
|
import Docs.Search.TypeIndex as TypeIndex
|
||||||
|
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)
|
||||||
|
|
||||||
|
data ResultsType = TypeResults TypeQuery | DeclResults
|
||||||
|
|
||||||
|
type State = { index :: Index
|
||||||
|
, typeIndex :: TypeIndex
|
||||||
|
}
|
||||||
|
|
||||||
|
query
|
||||||
|
:: State
|
||||||
|
-> String
|
||||||
|
-> Aff { searchEngineState :: State
|
||||||
|
, results :: Array SearchResult
|
||||||
|
, resultsType :: ResultsType
|
||||||
|
}
|
||||||
|
query { index, typeIndex } input =
|
||||||
|
case hush (parseTypeQuery input) >>= isValuableTypeQuery of
|
||||||
|
Nothing -> do
|
||||||
|
response <- Index.query index (String.toLower input)
|
||||||
|
pure { searchEngineState: { index: response.index, typeIndex }
|
||||||
|
, results: response.results
|
||||||
|
, resultsType: DeclResults }
|
||||||
|
|
||||||
|
Just typeQuery -> do
|
||||||
|
response <- TypeIndex.query typeIndex typeQuery
|
||||||
|
pure { searchEngineState: { index, typeIndex: response.typeIndex }
|
||||||
|
, results: sortByDistance typeQuery response.results
|
||||||
|
, resultsType: TypeResults typeQuery }
|
||||||
|
|
||||||
|
isValuableTypeQuery :: TypeQuery -> Maybe TypeQuery
|
||||||
|
isValuableTypeQuery (QVar _) = Nothing
|
||||||
|
isValuableTypeQuery (QConst _) = Nothing
|
||||||
|
isValuableTypeQuery other = Just other
|
||||||
|
|
||||||
|
sortByDistance :: TypeQuery -> Array SearchResult -> Array SearchResult
|
||||||
|
sortByDistance typeQuery results =
|
||||||
|
_.result <$> Array.sortBy comparePenalties resultsWithPenalties
|
||||||
|
where
|
||||||
|
comparePenalties r1 r2 = compare r1.penalty r2.penalty
|
||||||
|
resultsWithPenalties =
|
||||||
|
results <#>
|
||||||
|
\result -> { penalty: typeOf (unwrap result).info <#> penalty typeQuery
|
||||||
|
, result }
|
9
src/Docs/Search/Extra.js
Normal file
9
src/Docs/Search/Extra.js
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
/* global exports require */
|
||||||
|
|
||||||
|
var glob = require('glob');
|
||||||
|
|
||||||
|
exports.glob = function (pattern) {
|
||||||
|
return function () {
|
||||||
|
return glob.sync(pattern);
|
||||||
|
};
|
||||||
|
};
|
@ -2,8 +2,12 @@ module Docs.Search.Extra where
|
|||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Data.Foldable (class Foldable, foldMap)
|
import Data.Foldable (class Foldable, foldMap, foldl)
|
||||||
|
import Data.List.NonEmpty (NonEmptyList, cons', uncons)
|
||||||
import Data.Maybe (Maybe(..))
|
import Data.Maybe (Maybe(..))
|
||||||
|
import Effect (Effect)
|
||||||
|
import Data.List as List
|
||||||
|
import Data.List ((:))
|
||||||
|
|
||||||
whenJust :: forall a m. Monad m => Maybe a -> (a -> m Unit) -> m Unit
|
whenJust :: forall a m. Monad m => Maybe a -> (a -> m Unit) -> m Unit
|
||||||
whenJust (Just a) f = f a
|
whenJust (Just a) f = f a
|
||||||
@ -13,3 +17,19 @@ foldMapFlipped :: forall a m f. Foldable f => Monoid m => f a -> (a -> m) -> m
|
|||||||
foldMapFlipped = flip foldMap
|
foldMapFlipped = flip foldMap
|
||||||
|
|
||||||
infixr 7 foldMapFlipped as >#>
|
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
|
||||||
|
{ head, tail } -> foldl f head tail
|
||||||
|
|
||||||
|
foldr1 :: forall a. (a -> a -> a) -> NonEmptyList a -> a
|
||||||
|
foldr1 f = go List.Nil
|
||||||
|
where
|
||||||
|
go acc x = case uncons x of
|
||||||
|
{ head, tail } -> case List.uncons tail of
|
||||||
|
Nothing -> List.foldl (flip f) head acc
|
||||||
|
Just { head: head1, tail: tail1 } ->
|
||||||
|
go (head : acc) (cons' head1 tail1)
|
||||||
|
@ -98,6 +98,7 @@ getPartId (a : _) =
|
|||||||
Char.toCharCode a `mod` config.numberOfIndexParts
|
Char.toCharCode a `mod` config.numberOfIndexParts
|
||||||
getPartId _ = 0
|
getPartId _ = 0
|
||||||
|
|
||||||
|
-- | Load a part of the index by injecting a <script> tag into the DOM.
|
||||||
foreign import loadIndex_
|
foreign import loadIndex_
|
||||||
:: Int
|
:: Int
|
||||||
-> String
|
-> String
|
||||||
|
7
src/Docs/Search/IndexBuilder.js
Normal file
7
src/Docs/Search/IndexBuilder.js
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
/* global __dirname require exports */
|
||||||
|
|
||||||
|
var path = require('path');
|
||||||
|
|
||||||
|
exports.getDirname = function () {
|
||||||
|
return __dirname;
|
||||||
|
};
|
@ -5,7 +5,7 @@ import Prelude
|
|||||||
import Docs.Search.Config (config)
|
import Docs.Search.Config (config)
|
||||||
import Docs.Search.Declarations (Declarations(..), mkDeclarations)
|
import Docs.Search.Declarations (Declarations(..), mkDeclarations)
|
||||||
import Docs.Search.DocsJson (DocsJson)
|
import Docs.Search.DocsJson (DocsJson)
|
||||||
import Docs.Search.Extra ((>#>))
|
import Docs.Search.Extra ((>#>), glob)
|
||||||
import Docs.Search.Index (getPartId)
|
import Docs.Search.Index (getPartId)
|
||||||
import Docs.Search.SearchResult (SearchResult)
|
import Docs.Search.SearchResult (SearchResult)
|
||||||
import Docs.Search.TypeIndex (TypeIndex, mkTypeIndex)
|
import Docs.Search.TypeIndex (TypeIndex, mkTypeIndex)
|
||||||
@ -35,55 +35,83 @@ import Effect.Aff (Aff, launchAff_, parallel, sequential)
|
|||||||
import Effect.Class (liftEffect)
|
import Effect.Class (liftEffect)
|
||||||
import Effect.Console (log)
|
import Effect.Console (log)
|
||||||
import Node.Encoding (Encoding(UTF8))
|
import Node.Encoding (Encoding(UTF8))
|
||||||
import Node.FS.Aff (exists, mkdir, readTextFile, readdir, stat, writeTextFile)
|
import Node.FS.Aff (exists, mkdir, readFile, readTextFile, readdir, stat, writeFile, writeTextFile)
|
||||||
import Node.FS.Stats (isDirectory, isFile)
|
import Node.FS.Stats (isDirectory, isFile)
|
||||||
import Node.Process as Process
|
import Node.Process as Process
|
||||||
|
|
||||||
main :: Effect Unit
|
type Config = { docsFiles :: Array String
|
||||||
main = launchAff_ mainAff
|
, generatedDocs :: String
|
||||||
|
}
|
||||||
|
|
||||||
mainAff :: Aff Unit
|
run :: Config -> Effect Unit
|
||||||
mainAff = do
|
run = launchAff_ <<< run'
|
||||||
checkDirectories
|
|
||||||
|
|
||||||
docsJsons <- collectDocsJsons config.outputDirectory
|
run' :: Config -> Aff Unit
|
||||||
|
run' cfg = do
|
||||||
|
|
||||||
liftEffect $ log $
|
checkDirectories cfg
|
||||||
"Found " <> show (Array.length docsJsons) <> " modules."
|
|
||||||
|
liftEffect do
|
||||||
|
log "Building the search index..."
|
||||||
|
|
||||||
|
docsJsons <- decodeDocsJsons cfg
|
||||||
|
|
||||||
|
liftEffect do
|
||||||
|
log $ "Found " <> show (Array.length docsJsons) <> " modules."
|
||||||
|
|
||||||
let index = mkDeclarations docsJsons
|
let index = mkDeclarations docsJsons
|
||||||
typeIndex = mkTypeIndex index
|
typeIndex = mkTypeIndex index
|
||||||
|
|
||||||
createDirectories
|
createDirectories cfg
|
||||||
|
|
||||||
void $ sequential do
|
void $ sequential do
|
||||||
ignore <$> parallel (writeIndex index)
|
ignore <$> parallel (writeIndex cfg index)
|
||||||
<*> parallel (writeTypeIndex typeIndex)
|
<*> parallel (writeTypeIndex cfg typeIndex)
|
||||||
<*> parallel patchDocs
|
<*> parallel (patchDocs cfg)
|
||||||
|
<*> parallel (copyAppFile cfg)
|
||||||
|
|
||||||
liftEffect $ log $
|
liftEffect do
|
||||||
"Loaded " <>
|
log $
|
||||||
show (Trie.size $ unwrap index) <>
|
"Added " <>
|
||||||
" definitions and " <>
|
show (Trie.size $ unwrap index) <>
|
||||||
show (List.length $ join $ map snd $ Trie.entriesUnordered (unwrap index)) <>
|
" definitions and " <>
|
||||||
" type definitions"
|
show (List.length $ join $ map snd $ Trie.entriesUnordered (unwrap index)) <>
|
||||||
where ignore _ _ _ = unit
|
" type definitions to the search index."
|
||||||
|
|
||||||
|
where ignore _ _ _ _ = unit
|
||||||
|
|
||||||
-- | Exit early if something is missing.
|
-- | Exit early if something is missing.
|
||||||
checkDirectories :: Aff Unit
|
checkDirectories :: Config -> Aff Unit
|
||||||
checkDirectories = do
|
checkDirectories cfg = do
|
||||||
for_ config.requiredDirectories \dir -> do
|
|
||||||
|
let dirs = [ cfg.generatedDocs
|
||||||
|
, cfg.generatedDocs <> "/html"
|
||||||
|
]
|
||||||
|
|
||||||
|
for_ dirs \dir -> do
|
||||||
whenM (not <$> directoryExists dir) $
|
whenM (not <$> directoryExists dir) $
|
||||||
liftEffect $ logAndExit "Generate the documentation first!"
|
liftEffect do
|
||||||
|
logAndExit "Build the documentation first!"
|
||||||
|
|
||||||
-- | Read and decode all `docs.json` files in the `outputDir`.
|
-- | Read and decode given `docs.json` files.
|
||||||
collectDocsJsons :: String -> Aff (Array DocsJson)
|
decodeDocsJsons
|
||||||
collectDocsJsons outputDir = do
|
:: forall rest
|
||||||
paths <- readdir outputDir
|
. { docsFiles :: Array String | rest }
|
||||||
|
-> Aff (Array DocsJson)
|
||||||
|
decodeDocsJsons cfg = do
|
||||||
|
|
||||||
Array.catMaybes <$> for paths \moduleName -> do
|
paths <- Array.concat <$> for cfg.docsFiles \str -> do
|
||||||
let jsonFile = "output/" <> moduleName <> "/docs.json"
|
liftEffect $ glob str
|
||||||
|
|
||||||
|
when (Array.null paths) do
|
||||||
|
liftEffect do
|
||||||
|
logAndExit $
|
||||||
|
"The following globs do not match any files: " <> showGlobs cfg.docsFiles <>
|
||||||
|
".\nBuild the documentation first!"
|
||||||
|
|
||||||
|
docsJsons <- Array.catMaybes <$> for paths \jsonFile -> do
|
||||||
doesExist <- fileExists jsonFile
|
doesExist <- fileExists jsonFile
|
||||||
|
|
||||||
if doesExist then do
|
if doesExist then do
|
||||||
|
|
||||||
contents <- readTextFile UTF8 jsonFile
|
contents <- readTextFile UTF8 jsonFile
|
||||||
@ -92,20 +120,27 @@ collectDocsJsons outputDir = do
|
|||||||
case eiResult of
|
case eiResult of
|
||||||
Left error -> do
|
Left error -> do
|
||||||
liftEffect $ log $
|
liftEffect $ log $
|
||||||
"\"docs.json\" decoding failed failed for module " <> moduleName <> ": " <> show error
|
"\"docs.json\" decoding failed failed for " <> jsonFile <> ": " <> show error
|
||||||
pure Nothing
|
pure Nothing
|
||||||
Right result -> pure result
|
Right result -> pure result
|
||||||
|
|
||||||
else do
|
else do
|
||||||
liftEffect $ do
|
liftEffect $ do
|
||||||
log $
|
log $
|
||||||
"Couldn't find docs.json for " <> moduleName
|
"File does not exist: " <> jsonFile
|
||||||
pure Nothing
|
pure Nothing
|
||||||
|
|
||||||
writeTypeIndex :: TypeIndex -> Aff Unit
|
when (Array.null docsJsons) do
|
||||||
writeTypeIndex typeIndex =
|
liftEffect $ logAndExit $
|
||||||
|
"Couldn't decode any of the files matched by the following globs: " <> showGlobs cfg.docsFiles
|
||||||
|
|
||||||
|
pure docsJsons
|
||||||
|
|
||||||
|
-- | Write type index parts to files.
|
||||||
|
writeTypeIndex :: Config -> TypeIndex -> Aff Unit
|
||||||
|
writeTypeIndex { generatedDocs } typeIndex =
|
||||||
for_ entries \(Tuple typeShape results) -> do
|
for_ entries \(Tuple typeShape results) -> do
|
||||||
writeTextFile UTF8 ("generated-docs/index/types/" <> typeShape <> ".js")
|
writeTextFile UTF8 (generatedDocs <> "/index/types/" <> typeShape <> ".js")
|
||||||
(mkHeader typeShape <> stringify (encodeJson results))
|
(mkHeader typeShape <> stringify (encodeJson results))
|
||||||
where
|
where
|
||||||
mkHeader typeShape =
|
mkHeader typeShape =
|
||||||
@ -119,11 +154,7 @@ getIndex :: Declarations -> Map Int (Array (Tuple String (Array SearchResult)))
|
|||||||
getIndex (Declarations trie) =
|
getIndex (Declarations trie) =
|
||||||
Array.foldr insert mempty parts
|
Array.foldr insert mempty parts
|
||||||
where
|
where
|
||||||
prefixes :: Array (List Char)
|
insert part = Map.insertWith append (getPartId part.prefix) part.results
|
||||||
prefixes =
|
|
||||||
Set.toUnfoldable $
|
|
||||||
List.foldr (\entry -> Set.insert (List.take 2 $ fst entry)) mempty $
|
|
||||||
Trie.entriesUnordered trie
|
|
||||||
|
|
||||||
parts
|
parts
|
||||||
:: Array { prefix :: List Char
|
:: Array { prefix :: List Char
|
||||||
@ -131,24 +162,35 @@ getIndex (Declarations trie) =
|
|||||||
}
|
}
|
||||||
parts = prefixes <#> \prefix ->
|
parts = prefixes <#> \prefix ->
|
||||||
let results =
|
let results =
|
||||||
Array.fromFoldable $
|
Array.fromFoldable $ toTuple <$>
|
||||||
Trie.query prefix trie <#>
|
if List.length prefix == 2 then
|
||||||
\(Tuple path value) ->
|
Trie.query prefix trie
|
||||||
Tuple (path >#> String.singleton) (Array.fromFoldable value)
|
else
|
||||||
|
-- Entries with path lengths > 1 have been added already.
|
||||||
|
List.filter (\(Tuple path value) -> List.length path == 1) (
|
||||||
|
Trie.query prefix trie
|
||||||
|
)
|
||||||
in
|
in
|
||||||
{ prefix, results }
|
{ prefix, results }
|
||||||
|
|
||||||
insert part = Map.insertWith append (getPartId part.prefix) part.results
|
toTuple (Tuple path value) =
|
||||||
|
Tuple (path >#> String.singleton) (Array.fromFoldable value)
|
||||||
|
|
||||||
writeIndex :: Declarations -> Aff Unit
|
prefixes :: Array (List Char)
|
||||||
writeIndex = getIndex >>> \resultsMap -> do
|
prefixes =
|
||||||
|
Set.toUnfoldable $
|
||||||
|
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 _)
|
for_ (Map.toUnfoldableUnordered resultsMap :: Array _)
|
||||||
\(Tuple indexPartId results) -> do
|
\(Tuple indexPartId results) -> do
|
||||||
let header =
|
let header =
|
||||||
"// This file was generated by purescript-docs-search.\n" <>
|
"// This file was generated by purescript-docs-search.\n" <>
|
||||||
"window.DocsSearchIndex[\"" <> show indexPartId <> "\"] = "
|
"window.DocsSearchIndex[\"" <> show indexPartId <> "\"] = "
|
||||||
|
|
||||||
writeTextFile UTF8 (config.mkIndexPartPath indexPartId) $
|
writeTextFile UTF8 (generatedDocs <> config.mkIndexPartPath indexPartId) $
|
||||||
header <> stringify (encodeJson results)
|
header <> stringify (encodeJson results)
|
||||||
|
|
||||||
patchHTML :: String -> Tuple Boolean String
|
patchHTML :: String -> Tuple Boolean String
|
||||||
@ -166,9 +208,9 @@ patchHTML html =
|
|||||||
then Tuple true $ String.replace pattern (Replacement patch) html
|
then Tuple true $ String.replace pattern (Replacement patch) html
|
||||||
else Tuple false html
|
else Tuple false html
|
||||||
|
|
||||||
patchDocs :: Aff Unit
|
patchDocs :: Config -> Aff Unit
|
||||||
patchDocs = do
|
patchDocs cfg = do
|
||||||
let dirname = "generated-docs/"
|
let dirname = cfg.generatedDocs
|
||||||
|
|
||||||
files <- readdir (dirname <> "html")
|
files <- readdir (dirname <> "html")
|
||||||
|
|
||||||
@ -182,14 +224,13 @@ patchDocs = do
|
|||||||
writeTextFile UTF8 path patchedContents
|
writeTextFile UTF8 path patchedContents
|
||||||
_ -> pure unit
|
_ -> pure unit
|
||||||
|
|
||||||
createDirectories :: Aff Unit
|
createDirectories :: Config -> Aff Unit
|
||||||
createDirectories = do
|
createDirectories { generatedDocs } = do
|
||||||
let generatedDocsDir = "generated-docs/"
|
let indexDir = generatedDocs <> "/index"
|
||||||
indexDir = "generated-docs/index"
|
declIndexDir = generatedDocs <> "/index/declarations"
|
||||||
declIndexDir = "generated-docs/index/declarations"
|
typeIndexDir = generatedDocs <> "/index/types"
|
||||||
typeIndexDir = "generated-docs/index/types"
|
|
||||||
|
|
||||||
whenM (not <$> directoryExists generatedDocsDir) $ liftEffect do
|
whenM (not <$> directoryExists generatedDocs) $ liftEffect do
|
||||||
logAndExit "Generate the documentation first!"
|
logAndExit "Generate the documentation first!"
|
||||||
|
|
||||||
whenM (not <$> directoryExists indexDir) do
|
whenM (not <$> directoryExists indexDir) do
|
||||||
@ -201,6 +242,20 @@ createDirectories = do
|
|||||||
whenM (not <$> directoryExists typeIndexDir) do
|
whenM (not <$> directoryExists typeIndexDir) do
|
||||||
mkdir typeIndexDir
|
mkdir typeIndexDir
|
||||||
|
|
||||||
|
-- | Copy the client-side application, responsible for handling user input and rendering
|
||||||
|
-- | the results, to the destination path.
|
||||||
|
copyAppFile :: Config -> Aff Unit
|
||||||
|
copyAppFile { generatedDocs } = do
|
||||||
|
appDir <- liftEffect getDirname
|
||||||
|
let appFile = appDir <> "/docs-search-app.js"
|
||||||
|
whenM (not <$> fileExists appFile) do
|
||||||
|
liftEffect do
|
||||||
|
logAndExit $
|
||||||
|
"Client-side app was not found at " <> appFile <> ".\n" <>
|
||||||
|
"Check your installation."
|
||||||
|
buffer <- readFile appFile
|
||||||
|
writeFile (generatedDocs <> "/docs-search-app.js") buffer
|
||||||
|
|
||||||
directoryExists :: String -> Aff Boolean
|
directoryExists :: String -> Aff Boolean
|
||||||
directoryExists path = do
|
directoryExists path = do
|
||||||
doesExist <- exists path
|
doesExist <- exists path
|
||||||
@ -216,6 +271,12 @@ fileExists path = do
|
|||||||
true -> isFile <$> stat path
|
true -> isFile <$> stat path
|
||||||
|
|
||||||
logAndExit :: forall a. String -> Effect a
|
logAndExit :: forall a. String -> Effect a
|
||||||
logAndExit err = do
|
logAndExit message = do
|
||||||
log err
|
log message
|
||||||
Process.exit 1
|
Process.exit 1
|
||||||
|
|
||||||
|
showGlobs :: Array String -> String
|
||||||
|
showGlobs = Array.intercalate ", "
|
||||||
|
|
||||||
|
-- | Get __dirname.
|
||||||
|
foreign import getDirname :: Effect String
|
||||||
|
5
src/Docs/Search/Interactive.js
Normal file
5
src/Docs/Search/Interactive.js
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
/* global exports */
|
||||||
|
|
||||||
|
exports.consoleClear = function () {
|
||||||
|
console.clear();
|
||||||
|
};
|
258
src/Docs/Search/Interactive.purs
Normal file
258
src/Docs/Search/Interactive.purs
Normal file
@ -0,0 +1,258 @@
|
|||||||
|
module Docs.Search.Interactive where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
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.IndexBuilder as IndexBuilder
|
||||||
|
import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))
|
||||||
|
import Docs.Search.Terminal (bold, cyan, green, yellow)
|
||||||
|
import Docs.Search.TypeDecoder (Constraint, FunDeps, Kind, QualifiedName, Type, TypeArgument)
|
||||||
|
import Docs.Search.TypeIndex (mkTypeIndex)
|
||||||
|
import Docs.Search.TypePrinter (keyword, showConstraint, showFunDeps, showKind, showType, showTypeArgument, space, syntax)
|
||||||
|
import Docs.Search.TypeQuery (parseTypeQuery)
|
||||||
|
|
||||||
|
import Data.Array as Array
|
||||||
|
import Data.Either (hush)
|
||||||
|
import Data.List as List
|
||||||
|
import Data.Map as Map
|
||||||
|
import Data.Maybe (Maybe(..), fromMaybe)
|
||||||
|
import Data.Newtype (unwrap, wrap)
|
||||||
|
import Data.Search.Trie as Trie
|
||||||
|
import Data.String (length) as String
|
||||||
|
import Data.String.CodeUnits (fromCharArray, toCharArray) as String
|
||||||
|
import Data.String.Common (split, toLower, trim) as String
|
||||||
|
import Data.Tuple (snd, fst)
|
||||||
|
import Effect (Effect)
|
||||||
|
import Effect.Aff (launchAff_)
|
||||||
|
import Effect.Class (liftEffect)
|
||||||
|
import Effect.Console (log)
|
||||||
|
import Node.ReadLine (createConsoleInterface, question)
|
||||||
|
|
||||||
|
type Config = { docsFiles :: Array String }
|
||||||
|
|
||||||
|
run :: Config -> Effect Unit
|
||||||
|
run cfg = launchAff_ $ do
|
||||||
|
|
||||||
|
liftEffect do
|
||||||
|
log "Loading search index..."
|
||||||
|
|
||||||
|
docsJsons <- IndexBuilder.decodeDocsJsons cfg
|
||||||
|
|
||||||
|
let index = mkDeclarations docsJsons
|
||||||
|
typeIndex = Array.concat $ Array.fromFoldable (
|
||||||
|
Map.values (unwrap (mkTypeIndex index)) <#> fromMaybe []
|
||||||
|
) :: Array SearchResult
|
||||||
|
|
||||||
|
liftEffect do
|
||||||
|
log $
|
||||||
|
"Loaded " <>
|
||||||
|
show (Trie.size $ unwrap index) <>
|
||||||
|
" definitions and " <>
|
||||||
|
show (List.length $ join $ map snd $ Trie.entriesUnordered (unwrap index)) <>
|
||||||
|
" type definitions"
|
||||||
|
|
||||||
|
liftEffect do
|
||||||
|
let
|
||||||
|
call handler interface = do
|
||||||
|
question "> " (handler interface) interface
|
||||||
|
|
||||||
|
inputHandler interface input = do
|
||||||
|
let results =
|
||||||
|
case hush (parseTypeQuery input) >>= isValuableTypeQuery of
|
||||||
|
Nothing ->
|
||||||
|
Array.fromFoldable $
|
||||||
|
List.concat $
|
||||||
|
Trie.queryValues (List.fromFoldable $
|
||||||
|
String.toCharArray $
|
||||||
|
String.toLower $
|
||||||
|
input) (unwrap index)
|
||||||
|
|
||||||
|
Just typeQuery ->
|
||||||
|
Array.take 100 $
|
||||||
|
SearchEngine.sortByDistance typeQuery typeIndex
|
||||||
|
|
||||||
|
let total = Array.length results
|
||||||
|
|
||||||
|
consoleClear
|
||||||
|
|
||||||
|
if total > 0 then do
|
||||||
|
log $
|
||||||
|
Array.intercalate "\n\n\n" $
|
||||||
|
showResult <$> Array.reverse results
|
||||||
|
else do
|
||||||
|
log $
|
||||||
|
"Your search for " <> bold input <> " did not yield any results."
|
||||||
|
call inputHandler interface
|
||||||
|
|
||||||
|
interface <- do
|
||||||
|
interface <- createConsoleInterface (mkCompleter index)
|
||||||
|
pure interface
|
||||||
|
|
||||||
|
call inputHandler interface
|
||||||
|
|
||||||
|
mkCompleter
|
||||||
|
:: Declarations
|
||||||
|
-> String
|
||||||
|
-> Effect { completions :: Array String
|
||||||
|
, matched :: String }
|
||||||
|
mkCompleter index input = do
|
||||||
|
let path = List.fromFoldable $ String.toCharArray input
|
||||||
|
let paths =
|
||||||
|
Array.fromFoldable $
|
||||||
|
(String.fromCharArray <<< Array.fromFoldable) <$>
|
||||||
|
(fst <$> Trie.query path (unwrap index))
|
||||||
|
|
||||||
|
pure { completions: paths
|
||||||
|
, matched: input }
|
||||||
|
|
||||||
|
showResult :: SearchResult -> String
|
||||||
|
showResult result@(SearchResult { name, comments, moduleName, packageName, info }) =
|
||||||
|
showSignature result <> "\n" <>
|
||||||
|
|
||||||
|
(fromMaybe "\n" $
|
||||||
|
comments <#> \comment ->
|
||||||
|
"\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 }) =
|
||||||
|
case info of
|
||||||
|
ValueResult { type: ty } ->
|
||||||
|
yellow name <> syntax " :: " <> showType ty
|
||||||
|
|
||||||
|
TypeClassResult info' ->
|
||||||
|
showTypeClassSignature info' (unwrap result)
|
||||||
|
|
||||||
|
TypeClassMemberResult info' ->
|
||||||
|
showTypeClassMemberSignature info' (unwrap result)
|
||||||
|
|
||||||
|
DataResult info' ->
|
||||||
|
showDataSignature info' (unwrap result)
|
||||||
|
|
||||||
|
TypeSynonymResult info' ->
|
||||||
|
showTypeSynonymSignature info' (unwrap result)
|
||||||
|
|
||||||
|
ExternDataResult info' ->
|
||||||
|
showExternDataSignature info' (unwrap result)
|
||||||
|
|
||||||
|
ValueAliasResult ->
|
||||||
|
yellow ("(" <> name <> ")")
|
||||||
|
|
||||||
|
_ -> yellow name
|
||||||
|
|
||||||
|
showTypeClassSignature
|
||||||
|
:: forall rest
|
||||||
|
. { fundeps :: FunDeps
|
||||||
|
, arguments :: Array TypeArgument
|
||||||
|
, superclasses :: Array Constraint
|
||||||
|
}
|
||||||
|
-> { name :: String, moduleName :: String | rest }
|
||||||
|
-> String
|
||||||
|
showTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName } =
|
||||||
|
|
||||||
|
keyword "class" <>
|
||||||
|
( if Array.null superclasses
|
||||||
|
then
|
||||||
|
""
|
||||||
|
else
|
||||||
|
syntax " (" <> (
|
||||||
|
Array.intercalate (syntax ", " ) (
|
||||||
|
superclasses <#> showConstraint
|
||||||
|
)
|
||||||
|
) <>
|
||||||
|
syntax ")" <>
|
||||||
|
space <>
|
||||||
|
syntax "<="
|
||||||
|
) <>
|
||||||
|
space <>
|
||||||
|
yellow name <>
|
||||||
|
space <> (
|
||||||
|
Array.intercalate space $
|
||||||
|
arguments <#> showTypeArgument
|
||||||
|
) <> (
|
||||||
|
showFunDeps fundeps
|
||||||
|
)
|
||||||
|
|
||||||
|
showTypeClassMemberSignature
|
||||||
|
:: forall rest
|
||||||
|
. { type :: Type
|
||||||
|
, typeClass :: QualifiedName
|
||||||
|
, typeClassArguments :: Array String
|
||||||
|
}
|
||||||
|
-> { name :: String | rest }
|
||||||
|
-> String
|
||||||
|
showTypeClassMemberSignature { type: ty, typeClass, typeClassArguments } result =
|
||||||
|
yellow result.name <>
|
||||||
|
syntax " :: " <>
|
||||||
|
showType ty
|
||||||
|
|
||||||
|
showDataSignature
|
||||||
|
:: forall rest
|
||||||
|
. { typeArguments :: Array TypeArgument
|
||||||
|
, dataDeclType :: DataDeclType }
|
||||||
|
-> { name :: String | rest }
|
||||||
|
-> String
|
||||||
|
showDataSignature { typeArguments, dataDeclType } { name } =
|
||||||
|
( keyword
|
||||||
|
case dataDeclType of
|
||||||
|
NewtypeDataDecl -> "newtype"
|
||||||
|
DataDataDecl -> "data"
|
||||||
|
) <>
|
||||||
|
space <>
|
||||||
|
yellow name <>
|
||||||
|
space <> (
|
||||||
|
Array.intercalate space $
|
||||||
|
typeArguments <#> showTypeArgument
|
||||||
|
)
|
||||||
|
|
||||||
|
showTypeSynonymSignature
|
||||||
|
:: forall rest
|
||||||
|
. { type :: Type
|
||||||
|
, arguments :: Array TypeArgument
|
||||||
|
}
|
||||||
|
-> { name :: String | rest }
|
||||||
|
-> String
|
||||||
|
showTypeSynonymSignature { type: ty, arguments } { name } =
|
||||||
|
keyword "type" <>
|
||||||
|
space <>
|
||||||
|
yellow name <>
|
||||||
|
space <> (
|
||||||
|
Array.intercalate space $
|
||||||
|
arguments <#> showTypeArgument
|
||||||
|
) <>
|
||||||
|
space <>
|
||||||
|
syntax "=" <>
|
||||||
|
space <>
|
||||||
|
showType ty
|
||||||
|
|
||||||
|
showExternDataSignature
|
||||||
|
:: forall rest
|
||||||
|
. { kind :: Kind }
|
||||||
|
-> { name :: String | rest }
|
||||||
|
-> String
|
||||||
|
showExternDataSignature { kind } { name } =
|
||||||
|
keyword "foreign data" <>
|
||||||
|
space <>
|
||||||
|
yellow name <>
|
||||||
|
space <>
|
||||||
|
syntax " :: " <>
|
||||||
|
showKind kind
|
||||||
|
|
||||||
|
leftShift :: Int -> String -> String
|
||||||
|
leftShift shift str =
|
||||||
|
Array.intercalate "\n" $
|
||||||
|
leftPad shift <$>
|
||||||
|
String.trim <$>
|
||||||
|
String.split (wrap "\n") str
|
||||||
|
|
||||||
|
leftPad :: Int -> String -> String
|
||||||
|
leftPad w str = Array.fold (Array.replicate w " ") <> str
|
||||||
|
|
||||||
|
rightPad :: Int -> String -> String
|
||||||
|
rightPad w str = str <> Array.fold (Array.replicate (w - String.length str) " ")
|
||||||
|
|
||||||
|
foreign import consoleClear :: Effect Unit
|
103
src/Docs/Search/Main.purs
Normal file
103
src/Docs/Search/Main.purs
Normal file
@ -0,0 +1,103 @@
|
|||||||
|
module Docs.Search.Main where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Docs.Search.IndexBuilder as IndexBuilder
|
||||||
|
import Docs.Search.Interactive as Interactive
|
||||||
|
|
||||||
|
import Data.Generic.Rep (class Generic)
|
||||||
|
import Data.Generic.Rep.Show (genericShow)
|
||||||
|
import Data.List as List
|
||||||
|
import Data.List.NonEmpty as NonEmpty
|
||||||
|
import Data.Maybe (Maybe, fromMaybe, optional)
|
||||||
|
import Data.Unfoldable (class Unfoldable)
|
||||||
|
import Effect (Effect)
|
||||||
|
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 }
|
||||||
|
|
||||||
|
case fromMaybe defaultCommands args of
|
||||||
|
BuildIndex cfg -> IndexBuilder.run cfg
|
||||||
|
Search cfg -> Interactive.run cfg
|
||||||
|
|
||||||
|
getArgs :: Effect (Maybe Commands)
|
||||||
|
getArgs = execParser opts
|
||||||
|
where
|
||||||
|
opts =
|
||||||
|
info (commands <**> helper)
|
||||||
|
( fullDesc
|
||||||
|
<> progDesc "Search frontend for the documentation generated by the PureScript compiler."
|
||||||
|
)
|
||||||
|
|
||||||
|
data Commands
|
||||||
|
= BuildIndex { docsFiles :: Array String
|
||||||
|
, generatedDocs :: String
|
||||||
|
}
|
||||||
|
| Search { docsFiles :: Array String }
|
||||||
|
|
||||||
|
derive instance genericCommands :: Generic Commands _
|
||||||
|
|
||||||
|
instance showCommands :: Show Commands where
|
||||||
|
show = genericShow
|
||||||
|
|
||||||
|
commands :: Parser (Maybe Commands)
|
||||||
|
commands = optional $ subparser
|
||||||
|
( command "build-index"
|
||||||
|
( info buildIndex
|
||||||
|
( 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
|
||||||
|
( progDesc "Run the search engine."
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
buildIndex :: Parser Commands
|
||||||
|
buildIndex = ado
|
||||||
|
|
||||||
|
docsFiles <- fromMaybe defaultDocsFiles <$>
|
||||||
|
optional (
|
||||||
|
some ( strOption
|
||||||
|
( long "docs-files"
|
||||||
|
<> metavar "GLOB"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
generatedDocs <- strOption
|
||||||
|
( long "generated-docs"
|
||||||
|
<> metavar "DIR"
|
||||||
|
<> value "./generated-docs/"
|
||||||
|
)
|
||||||
|
|
||||||
|
in BuildIndex { docsFiles, generatedDocs }
|
||||||
|
|
||||||
|
startInteractive :: Parser Commands
|
||||||
|
startInteractive = ado
|
||||||
|
|
||||||
|
docsFiles <- fromMaybe defaultDocsFiles <$>
|
||||||
|
optional (
|
||||||
|
some ( strOption
|
||||||
|
( long "docs-files"
|
||||||
|
<> metavar "GLOB"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
in Search { docsFiles }
|
||||||
|
|
||||||
|
defaultDocsFiles :: Array String
|
||||||
|
defaultDocsFiles = [ "output/**/docs.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
|
23
src/Docs/Search/Terminal.purs
Normal file
23
src/Docs/Search/Terminal.purs
Normal file
@ -0,0 +1,23 @@
|
|||||||
|
module Docs.Search.Terminal where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
bold :: String -> String
|
||||||
|
bold str =
|
||||||
|
"\x1b[1m" <> str <> "\x1b[0m"
|
||||||
|
|
||||||
|
yellow :: String -> String
|
||||||
|
yellow str =
|
||||||
|
"\x1b[33m" <> str <> "\x1b[0m"
|
||||||
|
|
||||||
|
grey :: String -> String
|
||||||
|
grey str =
|
||||||
|
"\x1b[37m" <> str <> "\x1b[0m"
|
||||||
|
|
||||||
|
cyan :: String -> String
|
||||||
|
cyan str =
|
||||||
|
"\x1b[36m" <> str <> "\x1b[0m"
|
||||||
|
|
||||||
|
green :: String -> String
|
||||||
|
green str =
|
||||||
|
"\x1b[32m" <> str <> "\x1b[0m"
|
@ -69,23 +69,23 @@ mkTypeIndex (Declarations trie) = TypeIndex $ map (Array.fromFoldable >>> Just)
|
|||||||
lookup
|
lookup
|
||||||
:: String
|
:: String
|
||||||
-> TypeIndex
|
-> TypeIndex
|
||||||
-> Aff { index :: TypeIndex, results :: Array SearchResult }
|
-> Aff { typeIndex :: TypeIndex, results :: Array SearchResult }
|
||||||
lookup key index@(TypeIndex map) =
|
lookup key typeIndex@(TypeIndex map) =
|
||||||
case Map.lookup key map of
|
case Map.lookup key map of
|
||||||
Just results -> pure { index, results: Array.fold results }
|
Just results -> pure { typeIndex, results: Array.fold results }
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
eiJson <- try (toAffE (lookup_ key $ config.mkShapeScriptPath key))
|
eiJson <- try (toAffE (lookup_ key $ config.mkShapeScriptPath key))
|
||||||
pure $ fromMaybe'
|
pure $ fromMaybe'
|
||||||
(\_ -> { index: insert key Nothing index, results: [] })
|
(\_ -> { typeIndex: insert key Nothing typeIndex, results: [] })
|
||||||
do
|
do
|
||||||
json <- hush eiJson
|
json <- hush eiJson
|
||||||
results <- hush (decodeJson json)
|
results <- hush (decodeJson json)
|
||||||
pure { index: insert key (Just results) index, results }
|
pure { typeIndex: insert key (Just results) typeIndex, results }
|
||||||
|
|
||||||
query
|
query
|
||||||
:: TypeIndex
|
:: TypeIndex
|
||||||
-> TypeQuery
|
-> TypeQuery
|
||||||
-> Aff { index :: TypeIndex, results :: Array SearchResult }
|
-> Aff { typeIndex :: TypeIndex, results :: Array SearchResult }
|
||||||
query typeIndex typeQuery = do
|
query typeIndex typeQuery = do
|
||||||
res <- lookup (stringifyShape $ shapeOfTypeQuery typeQuery) typeIndex
|
res <- lookup (stringifyShape $ shapeOfTypeQuery typeQuery) typeIndex
|
||||||
pure $ res { results = sortByRelevance typeQuery res.results }
|
pure $ res { results = sortByRelevance typeQuery res.results }
|
||||||
|
156
src/Docs/Search/TypePrinter.purs
Normal file
156
src/Docs/Search/TypePrinter.purs
Normal file
@ -0,0 +1,156 @@
|
|||||||
|
module Docs.Search.TypePrinter where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Docs.Search.Terminal (cyan)
|
||||||
|
import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
|
||||||
|
|
||||||
|
import Data.Maybe (Maybe(..))
|
||||||
|
import Data.Array as Array
|
||||||
|
import Data.List as List
|
||||||
|
|
||||||
|
showType :: Type -> String
|
||||||
|
showType = case _ of
|
||||||
|
TypeVar str -> str
|
||||||
|
TypeLevelString str -> "\"" <> str <> "\"" -- TODO: add escaping
|
||||||
|
TypeWildcard -> "_"
|
||||||
|
TypeConstructor qname -> showQualifiedName qname
|
||||||
|
TypeOp qname -> showQualifiedName qname
|
||||||
|
|
||||||
|
TypeApp (TypeApp (TypeConstructor
|
||||||
|
(QualifiedName { moduleName: [ "Prim" ]
|
||||||
|
, name: "Function" })) t1) t2 ->
|
||||||
|
showType t1 <> syntax " -> " <> showType t2
|
||||||
|
|
||||||
|
TypeApp (TypeConstructor (QualifiedName { moduleName: [ "Prim" ]
|
||||||
|
, name: "Record" }))
|
||||||
|
row ->
|
||||||
|
showRow false row
|
||||||
|
|
||||||
|
TypeApp t1 t2 ->
|
||||||
|
showType t1 <> " " <> showType t2
|
||||||
|
|
||||||
|
ty@(ForAll _ _ _) ->
|
||||||
|
showForAll ty
|
||||||
|
|
||||||
|
ConstrainedType cnstr ty ->
|
||||||
|
showConstraint cnstr <>
|
||||||
|
syntax " => " <>
|
||||||
|
showType ty
|
||||||
|
|
||||||
|
ty@REmpty -> showRow true ty
|
||||||
|
ty@(RCons _ _ _) -> showRow true ty
|
||||||
|
|
||||||
|
BinaryNoParensType op t1 t2 ->
|
||||||
|
showType t1 <>
|
||||||
|
space <>
|
||||||
|
showType op <>
|
||||||
|
space <>
|
||||||
|
showType t2
|
||||||
|
|
||||||
|
ParensInType ty ->
|
||||||
|
"(" <>
|
||||||
|
showType ty <>
|
||||||
|
")"
|
||||||
|
|
||||||
|
showTypeArgument :: TypeArgument -> String
|
||||||
|
showTypeArgument (TypeArgument { name, mbKind }) =
|
||||||
|
case mbKind of
|
||||||
|
Nothing ->
|
||||||
|
name
|
||||||
|
Just kind ->
|
||||||
|
"(" <>
|
||||||
|
name <>
|
||||||
|
" :: " <>
|
||||||
|
showKind kind <>
|
||||||
|
")"
|
||||||
|
|
||||||
|
showFunDeps :: FunDeps -> String
|
||||||
|
showFunDeps (FunDeps []) = ""
|
||||||
|
showFunDeps (FunDeps deps) =
|
||||||
|
append (syntax " | ") $
|
||||||
|
Array.intercalate (syntax ", ") $
|
||||||
|
deps <#> renderFunDep
|
||||||
|
where
|
||||||
|
renderFunDep (FunDep { lhs, rhs }) =
|
||||||
|
Array.intercalate space lhs <>
|
||||||
|
syntax " -> " <>
|
||||||
|
Array.intercalate space rhs
|
||||||
|
|
||||||
|
showQualifiedName
|
||||||
|
:: QualifiedName
|
||||||
|
-> String
|
||||||
|
showQualifiedName (QualifiedName { name })
|
||||||
|
= name
|
||||||
|
|
||||||
|
showRow
|
||||||
|
:: Boolean
|
||||||
|
-> Type
|
||||||
|
-> String
|
||||||
|
showRow asRow =
|
||||||
|
joinRows >>> \ { rows, ty } ->
|
||||||
|
if List.null rows
|
||||||
|
then
|
||||||
|
if asRow then "()" else "{}"
|
||||||
|
else
|
||||||
|
opening <>
|
||||||
|
( Array.intercalate ", " $ Array.fromFoldable $ rows <#>
|
||||||
|
\entry ->
|
||||||
|
entry.row <> syntax " :: " <> showType entry.ty
|
||||||
|
) <>
|
||||||
|
|
||||||
|
case ty of
|
||||||
|
Just ty' -> " | " <> showType ty' <> closing
|
||||||
|
Nothing -> closing
|
||||||
|
|
||||||
|
where
|
||||||
|
opening = if asRow then "(" else "{ "
|
||||||
|
closing = if asRow then ")" else " }"
|
||||||
|
|
||||||
|
showForAll
|
||||||
|
:: Type
|
||||||
|
-> String
|
||||||
|
showForAll ty =
|
||||||
|
keyword "forall" <>
|
||||||
|
|
||||||
|
( Array.fold $ foralls.binders <#>
|
||||||
|
\ { var, mbKind } ->
|
||||||
|
case mbKind of
|
||||||
|
Nothing -> " " <> var
|
||||||
|
Just kind ->
|
||||||
|
" (" <> var <> " "
|
||||||
|
<> syntax "::"
|
||||||
|
<> space
|
||||||
|
<> showKind kind
|
||||||
|
<> ")"
|
||||||
|
) <>
|
||||||
|
|
||||||
|
syntax ". " <>
|
||||||
|
showType foralls.ty
|
||||||
|
|
||||||
|
where
|
||||||
|
foralls = joinForAlls ty
|
||||||
|
|
||||||
|
showKind
|
||||||
|
:: Kind
|
||||||
|
-> String
|
||||||
|
showKind = case _ of
|
||||||
|
Row k1 -> "# " <> showKind k1
|
||||||
|
FunKind k1 k2 -> showKind k1 <> syntax " -> " <> showKind k2
|
||||||
|
NamedKind qname -> showQualifiedName qname
|
||||||
|
|
||||||
|
showConstraint
|
||||||
|
:: Constraint
|
||||||
|
-> String
|
||||||
|
showConstraint (Constraint { constraintClass, constraintArgs }) =
|
||||||
|
showQualifiedName constraintClass <> space <>
|
||||||
|
Array.intercalate space (constraintArgs <#> showType)
|
||||||
|
|
||||||
|
syntax :: String -> String
|
||||||
|
syntax = cyan
|
||||||
|
|
||||||
|
space :: String
|
||||||
|
space = " "
|
||||||
|
|
||||||
|
keyword :: String -> String
|
||||||
|
keyword = cyan
|
@ -1,3 +1,4 @@
|
|||||||
|
-- | `TypeQuery` is a representation of a user-provided type.
|
||||||
module Docs.Search.TypeQuery
|
module Docs.Search.TypeQuery
|
||||||
( TypeQuery(..)
|
( TypeQuery(..)
|
||||||
, Substitution(..)
|
, Substitution(..)
|
||||||
@ -11,24 +12,21 @@ where
|
|||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Docs.Search.Config
|
import Docs.Search.Config (config)
|
||||||
import Docs.Search.DocsJson
|
import Docs.Search.Extra (foldl1, foldr1)
|
||||||
import Docs.Search.TypeDecoder
|
import Docs.Search.TypeDecoder (QualifiedName(..), Type(..), joinConstraints, joinRows)
|
||||||
|
|
||||||
import Control.Alt ((<|>))
|
import Control.Alt ((<|>))
|
||||||
import Data.Array as Array
|
import Data.Array as Array
|
||||||
import Data.Either (Either)
|
import Data.Either (Either)
|
||||||
import Data.Foldable (foldl)
|
|
||||||
import Data.Generic.Rep (class Generic)
|
import Data.Generic.Rep (class Generic)
|
||||||
import Data.Generic.Rep.Show (genericShow)
|
import Data.Generic.Rep.Show (genericShow)
|
||||||
import Data.List (List(..), many, some, (:))
|
import Data.List (List(..), many, some, (:))
|
||||||
import Data.List as List
|
import Data.List as List
|
||||||
import Data.List.NonEmpty (NonEmptyList, cons', uncons)
|
import Data.List.NonEmpty (NonEmptyList)
|
||||||
import Data.List.NonEmpty as NonEmptyList
|
import Data.List.NonEmpty as NonEmptyList
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
import Data.Map as Map
|
import Data.Map as Map
|
||||||
import Data.Maybe (Maybe(..))
|
|
||||||
import Data.Newtype (unwrap)
|
|
||||||
import Data.Ord (abs)
|
import Data.Ord (abs)
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
import Data.Set as Set
|
import Data.Set as Set
|
||||||
@ -93,25 +91,12 @@ typeQueryParser = fix \typeQuery ->
|
|||||||
|
|
||||||
constrained =
|
constrained =
|
||||||
QConstraint <$> (upperCaseIdent <* skipSpaces) <*>
|
QConstraint <$> (upperCaseIdent <* skipSpaces) <*>
|
||||||
(sepEndBy ((QVar <$> ident) <|> parens) (many space) <* string "=>" <* skipSpaces) <*>
|
(sepEndBy ((QVar <$> ident) <|> parens)
|
||||||
|
(many space) <* string "=>" <* skipSpaces) <*>
|
||||||
typeQuery
|
typeQuery
|
||||||
in
|
in
|
||||||
try constrained <|> funs
|
try constrained <|> funs
|
||||||
|
|
||||||
foldl1 :: forall a. (a -> a -> a) -> NonEmptyList a -> a
|
|
||||||
foldl1 f as =
|
|
||||||
case uncons as of
|
|
||||||
{ head, tail } -> foldl f head tail
|
|
||||||
|
|
||||||
foldr1 :: forall a. (a -> a -> a) -> NonEmptyList a -> a
|
|
||||||
foldr1 f = go List.Nil
|
|
||||||
where
|
|
||||||
go acc x = case uncons x of
|
|
||||||
{ head, tail } -> case List.uncons tail of
|
|
||||||
Nothing -> List.foldl (flip f) head acc
|
|
||||||
Just { head: head1, tail: tail1 } ->
|
|
||||||
go (head : acc) (cons' head1 tail1)
|
|
||||||
|
|
||||||
any :: Parser TypeQuery
|
any :: Parser TypeQuery
|
||||||
any = do
|
any = do
|
||||||
QVar <$> lowerCaseIdent
|
QVar <$> lowerCaseIdent
|
||||||
@ -188,7 +173,12 @@ data Substitution
|
|||||||
| MissingConstraint
|
| MissingConstraint
|
||||||
| ExcessiveConstraint
|
| ExcessiveConstraint
|
||||||
| RowsMismatch Int Int
|
| RowsMismatch Int Int
|
||||||
| Mismatch
|
| Mismatch TypeQuery Type
|
||||||
|
-- ^ Type and type query significantly differ.
|
||||||
|
| TypeMismatch Type
|
||||||
|
-- ^ A query of size 1 corresponds to some type.
|
||||||
|
| QueryMismatch TypeQuery
|
||||||
|
-- ^ A type of size 1 corresponds to some query.
|
||||||
|
|
||||||
derive instance genericSubstitution :: Generic Substitution _
|
derive instance genericSubstitution :: Generic Substitution _
|
||||||
|
|
||||||
@ -204,45 +194,11 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ })
|
|||||||
go acc ({ q, t } : rest)
|
go acc ({ q, t } : rest)
|
||||||
|
|
||||||
-- * ForAll
|
-- * ForAll
|
||||||
go acc ({ q: (QForAll queryBinders q), t:type_1@(ForAll _ _ _) } : rest) =
|
|
||||||
let { binders, ty } = joinForAlls type_1 in
|
|
||||||
go acc ({ q, t: ty } : rest)
|
|
||||||
go acc ({ q, t: ForAll _ t _ } : rest) =
|
go acc ({ q, t: ForAll _ t _ } : rest) =
|
||||||
go acc ({ q, t } : rest)
|
go acc ({ q, t } : rest)
|
||||||
go acc ({ q: (QForAll queryBinders q), t } : rest) =
|
go acc ({ q: (QForAll _ q), t } : rest) =
|
||||||
go acc ({ q, t } : rest)
|
go acc ({ q, t } : rest)
|
||||||
|
|
||||||
-- * Type variables
|
|
||||||
go acc ({ q: QVar q, t: TypeVar v } : rest) =
|
|
||||||
go (Substitute q v : acc) rest
|
|
||||||
go acc ({ q, t: TypeVar v } : rest ) =
|
|
||||||
go (Generalize q v : acc) rest
|
|
||||||
go acc ({ q: QVar v, t } : rest) =
|
|
||||||
go (Instantiate v t : acc) rest
|
|
||||||
|
|
||||||
-- * Names
|
|
||||||
go acc ({ q: QConst qname, t: TypeConstructor (QualifiedName { name }) } : rest) =
|
|
||||||
go (Match qname name : acc) rest
|
|
||||||
go acc ({ q: QConst qname, t } : rest) =
|
|
||||||
go (Mismatch : acc) rest
|
|
||||||
go acc ({ q, t: TypeConstructor (QualifiedName { name }) } : rest) =
|
|
||||||
go (Mismatch : acc) rest
|
|
||||||
|
|
||||||
-- type operators can't appear in type queries: this is always a mismatch
|
|
||||||
go acc ({ q, t: TypeOp (QualifiedName { name }) } : rest) =
|
|
||||||
go (Mismatch : acc) rest
|
|
||||||
go acc ({ q, t: BinaryNoParensType _ _ _ } : rest) =
|
|
||||||
go (Mismatch : acc) rest
|
|
||||||
|
|
||||||
-- * Functions
|
|
||||||
go acc ({ q: QFun q1 q2
|
|
||||||
, t: TypeApp (TypeApp (TypeConstructor
|
|
||||||
(QualifiedName { moduleName: [ "Prim" ]
|
|
||||||
, name: "Function" })) t1) t2 } : rest) =
|
|
||||||
go acc ({ q: q1, t: t1 } : { q: q2, t: t2 } : rest)
|
|
||||||
go acc ({ q: QFun q1 q2, t } : rest) =
|
|
||||||
go (Mismatch : acc) rest
|
|
||||||
|
|
||||||
-- * Constraints
|
-- * Constraints
|
||||||
go acc ({ q: q@(QConstraint _ _ _)
|
go acc ({ q: q@(QConstraint _ _ _)
|
||||||
, t: t@(ConstrainedType _ _) } : rest) =
|
, t: t@(ConstrainedType _ _) } : rest) =
|
||||||
@ -256,6 +212,37 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ })
|
|||||||
go acc ({ q, t: ConstrainedType _ t } : rest) =
|
go acc ({ q, t: ConstrainedType _ t } : rest) =
|
||||||
go (MissingConstraint : acc) ({ q, t } : rest)
|
go (MissingConstraint : acc) ({ q, t } : rest)
|
||||||
|
|
||||||
|
-- * Type variables
|
||||||
|
go acc ({ q: QVar q, t: TypeVar v } : rest) =
|
||||||
|
go (Substitute q v : acc) rest
|
||||||
|
go acc ({ q, t: TypeVar v } : rest ) =
|
||||||
|
go (Generalize q v : acc) rest
|
||||||
|
go acc ({ q: QVar v, t } : rest) =
|
||||||
|
go (Instantiate v t : acc) rest
|
||||||
|
|
||||||
|
-- * Names
|
||||||
|
go acc ({ q: QConst qname, t: TypeConstructor (QualifiedName { name }) } : rest) =
|
||||||
|
go (Match qname name : acc) rest
|
||||||
|
go acc ({ q: QConst qname, t } : rest) =
|
||||||
|
go (TypeMismatch t : acc) rest
|
||||||
|
go acc ({ q, t: TypeConstructor (QualifiedName { name }) } : rest) =
|
||||||
|
go (QueryMismatch q : acc) rest
|
||||||
|
|
||||||
|
-- type operators can't appear in type queries: this is always a mismatch
|
||||||
|
go acc ({ q, t: TypeOp (QualifiedName { name }) } : rest) =
|
||||||
|
go (QueryMismatch q : acc) rest
|
||||||
|
go acc ({ q, t: t@(BinaryNoParensType _ _ _) } : rest) =
|
||||||
|
go (Mismatch q t : acc) rest
|
||||||
|
|
||||||
|
-- * Functions
|
||||||
|
go acc ({ q: QFun q1 q2
|
||||||
|
, t: TypeApp (TypeApp (TypeConstructor
|
||||||
|
(QualifiedName { moduleName: [ "Prim" ]
|
||||||
|
, name: "Function" })) t1) t2 } : rest) =
|
||||||
|
go acc ({ q: q1, t: t1 } : { q: q2, t: t2 } : rest)
|
||||||
|
go acc ({ q: q@(QFun q1 q2), t } : rest) =
|
||||||
|
go (Mismatch q t : acc) rest
|
||||||
|
|
||||||
-- * Rows
|
-- * Rows
|
||||||
go acc ({ q: QApp (QConst "Record") (QRow qRows)
|
go acc ({ q: QApp (QConst "Record") (QRow qRows)
|
||||||
, t: TypeApp (TypeConstructor
|
, t: TypeApp (TypeConstructor
|
||||||
@ -278,24 +265,24 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ })
|
|||||||
else
|
else
|
||||||
go (RowsMismatch qRowsLength rowsLength : acc) rest
|
go (RowsMismatch qRowsLength rowsLength : acc) rest
|
||||||
|
|
||||||
go acc ({ q: QRow _ } : rest) =
|
go acc ({ q: q@(QRow _), t } : rest) =
|
||||||
go (Mismatch : acc) rest
|
go (Mismatch q t : acc) rest
|
||||||
|
|
||||||
-- * Type application
|
-- * Type application
|
||||||
go acc ({ q: QApp q1 q2, t: TypeApp t1 t2 } : rest) =
|
go acc ({ q: QApp q1 q2, t: TypeApp t1 t2 } : rest) =
|
||||||
go acc ({ q: q1, t: t1 } : { q: q2, t: t2 } : rest)
|
go acc ({ q: q1, t: t1 } : { q: q2, t: t2 } : rest)
|
||||||
|
|
||||||
go acc ({ q, t: TypeLevelString _ } : rest) =
|
go acc ({ q, t: TypeLevelString _ } : rest) =
|
||||||
go (Mismatch : acc) rest
|
go (QueryMismatch q : acc) rest
|
||||||
|
|
||||||
go acc ({ q, t: TypeWildcard } : rest) =
|
go acc ({ q, t: TypeWildcard } : rest) =
|
||||||
go (Mismatch : acc) rest
|
go (QueryMismatch q : acc) rest
|
||||||
|
|
||||||
go acc ({ q, t: RCons _ _ _ } : rest) =
|
go acc ({ q, t: t@(RCons _ _ _) } : rest) =
|
||||||
go (Mismatch : acc) rest
|
go (Mismatch q t : acc) rest
|
||||||
|
|
||||||
go acc ({ q, t: REmpty } : rest) =
|
go acc ({ q, t: REmpty } : rest) =
|
||||||
go (Mismatch : acc) rest
|
go (QueryMismatch q : acc) rest
|
||||||
|
|
||||||
penalty :: TypeQuery -> Type -> Int
|
penalty :: TypeQuery -> Type -> Int
|
||||||
penalty typeQuery ty =
|
penalty typeQuery ty =
|
||||||
@ -332,7 +319,6 @@ namesPenalty :: List Substitution -> Int
|
|||||||
namesPenalty = go 0
|
namesPenalty = go 0
|
||||||
where
|
where
|
||||||
go p Nil = p
|
go p Nil = p
|
||||||
go p (Mismatch : rest) = go (p + config.penalties.mismatch) rest
|
|
||||||
go p (Match a b : rest)
|
go p (Match a b : rest)
|
||||||
| a == b = go p rest
|
| a == b = go p rest
|
||||||
| otherwise = go (p + config.penalties.match) rest
|
| otherwise = go (p + config.penalties.match) rest
|
||||||
@ -348,10 +334,15 @@ mismatchPenalty :: List Substitution -> Int
|
|||||||
mismatchPenalty = go 0
|
mismatchPenalty = go 0
|
||||||
where
|
where
|
||||||
go n Nil = n
|
go n Nil = n
|
||||||
go n (Instantiate _ _ : rest) = go (n + config.penalties.instantiate) rest
|
go n (Instantiate q t : rest) = go (n + typeSize t *
|
||||||
go n (Generalize _ _ : rest) = go (n + config.penalties.generalize) rest
|
config.penalties.instantiate) rest
|
||||||
|
go n (Generalize q t : rest) = go (n + typeQuerySize q *
|
||||||
|
config.penalties.generalize) rest
|
||||||
go n (ExcessiveConstraint : rest) = go (n + config.penalties.excessiveConstraint) rest
|
go n (ExcessiveConstraint : rest) = go (n + config.penalties.excessiveConstraint) rest
|
||||||
go n (MissingConstraint : rest) = go (n + config.penalties.missingConstraint) rest
|
go n (MissingConstraint : rest) = go (n + config.penalties.missingConstraint) rest
|
||||||
|
go n (Mismatch q t : rest) = go (n + typeQuerySize q + typeSize t) rest
|
||||||
|
go n (TypeMismatch t : rest) = go (n + typeSize t) rest
|
||||||
|
go n (QueryMismatch q : rest) = go (n + typeQuerySize q) rest
|
||||||
go n (_ : rest) = go n rest
|
go n (_ : rest) = go n rest
|
||||||
|
|
||||||
-- | Only returns a list of type class names (lists of arguments are omitted).
|
-- | Only returns a list of type class names (lists of arguments are omitted).
|
||||||
@ -362,3 +353,55 @@ joinQueryConstraints = go Nil
|
|||||||
go acc (QConstraint name _ query) =
|
go acc (QConstraint name _ query) =
|
||||||
go (name : acc) query
|
go (name : acc) query
|
||||||
go acc ty = { constraints: List.sort acc, ty }
|
go acc ty = { constraints: List.sort acc, ty }
|
||||||
|
|
||||||
|
typeQuerySize :: TypeQuery -> Int
|
||||||
|
typeQuerySize = go 0 <<< List.singleton
|
||||||
|
where
|
||||||
|
go n Nil = n
|
||||||
|
go n (QVar _ : rest) =
|
||||||
|
go (n + 1) rest
|
||||||
|
go n (QConst _ : rest) =
|
||||||
|
go (n + 1) rest
|
||||||
|
go n (QFun q1 q2 : rest) =
|
||||||
|
go (n + 1) (q1 : q2 : rest)
|
||||||
|
go n (QApp q1 q2 : rest) =
|
||||||
|
go (n + 1) (q1 : q2 : rest)
|
||||||
|
go n (QForAll _ q : rest) =
|
||||||
|
go (n + 1) (q : rest)
|
||||||
|
go n (QConstraint _ _ q : rest) =
|
||||||
|
go (n + 1) (q : rest)
|
||||||
|
go n (QRow qs : rest) =
|
||||||
|
go n ((qs <#> snd) <> rest)
|
||||||
|
|
||||||
|
typeSize :: Type -> Int
|
||||||
|
typeSize = go 0 <<< List.singleton
|
||||||
|
where
|
||||||
|
go n Nil = n
|
||||||
|
go n (TypeVar _ : rest) =
|
||||||
|
go (n + 1) rest
|
||||||
|
go n (TypeLevelString _ : rest) =
|
||||||
|
go (n + 1) rest
|
||||||
|
go n (TypeWildcard : rest) =
|
||||||
|
go (n + 1) rest
|
||||||
|
go n (TypeConstructor _ : rest) =
|
||||||
|
go (n + 1) rest
|
||||||
|
go n (TypeOp _ : rest) =
|
||||||
|
go (n + 1) rest
|
||||||
|
go n (TypeApp (TypeApp (TypeConstructor
|
||||||
|
(QualifiedName { moduleName: [ "Prim" ]
|
||||||
|
, name: "Function" })) t1) t2 : rest) =
|
||||||
|
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 + 1) (t : rest)
|
||||||
|
go n (ConstrainedType _ t : rest) =
|
||||||
|
go (n + 1) (t : rest)
|
||||||
|
go n (RCons _ t1 t2 : rest) =
|
||||||
|
go (n + 1) (t1 : t2 : rest)
|
||||||
|
go n (REmpty : rest) =
|
||||||
|
go (n + 1) rest
|
||||||
|
go n (BinaryNoParensType op t1 t2 : rest) =
|
||||||
|
go (n + 1) (t1 : t2 : rest)
|
||||||
|
go n (ParensInType t : rest) =
|
||||||
|
go n (t : rest)
|
||||||
|
@ -2,19 +2,9 @@ module Test.IndexBuilder where
|
|||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Test.Extra
|
import Docs.Search.IndexBuilder (patchHTML)
|
||||||
|
|
||||||
import Docs.Search.IndexBuilder
|
import Data.Tuple (snd)
|
||||||
|
|
||||||
import Data.Either (Either(..))
|
|
||||||
import Data.Foldable (class Foldable)
|
|
||||||
import Data.List (List(..), (:))
|
|
||||||
import Data.List as List
|
|
||||||
import Data.List.NonEmpty (NonEmptyList)
|
|
||||||
import Data.List.NonEmpty as NonEmptyList
|
|
||||||
import Data.Set as Set
|
|
||||||
import Data.Tuple (Tuple(..), snd)
|
|
||||||
import Effect.Aff (Aff)
|
|
||||||
import Test.Unit (TestSuite, suite, test)
|
import Test.Unit (TestSuite, suite, test)
|
||||||
import Test.Unit.Assert as Assert
|
import Test.Unit.Assert as Assert
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user