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

Fix everything except toppoki tests

Browse Source
This commit is contained in:
Vladimir Kalnitsky 2022-05-08 21:06:38 +04:00
parent 66bffd8d29
commit 7ef455f041
25 changed files with 498 additions and 325 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
package.json
View File

@ -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",

74
packages.dhall
View File

@ -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

3
spago.dhall
View File

@ -39,10 +39,9 @@
, "profunctor"
, "profunctor-lenses"
, "search-trie"
, "spec"
, "string-parsers"
, "strings"
, "test-unit"
, "toppokki"
, "transformers"
, "tuples"
, "unfoldable"

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

@ -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)

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

@ -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

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

@ -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_

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

@ -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")

2
src/Docs/Search/BrowserEngine.js
View File

@ -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) {

9
src/Docs/Search/IndexBuilder.js
View File

@ -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);
};
};

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

@ -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

2
src/Docs/Search/Loader.js
View File

@ -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) {

2
src/Docs/Search/ModuleIndex.js
View File

@ -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') {

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

@ -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")

2
src/Docs/Search/TypeIndex.js
View File

@ -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) {

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

@ -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

2
src/Docs/Search/TypeShape.js
View File

@ -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;

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

@ -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);

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

@ -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

10
test/Main.purs
View File

@ -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

25
test/Test/Declarations.purs
View File

@ -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: []

11
test/Test/Extra.purs
View File

@ -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

18
test/Test/IndexBuilder.purs
View File

@ -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)

18
test/Test/ModuleIndex.purs
View File

@ -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" ]
)

36
test/Test/TypeJson.purs
View File

@ -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]}
"""

556
test/Test/TypeQuery.purs
View File

@ -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