rowtype-yoga/purescript-docs-search
1
0
Fork 0
mirror of https://github.com/rowtype-yoga/purescript-docs-search.git synced 2024-09-11 12:35:37 +03:00
Code Issues Packages Projects Releases Wiki Activity

Updates for v0.14 (#46)

Browse Source 
Co-authored-by: Fabrizio Ferrai <fabrizio.ferrai@gmail.com>
This commit is contained in:
Vladimir Kalnitsky 2021-04-15 22:15:05 +03:00 committed by GitHub
parent 58ce738318
commit c22dc0b2a6
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
26 changed files with 227 additions and 487 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
package.json
View File

@ -17,15 +17,14 @@
"scripts": {
"test": "spago docs --no-search && ./dist/purescript-docs-search build-index && spago test && npm run check-version",
"bundle-app": "spago bundle-app --no-build --no-install -m Docs.Search.App --to dist/docs-search-app.js",
"parcel-app": "parcel build --no-source-maps --target browser --out-file dist/docs-search-app.js dist/docs-search-app.js",
"build-app": "npm run bundle-app && npm run parcel-app",
"esbuild-app": "esbuild dist/docs-search-app.js --target=es2016 --bundle --minify --outfile=dist/docs-search-app.min.js && mv dist/docs-search-app.min.js dist/docs-search-app.js",
"build-app": "npm run bundle-app && npm run esbuild-app",
"bundle-main": "spago bundle-app --no-build --no-install -m Docs.Search.Main --to dist/main.js",
"parcel-main": "parcel build --no-source-maps --target node --bundle-node-modules --out-file dist/main.js dist/main.js",
"esbuild-main": "esbuild dist/main.js --platform=node --bundle --minify --outfile=dist/main.min.js && mv dist/main.min.js dist/main.js",
"add-shebang": "echo \"#!/usr/bin/env node\" > dist/purescript-docs-search && cat dist/main.js >> dist/purescript-docs-search",
"chmod-main": "chmod +x dist/purescript-docs-search",
"build-main": "npm run bundle-main && npm run parcel-main && npm run add-shebang && rm dist/main.js && npm run chmod-main",
"build-main": "npm run bundle-main && npm run esbuild-main && npm run add-shebang && rm dist/main.js && npm run chmod-main",
"build": "spago build && npm run build-app && npm run build-main",
"build-dev": "spago build && npm run build-app && npm run bundle-main && npm run add-shebang && rm dist/main.js && npm run chmod-main",
"clean": "rm -rf dist",
"check-version": "[ \"$(./dist/purescript-docs-search version)\" = \"$npm_package_version\" ]"
},
@ -44,10 +43,10 @@
"homepage": "https://github.com/spacchetti/purescript-docs-search#readme",
"dependencies": {},
"devDependencies": {
"esbuild": "^0.11.10",
"glob": "^7.1.6",
"markdown-it": "^11.0.0",
"parcel": "^1.12.4",
"puppeteer": "^5.2.1",
"spago": "^0.15.3"
"markdown-it": "^12.0.4",
"puppeteer": "^8.0.0",
"spago": "^0.20.0"
}
}

61
packages.dhall
View File

@ -2,7 +2,7 @@ let mkPackage =
https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2-20190725/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57
let upstream =
https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20200724/packages.dhall sha256:bb941d30820a49345a0e88937094d2b9983d939c9fd3a46969b85ce44953d7d9
https://github.com/purescript/package-sets/releases/download/psc-0.14.0-20210409/packages.dhall sha256:e81c2f2ce790c0e0d79869d22f7a37d16caeb5bd81cfda71d46c58f6199fd33f
let overrides = {=}
@ -13,12 +13,13 @@ let additions =
, "avar"
, "console"
, "const"
, "coroutines"
, "dom-indexed"
, "effect"
, "foreign"
, "fork"
, "free"
, "freeap"
, "halogen-subscriptions"
, "halogen-vdom"
, "media-types"
, "nullable"
@ -28,15 +29,29 @@ let additions =
, "transformers"
, "unsafe-coerce"
, "unsafe-reference"
, "web-file"
, "web-uievents"
]
"https://github.com/slamdata/purescript-halogen.git"
"v5.0.0-rc.6"
"https://github.com/purescript-halogen/purescript-halogen.git"
"v6.1.0"
, halogen-css =
mkPackage
[ "css", "halogen" ]
[ "halogen" ]
"https://github.com/slamdata/purescript-halogen-css.git"
"v8.0.0"
, memoize =
mkPackage
[ "prelude"
, "lazy"
, "either"
, "maybe"
, "tuples"
, "integers"
, "lists"
, "strings"
]
"https://github.com/paf31/purescript-memoize.git"
"9960694e82adc212fd89f8ed8778cf55fcb72aeb"
, optparse =
mkPackage
[ "prelude"
@ -46,14 +61,14 @@ let additions =
, "ordered-collections"
, "arrays"
, "console"
, "memoize"
, "transformers"
, "exists"
, "node-process"
, "free"
, "memoize"
]
"https://github.com/f-o-a-m/purescript-optparse.git"
"v3.0.1"
"https://github.com/srghma/purescript-optparse.git"
"d49b03fcd35f5be167e9c5c44ab1c17ca0956fb1"
, exitcodes =
mkPackage
[ "enums" ]
@ -66,9 +81,9 @@ let additions =
"v0.4.0"
, html-parser-halogen =
mkPackage
[ "string-parsers", "generics-rep", "halogen" ]
[ "string-parsers", "halogen" ]
"https://github.com/rnons/purescript-html-parser-halogen.git"
"890da763cdd2a1049ab8837e477c5ba1fcf6d4ce"
"458e492e441fcf69a66911b7b64beea5849e0dad"
, markdown-it-halogen =
mkPackage
[ "markdown-it", "html-parser-halogen" ]
@ -86,6 +101,32 @@ let additions =
]
"https://github.com/justinwoo/purescript-toppokki.git"
"v2.4.0"
, search-trie =
mkPackage
[ "prelude"
, "arrays"
, "ordered-collections"
, "lists"
, "foldable-traversable"
, "bifunctors"
]
"https://github.com/klntsky/purescript-search-trie.git"
"e7f7f22486a1dba22171ec885dbc2149dc815119"
, css =
mkPackage
[ "colors"
, "console"
, "effect"
, "exceptions"
, "nonempty"
, "profunctor"
, "psci-support"
, "strings"
, "these"
, "transformers"
]
"https://github.com/purescript-contrib/purescript-css.git"
"5c1a44ee95c259352a2b4570b060de14130540bc"
}
in upstream // overrides // additions

