mirror of
https://github.com/rowtype-yoga/purescript-docs-search.git
synced 2024-08-16 16:10:40 +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*
|
||||
/.psa*
|
||||
/.spago/
|
||||
/dist/
|
||||
|
17
.travis.yml
17
.travis.yml
@ -19,24 +19,31 @@ install:
|
||||
- tar -xvf $HOME/purescript.tar.gz -C $HOME/
|
||||
- chmod a+x $HOME/purescript
|
||||
- npm install -g spago
|
||||
- npm install
|
||||
- spago install
|
||||
|
||||
script:
|
||||
- spago build
|
||||
- spago test
|
||||
- spago docs
|
||||
- spago bundle-app -m Docs.Search.App --to docs-search-app.js
|
||||
- spago bundle-app -m Docs.Search.IndexBuilder --to index-builder.js
|
||||
- node index-builder.js
|
||||
- npm run build
|
||||
- node dist/main.js build-index
|
||||
|
||||
deploy:
|
||||
- provider: releases
|
||||
api_key: $API_KEY
|
||||
file:
|
||||
- docs-search-app.js
|
||||
- index-builder.js
|
||||
- dist/docs-search-app.js
|
||||
- dist/main.js
|
||||
skip_cleanup: true
|
||||
on:
|
||||
tags: true
|
||||
script:
|
||||
- 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.
|
||||
|
||||
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`.
|
||||
|
||||
```
|
||||
spago build
|
||||
spago docs
|
||||
spago bundle-app -m Docs.Search.App --to generated-docs/docs-search-app.js
|
||||
spago run -m Docs.Search.IndexBuilder
|
||||
```
|
||||
## Usage
|
||||
|
||||
## 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.
|
||||
|
||||
**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" ]
|
||||
"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"
|
||||
}
|
||||
|
||||
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-aff"
|
||||
, "node-process"
|
||||
, "node-readline"
|
||||
, "optparse"
|
||||
, "profunctor"
|
||||
, "search-trie"
|
||||
, "string-parsers"
|
||||
|
@ -7,24 +7,19 @@ import Docs.Search.Config (config)
|
||||
import Docs.Search.Declarations (DeclLevel(..), declLevelToHashAnchor)
|
||||
import Docs.Search.DocsJson (DataDeclType(..))
|
||||
import Docs.Search.Extra ((>#>))
|
||||
import Docs.Search.Index (Index)
|
||||
import Docs.Search.Index as Index
|
||||
import Docs.Search.SearchResult (ResultInfo(..), SearchResult, typeOf)
|
||||
import Docs.Search.SearchResult (ResultInfo(..), SearchResult)
|
||||
import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
|
||||
import Docs.Search.TypeIndex (TypeIndex)
|
||||
import Docs.Search.TypeIndex as TypeIndex
|
||||
import Docs.Search.TypeQuery (TypeQuery(..), parseTypeQuery, penalty)
|
||||
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.Either (hush)
|
||||
import Data.List as List
|
||||
import Data.Maybe (Maybe(..), isJust, maybe)
|
||||
import Data.Maybe (Maybe(..), isJust)
|
||||
import Data.Newtype (unwrap, wrap)
|
||||
import Data.String (length) 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 Effect.Aff (Aff)
|
||||
import Halogen as H
|
||||
@ -38,15 +33,11 @@ import Web.HTML as HTML
|
||||
import Web.HTML.Location as Location
|
||||
import Web.HTML.Window as Window
|
||||
|
||||
data Mode = Off | Loading | Active | InputTooShort
|
||||
data Mode = Off | Loading | Active
|
||||
|
||||
derive instance eqMode :: Eq Mode
|
||||
|
||||
-- | Is it a search by type or by name?
|
||||
data ResultsType = TypeResults TypeQuery | DeclResults
|
||||
|
||||
type State = { index :: Index
|
||||
, typeIndex :: TypeIndex
|
||||
type State = { searchEngineState :: SearchEngine.State
|
||||
, results :: Array SearchResult
|
||||
, resultsType :: ResultsType
|
||||
, input :: String
|
||||
@ -68,8 +59,7 @@ mkComponent
|
||||
-> H.Component HH.HTML Query i o Aff
|
||||
mkComponent contents =
|
||||
H.mkComponent
|
||||
{ initialState: const { index: mempty
|
||||
, typeIndex: mempty
|
||||
{ initialState: const { searchEngineState: mempty
|
||||
, results: []
|
||||
, resultsType: DeclResults
|
||||
, input: ""
|
||||
@ -99,36 +89,20 @@ handleQuery (MessageFromSearchField (InputUpdated input_) next) = do
|
||||
|
||||
state <- H.modify (_ { input = input })
|
||||
|
||||
if String.length input < 2
|
||||
then do
|
||||
if input == ""
|
||||
if String.null input
|
||||
then do
|
||||
H.modify_ (_ { mode = Off })
|
||||
showPageContents
|
||||
else do
|
||||
H.modify_ (_ { mode = InputTooShort })
|
||||
hidePageContents
|
||||
else do
|
||||
H.modify_ (_ { mode = Loading, resultsCount = config.resultsCount })
|
||||
|
||||
void $ H.fork do
|
||||
let resultsType =
|
||||
maybe DeclResults TypeResults (hush (parseTypeQuery state.input)
|
||||
>>= isValuableTypeQuery)
|
||||
|
||||
case resultsType of
|
||||
|
||||
DeclResults -> do
|
||||
{ index, results } <- H.liftAff $ Index.query state.index (String.toLower state.input)
|
||||
{ searchEngineState, results, resultsType } <- H.liftAff $
|
||||
SearchEngine.query state.searchEngineState 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 })
|
||||
, searchEngineState = searchEngineState
|
||||
, resultsType = resultsType })
|
||||
|
||||
hidePageContents
|
||||
|
||||
@ -181,12 +155,6 @@ render { mode: Off } = HH.div_ []
|
||||
render { mode: Loading } =
|
||||
renderContainer $
|
||||
[ 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: [] } =
|
||||
renderContainer $
|
||||
|
||||
@ -299,11 +267,7 @@ renderResultType
|
||||
renderResultType result =
|
||||
case result.info of
|
||||
ValueResult { type: ty } ->
|
||||
wrapSignature [ HH.a [ makeHref ValueLevel false result.moduleName result.name
|
||||
, HE.onClick $ const $ Just $ SearchResultClicked result.moduleName ]
|
||||
[ HH.text result.name ]
|
||||
, HH.text " :: "
|
||||
, renderType ty ]
|
||||
wrapSignature $ renderValueSignature result ty
|
||||
|
||||
TypeClassResult info ->
|
||||
wrapSignature $ renderTypeClassSignature info result
|
||||
@ -321,6 +285,21 @@ renderResultType result =
|
||||
wrapSignature 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
|
||||
:: forall a rest
|
||||
. { fundeps :: FunDeps
|
||||
@ -582,8 +561,8 @@ renderQualifiedName isInfix level (QualifiedName { moduleName, name })
|
||||
|
||||
renderKind
|
||||
:: forall a
|
||||
. Kind ->
|
||||
HH.HTML a Action
|
||||
. Kind
|
||||
-> HH.HTML a Action
|
||||
renderKind = case _ of
|
||||
Row k1 -> HH.span_ [ HH.text "# ", renderKind k1 ]
|
||||
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 = 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
|
||||
-- ^ In how many parts the index should be splitted?
|
||||
, mkIndexPartPath:
|
||||
\(partId :: Int) -> "generated-docs/index/declarations/" <> show partId <> ".js"
|
||||
\(partId :: Int) -> "/index/declarations/" <> show partId <> ".js"
|
||||
, mkIndexPartLoadPath:
|
||||
\(partId :: Int) -> "../index/declarations/" <> show partId <> ".js"
|
||||
, resultsCount: 25
|
||||
-- ^ How many results to show by default?
|
||||
, penalties: { typeVars: 6
|
||||
, penalties: { typeVars: 2
|
||||
, match: 2
|
||||
, matchConstraint: 1
|
||||
, instantiate: 1
|
||||
, generalize: 4
|
||||
, rowsMismatch: 6
|
||||
, mismatch: 10
|
||||
, instantiate: 2
|
||||
, generalize: 2
|
||||
, rowsMismatch: 3
|
||||
, missingConstraint: 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 Data.Array ((!!))
|
||||
import Data.Array as Array
|
||||
import Data.Foldable (foldr)
|
||||
import Data.List (List, (:))
|
||||
import Data.List as List
|
||||
@ -15,8 +16,8 @@ import Data.Maybe (Maybe(..), fromMaybe)
|
||||
import Data.Newtype (class Newtype, unwrap, wrap)
|
||||
import Data.Search.Trie (Trie, alter)
|
||||
import Data.String.CodeUnits (stripPrefix, stripSuffix, toCharArray)
|
||||
import Data.String.Common (toLower)
|
||||
import Data.String.Common (split) as String
|
||||
import Data.String.Common (toLower)
|
||||
import Data.String.Pattern (Pattern(..))
|
||||
|
||||
type ModuleName = String
|
||||
@ -178,10 +179,17 @@ extractPackageName name =
|
||||
let chunks = String.split (Pattern "/") name in
|
||||
fromMaybe "<unknown>" $
|
||||
chunks !! 0 >>= \dir ->
|
||||
-- TODO: is it safe to assume that directory name is ".spago"?
|
||||
if dir == ".spago" then
|
||||
chunks !! 1
|
||||
else
|
||||
let
|
||||
bowerComponentsIndex =
|
||||
Array.findIndex (_ == "bower_components") chunks
|
||||
in
|
||||
case bowerComponentsIndex of
|
||||
Just n ->
|
||||
chunks !! (n + 1)
|
||||
Nothing ->
|
||||
Just "<local package>"
|
||||
|
||||
resultsForChildDeclaration
|
||||
|
@ -2,10 +2,9 @@ module Docs.Search.DocsJson where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Docs.Search.TypeDecoder
|
||||
import Docs.Search.TypeDecoder (Constraint, FunDeps, Kind, Type, TypeArgument)
|
||||
|
||||
import Control.Promise (Promise, toAffE)
|
||||
import Data.Argonaut.Core (Json, fromString, stringify, toString)
|
||||
import Data.Argonaut.Core (fromString, stringify, toString)
|
||||
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:?))
|
||||
import Data.Argonaut.Encode (class EncodeJson, encodeJson)
|
||||
import Data.Either (Either(..))
|
||||
@ -13,8 +12,6 @@ import Data.Generic.Rep (class Generic)
|
||||
import Data.Generic.Rep.Show (genericShow)
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.Newtype (class Newtype, unwrap)
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff)
|
||||
|
||||
newtype DocsJson
|
||||
= 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 Data.Foldable (class Foldable, foldMap)
|
||||
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 ((:))
|
||||
|
||||
whenJust :: forall a m. Monad m => Maybe a -> (a -> m Unit) -> m Unit
|
||||
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
|
||||
|
||||
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
|
||||
getPartId _ = 0
|
||||
|
||||
-- | Load a part of the index by injecting a <script> tag into the DOM.
|
||||
foreign import loadIndex_
|
||||
:: Int
|
||||
-> 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.Declarations (Declarations(..), mkDeclarations)
|
||||
import Docs.Search.DocsJson (DocsJson)
|
||||
import Docs.Search.Extra ((>#>))
|
||||
import Docs.Search.Extra ((>#>), glob)
|
||||
import Docs.Search.Index (getPartId)
|
||||
import Docs.Search.SearchResult (SearchResult)
|
||||
import Docs.Search.TypeIndex (TypeIndex, mkTypeIndex)
|
||||
@ -35,55 +35,83 @@ import Effect.Aff (Aff, launchAff_, parallel, sequential)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Console (log)
|
||||
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.Process as Process
|
||||
|
||||
main :: Effect Unit
|
||||
main = launchAff_ mainAff
|
||||
type Config = { docsFiles :: Array String
|
||||
, generatedDocs :: String
|
||||
}
|
||||
|
||||
mainAff :: Aff Unit
|
||||
mainAff = do
|
||||
checkDirectories
|
||||
run :: Config -> Effect Unit
|
||||
run = launchAff_ <<< run'
|
||||
|
||||
docsJsons <- collectDocsJsons config.outputDirectory
|
||||
run' :: Config -> Aff Unit
|
||||
run' cfg = do
|
||||
|
||||
liftEffect $ log $
|
||||
"Found " <> show (Array.length docsJsons) <> " modules."
|
||||
checkDirectories cfg
|
||||
|
||||
liftEffect do
|
||||
log "Building the search index..."
|
||||
|
||||
docsJsons <- decodeDocsJsons cfg
|
||||
|
||||
liftEffect do
|
||||
log $ "Found " <> show (Array.length docsJsons) <> " modules."
|
||||
|
||||
let index = mkDeclarations docsJsons
|
||||
typeIndex = mkTypeIndex index
|
||||
|
||||
createDirectories
|
||||
createDirectories cfg
|
||||
|
||||
void $ sequential do
|
||||
ignore <$> parallel (writeIndex index)
|
||||
<*> parallel (writeTypeIndex typeIndex)
|
||||
<*> parallel patchDocs
|
||||
ignore <$> parallel (writeIndex cfg index)
|
||||
<*> parallel (writeTypeIndex cfg typeIndex)
|
||||
<*> parallel (patchDocs cfg)
|
||||
<*> parallel (copyAppFile cfg)
|
||||
|
||||
liftEffect $ log $
|
||||
"Loaded " <>
|
||||
liftEffect do
|
||||
log $
|
||||
"Added " <>
|
||||
show (Trie.size $ unwrap index) <>
|
||||
" definitions and " <>
|
||||
show (List.length $ join $ map snd $ Trie.entriesUnordered (unwrap index)) <>
|
||||
" type definitions"
|
||||
where ignore _ _ _ = unit
|
||||
" type definitions to the search index."
|
||||
|
||||
where ignore _ _ _ _ = unit
|
||||
|
||||
-- | Exit early if something is missing.
|
||||
checkDirectories :: Aff Unit
|
||||
checkDirectories = do
|
||||
for_ config.requiredDirectories \dir -> do
|
||||
checkDirectories :: Config -> Aff Unit
|
||||
checkDirectories cfg = do
|
||||
|
||||
let dirs = [ cfg.generatedDocs
|
||||
, cfg.generatedDocs <> "/html"
|
||||
]
|
||||
|
||||
for_ dirs \dir -> do
|
||||
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`.
|
||||
collectDocsJsons :: String -> Aff (Array DocsJson)
|
||||
collectDocsJsons outputDir = do
|
||||
paths <- readdir outputDir
|
||||
-- | Read and decode given `docs.json` files.
|
||||
decodeDocsJsons
|
||||
:: forall rest
|
||||
. { docsFiles :: Array String | rest }
|
||||
-> Aff (Array DocsJson)
|
||||
decodeDocsJsons cfg = do
|
||||
|
||||
Array.catMaybes <$> for paths \moduleName -> do
|
||||
let jsonFile = "output/" <> moduleName <> "/docs.json"
|
||||
paths <- Array.concat <$> for cfg.docsFiles \str -> do
|
||||
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
|
||||
|
||||
if doesExist then do
|
||||
|
||||
contents <- readTextFile UTF8 jsonFile
|
||||
@ -92,20 +120,27 @@ collectDocsJsons outputDir = do
|
||||
case eiResult of
|
||||
Left error -> do
|
||||
liftEffect $ log $
|
||||
"\"docs.json\" decoding failed failed for module " <> moduleName <> ": " <> show error
|
||||
"\"docs.json\" decoding failed failed for " <> jsonFile <> ": " <> show error
|
||||
pure Nothing
|
||||
Right result -> pure result
|
||||
|
||||
else do
|
||||
liftEffect $ do
|
||||
log $
|
||||
"Couldn't find docs.json for " <> moduleName
|
||||
"File does not exist: " <> jsonFile
|
||||
pure Nothing
|
||||
|
||||
writeTypeIndex :: TypeIndex -> Aff Unit
|
||||
writeTypeIndex typeIndex =
|
||||
when (Array.null docsJsons) do
|
||||
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
|
||||
writeTextFile UTF8 ("generated-docs/index/types/" <> typeShape <> ".js")
|
||||
writeTextFile UTF8 (generatedDocs <> "/index/types/" <> typeShape <> ".js")
|
||||
(mkHeader typeShape <> stringify (encodeJson results))
|
||||
where
|
||||
mkHeader typeShape =
|
||||
@ -119,11 +154,7 @@ getIndex :: Declarations -> Map Int (Array (Tuple String (Array SearchResult)))
|
||||
getIndex (Declarations trie) =
|
||||
Array.foldr insert mempty parts
|
||||
where
|
||||
prefixes :: Array (List Char)
|
||||
prefixes =
|
||||
Set.toUnfoldable $
|
||||
List.foldr (\entry -> Set.insert (List.take 2 $ fst entry)) mempty $
|
||||
Trie.entriesUnordered trie
|
||||
insert part = Map.insertWith append (getPartId part.prefix) part.results
|
||||
|
||||
parts
|
||||
:: Array { prefix :: List Char
|
||||
@ -131,24 +162,35 @@ getIndex (Declarations trie) =
|
||||
}
|
||||
parts = prefixes <#> \prefix ->
|
||||
let results =
|
||||
Array.fromFoldable $
|
||||
Trie.query prefix trie <#>
|
||||
\(Tuple path value) ->
|
||||
Tuple (path >#> String.singleton) (Array.fromFoldable value)
|
||||
Array.fromFoldable $ toTuple <$>
|
||||
if List.length prefix == 2 then
|
||||
Trie.query prefix trie
|
||||
else
|
||||
-- Entries with path lengths > 1 have been added already.
|
||||
List.filter (\(Tuple path value) -> List.length path == 1) (
|
||||
Trie.query prefix trie
|
||||
)
|
||||
in
|
||||
{ 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
|
||||
writeIndex = getIndex >>> \resultsMap -> do
|
||||
prefixes :: Array (List Char)
|
||||
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 _)
|
||||
\(Tuple indexPartId results) -> do
|
||||
let header =
|
||||
"// This file was generated by purescript-docs-search.\n" <>
|
||||
"window.DocsSearchIndex[\"" <> show indexPartId <> "\"] = "
|
||||
|
||||
writeTextFile UTF8 (config.mkIndexPartPath indexPartId) $
|
||||
writeTextFile UTF8 (generatedDocs <> config.mkIndexPartPath indexPartId) $
|
||||
header <> stringify (encodeJson results)
|
||||
|
||||
patchHTML :: String -> Tuple Boolean String
|
||||
@ -166,9 +208,9 @@ patchHTML html =
|
||||
then Tuple true $ String.replace pattern (Replacement patch) html
|
||||
else Tuple false html
|
||||
|
||||
patchDocs :: Aff Unit
|
||||
patchDocs = do
|
||||
let dirname = "generated-docs/"
|
||||
patchDocs :: Config -> Aff Unit
|
||||
patchDocs cfg = do
|
||||
let dirname = cfg.generatedDocs
|
||||
|
||||
files <- readdir (dirname <> "html")
|
||||
|
||||
@ -182,14 +224,13 @@ patchDocs = do
|
||||
writeTextFile UTF8 path patchedContents
|
||||
_ -> pure unit
|
||||
|
||||
createDirectories :: Aff Unit
|
||||
createDirectories = do
|
||||
let generatedDocsDir = "generated-docs/"
|
||||
indexDir = "generated-docs/index"
|
||||
declIndexDir = "generated-docs/index/declarations"
|
||||
typeIndexDir = "generated-docs/index/types"
|
||||
createDirectories :: Config -> Aff Unit
|
||||
createDirectories { generatedDocs } = do
|
||||
let indexDir = generatedDocs <> "/index"
|
||||
declIndexDir = generatedDocs <> "/index/declarations"
|
||||
typeIndexDir = generatedDocs <> "/index/types"
|
||||
|
||||
whenM (not <$> directoryExists generatedDocsDir) $ liftEffect do
|
||||
whenM (not <$> directoryExists generatedDocs) $ liftEffect do
|
||||
logAndExit "Generate the documentation first!"
|
||||
|
||||
whenM (not <$> directoryExists indexDir) do
|
||||
@ -201,6 +242,20 @@ createDirectories = 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
|
||||
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 path = do
|
||||
doesExist <- exists path
|
||||
@ -216,6 +271,12 @@ fileExists path = do
|
||||
true -> isFile <$> stat path
|
||||
|
||||
logAndExit :: forall a. String -> Effect a
|
||||
logAndExit err = do
|
||||
log err
|
||||
logAndExit message = do
|
||||
log message
|
||||
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
|
||||
:: String
|
||||
-> TypeIndex
|
||||
-> Aff { index :: TypeIndex, results :: Array SearchResult }
|
||||
lookup key index@(TypeIndex map) =
|
||||
-> Aff { typeIndex :: TypeIndex, results :: Array SearchResult }
|
||||
lookup key typeIndex@(TypeIndex map) =
|
||||
case Map.lookup key map of
|
||||
Just results -> pure { index, results: Array.fold results }
|
||||
Just results -> pure { typeIndex, results: Array.fold results }
|
||||
Nothing -> do
|
||||
eiJson <- try (toAffE (lookup_ key $ config.mkShapeScriptPath key))
|
||||
pure $ fromMaybe'
|
||||
(\_ -> { index: insert key Nothing index, results: [] })
|
||||
(\_ -> { typeIndex: insert key Nothing typeIndex, results: [] })
|
||||
do
|
||||
json <- hush eiJson
|
||||
results <- hush (decodeJson json)
|
||||
pure { index: insert key (Just results) index, results }
|
||||
pure { typeIndex: insert key (Just results) typeIndex, results }
|
||||
|
||||
query
|
||||
:: TypeIndex
|
||||
-> TypeQuery
|
||||
-> Aff { index :: TypeIndex, results :: Array SearchResult }
|
||||
-> Aff { typeIndex :: TypeIndex, results :: Array SearchResult }
|
||||
query typeIndex typeQuery = do
|
||||
res <- lookup (stringifyShape $ shapeOfTypeQuery typeQuery) typeIndex
|
||||
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
|
||||
( TypeQuery(..)
|
||||
, Substitution(..)
|
||||
@ -11,24 +12,21 @@ where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Docs.Search.Config
|
||||
import Docs.Search.DocsJson
|
||||
import Docs.Search.TypeDecoder
|
||||
import Docs.Search.Config (config)
|
||||
import Docs.Search.Extra (foldl1, foldr1)
|
||||
import Docs.Search.TypeDecoder (QualifiedName(..), Type(..), joinConstraints, joinRows)
|
||||
|
||||
import Control.Alt ((<|>))
|
||||
import Data.Array as Array
|
||||
import Data.Either (Either)
|
||||
import Data.Foldable (foldl)
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import Data.Generic.Rep.Show (genericShow)
|
||||
import Data.List (List(..), many, some, (:))
|
||||
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.Map (Map)
|
||||
import Data.Map as Map
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.Newtype (unwrap)
|
||||
import Data.Ord (abs)
|
||||
import Data.Set (Set)
|
||||
import Data.Set as Set
|
||||
@ -93,25 +91,12 @@ typeQueryParser = fix \typeQuery ->
|
||||
|
||||
constrained =
|
||||
QConstraint <$> (upperCaseIdent <* skipSpaces) <*>
|
||||
(sepEndBy ((QVar <$> ident) <|> parens) (many space) <* string "=>" <* skipSpaces) <*>
|
||||
(sepEndBy ((QVar <$> ident) <|> parens)
|
||||
(many space) <* string "=>" <* skipSpaces) <*>
|
||||
typeQuery
|
||||
in
|
||||
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 = do
|
||||
QVar <$> lowerCaseIdent
|
||||
@ -188,7 +173,12 @@ data Substitution
|
||||
| MissingConstraint
|
||||
| ExcessiveConstraint
|
||||
| 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 _
|
||||
|
||||
@ -204,45 +194,11 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ })
|
||||
go acc ({ q, t } : rest)
|
||||
|
||||
-- * 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 } : rest)
|
||||
go acc ({ q: (QForAll queryBinders q), t } : rest) =
|
||||
go acc ({ q: (QForAll _ 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
|
||||
go acc ({ q: q@(QConstraint _ _ _)
|
||||
, 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 (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
|
||||
go acc ({ q: QApp (QConst "Record") (QRow qRows)
|
||||
, t: TypeApp (TypeConstructor
|
||||
@ -278,24 +265,24 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ })
|
||||
else
|
||||
go (RowsMismatch qRowsLength rowsLength : acc) rest
|
||||
|
||||
go acc ({ q: QRow _ } : rest) =
|
||||
go (Mismatch : acc) rest
|
||||
go acc ({ q: q@(QRow _), t } : rest) =
|
||||
go (Mismatch q t : acc) rest
|
||||
|
||||
-- * Type application
|
||||
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, t: TypeLevelString _ } : rest) =
|
||||
go (Mismatch : acc) rest
|
||||
go (QueryMismatch q : acc) rest
|
||||
|
||||
go acc ({ q, t: TypeWildcard } : rest) =
|
||||
go (Mismatch : acc) rest
|
||||
go (QueryMismatch q : acc) rest
|
||||
|
||||
go acc ({ q, t: RCons _ _ _ } : rest) =
|
||||
go (Mismatch : acc) rest
|
||||
go acc ({ q, t: t@(RCons _ _ _) } : rest) =
|
||||
go (Mismatch q t : acc) rest
|
||||
|
||||
go acc ({ q, t: REmpty } : rest) =
|
||||
go (Mismatch : acc) rest
|
||||
go (QueryMismatch q : acc) rest
|
||||
|
||||
penalty :: TypeQuery -> Type -> Int
|
||||
penalty typeQuery ty =
|
||||
@ -332,7 +319,6 @@ namesPenalty :: List Substitution -> Int
|
||||
namesPenalty = go 0
|
||||
where
|
||||
go p Nil = p
|
||||
go p (Mismatch : rest) = go (p + config.penalties.mismatch) rest
|
||||
go p (Match a b : rest)
|
||||
| a == b = go p rest
|
||||
| otherwise = go (p + config.penalties.match) rest
|
||||
@ -348,10 +334,15 @@ mismatchPenalty :: List Substitution -> Int
|
||||
mismatchPenalty = go 0
|
||||
where
|
||||
go n Nil = n
|
||||
go n (Instantiate _ _ : rest) = go (n + config.penalties.instantiate) rest
|
||||
go n (Generalize _ _ : rest) = go (n + config.penalties.generalize) rest
|
||||
go n (Instantiate q t : rest) = go (n + typeSize t *
|
||||
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 (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
|
||||
|
||||
-- | 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 (name : acc) query
|
||||
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 Test.Extra
|
||||
import Docs.Search.IndexBuilder (patchHTML)
|
||||
|
||||
import Docs.Search.IndexBuilder
|
||||
|
||||
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 Data.Tuple (snd)
|
||||
import Test.Unit (TestSuite, suite, test)
|
||||
import Test.Unit.Assert as Assert
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user