mirror of
https://github.com/rowtype-yoga/purescript-docs-search.git
synced 2024-09-11 12:35:37 +03:00
Fix everything except toppoki tests
This commit is contained in:
parent
66bffd8d29
commit
7ef455f041
@ -1,5 +1,6 @@
|
||||
{
|
||||
"name": "purescript-docs-search",
|
||||
"type": "module",
|
||||
"version": "0.0.11",
|
||||
"description": "Search frontend for the documentation generated by the PureScript compiler.",
|
||||
"directories": {
|
||||
@ -19,7 +20,7 @@
|
||||
"bundle-app": "spago bundle-app --no-build --no-install -m Docs.Search.App --to dist/docs-search-app.js",
|
||||
"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",
|
||||
"bundle-main": "spago bundle-app --no-build --no-install --platform node -m Docs.Search.Main --to 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",
|
||||
|
@ -1,8 +1,10 @@
|
||||
let mkPackage =
|
||||
https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2-20190725/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57
|
||||
https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2-20190725/src/mkPackage.dhall
|
||||
sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57
|
||||
|
||||
let upstream =
|
||||
https://github.com/purescript/package-sets/releases/download/psc-0.14.0-20210409/packages.dhall sha256:e81c2f2ce790c0e0d79869d22f7a37d16caeb5bd81cfda71d46c58f6199fd33f
|
||||
https://github.com/purescript/package-sets/releases/download/psc-0.15.0-20220506/packages.dhall
|
||||
sha256:f83b68ff07cf6557e82379e749118e6ff11eecc6be5754540aae855cd1e46917
|
||||
|
||||
let overrides = {=}
|
||||
|
||||
@ -33,12 +35,7 @@ let additions =
|
||||
, "web-uievents"
|
||||
]
|
||||
"https://github.com/purescript-halogen/purescript-halogen.git"
|
||||
"v6.1.0"
|
||||
, halogen-css =
|
||||
mkPackage
|
||||
[ "halogen" ]
|
||||
"https://github.com/slamdata/purescript-halogen-css.git"
|
||||
"v8.0.0"
|
||||
"v7.0.0"
|
||||
, memoize =
|
||||
mkPackage
|
||||
[ "prelude"
|
||||
@ -67,8 +64,8 @@ let additions =
|
||||
, "free"
|
||||
, "memoize"
|
||||
]
|
||||
"https://github.com/srghma/purescript-optparse.git"
|
||||
"d49b03fcd35f5be167e9c5c44ab1c17ca0956fb1"
|
||||
"https://github.com/klntsky/purescript-optparse.git"
|
||||
"2fe4265b7c6b09744c11190a43ca06777c752473"
|
||||
, exitcodes =
|
||||
mkPackage
|
||||
[ "enums" ]
|
||||
@ -77,30 +74,42 @@ let additions =
|
||||
, markdown-it =
|
||||
mkPackage
|
||||
[ "prelude", "effect", "options" ]
|
||||
"https://github.com/nonbili/purescript-markdown-it.git"
|
||||
"v0.4.0"
|
||||
"https://github.com/klntsky/purescript-markdown-it.git"
|
||||
"f3b7654783a83a80d7c09b6caaa7cd40b93ddce1"
|
||||
, string-parsers =
|
||||
mkPackage
|
||||
[ "arrays"
|
||||
, "assert"
|
||||
, "bifunctors"
|
||||
, "console"
|
||||
, "control"
|
||||
, "effect"
|
||||
, "either"
|
||||
, "enums"
|
||||
, "foldable-traversable"
|
||||
, "lists"
|
||||
, "maybe"
|
||||
, "minibench"
|
||||
, "nonempty"
|
||||
, "partial"
|
||||
, "prelude"
|
||||
, "strings"
|
||||
, "tailrec"
|
||||
, "transformers"
|
||||
, "unfoldable"
|
||||
]
|
||||
"https://github.com/purescript-contrib/purescript-string-parsers.git"
|
||||
"v8.0.0"
|
||||
, html-parser-halogen =
|
||||
mkPackage
|
||||
[ "string-parsers", "halogen" ]
|
||||
"https://github.com/rnons/purescript-html-parser-halogen.git"
|
||||
"458e492e441fcf69a66911b7b64beea5849e0dad"
|
||||
"https://github.com/klntsky/purescript-html-parser-halogen.git"
|
||||
"5c31890d060d5abd0038fed6acd3f999a9362369"
|
||||
, markdown-it-halogen =
|
||||
mkPackage
|
||||
[ "markdown-it", "html-parser-halogen" ]
|
||||
"https://github.com/nonbili/purescript-markdown-it-halogen.git"
|
||||
"08c9625015bf04214be14e45230e8ce12f3fa2bf"
|
||||
, toppokki =
|
||||
mkPackage
|
||||
[ "prelude"
|
||||
, "record"
|
||||
, "functions"
|
||||
, "node-http"
|
||||
, "aff-promise"
|
||||
, "node-buffer"
|
||||
, "node-fs-aff"
|
||||
]
|
||||
"https://github.com/justinwoo/purescript-toppokki.git"
|
||||
"v2.4.0"
|
||||
, search-trie =
|
||||
mkPackage
|
||||
[ "prelude"
|
||||
@ -126,7 +135,18 @@ let additions =
|
||||
, "transformers"
|
||||
]
|
||||
"https://github.com/purescript-contrib/purescript-css.git"
|
||||
"5c1a44ee95c259352a2b4570b060de14130540bc"
|
||||
"710d6a742beb88299faf08aaeb997ee1e24483ab"
|
||||
, jest =
|
||||
mkPackage
|
||||
[ "aff"
|
||||
, "aff-promise"
|
||||
, "effect"
|
||||
, "prelude"
|
||||
, "psci-support"
|
||||
, "foldable-traversable"
|
||||
]
|
||||
"https://github.com/klntsky/purescript-jest.git"
|
||||
"7feaa5a880fc75002c4eca312993174e7220252b"
|
||||
}
|
||||
|
||||
in upstream // overrides // additions
|
||||
|
@ -39,10 +39,9 @@
|
||||
, "profunctor"
|
||||
, "profunctor-lenses"
|
||||
, "search-trie"
|
||||
, "spec"
|
||||
, "string-parsers"
|
||||
, "strings"
|
||||
, "test-unit"
|
||||
, "toppokki"
|
||||
, "transformers"
|
||||
, "tuples"
|
||||
, "unfoldable"
|
||||
|
@ -86,7 +86,7 @@ main = do
|
||||
srio <- runUI resultsComponent unit searchResults
|
||||
|
||||
void $ H.liftEffect $ subscribe sfio.messages $ \sfm -> do
|
||||
launchAff_ do
|
||||
launchAff_ $ void do
|
||||
srio.query (SearchResults.MessageFromSearchField sfm unit)
|
||||
|
||||
-- We need to read the URI hash only when both components are initialized and
|
||||
@ -97,8 +97,8 @@ main = do
|
||||
H.liftEffect do
|
||||
|
||||
listener <-
|
||||
eventListener \event ->
|
||||
launchAff_ do
|
||||
eventListener \_event ->
|
||||
launchAff_ $ void do
|
||||
sfio.query $ SearchField.ReadURIHash unit
|
||||
|
||||
addEventListener hashchange listener true (Window.toEventTarget window)
|
||||
@ -111,8 +111,8 @@ main = do
|
||||
H.liftEffect do
|
||||
|
||||
listener <-
|
||||
eventListener \event ->
|
||||
launchAff_ do
|
||||
eventListener \_event ->
|
||||
launchAff_ $ void do
|
||||
sbio.query $ Sidebar.UpdateModuleGrouping unit
|
||||
|
||||
addEventListener focus listener true (Window.toEventTarget window)
|
||||
|
@ -156,7 +156,7 @@ render state =
|
||||
[ HH.input
|
||||
[ HP.value state.input
|
||||
, HP.placeholder "Search for definitions... (S to focus)"
|
||||
, HP.id_ "docs-search-query-field"
|
||||
, HP.id "docs-search-query-field"
|
||||
, HP.type_ HP.InputText
|
||||
, HE.onKeyUp (\event ->
|
||||
case KeyboardEvent.code event of
|
||||
|
@ -202,9 +202,9 @@ render state@{ mode: Active } =
|
||||
, HH.div_ $
|
||||
Array.concat $ shownResults <#> renderResult state
|
||||
|
||||
, HH.div [ HP.class_ (wrap "load_more"), HP.id_ "load-more" ]
|
||||
, 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"
|
||||
then HH.a [ HP.id "load-more-link"
|
||||
, HE.onClick $ const MoreResultsRequested ]
|
||||
[ HH.text "Show more results" ]
|
||||
else HH.p_
|
||||
|
@ -17,7 +17,6 @@ import Data.Maybe (Maybe(..), isJust, fromMaybe)
|
||||
import Data.Newtype (wrap, unwrap)
|
||||
import Data.Set (Set)
|
||||
import Data.Set as Set
|
||||
import Data.Symbol (SProxy(..))
|
||||
import Data.Tuple.Nested (type (/\), (/\))
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff)
|
||||
@ -25,6 +24,7 @@ import Halogen as H
|
||||
import Halogen.HTML as HH
|
||||
import Halogen.HTML.Events as HE
|
||||
import Halogen.HTML.Properties as HP
|
||||
import Type.Proxy (Proxy(..))
|
||||
import Web.HTML as HTML
|
||||
import Web.HTML.Window as Window
|
||||
import Web.Storage.Storage as Storage
|
||||
@ -131,7 +131,7 @@ render state@{ groupingMode, moduleNames, localPackageName } =
|
||||
]
|
||||
|
||||
[ HH.h3_ [ HH.text $ if groupingMode == DontGroup then "Modules" else "Packages" ]
|
||||
, HH.input [ HP.id_ "group-modules__input"
|
||||
, HH.input [ HP.id "group-modules__input"
|
||||
, HP.type_ HP.InputCheckbox
|
||||
, HP.checked (groupingMode == GroupByPackage)
|
||||
, HE.onChecked $ ToggleGrouping <<< isCheckedToGroupingMode
|
||||
@ -139,7 +139,7 @@ render state@{ groupingMode, moduleNames, localPackageName } =
|
||||
|
||||
, HH.text " "
|
||||
, HH.label [ HP.for "group-modules__input"
|
||||
, HP.id_ "group-modules__label"
|
||||
, HP.id "group-modules__label"
|
||||
]
|
||||
[ HH.text " GROUP BY PACKAGE" ]
|
||||
|
||||
@ -215,4 +215,4 @@ isCheckedToGroupingMode = if _ then GroupByPackage else DontGroup
|
||||
-- Some optics:
|
||||
|
||||
_groupingMode :: forall a b rest. (a -> b) -> { groupingMode :: a | rest } -> { groupingMode :: b | rest }
|
||||
_groupingMode = prop (SProxy :: SProxy "groupingMode")
|
||||
_groupingMode = prop (Proxy :: Proxy "groupingMode")
|
||||
|
@ -1,6 +1,6 @@
|
||||
/* global exports */
|
||||
|
||||
exports.loadIndex_ = function (partId) {
|
||||
export function loadIndex_ (partId) {
|
||||
return function (url) {
|
||||
return function () {
|
||||
return new Promise(function(resolve, reject) {
|
||||
|
@ -1,14 +1,13 @@
|
||||
/* global __dirname require exports */
|
||||
|
||||
var path = require('path');
|
||||
var glob = require('glob');
|
||||
import globMain from "glob";
|
||||
|
||||
exports.getDirname = function () {
|
||||
export function getDirname () {
|
||||
return __dirname;
|
||||
};
|
||||
|
||||
exports.glob = function (pattern) {
|
||||
export function glob (pattern) {
|
||||
return function () {
|
||||
return glob.sync(pattern);
|
||||
return globMain.sync(pattern);
|
||||
};
|
||||
};
|
||||
|
@ -43,7 +43,8 @@ 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, readFile, readTextFile, readdir, stat, writeFile, writeTextFile)
|
||||
import Node.FS.Aff (mkdir, readFile, readTextFile, readdir, stat, writeFile, writeTextFile)
|
||||
import Node.FS.Sync (exists)
|
||||
import Node.FS.Stats (isDirectory, isFile)
|
||||
import Node.Process as Process
|
||||
import Web.Bower.PackageMeta (PackageMeta(..))
|
||||
@ -369,7 +370,7 @@ copyAppFile { generatedDocs } = do
|
||||
|
||||
directoryExists :: String -> Aff Boolean
|
||||
directoryExists path = do
|
||||
doesExist <- exists path
|
||||
doesExist <- liftEffect $ exists path
|
||||
case doesExist of
|
||||
false -> pure false
|
||||
true -> isDirectory <$> stat path
|
||||
@ -377,7 +378,7 @@ directoryExists path = do
|
||||
|
||||
fileExists :: String -> Aff Boolean
|
||||
fileExists path = do
|
||||
doesExist <- exists path
|
||||
doesExist <- liftEffect $ exists path
|
||||
case doesExist of
|
||||
false -> pure false
|
||||
true -> isFile <$> stat path
|
||||
|
@ -1,6 +1,6 @@
|
||||
/* global exports */
|
||||
|
||||
exports.loadFromScript = function (globalIdentifier) {
|
||||
export function loadFromScript (globalIdentifier) {
|
||||
return function (url) {
|
||||
return function () {
|
||||
return new Promise(function (resolve, reject) {
|
||||
|
@ -1,6 +1,6 @@
|
||||
/* global exports */
|
||||
|
||||
exports.load = function (url) {
|
||||
export function load (url) {
|
||||
return function () {
|
||||
return new Promise(function (resolve, reject) {
|
||||
if (typeof window.DocsSearchModuleIndex === 'undefined') {
|
||||
|
@ -30,12 +30,11 @@ import Data.Set as Set
|
||||
import Data.String.CodeUnits (toCharArray) as String
|
||||
import Data.String.Common (split, toLower) as String
|
||||
import Data.String.Pattern (Pattern(..))
|
||||
import Data.Symbol (SProxy(..))
|
||||
import Data.Traversable (foldr, for_)
|
||||
import Data.Tuple.Nested ((/\))
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff)
|
||||
|
||||
import Type.Proxy (Proxy(..))
|
||||
|
||||
-- | Module index that is actually stored in a JS file.
|
||||
type PackedModuleIndex = Map PackageInfo (Set ModuleName)
|
||||
@ -116,7 +115,7 @@ foreign import load
|
||||
|
||||
|
||||
_modulePackages :: forall a b rest. (a -> b) -> { modulePackages :: a | rest } -> { modulePackages :: b | rest }
|
||||
_modulePackages = prop (SProxy :: SProxy "modulePackages")
|
||||
_modulePackages = prop (Proxy :: Proxy "modulePackages")
|
||||
|
||||
_index :: forall a b rest. (a -> b) -> { index :: a | rest } -> { index :: b | rest }
|
||||
_index = prop (SProxy :: SProxy "index")
|
||||
_index = prop (Proxy :: Proxy "index")
|
||||
|
@ -1,6 +1,6 @@
|
||||
/* global exports */
|
||||
|
||||
exports.lookup_ = function (shape) {
|
||||
export function lookup_ (shape) {
|
||||
return function (url) {
|
||||
return function () {
|
||||
return new Promise(function (resolve, reject) {
|
||||
|
@ -34,9 +34,9 @@ import Data.Set as Set
|
||||
import Data.String.CodeUnits (fromCharArray)
|
||||
import Data.String.Common (trim) as String
|
||||
import Data.Tuple (Tuple(..), fst, snd)
|
||||
import Text.Parsing.StringParser (ParseError, Parser, runParser, try)
|
||||
import Text.Parsing.StringParser.CodePoints (alphaNum, anyLetter, char, eof, lowerCaseChar, skipSpaces, string, upperCaseChar)
|
||||
import Text.Parsing.StringParser.Combinators (fix, sepBy, sepBy1, sepEndBy, sepEndBy1)
|
||||
import StringParser (ParseError, Parser, runParser, try)
|
||||
import StringParser.CodePoints (alphaNum, anyLetter, char, eof, lowerCaseChar, skipSpaces, string, upperCaseChar)
|
||||
import StringParser.Combinators (fix, sepBy, sepBy1, sepEndBy, sepEndBy1)
|
||||
|
||||
|
||||
-- | We need type queries because we don't have a full-featured type parser
|
||||
|
@ -1,6 +1,6 @@
|
||||
/* global exports */
|
||||
|
||||
exports.hash = function (string) {
|
||||
export function hash (string) {
|
||||
var hash = Math.floor(Number.MAX_SAFE_INTEGER / 2);
|
||||
if (string.length == 0) {
|
||||
return hash;
|
||||
|
@ -1,7 +1,7 @@
|
||||
/* global exports history */
|
||||
|
||||
// https://stackoverflow.com/questions/1397329
|
||||
exports.removeHash = function () {
|
||||
export function removeHash () {
|
||||
var scrollV, scrollH, loc = window.location;
|
||||
if ("pushState" in history)
|
||||
history.pushState("", document.title, loc.pathname + loc.search);
|
||||
|
@ -7,7 +7,7 @@ where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Maybe (Maybe(Just), fromMaybe)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.String.CodeUnits as String
|
||||
import Effect (Effect)
|
||||
import JSURI (decodeURIComponent, encodeURIComponent)
|
||||
@ -31,7 +31,7 @@ getInput = do
|
||||
location <- Window.location window
|
||||
hash <- Location.hash location
|
||||
pure $
|
||||
if String.slice 0 8 hash == Just "#search:"
|
||||
if String.slice 0 8 hash == "#search:"
|
||||
then fromMaybe "" $
|
||||
decodeURIComponent $
|
||||
String.drop 8 hash
|
||||
|
@ -9,15 +9,17 @@ import Test.ModuleIndex as ModuleIndex
|
||||
import Test.TypeQuery as TypeQuery
|
||||
import Test.TypeJson as TypeJson
|
||||
import Test.UI as UI
|
||||
import Test.Unit (TestSuite)
|
||||
import Test.Unit.Main (runTest)
|
||||
import Test.Spec (Spec)
|
||||
import Test.Spec.Reporter.Console (consoleReporter)
|
||||
import Test.Spec.Runner (runSpec)
|
||||
import Effect.Aff (launchAff_)
|
||||
|
||||
main :: Effect Unit
|
||||
main = do
|
||||
runTest mainTest
|
||||
launchAff_ $ runSpec [consoleReporter] mainTest
|
||||
UI.main
|
||||
|
||||
mainTest :: TestSuite
|
||||
mainTest :: Spec Unit
|
||||
mainTest = do
|
||||
TypeQuery.tests
|
||||
TypeJson.tests
|
||||
|
@ -7,33 +7,32 @@ import Docs.Search.Types (PackageName(..), PackageInfo(..))
|
||||
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.Newtype (wrap)
|
||||
import Test.Spec (Spec, describe, it)
|
||||
import Test.Spec.Assertions (shouldEqual)
|
||||
|
||||
import Test.Unit (TestSuite, suite, test)
|
||||
import Test.Unit.Assert as Assert
|
||||
|
||||
tests :: TestSuite
|
||||
tests :: Spec Unit
|
||||
tests = do
|
||||
suite "Declarations" do
|
||||
test "extractPackageName" do
|
||||
Assert.equal Builtin (extractPackageName (wrap "Prim") Nothing)
|
||||
Assert.equal Builtin (extractPackageName (wrap "Prim.Foo") Nothing)
|
||||
Assert.equal Builtin (extractPackageName (wrap "Prim.Foo.Bar") Nothing)
|
||||
Assert.equal UnknownPackage (extractPackageName (wrap "Primitive") Nothing)
|
||||
Assert.equal (Package $ PackageName "foo")
|
||||
describe "Declarations" do
|
||||
it "extractPackageName works correctly" do
|
||||
Builtin `shouldEqual` (extractPackageName (wrap "Prim") Nothing)
|
||||
Builtin `shouldEqual` (extractPackageName (wrap "Prim.Foo") Nothing)
|
||||
Builtin `shouldEqual` (extractPackageName (wrap "Prim.Foo.Bar") Nothing)
|
||||
UnknownPackage `shouldEqual` (extractPackageName (wrap "Primitive") Nothing)
|
||||
Package (PackageName "foo") `shouldEqual`
|
||||
(extractPackageName (wrap "Foo") $
|
||||
Just { start: []
|
||||
, end: []
|
||||
, name: ".spago/foo/src/Foo.purs"
|
||||
}
|
||||
)
|
||||
Assert.equal (Package $ PackageName "bar")
|
||||
Package (PackageName "bar") `shouldEqual`
|
||||
(extractPackageName (wrap "Bar") $
|
||||
Just { start: []
|
||||
, end: []
|
||||
, name: "/path/to/somewhere/bower_components/bar/src/Bar.purs"
|
||||
}
|
||||
)
|
||||
Assert.equal LocalPackage
|
||||
LocalPackage `shouldEqual`
|
||||
(extractPackageName (wrap "Bar") $
|
||||
Just { start: []
|
||||
, end: []
|
||||
|
@ -4,7 +4,8 @@ import Prelude
|
||||
|
||||
import Data.Either (Either(..))
|
||||
import Effect.Aff (Aff)
|
||||
import Test.Unit.Assert as Assert
|
||||
import Test.Spec.Assertions (shouldEqual)
|
||||
|
||||
|
||||
assertRight
|
||||
:: forall a b
|
||||
@ -17,7 +18,7 @@ assertRight
|
||||
-> Aff Unit
|
||||
assertRight eiActual expected =
|
||||
case eiActual of
|
||||
Left string -> do
|
||||
Assert.equal (Right expected) eiActual
|
||||
Right actual -> do
|
||||
Assert.equal (Right expected) eiActual
|
||||
Left _ -> do
|
||||
Right expected `shouldEqual` eiActual
|
||||
Right _ -> do
|
||||
Right expected `shouldEqual` eiActual
|
||||
|
@ -5,16 +5,16 @@ import Prelude
|
||||
import Docs.Search.IndexBuilder (patchHTML)
|
||||
|
||||
import Data.Tuple (snd)
|
||||
import Test.Unit (TestSuite, suite, test)
|
||||
import Test.Unit.Assert as Assert
|
||||
import Test.Spec (Spec, describe, it)
|
||||
import Test.Spec.Assertions (shouldEqual, shouldNotSatisfy)
|
||||
|
||||
tests :: TestSuite
|
||||
tests :: Spec Unit
|
||||
tests = do
|
||||
suite "IndexBuilder" do
|
||||
suite "patchHTML" do
|
||||
test "works" do
|
||||
describe "IndexBuilder" do
|
||||
describe "patchHTML" do
|
||||
it "works" do
|
||||
let input = "</body>"
|
||||
Assert.assertFalse "patchHTML works" (snd (patchHTML input) == input)
|
||||
test "is idempotent" do
|
||||
shouldNotSatisfy (snd (patchHTML input)) (eq input)
|
||||
it "is idempotent" do
|
||||
let input = "</body>"
|
||||
Assert.equal (snd $ patchHTML $ snd $ patchHTML input) (snd $ patchHTML input)
|
||||
shouldEqual (snd $ patchHTML $ snd $ patchHTML input) (snd $ patchHTML input)
|
||||
|
@ -6,20 +6,18 @@ import Prelude
|
||||
|
||||
import Data.List as List
|
||||
import Data.Newtype (wrap)
|
||||
import Test.Unit (TestSuite, suite, test)
|
||||
import Test.Unit.Assert as Assert
|
||||
import Test.Spec (Spec, describe, it)
|
||||
import Test.Spec.Assertions (shouldEqual)
|
||||
|
||||
|
||||
tests :: TestSuite
|
||||
tests :: Spec Unit
|
||||
tests = do
|
||||
suite "ModuleIndex" do
|
||||
describe "ModuleIndex" do
|
||||
|
||||
test "test #0" do
|
||||
Assert.equal (extractModuleNameParts $ wrap "Data.Array.ST") (
|
||||
it "test #0" do
|
||||
extractModuleNameParts (wrap "Data.Array.ST") `shouldEqual`
|
||||
List.fromFoldable [ "st", "array.st", "data.array.st" ]
|
||||
)
|
||||
|
||||
test "test #1" do
|
||||
Assert.equal (extractModuleNameParts $ wrap "Foo") (
|
||||
it "test #1" do
|
||||
extractModuleNameParts (wrap "Foo") `shouldEqual`
|
||||
List.fromFoldable [ "foo" ]
|
||||
)
|
||||
|
@ -15,13 +15,13 @@ import Data.Argonaut.Parser (jsonParser)
|
||||
import Data.Either (Either(..))
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
import Test.Unit (TestSuite, suite, test)
|
||||
import Test.Spec (Spec, describe, it)
|
||||
|
||||
|
||||
tests :: TestSuite
|
||||
tests :: Spec Unit
|
||||
tests = do
|
||||
suite "FunDeps decoder" do
|
||||
test "FunDeps" do
|
||||
describe "FunDeps decoder" do
|
||||
it "FunDeps" do
|
||||
let
|
||||
funDeps = mkJson """
|
||||
[
|
||||
@ -42,8 +42,8 @@ tests = do
|
||||
}
|
||||
])
|
||||
|
||||
suite "Constraint decoder" do
|
||||
test "Constraint" do
|
||||
describe "Constraint decoder" do
|
||||
it "Constraint" do
|
||||
let constraint = mkJson """
|
||||
{
|
||||
"constraintAnn": [],
|
||||
@ -62,8 +62,8 @@ tests = do
|
||||
, constraintArgs: []
|
||||
})
|
||||
|
||||
suite "Type decoder" do
|
||||
test "TypeVar" do
|
||||
describe "Type decoder" do
|
||||
it "TypeVar" do
|
||||
let typeVar = mkJson """
|
||||
{
|
||||
"annotation": [],
|
||||
@ -75,7 +75,7 @@ tests = do
|
||||
assertRight (decodeJson typeVar)
|
||||
(TypeVar "m")
|
||||
|
||||
test "TypeApp" do
|
||||
it "TypeApp" do
|
||||
let typeApp1 = mkJson """
|
||||
{
|
||||
"annotation": [],
|
||||
@ -114,7 +114,7 @@ tests = do
|
||||
))
|
||||
(TypeVar "h")
|
||||
|
||||
test "TypeOp" do
|
||||
it "TypeOp" do
|
||||
let typeOp = mkJson """
|
||||
{
|
||||
"annotation": [],
|
||||
@ -131,7 +131,7 @@ tests = do
|
||||
assertRight (decodeJson typeOp) $
|
||||
TypeOp $ qualified [ "Data", "NaturalTransformation" ] "~>"
|
||||
|
||||
test "BinaryNoParens" do
|
||||
it "BinaryNoParens" do
|
||||
let binaryNoParens = mkJson """
|
||||
{
|
||||
"annotation": [],
|
||||
@ -168,7 +168,7 @@ tests = do
|
||||
(TypeVar "m")
|
||||
(TypeVar "n")
|
||||
|
||||
test "ParensInType" do
|
||||
it "ParensInType" do
|
||||
let parensInType = mkJson """
|
||||
{
|
||||
"annotation": [],
|
||||
@ -208,7 +208,7 @@ tests = do
|
||||
TypeApp
|
||||
(TypeConstructor (qualified [ "Data", "Maybe" ] "Maybe"))
|
||||
(TypeConstructor (qualified [ "Prim" ] "String"))
|
||||
test "RCons" do
|
||||
it "RCons" do
|
||||
|
||||
let rcons = mkJson """
|
||||
{
|
||||
@ -253,7 +253,7 @@ tests = do
|
||||
(TypeVar "t"))
|
||||
REmpty
|
||||
|
||||
test "ForAll #1" do
|
||||
it "ForAll #1" do
|
||||
let forallJson = mkJson """
|
||||
{"annotation":[],"tag":"ForAll","contents":["a",{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"String"]}]},{"annotation":[],"tag":"TypeVar","contents":"a"}]},null]}
|
||||
"""
|
||||
@ -262,13 +262,13 @@ tests = do
|
||||
(TypeConstructor $ qualified ["Prim"] "String"))
|
||||
(TypeVar "a"))
|
||||
|
||||
test "KindApp" do
|
||||
it "KindApp" do
|
||||
let kindAppJson = mkJson """
|
||||
{"annotation":[],"tag":"KindApp","contents":[{"annotation":[],"tag":"REmpty"},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}
|
||||
"""
|
||||
assertRight (decodeJson kindAppJson) $
|
||||
KindApp REmpty (TypeConstructor (qualified ["Prim"] "Type"))
|
||||
test "KindedType" do
|
||||
it "KindedType" do
|
||||
let kindedTypeJson = mkJson """
|
||||
{"annotation":[],"tag":"KindedType","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Data","Const"],"Const"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Data","Void"],"Void"]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]},{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Type"]}]}]}
|
||||
"""
|
||||
@ -281,9 +281,9 @@ tests = do
|
||||
(TypeConstructor (qualified ["Prim"] "Function"))
|
||||
(TypeConstructor (qualified ["Prim"] "Type" )))
|
||||
(TypeConstructor (qualified ["Prim"] "Type")))
|
||||
suite "jsons" do
|
||||
describe "jsons" do
|
||||
|
||||
test "jsons #1" do
|
||||
it "jsons #1" do
|
||||
let json = mkJson """
|
||||
{"annotation":[],"tag":"ForAll","contents":["o",{"annotation":[],"tag":"ForAll","contents":["r",{"annotation":[],"tag":"ForAll","contents":["l",{"annotation":[],"tag":"ConstrainedType","contents":[{"constraintAnn":[],"constraintClass":[["Type","Data","Boolean"],"And"],"constraintArgs":[{"annotation":[],"tag":"TypeVar","contents":"l"},{"annotation":[],"tag":"TypeVar","contents":"r"},{"annotation":[],"tag":"TypeVar","contents":"o"}],"constraintData":null},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Type","Data","Boolean"],"BProxy"]},{"annotation":[],"tag":"TypeVar","contents":"l"}]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Prim"],"Function"]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Type","Data","Boolean"],"BProxy"]},{"annotation":[],"tag":"TypeVar","contents":"r"}]}]},{"annotation":[],"tag":"TypeApp","contents":[{"annotation":[],"tag":"TypeConstructor","contents":[["Type","Data","Boolean"],"BProxy"]},{"annotation":[],"tag":"TypeVar","contents":"o"}]}]}]}]},null]},null]},null]}
|
||||
"""
|
||||
|
@ -15,384 +15,535 @@ import Data.List.NonEmpty as NonEmptyList
|
||||
import Data.Set as Set
|
||||
import Data.Tuple (Tuple(..))
|
||||
import Test.Extra (assertRight)
|
||||
import Test.Unit (TestSuite, suite, test)
|
||||
import Test.Unit.Assert as Assert
|
||||
import Test.Spec (Spec, describe, it)
|
||||
import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
|
||||
import Data.Maybe (Maybe(..))
|
||||
|
||||
|
||||
tests :: TestSuite
|
||||
tests :: Spec Unit
|
||||
tests = do
|
||||
suite "TypeQuery parser" do
|
||||
describe "TypeQuery parser" do
|
||||
|
||||
test "test #0" do
|
||||
it "test #0" do
|
||||
let input = "a"
|
||||
assertRight (parseTypeQuery input) (qVar "a")
|
||||
|
||||
test "test #1" do
|
||||
it "test #1" do
|
||||
let input = "ab"
|
||||
assertRight (parseTypeQuery input) (qVar "ab")
|
||||
|
||||
test "test #2" do
|
||||
it "test #2" do
|
||||
let input = "a b"
|
||||
assertRight (parseTypeQuery input) (QApp (qVar "a") (qVar "b"))
|
||||
|
||||
test "test #3" do
|
||||
it "test #3" do
|
||||
let input = "a b c"
|
||||
assertRight (parseTypeQuery input) (QApp (QApp (qVar "a") (qVar "b")) (qVar "c"))
|
||||
|
||||
test "test #4" do
|
||||
it "test #4" do
|
||||
let input = "a -> b"
|
||||
assertRight (parseTypeQuery input) (QFun (qVar "a") (qVar "b"))
|
||||
|
||||
test "test #5" do
|
||||
it "test #5" do
|
||||
let input = "a -> b c"
|
||||
assertRight (parseTypeQuery input) (QFun (qVar "a") (QApp (qVar "b") (qVar "c")))
|
||||
|
||||
test "test #6" do
|
||||
it "test #6" do
|
||||
let input = "a b -> c"
|
||||
assertRight (parseTypeQuery input) (QFun (QApp (qVar "a") (qVar "b")) (qVar "c"))
|
||||
|
||||
test "test #7" do
|
||||
it "test #7" do
|
||||
let input = "a b"
|
||||
assertRight (parseTypeQuery input) (QApp (qVar "a") (qVar "b"))
|
||||
|
||||
test "test #8" do
|
||||
it "test #8" do
|
||||
let input = "a (b c)"
|
||||
assertRight (parseTypeQuery input) (QApp (qVar "a") (QApp (qVar "b") (qVar "c")))
|
||||
|
||||
test "test #9" do
|
||||
it "test #9" do
|
||||
let input = "(a b) (c d)"
|
||||
assertRight (parseTypeQuery input)
|
||||
(QApp (QApp (qVar "a") (qVar "b"))
|
||||
(QApp (qVar "c") (qVar "d")))
|
||||
( QApp (QApp (qVar "a") (qVar "b"))
|
||||
(QApp (qVar "c") (qVar "d"))
|
||||
)
|
||||
|
||||
test "test #10" do
|
||||
it "test #10" do
|
||||
let input = "a ( b c )"
|
||||
assertRight (parseTypeQuery input) (QApp (qVar "a") (QApp (qVar "b") (qVar "c")))
|
||||
|
||||
test "test #11" do
|
||||
it "test #11" do
|
||||
let input = "aaa"
|
||||
assertRight (parseTypeQuery input) (qVar "aaa")
|
||||
|
||||
test "test #12" do
|
||||
it "test #12" do
|
||||
let input = "aaa ( bbb ccc )"
|
||||
assertRight (parseTypeQuery input) (QApp (qVar "aaa") (QApp (qVar "bbb") (qVar "ccc")))
|
||||
|
||||
test "test #13" do
|
||||
it "test #13" do
|
||||
let input = "(a -> b) -> (c -> d)"
|
||||
assertRight (parseTypeQuery input) (QFun (QFun (qVar "a") (qVar "b"))
|
||||
(QFun (qVar "c") (qVar "d")))
|
||||
assertRight (parseTypeQuery input)
|
||||
( QFun (QFun (qVar "a") (qVar "b"))
|
||||
(QFun (qVar "c") (qVar "d"))
|
||||
)
|
||||
|
||||
test "test #14" do
|
||||
it "test #14" do
|
||||
let input = "a -> b -> c -> d"
|
||||
assertRight (parseTypeQuery input) (QFun (qVar "a")
|
||||
(QFun (qVar "b")
|
||||
(QFun (qVar "c") (qVar "d"))))
|
||||
assertRight (parseTypeQuery input)
|
||||
( QFun (qVar "a")
|
||||
( QFun (qVar "b")
|
||||
(QFun (qVar "c") (qVar "d"))
|
||||
)
|
||||
)
|
||||
|
||||
test "test #15" do
|
||||
it "test #15" do
|
||||
let input = "a -> b -> c"
|
||||
assertRight (parseTypeQuery input) (QFun (qVar "a")
|
||||
(QFun (qVar "b")
|
||||
(qVar "c")))
|
||||
assertRight (parseTypeQuery input)
|
||||
( QFun (qVar "a")
|
||||
( QFun (qVar "b")
|
||||
(qVar "c")
|
||||
)
|
||||
)
|
||||
|
||||
test "test #16" do
|
||||
it "test #16" do
|
||||
let input = "forall a b c. c"
|
||||
assertRight (parseTypeQuery input) (QForAll (nl "a" ["b", "c"]) (qVar "c"))
|
||||
assertRight (parseTypeQuery input) (QForAll (nl "a" [ "b", "c" ]) (qVar "c"))
|
||||
|
||||
test "test #17" do
|
||||
it "test #17" do
|
||||
let input = "forall a. Maybe a"
|
||||
assertRight (parseTypeQuery input) (QForAll (nl "a" $ []) (QApp (qConst "Maybe") (qVar "a")))
|
||||
|
||||
test "test #18" do
|
||||
it "test #18" do
|
||||
let input = "forall m a. Monad m => a -> m a"
|
||||
assertRight (parseTypeQuery input)
|
||||
(QForAll (nl "m" ["a"])
|
||||
(qConstraint "Monad" (l [qVar "m"])
|
||||
(QFun (qVar "a")
|
||||
(QApp (qVar "m") (qVar "a")))))
|
||||
( QForAll (nl "m" [ "a" ])
|
||||
( qConstraint "Monad" (l [ qVar "m" ])
|
||||
( QFun (qVar "a")
|
||||
(QApp (qVar "m") (qVar "a"))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
test "test #19" do
|
||||
it "test #19" do
|
||||
let input = "{ a :: Int }"
|
||||
assertRight (parseTypeQuery input)
|
||||
(QApp (qConst "Record") (QRow (pure (Tuple (Identifier "a") (qConst "Int")))))
|
||||
|
||||
test "test #20" do
|
||||
it "test #20" do
|
||||
let input = "{a::Int}"
|
||||
assertRight (parseTypeQuery input)
|
||||
(QApp (qConst "Record") (QRow (pure (Tuple (Identifier "a") (qConst "Int")))))
|
||||
|
||||
test "test #21" do
|
||||
it "test #21" do
|
||||
let input = "Int"
|
||||
assertRight (parseTypeQuery input) (qConst "Int")
|
||||
|
||||
test "test #22" do
|
||||
it "test #22" do
|
||||
let input = "a->b"
|
||||
assertRight (parseTypeQuery input) (QFun (qVar "a") (qVar "b"))
|
||||
|
||||
test "test #23" do
|
||||
it "test #23" do
|
||||
let input = "forall m a. MonadRec m => Process m a -> m a"
|
||||
assertRight (parseTypeQuery input) (QForAll (nl "m" ("a" : Nil))
|
||||
(qConstraint "MonadRec" (l [qVar "m"])
|
||||
(QFun (QApp (QApp (qConst "Process")
|
||||
(qVar "m")) (qVar "a"))
|
||||
(QApp (qVar "m") (qVar "a")))))
|
||||
assertRight (parseTypeQuery input)
|
||||
( QForAll (nl "m" ("a" : Nil))
|
||||
( qConstraint "MonadRec" (l [ qVar "m" ])
|
||||
( QFun
|
||||
( QApp
|
||||
( QApp (qConst "Process")
|
||||
(qVar "m")
|
||||
)
|
||||
(qVar "a")
|
||||
)
|
||||
(QApp (qVar "m") (qVar "a"))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
test "test #24" do
|
||||
it "test #24" do
|
||||
let input = "forall t f a. Foldable1 t => Apply f => f"
|
||||
assertRight (parseTypeQuery input) (QForAll (nl "t" ["f", "a"])
|
||||
(qConstraint "Foldable1" (l [qVar "t"])
|
||||
(qConstraint "Apply" (l [qVar "f"]) (qVar "f"))))
|
||||
assertRight (parseTypeQuery input)
|
||||
( QForAll (nl "t" [ "f", "a" ])
|
||||
( qConstraint "Foldable1" (l [ qVar "t" ])
|
||||
(qConstraint "Apply" (l [ qVar "f" ]) (qVar "f"))
|
||||
)
|
||||
)
|
||||
|
||||
test "test #25" do
|
||||
it "test #25" do
|
||||
let input = "forall m a.MonadRec m=>Process m a->m a"
|
||||
assertRight (parseTypeQuery input) ((QForAll (nl "m" ("a" : Nil))
|
||||
(qConstraint "MonadRec" (l [qVar "m"])
|
||||
(QFun (QApp (QApp (qConst "Process")
|
||||
(qVar "m")) (qVar "a"))
|
||||
(QApp (qVar "m") (qVar "a"))))))
|
||||
assertRight (parseTypeQuery input)
|
||||
( ( QForAll (nl "m" ("a" : Nil))
|
||||
( qConstraint "MonadRec" (l [ qVar "m" ])
|
||||
( QFun
|
||||
( QApp
|
||||
( QApp (qConst "Process")
|
||||
(qVar "m")
|
||||
)
|
||||
(qVar "a")
|
||||
)
|
||||
(QApp (qVar "m") (qVar "a"))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
test "test #26" do
|
||||
it "test #26" do
|
||||
let input = "m a -> (a -> m b) -> m b"
|
||||
assertRight (parseTypeQuery input) (QFun (QApp (qVar "m") (qVar "a")) (QFun (QFun (qVar "a") (QApp (qVar "m") (qVar "b"))) (QApp (qVar "m") (qVar "b"))))
|
||||
|
||||
test "test #27" do
|
||||
it "test #27" do
|
||||
let input = "forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a)"
|
||||
assertRight (parseTypeQuery input) ((QForAll (nl "f" ["a"]))
|
||||
(qConstraint "Alternative" (l [qVar "f"])
|
||||
(qConstraint "Lazy" (l [QApp (qVar "f")
|
||||
(QApp (qConst "List") (qVar "a"))])
|
||||
(QFun (QApp (qVar "f") (qVar "a"))
|
||||
(QApp (qVar "f")
|
||||
(QApp (qConst "List") (qVar "a")))))))
|
||||
assertRight (parseTypeQuery input)
|
||||
( (QForAll (nl "f" [ "a" ]))
|
||||
( qConstraint "Alternative" (l [ qVar "f" ])
|
||||
( qConstraint "Lazy"
|
||||
( l
|
||||
[ QApp (qVar "f")
|
||||
(QApp (qConst "List") (qVar "a"))
|
||||
]
|
||||
)
|
||||
( QFun (QApp (qVar "f") (qVar "a"))
|
||||
( QApp (qVar "f")
|
||||
(QApp (qConst "List") (qVar "a"))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
test "test #28" do
|
||||
it "test #28" do
|
||||
let input = "forall f a. Alternative f => Lazy(f (List a))=>f a -> f (List a)"
|
||||
assertRight (parseTypeQuery input) ((QForAll (nl "f" ["a"]))
|
||||
(qConstraint "Alternative" (l [qVar "f"])
|
||||
(qConstraint "Lazy" (l [QApp (qVar "f")
|
||||
(QApp (qConst "List") (qVar "a"))])
|
||||
(QFun (QApp (qVar "f") (qVar "a"))
|
||||
(QApp (qVar "f")
|
||||
(QApp (qConst "List") (qVar "a")))))))
|
||||
assertRight (parseTypeQuery input)
|
||||
( (QForAll (nl "f" [ "a" ]))
|
||||
( qConstraint "Alternative" (l [ qVar "f" ])
|
||||
( qConstraint "Lazy"
|
||||
( l
|
||||
[ QApp (qVar "f")
|
||||
(QApp (qConst "List") (qVar "a"))
|
||||
]
|
||||
)
|
||||
( QFun (QApp (qVar "f") (qVar "a"))
|
||||
( QApp (qVar "f")
|
||||
(QApp (qConst "List") (qVar "a"))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
test "test #29" do
|
||||
it "test #29" do
|
||||
let input = "{a::Int,b::Int}"
|
||||
assertRight (parseTypeQuery input)
|
||||
(QApp (qConst "Record") (QRow (List.fromFoldable
|
||||
[ Tuple (Identifier "a") (qConst "Int")
|
||||
, Tuple (Identifier "b") (qConst "Int")])))
|
||||
( QApp (qConst "Record")
|
||||
( QRow
|
||||
( List.fromFoldable
|
||||
[ Tuple (Identifier "a") (qConst "Int")
|
||||
, Tuple (Identifier "b") (qConst "Int")
|
||||
]
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
test "test #30" do
|
||||
it "test #30" do
|
||||
let input = "{record''' :: Int}"
|
||||
assertRight (parseTypeQuery input)
|
||||
(QApp (qConst "Record") (QRow (List.fromFoldable [ Tuple (Identifier "record'''") (qConst "Int")])))
|
||||
(QApp (qConst "Record") (QRow (List.fromFoldable [ Tuple (Identifier "record'''") (qConst "Int") ])))
|
||||
|
||||
test "test #31" do
|
||||
it "test #31" do
|
||||
let input = "(row''' :: Int)"
|
||||
assertRight (parseTypeQuery input)
|
||||
(QRow (List.fromFoldable [ Tuple (Identifier "row'''") (qConst "Int")]))
|
||||
(QRow (List.fromFoldable [ Tuple (Identifier "row'''") (qConst "Int") ]))
|
||||
|
||||
test "test #32" do
|
||||
it "test #32" do
|
||||
let input = "(row1 :: Int, row2 :: (),row3::(row4::{}))"
|
||||
assertRight (parseTypeQuery input)
|
||||
(QRow (l [ Tuple (Identifier "row1") (qConst "Int")
|
||||
, Tuple (Identifier "row2") (QRow Nil)
|
||||
, Tuple (Identifier "row3") (QRow (l [ Tuple (Identifier "row4") (QApp (qConst "Record") (QRow Nil)) ])) ]))
|
||||
( QRow
|
||||
( l
|
||||
[ Tuple (Identifier "row1") (qConst "Int")
|
||||
, Tuple (Identifier "row2") (QRow Nil)
|
||||
, Tuple (Identifier "row3") (QRow (l [ Tuple (Identifier "row4") (QApp (qConst "Record") (QRow Nil)) ]))
|
||||
]
|
||||
)
|
||||
)
|
||||
|
||||
test "test #33" do
|
||||
it "test #33" do
|
||||
let input = "Foldable1 t => Apply f => t (f a) -> f Unit"
|
||||
assertRight (parseTypeQuery input)
|
||||
(qConstraint "Foldable1" ((qVar "t") : Nil) (qConstraint "Apply" ((qVar "f") : Nil) (QFun (QApp (qVar "t") (QApp (qVar "f") (qVar "a"))) (QApp (qVar "f") (qConst "Unit")))))
|
||||
|
||||
test "test #34" do
|
||||
it "test #34" do
|
||||
let input = "Foldable1 t => Apply f => t (f a) -> f a"
|
||||
assertRight (parseTypeQuery input)
|
||||
(qConstraint "Foldable1" ((qVar "t") : Nil) (qConstraint "Apply" ((qVar "f") : Nil) (QFun (QApp (qVar "t") (QApp (qVar "f") (qVar "a"))) (QApp (qVar "f") (qVar "a")))))
|
||||
|
||||
test "test #35" do
|
||||
it "test #35" do
|
||||
let input = "Generic a rep => GenericEq rep => a -> a -> Boolean"
|
||||
assertRight (parseTypeQuery input)
|
||||
(qConstraint "Generic" ((qVar "a") : (qVar "rep") : Nil)
|
||||
(qConstraint "GenericEq" ((qVar "rep") : Nil)
|
||||
(QFun (qVar "a") (QFun (qVar "a") (qConst "Boolean")))))
|
||||
( qConstraint "Generic" ((qVar "a") : (qVar "rep") : Nil)
|
||||
( qConstraint "GenericEq" ((qVar "rep") : Nil)
|
||||
(QFun (qVar "a") (QFun (qVar "a") (qConst "Boolean")))
|
||||
)
|
||||
)
|
||||
|
||||
suite "polish notation" do
|
||||
describe "polish notation" do
|
||||
|
||||
test "test #1" do
|
||||
it "test #1" do
|
||||
let input = "(a -> b) -> (b -> ((a -> b) -> c))"
|
||||
assertRight (shapeOfTypeQuery <$> parseTypeQuery input)
|
||||
(l [ PForAll 3, PFun, PFun, PVar, PVar, PFun, PVar, PFun, PFun
|
||||
, PVar, PVar, PVar ])
|
||||
( l
|
||||
[ PForAll 3
|
||||
, PFun
|
||||
, PFun
|
||||
, PVar
|
||||
, PVar
|
||||
, PFun
|
||||
, PVar
|
||||
, PFun
|
||||
, PFun
|
||||
, PVar
|
||||
, PVar
|
||||
, PVar
|
||||
]
|
||||
)
|
||||
|
||||
test "test #2" do
|
||||
it "test #2" do
|
||||
let input = "forall a. (a -> b) -> (b -> ((a -> b) -> c))"
|
||||
assertRight (shapeOfTypeQuery <$> parseTypeQuery input)
|
||||
(l [ PForAll 3, PFun, PFun, PVar, PVar, PFun, PVar, PFun, PFun
|
||||
, PVar, PVar, PVar ])
|
||||
( l
|
||||
[ PForAll 3
|
||||
, PFun
|
||||
, PFun
|
||||
, PVar
|
||||
, PVar
|
||||
, PFun
|
||||
, PVar
|
||||
, PFun
|
||||
, PFun
|
||||
, PVar
|
||||
, PVar
|
||||
, PVar
|
||||
]
|
||||
)
|
||||
|
||||
test "test #3" do
|
||||
it "test #3" do
|
||||
let input = "forall a. (a -> b) -> (b -> ((a -> b) -> c))"
|
||||
assertRight (shapeOfTypeQuery <$> parseTypeQuery input)
|
||||
(l [ PForAll 3, PFun, PFun, PVar, PVar, PFun, PVar, PFun, PFun
|
||||
, PVar, PVar, PVar ])
|
||||
( l
|
||||
[ PForAll 3
|
||||
, PFun
|
||||
, PFun
|
||||
, PVar
|
||||
, PVar
|
||||
, PFun
|
||||
, PVar
|
||||
, PFun
|
||||
, PFun
|
||||
, PVar
|
||||
, PVar
|
||||
, PVar
|
||||
]
|
||||
)
|
||||
|
||||
test "test #4" do
|
||||
it "test #4" do
|
||||
let input = "forall a. (forall h. ST h (STArray h a)) -> Array a"
|
||||
assertRight (shapeOfTypeQuery <$> parseTypeQuery input)
|
||||
(l [ PForAll 1, PFun, PForAll 1, PApp, PApp, PVar, PVar, PApp, PApp, PVar, PVar, PVar, PApp, PVar, PVar ])
|
||||
(l [ PForAll 1, PFun, PForAll 1, PApp, PApp, PVar, PVar, PApp, PApp, PVar, PVar, PVar, PApp, PVar, PVar ])
|
||||
|
||||
suite "type shapes" do
|
||||
test "test #1" do
|
||||
let query = "Generic a rep => GenericEq rep => a -> a -> Boolean"
|
||||
c1 = constr (qname [""] "Generic") [TypeVar "a", TypeVar "rep"]
|
||||
c2 = constr (qname [""] "GenericEq") [TypeVar "rep"]
|
||||
describe "type shapes" do
|
||||
it "test #1" do
|
||||
let
|
||||
query = "Generic a rep => GenericEq rep => a -> a -> Boolean"
|
||||
c1 = constr (qname [ "" ] "Generic") [ TypeVar "a", TypeVar "rep" ]
|
||||
c2 = constr (qname [ "" ] "GenericEq") [ TypeVar "rep" ]
|
||||
|
||||
fun t1 t2 =
|
||||
TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"]
|
||||
, name: Identifier "Function" })) t1) t2
|
||||
type_ =
|
||||
ForAll "a" Nothing $
|
||||
ForAll "rep" Nothing $
|
||||
ConstrainedType c1
|
||||
(ConstrainedType c2
|
||||
(fun (TypeVar "a") (fun (TypeVar "b")
|
||||
(TypeConstructor $ qname ["Prim", "Boolean"] "Boolean"))))
|
||||
shape = shapeOfTypeQuery <$> parseTypeQuery query
|
||||
Assert.equal (pure $ shapeOfType type_) shape
|
||||
fun t1 t2 =
|
||||
TypeApp
|
||||
( TypeApp
|
||||
( TypeConstructor
|
||||
( QualifiedName
|
||||
{ moduleNameParts: [ "Prim" ]
|
||||
, name: Identifier "Function"
|
||||
}
|
||||
)
|
||||
)
|
||||
t1
|
||||
)
|
||||
t2
|
||||
type_ =
|
||||
ForAll "a" Nothing
|
||||
$ ForAll "rep" Nothing
|
||||
$
|
||||
ConstrainedType c1
|
||||
( ConstrainedType c2
|
||||
( fun (TypeVar "a")
|
||||
( fun (TypeVar "b")
|
||||
(TypeConstructor $ qname [ "Prim", "Boolean" ] "Boolean")
|
||||
)
|
||||
)
|
||||
)
|
||||
shape = shapeOfTypeQuery <$> parseTypeQuery query
|
||||
pure (shapeOfType type_) `shouldEqual` shape
|
||||
|
||||
suite "free variable counting" do
|
||||
describe "free variable counting" do
|
||||
|
||||
test "test #1" do
|
||||
it "test #1" do
|
||||
let input = "forall a. (a -> b) -> (b -> ((a -> b) -> c))"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 2
|
||||
|
||||
test "test #2" do
|
||||
it "test #2" do
|
||||
-- `b` is not bound on the left, `a` is not bound on the right
|
||||
let input = "(forall a. (a -> b)) -> forall b. (b -> a)"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 2
|
||||
|
||||
test "test #3" do
|
||||
it "test #3" do
|
||||
let input = "a -> forall a. a"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 1
|
||||
|
||||
test "test #4" do
|
||||
it "test #4" do
|
||||
let input = "(forall a. a) -> a"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 1
|
||||
|
||||
test "test #5" do
|
||||
it "test #5" do
|
||||
let input = "forall a. a -> a"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 0
|
||||
|
||||
test "test #6" do
|
||||
it "test #6" do
|
||||
let input = "a -> b -> c"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 3
|
||||
|
||||
test "test #7" do
|
||||
it "test #7" do
|
||||
let input = "forall m a. Monad m => a -> m a"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 0
|
||||
|
||||
test "test #8" do
|
||||
it "test #8" do
|
||||
let input = "Monad m => a -> m a"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 2
|
||||
|
||||
test "test #9" do
|
||||
it "test #9" do
|
||||
let input = "Monad m => a -> a"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 2
|
||||
|
||||
test "test #10" do
|
||||
it "test #10" do
|
||||
let input = "forall a. (forall a. a) a"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 0
|
||||
|
||||
test "test #11" do
|
||||
it "test #11" do
|
||||
let input = "forall a. (forall b. a) a"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 0
|
||||
|
||||
test "test #12" do
|
||||
it "test #12" do
|
||||
let input = "forall a. (forall b. a) a b"
|
||||
assertRight (countFreeVars <$> parseTypeQuery input) 1
|
||||
|
||||
suite "typeVarPenalty" do
|
||||
describe "typeVarPenalty" do
|
||||
|
||||
test "#0" do
|
||||
Assert.equal 0 (typeVarPenalty mempty)
|
||||
it "#0" do
|
||||
0 `shouldEqual` (typeVarPenalty mempty)
|
||||
|
||||
test "#1" do
|
||||
Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "b"
|
||||
, substitute "b" "a"
|
||||
])
|
||||
it "#1" do
|
||||
0 `shouldEqual`
|
||||
( typeVarPenalty $ l
|
||||
[ substitute "a" "b"
|
||||
, substitute "b" "a"
|
||||
]
|
||||
)
|
||||
|
||||
test "#2" do
|
||||
Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "b"
|
||||
, substitute "a" "b"
|
||||
, substitute "a" "b"
|
||||
])
|
||||
it "#2" do
|
||||
0 `shouldEqual`
|
||||
( typeVarPenalty $ l
|
||||
[ substitute "a" "b"
|
||||
, substitute "a" "b"
|
||||
, substitute "a" "b"
|
||||
]
|
||||
)
|
||||
|
||||
test "#3" do
|
||||
Assert.equal 1 (typeVarPenalty $ l [ substitute "a" "b"
|
||||
, substitute "a" "c"
|
||||
])
|
||||
it "#3" do
|
||||
1 `shouldEqual`
|
||||
( typeVarPenalty $ l
|
||||
[ substitute "a" "b"
|
||||
, substitute "a" "c"
|
||||
]
|
||||
)
|
||||
|
||||
test "#4" do
|
||||
Assert.equal 1 (typeVarPenalty $ l [ substitute "a" "b"
|
||||
, substitute "b" "a"
|
||||
, substitute "b" "c"
|
||||
])
|
||||
it "#4" do
|
||||
1 `shouldEqual`
|
||||
( typeVarPenalty $ l
|
||||
[ substitute "a" "b"
|
||||
, substitute "b" "a"
|
||||
, substitute "b" "c"
|
||||
]
|
||||
)
|
||||
|
||||
test "#5" do
|
||||
Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "b"
|
||||
, substitute "b" "c"
|
||||
, substitute "c" "a"
|
||||
])
|
||||
it "#5" do
|
||||
0 `shouldEqual`
|
||||
( typeVarPenalty $ l
|
||||
[ substitute "a" "b"
|
||||
, substitute "b" "c"
|
||||
, substitute "c" "a"
|
||||
]
|
||||
)
|
||||
|
||||
test "#6" do
|
||||
Assert.equal 2 (typeVarPenalty $ l [ substitute "a" "b"
|
||||
, substitute "a" "c"
|
||||
, substitute "a" "a"
|
||||
])
|
||||
it "#6" do
|
||||
2 `shouldEqual`
|
||||
( typeVarPenalty $ l
|
||||
[ substitute "a" "b"
|
||||
, substitute "a" "c"
|
||||
, substitute "a" "a"
|
||||
]
|
||||
)
|
||||
|
||||
test "#7" do
|
||||
Assert.equal 2 (typeVarPenalty $ l [ substitute "a" "a"
|
||||
, substitute "b" "a"
|
||||
, substitute "c" "a"
|
||||
])
|
||||
it "#7" do
|
||||
2 `shouldEqual`
|
||||
( typeVarPenalty $ l
|
||||
[ substitute "a" "a"
|
||||
, substitute "b" "a"
|
||||
, substitute "c" "a"
|
||||
]
|
||||
)
|
||||
|
||||
test "#8" do
|
||||
Assert.equal 4 (typeVarPenalty $ l [ substitute "a" "a"
|
||||
, substitute "b" "a"
|
||||
, substitute "c" "a"
|
||||
, substitute "a" "b"
|
||||
, substitute "a" "c"
|
||||
, substitute "a" "a"
|
||||
])
|
||||
it "#8" do
|
||||
4 `shouldEqual`
|
||||
( typeVarPenalty $ l
|
||||
[ substitute "a" "a"
|
||||
, substitute "b" "a"
|
||||
, substitute "c" "a"
|
||||
, substitute "a" "b"
|
||||
, substitute "a" "c"
|
||||
, substitute "a" "a"
|
||||
]
|
||||
)
|
||||
|
||||
test "#9" do
|
||||
Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "e"
|
||||
, substitute "b" "d"
|
||||
, substitute "c" "f"
|
||||
])
|
||||
it "#9" do
|
||||
0 `shouldEqual`
|
||||
( typeVarPenalty $ l
|
||||
[ substitute "a" "e"
|
||||
, substitute "b" "d"
|
||||
, substitute "c" "f"
|
||||
]
|
||||
)
|
||||
|
||||
suite "unification" do
|
||||
test "instantiation #0" do
|
||||
let mVarQuery = qVar "m"
|
||||
unitConstQuery = qConst "Unit"
|
||||
describe "unification" do
|
||||
it "instantiation #0" do
|
||||
let
|
||||
mVarQuery = qVar "m"
|
||||
unitConstQuery = qConst "Unit"
|
||||
|
||||
Assert.assert "instantiation #0" $
|
||||
(penalty unitConstQuery unitType < penalty mVarQuery unitType)
|
||||
shouldSatisfy
|
||||
(penalty unitConstQuery unitType)
|
||||
(_ < penalty mVarQuery unitType)
|
||||
|
||||
test "generalization #0" do
|
||||
let query = qVar "m"
|
||||
t1 = TypeVar "m"
|
||||
|
||||
Assert.assert "qeneralization #0" $
|
||||
(penalty query unitType > penalty query t1)
|
||||
it "generalization #0" do
|
||||
let
|
||||
query = qVar "m"
|
||||
t1 = TypeVar "m"
|
||||
|
||||
shouldSatisfy
|
||||
(penalty query unitType)
|
||||
(_ > penalty query t1)
|
||||
|
||||
l :: forall f. Foldable f => (forall a. f a -> List a)
|
||||
l = List.fromFoldable
|
||||
|
||||
nl
|
||||
:: forall t
|
||||
. Foldable t
|
||||
. Foldable t
|
||||
=> Functor t
|
||||
=> String
|
||||
-> t String
|
||||
@ -400,9 +551,12 @@ nl
|
||||
nl x rst = NonEmptyList.cons' (Identifier x) $ List.fromFoldable (rst <#> Identifier)
|
||||
|
||||
unitType :: Type
|
||||
unitType = TypeConstructor (QualifiedName { moduleNameParts: []
|
||||
, name: Identifier "Unit"
|
||||
})
|
||||
unitType = TypeConstructor
|
||||
( QualifiedName
|
||||
{ moduleNameParts: []
|
||||
, name: Identifier "Unit"
|
||||
}
|
||||
)
|
||||
|
||||
countFreeVars :: TypeQuery -> Int
|
||||
countFreeVars = getFreeVariables >>> Set.size
|
||||
|
Loading…
Reference in New Issue
Block a user