96
spago.dhall
View File

@ -1,44 +1,56 @@
{ sources =
[ "src/**/*.purs", "test/**/*.purs" ]
, name =
"docs-search"
{ sources = [ "src/**/*.purs", "test/**/*.purs" ]
, name = "docs-search"
, dependencies =
[ "aff-promise"
, "argonaut-codecs"
, "argonaut-core"
, "argonaut-generic"
, "arrays"
, "bower-json"
, "console"
, "control"
, "coroutines"
, "effect"
, "foldable-traversable"
, "generics-rep"
, "halogen"
, "halogen-css"
, "lists"
, "markdown-it"
, "markdown-it-halogen"
, "maybe"
, "newtype"
, "node-buffer"
, "node-fs"
, "node-fs-aff"
, "node-process"
, "node-readline"
, "optparse"
, "profunctor"
, "profunctor-lenses"
, "search-trie"
, "string-parsers"
, "strings"
, "test-unit"
, "web-dom"
, "web-html"
, "toppokki"
, "web-storage"
]
, packages =
./packages.dhall
[ "aff"
, "aff-promise"
, "argonaut-codecs"
, "argonaut-core"
, "argonaut-generic"
, "arrays"
, "bower-json"
, "console"
, "control"
, "css"
, "effect"
, "either"
, "exceptions"
, "foldable-traversable"
, "foreign"
, "foreign-object"
, "halogen"
, "halogen-css"
, "halogen-subscriptions"
, "identity"
, "js-uri"
, "lists"
, "markdown-it"
, "markdown-it-halogen"
, "maybe"
, "newtype"
, "node-buffer"
, "node-fs"
, "node-fs-aff"
, "node-process"
, "node-readline"
, "optparse"
, "ordered-collections"
, "partial"
, "prelude"
, "profunctor"
, "profunctor-lenses"
, "search-trie"
, "string-parsers"
, "strings"
, "test-unit"
, "toppokki"
, "transformers"
, "tuples"
, "unfoldable"
, "web-dom"
, "web-events"
, "web-html"
, "web-storage"
, "web-uievents"
]
, packages = ./packages.dhall
}

19
src/Docs/Search/App.purs
View File

@ -13,15 +13,16 @@ import Docs.Search.Meta as Meta
import Prelude
import Control.Alt (alt)
import Control.Coroutine as Coroutine
import Data.Maybe (Maybe(..))
import Data.Newtype (wrap)
import Data.Map as Map
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Halogen as H
import Halogen.Aff as HA
import Halogen.Subscription (subscribe)
import Halogen.VDom.Driver (runUI)
import MarkdownIt as MD
import Web.DOM.ChildNode as ChildNode
@ -70,11 +71,10 @@ main = do
let initialSearchEngineState = { packageIndex
, moduleIndex
, index: mempty
, typeIndex: mempty
, index: wrap Map.empty
, typeIndex: wrap Map.empty
, scores
}
resultsComponent =
SearchResults.mkComponent
initialSearchEngineState
@ -85,12 +85,13 @@ main = do
sfio <- runUI SearchField.component unit searchField
srio <- runUI resultsComponent unit searchResults
sfio.subscribe $
Coroutine.consumer (srio.query <<< H.tell <<< SearchResults.MessageFromSearchField)
void $ H.liftEffect $ subscribe sfio.messages $ \sfm -> do
launchAff_ do
srio.query (SearchResults.MessageFromSearchField sfm unit)
-- We need to read the URI hash only when both components are initialized and
-- the search field is subscribed to the main component.
void $ sfio.query $ H.tell SearchField.ReadURIHash
void $ sfio.query $ SearchField.ReadURIHash unit
-- Subscribe to URI hash updates
H.liftEffect do
@ -98,7 +99,7 @@ main = do
listener <-
eventListener \event ->
launchAff_ do
sfio.query $ H.tell SearchField.ReadURIHash
sfio.query $ SearchField.ReadURIHash unit
addEventListener hashchange listener true (Window.toEventTarget window)
@ -112,7 +113,7 @@ main = do
listener <-
eventListener \event ->
launchAff_ do
sbio.query $ H.tell Sidebar.UpdateModuleGrouping
sbio.query $ Sidebar.UpdateModuleGrouping unit
addEventListener focus listener true (Window.toEventTarget window)

19
src/Docs/Search/App/SearchField.purs
View File

@ -15,7 +15,7 @@ import Halogen.HTML as HH
import Halogen.HTML.CSS as HS
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.Query.EventSource as ES
import Halogen.Query.Event as ES
import Web.DOM.Document as Document
import Web.DOM.ParentNode as ParentNode
import Web.HTML as HTML
@ -36,6 +36,7 @@ data Action
| FocusChanged Boolean
| InitKeyboardListener
| HandleKey H.SubscriptionId KeyboardEvent
| NoOp
data Query a
= ReadURIHash a
@ -46,7 +47,7 @@ data SearchFieldMessage
| Focused
| LostFocus
component :: forall i. H.Component HH.HTML Query i SearchFieldMessage Aff
component :: forall i. H.Component Query i SearchFieldMessage Aff
component =
H.mkComponent
{ initialState
@ -73,12 +74,12 @@ initialState _ = { input: "", focused: false }
handleAction :: Action -> H.HalogenM State Action () SearchFieldMessage Aff Unit
handleAction = case _ of
NoOp -> pure unit
InitKeyboardListener -> do
document <- H.liftEffect $ Window.document =<< HTML.window
H.subscribe' \sid ->
ES.eventListenerEventSource
ES.eventListener
KET.keyup
(HTMLDocument.toEventTarget document)
(map (HandleKey sid) <<< KE.fromEvent)
@ -159,11 +160,11 @@ render state =
, HP.type_ HP.InputText
, HE.onKeyUp (\event ->
case KeyboardEvent.code event of
"Enter" -> Just EnterPressed
_ -> Nothing)
, HE.onValueInput (Just <<< InputAction)
, HE.onFocusIn $ const $ Just $ FocusChanged true
, HE.onFocusOut $ const $ Just $ FocusChanged false
"Enter" -> EnterPressed
_ -> NoOp)
, HE.onValueInput InputAction
, HE.onFocusIn $ const $ FocusChanged true
, HE.onFocusOut $ const $ FocusChanged false
, HS.style do
let pursuitColor = rgb 0x1d 0x22 0x2d

30
src/Docs/Search/App/SearchResults.purs
View File

@ -12,13 +12,13 @@ import Docs.Search.Extra (homePageFromRepository, (>#>))
import Docs.Search.ModuleIndex (ModuleResult)
import Docs.Search.PackageIndex (PackageResult)
import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))
import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
import Docs.Search.TypeIndex (TypeIndex)
import Docs.Search.Types (Identifier(..), ModuleName(..), PackageName)
import Docs.Search.Meta (Meta)
import Prelude
import Prim hiding (Type, Constraint)
import Data.Array ((!!))
import Data.Array as Array
import Data.List as List
@ -76,7 +76,7 @@ mkComponent
-> Element
-> MD.MarkdownIt
-> Meta
-> H.Component HH.HTML Query i o Aff
-> H.Component Query i o Aff
mkComponent initialEngineState contents markdownIt { localPackageName } =
H.mkComponent
{ initialState: const { engineState: initialEngineState
@ -205,7 +205,7 @@ render state@{ mode: Active } =
, HH.div [ HP.class_ (wrap "load_more"), HP.id_ "load-more" ]
[ if Array.length shownResults < Array.length state.results
then HH.a [ HP.id_ "load-more-link"
, HE.onClick $ const $ Just MoreResultsRequested ]
, HE.onClick $ const MoreResultsRequested ]
[ HH.text "Show more results" ]
else HH.p_
[ HH.text "No further results." ]
@ -305,7 +305,7 @@ renderSearchResult state (SearchResult result) =
[ HH.div [ HP.class_ (wrap "result") ]
[ HH.h3 [ HP.class_ (wrap "result__title") ]
[ HH.a [ HP.class_ (wrap "result__link")
, HE.onClick $ const $ Just $ SearchResultClicked result.moduleName
, HE.onClick $ const $ SearchResultClicked result.moduleName
, HP.href $
unwrap result.moduleName <> ".html#" <>
result.hashAnchor <> ":" <> unwrap result.name
@ -386,7 +386,7 @@ renderValueSignature
-> Array (HH.HTML a Action)
renderValueSignature result ty =
[ HH.a [ makeHref ValueLevel false result.moduleName result.name
, HE.onClick $ const $ Just $ SearchResultClicked result.moduleName ]
, HE.onClick $ const $ SearchResultClicked result.moduleName ]
[ HH.text $ unwrap result.name ]
, HH.text " :: "
, renderType ty ]
@ -417,7 +417,7 @@ renderTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName
]
, space
, HH.a [ makeHref TypeLevel false moduleName name
, HE.onClick $ const $ Just $
, HE.onClick $ const $
SearchResultClicked moduleName
]
[ HH.text $ unwrap name ]
@ -510,7 +510,7 @@ renderTypeArgument (TypeArgument { name, mbKind }) =
[ HH.text "("
, HH.text $ name
, HH.text " :: "
, renderKind kind
, renderType kind
, HH.text ")"
]
@ -592,7 +592,7 @@ renderForAll ty =
HH.span_ [ HH.text $ " (" <> name <> " "
, syntax "::"
, space
, renderKind kind
, renderType kind
, HH.text ")" ]
) <>
@ -666,7 +666,7 @@ renderQualifiedName isInfix level (QualifiedName { moduleNameParts, name })
= if isBuiltIn then
HH.text $ unwrap name
else
HH.a [ HE.onClick $ const $ Just $
HH.a [ HE.onClick $ const $
SearchResultClicked $ moduleName
, makeHref level isInfix moduleName name
]
@ -676,16 +676,6 @@ renderQualifiedName isInfix level (QualifiedName { moduleNameParts, name })
isBuiltIn = moduleNameParts !! 0 == Just "Prim"
renderKind
:: forall a
. 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 ]
NamedKind qname -> renderQualifiedName false KindLevel qname
-- | Construct a `href` property value w.r.t. `DeclLevel`.
makeHref
:: forall t rest

4
src/Docs/Search/App/Sidebar.purs
View File

@ -64,7 +64,7 @@ mkComponent
. ModuleIndex
-> IsIndexHTML
-> Meta
-> Aff (H.Component HH.HTML Query i Action Aff)
-> Aff (H.Component Query i Action Aff)
mkComponent moduleIndex@{ packageModules } isIndexHTML { localPackageName } = do
groupingMode <- H.liftEffect loadGroupingModeFromLocalStorage
mbModuleName <- H.liftEffect getCurrentModuleName
@ -134,7 +134,7 @@ render state@{ groupingMode, moduleNames, localPackageName } =
, HH.input [ HP.id_ "group-modules__input"
, HP.type_ HP.InputCheckbox
, HP.checked (groupingMode == GroupByPackage)
, HE.onChecked $ Just <<< ToggleGrouping <<< isCheckedToGroupingMode
, HE.onChecked $ ToggleGrouping <<< isCheckedToGroupingMode
]
, HH.text " "

3
src/Docs/Search/BrowserEngine.purs
View File

@ -36,9 +36,6 @@ newtype PartialIndex
= PartialIndex (Map PartId Index)
derive instance newtypePartialIndex :: Newtype PartialIndex _
derive newtype instance semigroupPartialIndex :: Semigroup PartialIndex
derive newtype instance monoidPartialIndex :: Monoid PartialIndex
type BrowserEngineState = EngineState PartialIndex TypeIndex

6
src/Docs/Search/Declarations.purs
View File

@ -3,11 +3,11 @@ module Docs.Search.Declarations where
import Docs.Search.DocsJson (ChildDeclType(..), ChildDeclaration(..), DeclType(..), Declaration(..), DocsJson(..), SourceSpan)
import Docs.Search.Score (Scores, getPackageScore, getPackageScoreForPackageName)
import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))
import Docs.Search.TypeDecoder (Constraint(..), QualifiedName(..), Type(..), Kind, joinForAlls)
import Docs.Search.TypeDecoder (Constraint(..), QualifiedName(..), Type(..), joinForAlls)
import Docs.Search.Types (ModuleName(..), PackageName(..), PackageInfo(..), Identifier(..))
import Prelude
import Prim hiding (Type)
import Control.Alt ((<|>))
import Data.Array ((!!))
import Data.Array as Array
@ -271,7 +271,7 @@ mkChildInfo
-- We concatenate two lists:
-- * a list of type parameters of the type class, and
-- * a list of quantified variables of the unconstrained type
allArguments :: Array { name :: String, mbKind :: Maybe Kind }
allArguments :: Array { name :: String, mbKind :: Maybe Type }
allArguments =
(arguments <#> unwrap) <> List.toUnfoldable binders

8
src/Docs/Search/DocsJson.purs
View File

@ -2,8 +2,8 @@
module Docs.Search.DocsJson where
import Prelude
import Docs.Search.TypeDecoder (Constraint, FunDeps, Kind, Type, TypeArgument)
import Prim hiding (Type, Constraint)
import Docs.Search.TypeDecoder (Constraint, FunDeps, Type, TypeArgument)
import Data.Argonaut.Core (fromString, stringify, toString)
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:?))
@ -11,7 +11,7 @@ import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Argonaut.Encode (class EncodeJson, encodeJson)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, unwrap)
@ -44,7 +44,7 @@ newtype Declaration
, comments :: Maybe String
, info :: { declType :: DeclType
, dataDeclType :: Maybe DataDeclType
, kind :: Maybe Kind
, kind :: Maybe Type
, typeArguments :: Maybe (Array TypeArgument)
, type :: Maybe Type
, superclasses :: Maybe (Array Constraint)

2
src/Docs/Search/IndexBuilder.purs
View File

@ -249,7 +249,7 @@ writeMeta meta = do
-- | Get a mapping from index parts to index contents.
getIndex :: Declarations -> Map PartId (Array (Tuple String (Array SearchResult)))
getIndex (Declarations trie) =
Array.foldr insert mempty parts
Array.foldr insert Map.empty parts
where
insert part = Map.insertWith append (getPartId part.prefix) part.results

10
src/Docs/Search/Interactive.purs
View File

@ -13,13 +13,13 @@ import Docs.Search.PackageIndex (PackageResult, mkPackageIndex, mkPackageInfo)
import Docs.Search.Score (mkScores)
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.TypeDecoder (Constraint, FunDeps, QualifiedName, Type, TypeArgument)
import Docs.Search.TypeIndex (resultsWithTypes)
import Docs.Search.TypePrinter (keyword, showConstraint, showFunDeps, showKind, showType, showTypeArgument, space, syntax)
import Docs.Search.TypePrinter (keyword, showConstraint, showFunDeps, showType, showTypeArgument, space, syntax)
import Docs.Search.Types (ModuleName, PackageName, PackageInfo, Identifier)
import Prelude
import Prim hiding (Type, Constraint)
import Data.Array as Array
import Data.Identity (Identity(..))
import Data.List as List
@ -279,7 +279,7 @@ showTypeSynonymSignature { type: ty, arguments } { name } =
showExternDataSignature
:: forall rest
. { kind :: Kind }
. { kind :: Type }
-> { name :: Identifier | rest }
-> String
showExternDataSignature { kind } { name } =
@ -288,7 +288,7 @@ showExternDataSignature { kind } { name } =
yellow (unwrap name) <>
space <>
syntax " :: " <>
showKind kind
showType kind
leftShift :: Int -> String -> String

2
src/Docs/Search/Main.purs
View File

@ -9,7 +9,7 @@ import Docs.Search.Config as Config
import Docs.Search.Types (PackageName(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Show.Generic (genericShow)
import Data.List as List
import Data.List.NonEmpty as NonEmpty
import Data.Maybe (Maybe, fromMaybe, optional)

8
src/Docs/Search/ModuleIndex.purs
View File

@ -56,7 +56,7 @@ type ModuleResult
unpackModuleIndex :: PackedModuleIndex -> ModuleIndex
unpackModuleIndex packageModules =
flip execState { packageModules, modulePackages: mempty, index: mempty } do
flip execState { packageModules, modulePackages: Map.empty, index: mempty } do
for_ (Map.toUnfoldableUnordered packageModules :: Array _)
\(package /\ moduleNames) -> do
for_ moduleNames \moduleName -> do
@ -94,12 +94,12 @@ queryModuleIndex scores { index, modulePackages } query =
-- | Constructs a mapping from packages to modules
mkPackedModuleIndex :: Declarations -> PackedModuleIndex
mkPackedModuleIndex (Declarations trie) =
foldr (Map.unionWith Set.union) mempty $ extract <$> Trie.values trie
foldr (Map.unionWith Set.union) Map.empty $ extract <$> Trie.values trie
where
extract
:: List SearchResult
-> Map PackageInfo (Set ModuleName)
extract = foldr (Map.unionWith Set.union) mempty <<< map mkEntry
extract = foldr (Map.unionWith Set.union) Map.empty <<< map mkEntry
where
mkEntry (SearchResult { packageInfo, moduleName }) =
Map.singleton packageInfo (Set.singleton moduleName)
@ -107,7 +107,7 @@ mkPackedModuleIndex (Declarations trie) =
loadModuleIndex :: Aff PackedModuleIndex
loadModuleIndex = do
json <- toAffE $ load Config.moduleIndexLoadPath
pure $ fromMaybe mempty $ hush $ decodeJson json
pure $ fromMaybe Map.empty $ hush $ decodeJson json
foreign import load

5
src/Docs/Search/PackageIndex.purs
View File

@ -36,7 +36,7 @@ mkPackageInfo :: Scores -> Array PackageMeta -> PackageInfo
mkPackageInfo packageScores pms =
Array.fromFoldable $
Map.values $
Array.foldr insert mempty pms
Array.foldr insert Map.empty pms
where
insert
@ -64,7 +64,8 @@ mkPackageInfo packageScores pms =
mkScoresFromPackageIndex :: PackageIndex -> Scores
mkScoresFromPackageIndex =
Trie.values >>> Array.foldr (\ { name, score } -> Map.insert name score) mempty
Trie.values >>> Array.fromFoldable >>>
Array.foldr (\ { name, score } -> Map.insert name score) Map.empty
loadPackageIndex :: Aff PackageIndex

2
src/Docs/Search/Score.purs
View File

@ -29,7 +29,7 @@ mkScores =
updateScoresFor (unwrap pm).dependencies >>>
updateScoresFor (unwrap pm).devDependencies
)
mempty
Map.empty
where
updateScoresFor :: Dependencies -> Scores -> Scores

10
src/Docs/Search/SearchResult.purs
View File

@ -1,15 +1,15 @@
module Docs.Search.SearchResult where
import Docs.Search.DocsJson (DataDeclType)
import Docs.Search.TypeDecoder (Constraint, FunDeps, Kind, QualifiedName, Type, TypeArgument)
import Docs.Search.TypeDecoder (Constraint, FunDeps, QualifiedName, Type, TypeArgument)
import Docs.Search.Types (ModuleName, PackageInfo, Identifier, PackageScore)
import Prelude
import Prim hiding (Type, Constraint)
import Data.Argonaut.Decode (class DecodeJson)
import Data.Argonaut.Decode.Generic.Rep (genericDecodeJson)
import Data.Argonaut.Decode.Generic (genericDecodeJson)
import Data.Argonaut.Encode (class EncodeJson)
import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson)
import Data.Argonaut.Encode.Generic (genericEncodeJson)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, un)
@ -19,7 +19,7 @@ import Data.Newtype (class Newtype, un)
data ResultInfo
= DataResult { typeArguments :: Array TypeArgument
, dataDeclType :: DataDeclType }
| ExternDataResult { kind :: Kind }
| ExternDataResult { kind :: Type }
| TypeSynonymResult { arguments :: Array TypeArgument
, type :: Type }
| DataConstructorResult { arguments :: Array Type }

