mirror of
https://github.com/rowtype-yoga/purescript-docs-search.git
synced 2024-09-11 12:35:37 +03:00
Updates for v0.14 (#46)
Co-authored-by: Fabrizio Ferrai <fabrizio.ferrai@gmail.com>
This commit is contained in:
parent
58ce738318
commit
c22dc0b2a6
17
package.json
17
package.json
@ -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"
|
||||
}
|
||||
}
|
||||
|
@ -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
96
spago.dhall
@ -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
|
||||
}
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 " "
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -29,7 +29,7 @@ mkScores =
|
||||
updateScoresFor (unwrap pm).dependencies >>>
|
||||
updateScoresFor (unwrap pm).devDependencies
|
||||
)
|
||||
mempty
|
||||
Map.empty
|
||||
|
||||
where
|
||||
updateScoresFor :: Dependencies -> Scores -> Scores
|
||||
|
@ -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 }
|
||||
|
@ -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
|
||||
|
@ -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'
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
||||
|
||||
|
@ -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
307
test/Main.purs
@ -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 }
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user