57
src/Docs/Search/TypeDecoder.purs
View File

@ -1,9 +1,10 @@
-- | A decoder for types located in 'Language.PureScript.Types'.
module Docs.Search.TypeDecoder where
import Docs.Search.Types (Identifier)
import Prelude
import Prim hiding (Type, Constraint)
import Control.Alt ((<|>))
import Data.Argonaut.Core (Json, caseJsonObject, fromArray, fromObject, jsonEmptyObject, stringify, toArray)
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:))
@ -11,7 +12,7 @@ import Data.Argonaut.Encode (class EncodeJson, encodeJson)
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Show.Generic (genericShow)
import Data.List (List(..), (:))
import Data.List as List
import Data.Maybe (Maybe(..))
@ -49,49 +50,6 @@ mkJsonError name json _ =
mkJsonError' :: String -> Json -> JsonDecodeError
mkJsonError' name json = mkJsonError name json unit
-- | The data type of kinds
data Kind
-- | Kinds for labelled, unordered rows without duplicates
= Row Kind
-- | Function kinds
| FunKind Kind Kind
-- | A named kind
| NamedKind QualifiedName
derive instance eqKind :: Eq Kind
derive instance genericKind :: Generic Kind _
instance showKind :: Show Kind where
show x = genericShow x
instance decodeJsonKind :: DecodeJson Kind where
decodeJson json = do
handle <- decodeJson json
tag <- handle .: "tag"
case tag of
"NamedKind" -> do
contents <- handle .: "contents"
pure $ NamedKind contents
"Row" -> do
contents <- handle .: "contents"
pure $ Row contents
"FunKind" -> do
contents <- handle .: "contents"
case contents of
[k1, k2] ->
Right $ FunKind k1 k2
_ -> Left $ mkJsonError' "FunKind" json
_ -> Left $ mkJsonError' "Kind" json
instance encodeJsonKind :: EncodeJson Kind where
encodeJson = case _ of
Row k ->
tagged "Row" (encodeJson k)
FunKind k1 k2 ->
tagged "FunKind" (encodeTuple k1 k2)
NamedKind qname ->
tagged "NamedKind" (encodeJson qname)
-- | A typeclass constraint
newtype Constraint = Constraint
{ constraintClass :: QualifiedName
@ -141,7 +99,7 @@ data Type
-- | A type application
| TypeApp Type Type
-- | Forall quantifier
| ForAll String (Maybe Kind) Type
| ForAll String (Maybe Type) Type
-- | A type withset of type class constraints
| ConstrainedType Constraint Type
{-
@ -189,9 +147,10 @@ instance decodeJsonType :: DecodeJson Type where
(Left $ err unit)
json
<|>
-- Ignore SkolemScope
decodeContents
(decodeQuadriple
(\f (k :: Kind) a (_ :: Maybe Int) ->
(\f (k :: Type) a (_ :: Maybe Int) ->
ForAll f (Just k) a)
err)
(Left $ err unit)
@ -270,7 +229,7 @@ instance encodeJsonFunDeps :: EncodeJson FunDeps where
newtype TypeArgument
= TypeArgument
{ name :: String
, mbKind :: Maybe Kind
, mbKind :: Maybe Type
}
derive newtype instance eqTypeArgument :: Eq TypeArgument
@ -404,7 +363,7 @@ tagged tag contents =
joinForAlls
:: Type
-> { binders :: List { name :: String
, mbKind :: Maybe Kind }
, mbKind :: Maybe Type }
, ty :: Type
}
joinForAlls ty = go Nil ty

9
src/Docs/Search/TypeIndex.purs
View File

@ -12,12 +12,13 @@ import Docs.Search.Types (ModuleName(..))
import Docs.Search.TypeShape (shapeOfType, shapeOfTypeQuery, stringifyShape)
import Prelude
import Prim hiding (Type)
import Control.Promise (Promise, toAffE)
import Data.Argonaut.Core (Json)
import Data.Argonaut.Decode (decodeJson)
import Data.Array as Array
import Data.Either (hush)
import Data.Foldable (fold, foldr)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe', isJust)
@ -28,14 +29,12 @@ import Effect.Aff (Aff, try)
newtype TypeIndex = TypeIndex (Map String (Maybe (Array SearchResult)))
derive newtype instance semigroupTypeIndex :: Semigroup TypeIndex
derive newtype instance monoidTypeIndex :: Monoid TypeIndex
derive instance newtypeTypeIndex :: Newtype TypeIndex _
mkTypeIndex :: Scores -> Array DocsJson -> TypeIndex
mkTypeIndex scores docsJsons =
TypeIndex $ map Just $ Array.foldr insert mempty docsJsons
TypeIndex $ map Just $ foldr insert Map.empty docsJsons
where
insert :: DocsJson -> Map String (Array SearchResult) -> Map String (Array SearchResult)
insert docsJson mp =
@ -78,7 +77,7 @@ lookup
-> Aff { index :: TypeIndex, results :: Array SearchResult }
lookup key index@(TypeIndex map) =
case Map.lookup key map of
Just results -> pure { index, results: Array.fold results }
Just results -> pure { index, results: fold results }
Nothing -> do
eiJson <- try (toAffE (lookup_ key $ Config.mkShapeScriptPath key))
pure $ fromMaybe'

19
src/Docs/Search/TypePrinter.purs
View File

@ -1,10 +1,10 @@
module Docs.Search.TypePrinter where
import Prelude
import Prim hiding (Type, Constraint)
import Docs.Search.Extra ((>#>))
import Docs.Search.Terminal (cyan)
import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
import Docs.Search.Types (Identifier(..))
import Data.Array as Array
@ -70,7 +70,7 @@ showTypeArgument (TypeArgument { name, mbKind }) =
"(" <>
name <>
" :: " <>
showKind kind <>
showType kind <>
")"
@ -127,7 +127,7 @@ showForAll
showForAll ty =
keyword "forall" <>
( Array.fold $ foralls.binders <#>
( Array.fold $ Array.fromFoldable $ foralls.binders <#>
\ { name, mbKind } ->
case mbKind of
Nothing -> " " <> name
@ -135,7 +135,7 @@ showForAll ty =
" (" <> name <> " "
<> syntax "::"
<> space
<> showKind kind
<> showType kind
<> ")"
) <>
@ -146,15 +146,6 @@ showForAll ty =
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

6
src/Docs/Search/TypeQuery.purs
View File

@ -16,12 +16,12 @@ import Docs.Search.TypeDecoder (QualifiedName(..), Type(..), joinConstraints, jo
import Docs.Search.Types (Identifier(..))
import Prelude
import Prim hiding (Type)
import Control.Alt ((<|>))
import Data.Array as Array
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Show.Generic (genericShow)
import Data.List (List(..), many, some, (:))
import Data.List as List
import Data.List.NonEmpty (NonEmptyList)
@ -331,7 +331,7 @@ typeVarPenalty substs =
Substitute v1 v2 ->
f v1 v2
_ -> identity
) mempty substs
) Map.empty substs
-- | Penalty for name mismatches.

4
src/Docs/Search/TypeShape.purs
View File

@ -8,9 +8,9 @@ import Docs.Search.TypeQuery (TypeQuery(..), getFreeVariables)
import Docs.Search.Types (Identifier(..))
import Prelude
import Prim hiding (Type)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Show.Generic (genericShow)
import Data.List (List(..), (:))
import Data.List as List
import Data.List.NonEmpty as NonEmptyList

6
src/Docs/Search/Types.purs
View File

@ -3,11 +3,11 @@ module Docs.Search.Types where
import Prelude
import Data.Argonaut.Decode (class DecodeJson)
import Data.Argonaut.Decode.Generic.Rep (genericDecodeJson)
import Data.Argonaut.Decode.Generic (genericDecodeJson)
import Data.Argonaut.Encode (class EncodeJson)
import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson)
import Data.Argonaut.Encode.Generic (genericEncodeJson)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Show.Generic (genericShow)
import Data.Newtype (class Newtype)

2
src/Docs/Search/URIHash.purs
View File

@ -10,7 +10,7 @@ import Prelude
import Data.Maybe (Maybe(Just), fromMaybe)
import Data.String.CodeUnits as String
import Effect (Effect)
import Global (decodeURIComponent, encodeURIComponent)
import JSURI (decodeURIComponent, encodeURIComponent)
import Web.HTML as HTML
import Web.HTML.Location as Location
import Web.HTML.Window as Window

307
test/Main.purs
View File

@ -2,23 +2,21 @@ module Test.Main where
import Prelude
import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..))
import Docs.Search.Types (Identifier(..))
import Test.TypeQuery as TypeQuery
import Test.IndexBuilder as IndexBuilder
import Test.Declarations as Declarations
import Test.ModuleIndex as ModuleIndex
import Test.UI as UI
import Test.Extra (assertRight)
import Data.Argonaut.Core (Json)
import Data.Argonaut.Decode (decodeJson)
import Data.Argonaut.Encode (encodeJson)
import Data.Argonaut.Parser (jsonParser)
import Data.Either (fromRight)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), QualifiedName(..), Type(..))
import Docs.Search.Types (Identifier(..))
import Effect (Effect)
import Partial.Unsafe (unsafePartial)
import Test.Declarations as Declarations
import Test.Extra (assertRight)
import Test.IndexBuilder as IndexBuilder
import Test.ModuleIndex as ModuleIndex
import Test.TypeQuery as TypeQuery
import Test.UI as UI
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Main (runTest)
@ -27,131 +25,39 @@ main = do
runTest mainTest
UI.main
mkJson :: String -> Json
mkJson str =
unsafePartial $ case jsonParser str of
Right r -> r
mainTest :: TestSuite
mainTest = do
TypeQuery.tests
IndexBuilder.tests
Declarations.tests
ModuleIndex.tests
let mkJson x = unsafePartial $ fromRight $ jsonParser x
suite "FunDeps decoder" do
test "FunDeps" do
let funDeps = mkJson """
[
let
funDeps = mkJson """
[
[
"lhs",
"rhs"
],
[
"output"
]
]
]
"""
[
[
"lhs",
"rhs"
],
[
"output"
]
]
]
"""
assertRight (decodeJson funDeps)
(FunDeps [ FunDep { lhs: [ "lhs", "rhs" ]
, rhs: [ "output"]
}
])
suite "Kind decoder" do
test "QualifiedName" do
let qualifiedName = mkJson """
[
[
"Prim"
],
"Type"
]
"""
assertRight (decodeJson qualifiedName)
(qualified ["Prim"] "Type")
test "NamedKind" do
let namedKind = mkJson """
{
"annotation": [],
"tag": "NamedKind",
"contents": [
[
"Prim"
],
"Type"
]
}
"""
assertRight (decodeJson namedKind)
(NamedKind $ qualified ["Prim"] "Type")
test "Row" do
let row = mkJson """
{
"annotation": [],
"tag": "Row",
"contents": {
"annotation": [],
"tag": "NamedKind",
"contents": [
[
"Prim"
],
"Type"
]
}
}
"""
assertRight (decodeJson row) (Row $ NamedKind $ qualified ["Prim"] "Type")
test "FunKind" do
let funKind = mkJson """
{
"annotation": [],
"tag": "FunKind",
"contents": [
{
"annotation": [],
"tag": "Row",
"contents": {
"annotation": [],
"tag": "NamedKind",
"contents": [
[
"Prim"
],
"Type"
]
}
},
{
"annotation": [],
"tag": "Row",
"contents": {
"annotation": [],
"tag": "NamedKind",
"contents": [
[
"Prim"
],
"Type"
]
}
}
]
}
"""
assertRight (decodeJson funKind)
(FunKind (Row $ NamedKind $ qualified ["Prim"] "Type")
(Row $ NamedKind $ qualified ["Prim"] "Type")
)
suite "Constraint decoder" do
test "Constraint" do
let constraint = mkJson """
@ -372,155 +278,6 @@ mainTest = do
(TypeConstructor $ qualified ["Prim"] "String"))
(TypeVar "a"))
test "ForAll #2" do
let forallJson = mkJson """
{
"annotation": [],
"tag": "ForAll",
"contents": [
"f",
{
"annotation": [],
"tag": "FunKind",
"contents": [
{
"annotation": [],
"tag": "NamedKind",
"contents": [
[
"Prim",
"RowList"
],
"RowList"
]
},
{
"annotation": [],
"tag": "NamedKind",
"contents": [
[
"Prim"
],
"Type"
]
}
]
},
{
"annotation": [],
"tag": "TypeApp",
"contents": [
{
"annotation": [],
"tag": "TypeApp",
"contents": [
{
"annotation": [],
"tag": "TypeConstructor",
"contents": [
[
"Prim"
],
"Function"
]
},
{
"annotation": [],
"tag": "TypeApp",
"contents": [
{
"annotation": [],
"tag": "TypeVar",
"contents": "f"
},
{
"annotation": [],
"tag": "TypeVar",
"contents": "l"
}
]
}
]
},
{
"annotation": [],
"tag": "TypeApp",
"contents": [
{
"annotation": [],
"tag": "TypeConstructor",
"contents": [
[
"Data",
"List",
"Types"
],
"List"
]
},
{
"annotation": [],
"tag": "ParensInType",
"contents": {
"annotation": [],
"tag": "TypeApp",
"contents": [
{
"annotation": [],
"tag": "TypeApp",
"contents": [
{
"annotation": [],
"tag": "TypeConstructor",
"contents": [
[
"Data",
"Tuple"
],
"Tuple"
]
},
{
"annotation": [],
"tag": "TypeConstructor",
"contents": [
[
"Prim"
],
"String"
]
}
]
},
{
"annotation": [],
"tag": "TypeConstructor",
"contents": [
[
"Prim"
],
"String"
]
}
]
}
}
]
}
]
},
null
]
}
"""
assertRight (decodeJson forallJson) $
ForAll "f"
(Just (FunKind (NamedKind (QualifiedName { moduleNameParts: ["Prim","RowList"], name: Identifier "RowList" })) (NamedKind (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "Type" }))))
(TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "Function" })) (TypeApp (TypeVar "f") (TypeVar "l"))) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Data","List","Types"], name: Identifier "List" })) (ParensInType (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Data","Tuple"], name: Identifier "Tuple" })) (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "String" }))) (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "String" }))))))
suite "jsons" do
test "jsons #1" do
@ -530,14 +287,6 @@ mainTest = do
assertRight (decodeJson json) $ (ForAll "o" Nothing (ForAll "r" Nothing (ForAll "l" Nothing (ConstrainedType (Constraint { constraintArgs: [(TypeVar "l"),(TypeVar "r"),(TypeVar "o")], constraintClass: (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: Identifier "And" }) }) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: Identifier "BProxy" })) (TypeVar "l"))) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: Identifier "BProxy" })) (TypeVar "r"))) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: Identifier "BProxy" })) (TypeVar "o"))))))))
suite "Kind encoder" do
test "FunKind" do
let k1 =
FunKind (Row (NamedKind $ qualified [] "a"))
(FunKind (NamedKind $ qualified [] "b")
(NamedKind $ qualified [] "b"))
assertRight (decodeJson $ encodeJson $ k1) k1
qualified :: Array String -> String -> QualifiedName
qualified moduleNameParts name = QualifiedName { moduleNameParts, name: Identifier name }

2
test/Test/TypeQuery.purs
View File

@ -6,7 +6,7 @@ import Docs.Search.TypeShape (ShapeChunk(..), shapeOfType, shapeOfTypeQuery)
import Docs.Search.Types (Identifier(..))
import Prelude
import Prim hiding (Constraint, Type)
import Data.Foldable (class Foldable)
import Data.List (List(..), (:))
import Data.List as List