d502fce · rowtype-yoga/purescript-docs-search

git.iko.soy/rowtype-yoga/purescript-docs-search

on master help sign in

Wrap package scores and identifiers in newtypes

d502fceklntsky6 years ago

src/Docs/Search/App/SearchResults.purs+25−25

compare with master

unifiedsplit

@@ -6,7 +6,7 @@ import Docs.Search.BrowserEngine (PartialIndex, browserSearchEngine)

6import Docs.Search.Config (config)

7import Docs.Search.Declarations (DeclLevel(..), declLevelToHashAnchor)

8import Docs.Search.DocsJson (DataDeclType(..))

9−import Docs.Search.Engine (Result(..))

9+import Docs.Search.Engine (Result(..), packageInfoToString)

10import Docs.Search.Engine as Engine

11import Docs.Search.Extra (homePageFromRepository, (>#>))

12import Docs.Search.ModuleIndex (ModuleResult)

@@ -14,7 +14,7 @@ import Docs.Search.PackageIndex (PackageResult)

14import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))

15import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)

16import Docs.Search.TypeIndex (TypeIndex)

17−import Docs.Search.Types (ModuleName(..), packageInfoToString)

17+import Docs.Search.Types (ModuleName(..), Identifier(..))

19import Prelude

@@ -302,9 +302,9 @@ renderSearchResult markdownIt (SearchResult result) =

302 , HE.onClick $ const $ Just $ SearchResultClicked result.moduleName

303 , HP.href $

304 unwrap result.moduleName <> ".html#" <>

305− result.hashAnchor <> ":" <> result.name

305+ result.hashAnchor <> ":" <> unwrap result.name

306 ]

307− [ HH.text result.name ]

307+ [ HH.text $ unwrap result.name ]

308 ]

309 ]

310

@@ -341,7 +341,7 @@ renderSearchResult markdownIt (SearchResult result) =

341renderResultType

342 :: forall a rest

343 . { info :: ResultInfo

344− , name :: String

344+ , name :: Identifier

345 , moduleName :: ModuleName

346 | rest

347 }

@@ -373,7 +373,7 @@ renderResultType result =

373renderValueSignature

374 :: forall a rest

375 . { moduleName :: ModuleName

376− , name :: String

376+ , name :: Identifier

377 | rest

378 }

379 -> Type

@@ -381,7 +381,7 @@ renderValueSignature

381renderValueSignature result ty =

382 [ HH.a [ makeHref ValueLevel false result.moduleName result.name

383 , HE.onClick $ const $ Just $ SearchResultClicked result.moduleName ]

384− [ HH.text result.name ]

384+ [ HH.text $ unwrap result.name ]

385 , HH.text " :: "

386 , renderType ty ]

387

@@ -392,7 +392,7 @@ renderTypeClassSignature

392 , arguments :: Array TypeArgument

393 , superclasses :: Array Constraint

394 }

395− -> { name :: String, moduleName :: ModuleName | rest }

395+ -> { name :: Identifier, moduleName :: ModuleName | rest }

396 -> Array (HH.HTML a Action)

397renderTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName } =

398 [ keyword "class"

@@ -414,7 +414,7 @@ renderTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName

414 , HE.onClick $ const $ Just $

415 SearchResultClicked moduleName

416 ]

417− [ HH.text name ]

417+ [ HH.text $ unwrap name ]

418 , space

419 ] <> (

420 Array.intercalate [ space ] $

@@ -444,10 +444,10 @@ renderTypeClassMemberSignature

444 , typeClass :: QualifiedName

445 , typeClassArguments :: Array TypeArgument

446 }

447− -> { name :: String | rest }

447+ -> { name :: Identifier | rest }

448 -> Array (HH.HTML a Action)

449renderTypeClassMemberSignature { type: ty, typeClass, typeClassArguments } result =

450− [ HH.text result.name

450+ [ HH.text $ unwrap result.name

451 , HH.text " :: "

452 , renderType ty

453 ]

@@ -457,7 +457,7 @@ renderDataSignature

457 :: forall a rest

458 . { typeArguments :: Array TypeArgument

459 , dataDeclType :: DataDeclType }

460− -> { name :: String | rest }

460+ -> { name :: Identifier | rest }

461 -> Array (HH.HTML a Action)

462renderDataSignature { typeArguments, dataDeclType } { name } =

463 [ keyword

@@ -465,7 +465,7 @@ renderDataSignature { typeArguments, dataDeclType } { name } =

465 NewtypeDataDecl -> "newtype"

466 DataDataDecl -> "data"

467 , space

468− , HH.text name

468+ , HH.text $ unwrap name

469 , space

470 , HH.span_ $

471 Array.intercalate [ space ] $

@@ -478,12 +478,12 @@ renderTypeSynonymSignature

478 . { type :: Type

479 , arguments :: Array TypeArgument

480 }

481− -> { name :: String | rest }

481+ -> { name :: Identifier | rest }

482 -> Array (HH.HTML a Action)

483renderTypeSynonymSignature { type: ty, arguments } { name } =

484 [ keyword "type"

485 , space

486− , HH.text name

486+ , HH.text $ unwrap name

487 , space

488 , HH.span_ $

489 Array.intercalate [ space ] $

@@ -499,10 +499,10 @@ renderTypeArgument :: forall a. TypeArgument -> Array (HH.HTML a Action)

499renderTypeArgument (TypeArgument { name, mbKind }) =

500 case mbKind of

501 Nothing ->

502− [ HH.text name ]

502+ [ HH.text $ name ]

503 Just kind ->

504 [ HH.text "("

505− , HH.text name

505+ , HH.text $ name

506 , HH.text " :: "

507 , renderKind kind

508 , HH.text ")"

@@ -522,14 +522,14 @@ renderType = case _ of

522

523 TypeApp (TypeApp (TypeConstructor

524 (QualifiedName { moduleNameParts: [ "Prim" ]

525− , name: "Function" })) t1) t2 ->

525+ , name: Identifier "Function" })) t1) t2 ->

526 HH.span_ [ renderType t1

527 , syntax " -> "

528 , renderType t2

529 ]

530

531 TypeApp (TypeConstructor (QualifiedName { moduleNameParts: [ "Prim" ]

532− , name: "Record" }))

532+ , name: Identifier "Record" }))

533 row ->

534 renderRow false row

535

@@ -624,7 +624,7 @@ renderRow asRow =

624

625 ( Array.intercalate [ HH.text ", " ] $ Array.fromFoldable $ rows <#>

626 \entry ->

627− [ HH.span_ [ HH.text $ entry.row <> " :: "

627+ [ HH.span_ [ HH.text $ unwrap entry.row <> " :: "

628 , renderType entry.ty ] ]

629 ) <>

630

@@ -637,7 +637,7 @@ renderRow asRow =

637 closing = if asRow then " )" else " }"

638

639 primRecord :: QualifiedName

640− primRecord = QualifiedName { moduleNameParts: [ "Prim" ], name: "Record" }

640+ primRecord = QualifiedName { moduleNameParts: [ "Prim" ], name: Identifier "Record" }

641

642

643renderConstraint

@@ -658,13 +658,13 @@ renderQualifiedName

658 -> HH.HTML a Action

659renderQualifiedName isInfix level (QualifiedName { moduleNameParts, name })

660 = if isBuiltIn then

661− HH.text name

661+ HH.text $ unwrap name

662 else

663 HH.a [ HE.onClick $ const $ Just $

664 SearchResultClicked $ moduleName

665 , makeHref level isInfix moduleName name

666 ]

667− [ HH.text name ]

667+ [ HH.text $ unwrap name ]

668 where

669 moduleName = ModuleName $ Array.intercalate "." $ moduleNameParts

670 isBuiltIn = moduleNameParts !! 0 == Just "Prim"

@@ -686,13 +686,13 @@ makeHref

686 . DeclLevel

687 -> Boolean

688 -> ModuleName

689− -> String

689+ -> Identifier

690 -> HH.IProp ( href :: String | rest ) t

691makeHref level isInfix moduleName name =

692 HP.href $

693 unwrap moduleName <> ".html#" <>

694 declLevelToHashAnchor level <> ":" <>

695− if isInfix then "type (" <> name <> ")" else name

695+ if isInfix then "type (" <> unwrap name <> ")" else unwrap name

696

697

698keyword

src/Docs/Search/Declarations.purs+4−4

@@ -4,7 +4,7 @@ import Docs.Search.DocsJson (ChildDeclType(..), ChildDeclaration(..), DeclType(.

4import Docs.Search.Score (Scores, getPackageScore, getPackageScoreForPackageName)

5import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))

6import Docs.Search.TypeDecoder (Constraint(..), QualifiedName(..), Type(..), Kind, joinForAlls)

7−import Docs.Search.Types (ModuleName(..), PackageName(..), PackageInfo(..))

7+import Docs.Search.Types (ModuleName(..), PackageName(..), PackageInfo(..), Identifier(..))

9import Prelude

@@ -83,14 +83,14 @@ resultsForDeclaration scores moduleName indexEntry@(Declaration entry) =

83 case mkInfo declLevel indexEntry of

84 Nothing -> mempty

85 Just info' ->

86− let result = SearchResult { name: title

86+ let result = SearchResult { name: Identifier title

87 , comments

88 , hashAnchor: declLevelToHashAnchor declLevel

89 , moduleName

90 , sourceSpan

91 , packageInfo

92 , score:

93− fromMaybe 0 $ getPackageScoreForPackageName scores <$> mbPackageName

93+ fromMaybe zero $ getPackageScoreForPackageName scores <$> mbPackageName

94 , info: info'

95 }

96 in

@@ -219,7 +219,7 @@ resultsForChildDeclaration scores packageInfo moduleName parentResult

219 child@(ChildDeclaration { title, info, comments, mbSourceSpan })

220 | Just resultInfo <- mkChildInfo parentResult child =

221 { path: title

222− , result: SearchResult { name: title

222+ , result: SearchResult { name: Identifier title

223 , comments

224 -- `ChildDeclaration`s are always either data

225 -- constructors, type class members or instances.

src/Docs/Search/Engine.purs+11−4

@@ -5,7 +5,7 @@ import Docs.Search.PackageIndex (PackageIndex, PackageResult)

5import Docs.Search.Score (Scores)

6import Docs.Search.SearchResult (SearchResult, typeOfResult)

7import Docs.Search.TypeQuery (TypeQuery(..), parseTypeQuery, penalty)

8−import Docs.Search.Types (PackageInfo(..), PackageName(..), ModuleName(..))

8+import Docs.Search.Types (PackageInfo(..), ModuleName(..), PackageName(..), PackageScore)

10import Prelude

@@ -66,7 +66,7 @@ data Result

66 | MdlResult ModuleResult

69−getResultScore :: Result -> Int

69+getResultScore :: Result -> PackageScore

70getResultScore (DeclResult r) = (unwrap r).score

71getResultScore (TypeResult r) = (unwrap r).score

72getResultScore (PackResult r) = r.score

@@ -88,8 +88,8 @@ getResultModuleName (MdlResult r) = r.name

90getResultName :: Result -> String

91−getResultName (DeclResult r) = (unwrap r).name

91+getResultName (DeclResult r) = unwrap (unwrap r).name

92−getResultName (TypeResult r) = (unwrap r).name

92+getResultName (TypeResult r) = unwrap (unwrap r).name

93getResultName (PackResult r) = unwrap r.name

94getResultName (MdlResult r) = unwrap r.name

@@ -158,3 +158,10 @@ sortByDistance

158 -> Array SearchResult

159sortByDistance typeQuery =

160 Array.sortWith (map (penalty typeQuery) <<< typeOfResult)

161+

162+

163+packageInfoToString :: PackageInfo -> String

164+packageInfoToString (Package (PackageName p)) = p

165+packageInfoToString Builtin = "<builtin>"

166+packageInfoToString LocalPackage = "<local package>"

167+packageInfoToString UnknownPackage = "<unknown package>"

src/Docs/Search/Interactive.purs+25−25

@@ -3,7 +3,7 @@ module Docs.Search.Interactive where

4import Docs.Search.Declarations (Declarations, mkDeclarations)

5import Docs.Search.DocsJson (DataDeclType(..))

6−import Docs.Search.Engine (mkEngineState, Result(..))

6+import Docs.Search.Engine (mkEngineState, packageInfoToString, Result(..))

7import Docs.Search.Engine as Engine

8import Docs.Search.Extra (listToString, stringToList, (>#>))

9import Docs.Search.IndexBuilder as IndexBuilder

@@ -16,7 +16,7 @@ import Docs.Search.Terminal (bold, cyan, green, yellow)

16import Docs.Search.TypeDecoder (Constraint, FunDeps, Kind, QualifiedName, Type, TypeArgument)

17import Docs.Search.TypeIndex (resultsWithTypes)

18import Docs.Search.TypePrinter (keyword, showConstraint, showFunDeps, showKind, showType, showTypeArgument, space, syntax)

19−import Docs.Search.Types (PackageName, ModuleName, PackageInfo, packageInfoToString)

19+import Docs.Search.Types (ModuleName, PackageInfo, Identifier)

21import Prelude

@@ -150,19 +150,19 @@ showModuleResult { name, package } =

150 bold (cyan "module") <> " " <> bold (green $ unwrap name)

151

152

153−showSignature ::

153+showSignature

154− forall rest.

154+ :: forall rest

155− { name :: String

155+ . { name :: Identifier

156− , moduleName :: ModuleName

156+ , moduleName :: ModuleName

157− , packageInfo :: PackageInfo

157+ , packageInfo :: PackageInfo

158− , info :: ResultInfo

158+ , info :: ResultInfo

159− | rest

159+ | rest

160− }

160+ }

161 -> String

162showSignature result@{ name, info } =

163 case info of

164 ValueResult { type: ty } ->

165− yellow name <> syntax " :: " <> showType ty

165+ yellow (unwrap name) <> syntax " :: " <> showType ty

166

167 TypeClassResult info' ->

168 showTypeClassSignature info' result

@@ -180,9 +180,9 @@ showSignature result@{ name, info } =

180 showExternDataSignature info' result

181

182 ValueAliasResult ->

183− yellow ("(" <> name <> ")")

183+ yellow ("(" <> unwrap name <> ")")

184

185− _ -> yellow name

185+ _ -> yellow $ unwrap name

186

187

188showTypeClassSignature

@@ -191,7 +191,7 @@ showTypeClassSignature

191 , arguments :: Array TypeArgument

192 , superclasses :: Array Constraint

193 }

194− -> { name :: String, moduleName :: ModuleName | rest }

194+ -> { name :: Identifier, moduleName :: ModuleName | rest }

195 -> String

196showTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName } =

197

@@ -210,7 +210,7 @@ showTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName }

210 syntax "<="

211 ) <>

212 space <>

213− yellow name <>

213+ yellow (unwrap name) <>

214 space <> (

215 Array.intercalate space $

216 arguments <#> showTypeArgument

@@ -221,14 +221,14 @@ showTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName }

221

222showTypeClassMemberSignature

223 :: forall rest

224− . { type :: Type

224+ . { "type" :: Type

225 , typeClass :: QualifiedName

226 , typeClassArguments :: Array TypeArgument

227 }

228− -> { name :: String | rest }

228+ -> { name :: Identifier | rest }

229 -> String

230−showTypeClassMemberSignature { type: ty, typeClass, typeClassArguments } result =

230+showTypeClassMemberSignature { "type": ty, typeClass, typeClassArguments } result =

231− yellow result.name <>

231+ yellow (unwrap result.name) <>

232 syntax " :: " <>

233 showType ty

234

@@ -237,7 +237,7 @@ showDataSignature

237 :: forall rest

238 . { typeArguments :: Array TypeArgument

239 , dataDeclType :: DataDeclType }

240− -> { name :: String | rest }

240+ -> { name :: Identifier | rest }

241 -> String

242showDataSignature { typeArguments, dataDeclType } { name } =

243 ( keyword

@@ -246,7 +246,7 @@ showDataSignature { typeArguments, dataDeclType } { name } =

246 DataDataDecl -> "data"

247 ) <>

248 space <>

249− yellow name <>

249+ yellow (unwrap name) <>

250 space <> (

251 Array.intercalate space $

252 typeArguments <#> showTypeArgument

@@ -258,12 +258,12 @@ showTypeSynonymSignature

258 . { type :: Type

259 , arguments :: Array TypeArgument

260 }

261− -> { name :: String | rest }

261+ -> { name :: Identifier | rest }

262 -> String

263showTypeSynonymSignature { type: ty, arguments } { name } =

264 keyword "type" <>

265 space <>

266− yellow name <>

266+ yellow (unwrap name) <>

267 space <> (

268 Array.intercalate space $

269 arguments <#> showTypeArgument

@@ -277,12 +277,12 @@ showTypeSynonymSignature { type: ty, arguments } { name } =

277showExternDataSignature

278 :: forall rest

279 . { kind :: Kind }

280− -> { name :: String | rest }

280+ -> { name :: Identifier | rest }

281 -> String

282showExternDataSignature { kind } { name } =

283 keyword "foreign data" <>

284 space <>

285− yellow name <>

285+ yellow (unwrap name) <>

286 space <>

287 syntax " :: " <>

288 showKind kind

src/Docs/Search/ModuleIndex.purs+5−4

@@ -3,9 +3,9 @@ module Docs.Search.ModuleIndex where

3import Docs.Search.Config (config)

4import Docs.Search.Declarations (Declarations(..))

5import Docs.Search.SearchResult (SearchResult(..))

6−import Docs.Search.Types (ModuleName, PackageName, PackageInfo(..))

6+import Docs.Search.Types (ModuleName, PackageName, PackageInfo(..), PackageScore)

7import Docs.Search.Extra (stringToList)

8−import Docs.Search.Score (Scores)

8+import Docs.Search.Score (Scores, getPackageScoreForPackageName)

10import Prelude

@@ -50,7 +50,7 @@ type ModuleIndex = { packageModules :: Map PackageName (Set ModuleName)

50type ModuleResult

51 = { name :: ModuleName

52 , package :: PackageName

53− , score :: Int

53+ , score :: PackageScore

54 }

@@ -86,7 +86,8 @@ queryModuleIndex scores { index, modulePackages } query =

86 Array.nub <#>

87 (\name -> do

88 package <- Map.lookup name modulePackages

89− pure { name, package, score: fromMaybe 0 $ Map.lookup package scores }) #

89+ pure { name, package

90+ , score: getPackageScoreForPackageName scores package }) #

90 Array.catMaybes

91 Array.catMaybes

src/Docs/Search/PackageIndex.purs+2−2

@@ -3,7 +3,7 @@ module Docs.Search.PackageIndex where

3import Docs.Search.Config (config)

4import Docs.Search.Extra (stringToList)

5import Docs.Search.Score (Scores, getPackageScoreForPackageName, normalizePackageName)

6−import Docs.Search.Types (PackageName, RawPackageName(..))

6+import Docs.Search.Types (PackageName, RawPackageName(..), PackageScore)

8import Prelude

@@ -26,7 +26,7 @@ import Web.Bower.PackageMeta (PackageMeta(..))

26type PackageResult

27 = { name :: PackageName

28 , description :: Maybe String

29− , score :: Int

29+ , score :: PackageScore

30 , dependencies :: Array PackageName

31 , repository :: Maybe String

32 }

src/Docs/Search/Score.purs+9−9

@@ -1,6 +1,6 @@

1module Docs.Search.Score where

3−import Docs.Search.Types (RawPackageName(..), PackageName(..), PackageInfo(..))

3+import Docs.Search.Types (RawPackageName(..), PackageName(..), PackageInfo(..), PackageScore(..))

5import Prelude

@@ -13,7 +13,7 @@ import Data.String.CodeUnits as String

13import Web.Bower.PackageMeta (Dependencies, PackageMeta)

16−type Scores = Map PackageName Int

16+type Scores = Map PackageName PackageScore

18normalizePackageName :: RawPackageName -> PackageName

19normalizePackageName (RawPackageName p) =

@@ -35,18 +35,18 @@ mkScores =

35 updateScoresFor :: Dependencies -> Scores -> Scores

36 updateScoresFor deps scores =

37 Array.foldr

38− (\dep -> Map.insertWith add dep 1)

38+ (\dep -> Map.insertWith add dep one)

39 scores

40 (deps # unwrap >>> map (_.packageName >>> RawPackageName >>> normalizePackageName))

43−getPackageScore :: Scores -> PackageInfo -> Int

43+getPackageScore :: Scores -> PackageInfo -> PackageScore

44getPackageScore scores = case _ of

45 Package p -> getPackageScoreForPackageName scores p

46− Builtin -> 100000

46+ Builtin -> PackageScore 100000

47− LocalPackage -> 200000

47+ LocalPackage -> PackageScore 200000

48− UnknownPackage -> 0

48+ UnknownPackage -> zero

51−getPackageScoreForPackageName :: Scores -> PackageName -> Int

51+getPackageScoreForPackageName :: Scores -> PackageName -> PackageScore

52−getPackageScoreForPackageName scores p = fromMaybe 0 $ Map.lookup p scores

52+getPackageScoreForPackageName scores p = fromMaybe zero $ Map.lookup p scores

src/Docs/Search/SearchResult.purs+3−3

@@ -2,7 +2,7 @@ module Docs.Search.SearchResult where

3import Docs.Search.DocsJson (DataDeclType)

4import Docs.Search.TypeDecoder (Constraint, FunDeps, Kind, QualifiedName, Type, TypeArgument)

5−import Docs.Search.Types (PackageName, PackageInfo, ModuleName)

5+import Docs.Search.Types (ModuleName, PackageInfo, Identifier, PackageScore)

7import Prelude

@@ -57,12 +57,12 @@ typeOf _ = Nothing

57-- | Common metadata for all types of search results.

58newtype SearchResult

59 = SearchResult

60− { name :: String

60+ { name :: Identifier

61 , comments :: Maybe String

62 , hashAnchor :: String

63 , moduleName :: ModuleName

64 , packageInfo :: PackageInfo

65− , score :: Int

65+ , score :: PackageScore

66 , sourceSpan :: Maybe { start :: Array Int

67 , end :: Array Int

68 , name :: String

src/Docs/Search/TypeDecoder.purs+6−4

@@ -1,5 +1,7 @@

1module Docs.Search.TypeDecoder where

3+import Docs.Search.Types (Identifier)

3import Prelude

5import Prelude

5import Control.Alt ((<|>))

7import Control.Alt ((<|>))

@@ -26,7 +28,7 @@ instance showQualifiedName :: Show QualifiedName where

27newtype QualifiedName

29newtype QualifiedName

28 = QualifiedName { moduleNameParts :: Array String

30 = QualifiedName { moduleNameParts :: Array String

29− , name :: String

31+ , name :: Identifier

30 }

32 }

32instance decodeJsonQualifiedName :: DecodeJson QualifiedName where

34instance decodeJsonQualifiedName :: DecodeJson QualifiedName where

@@ -149,7 +151,7 @@ data Type

149 -- | An empty row

151 -- | An empty row

150 | REmpty

152 | REmpty

151 -- | A non-empty row

153 -- | A non-empty row

152− | RCons String Type Type

154+ | RCons Identifier Type Type

153 {-

155 {-

154 -- | A type with a kind annotation

156 -- | A type with a kind annotation

155 | Kinded Type Kind

157 | Kinded Type Kind

@@ -412,7 +414,7 @@ joinForAlls ty = go Nil ty

412 go ({ name, mbKind } : acc) ty'

414 go ({ name, mbKind } : acc) ty'

413 go acc ty' = { binders: acc, ty: ty' }

415 go acc ty' = { binders: acc, ty: ty' }

414

416

415−joinRows :: Type -> { rows :: List { row :: String

417+joinRows :: Type -> { rows :: List { row :: Identifier

416 , ty :: Type

418 , ty :: Type

417 }

419 }

418 , ty :: Maybe Type }

420 , ty :: Maybe Type }

@@ -428,7 +430,7 @@ joinRows = go Nil

428 }

430 }

429

431

430-- | Only returns a list of type class names (lists of arguments are omitted).

432-- | Only returns a list of type class names (lists of arguments are omitted).

431−joinConstraints :: Type -> { constraints :: List String

433+joinConstraints :: Type -> { constraints :: List Identifier

432 , ty :: Type }

434 , ty :: Type }

433joinConstraints = go Nil

435joinConstraints = go Nil

434 where

436 where

src/Docs/Search/TypePrinter.purs+7−5

@@ -5,10 +5,12 @@ import Prelude

5import Docs.Search.Extra ((>#>))

6import Docs.Search.Terminal (cyan)

7import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)

8+import Docs.Search.Types (Identifier(..))

9−import Data.Maybe (Maybe(..), fromMaybe)

10import Data.Array as Array

11import Data.List as List

12+import Data.Maybe (Maybe(..), fromMaybe)

13+import Data.Newtype (unwrap)

14-- | A pretty-printer for types, for TTY with colors.

16-- | A pretty-printer for types, for TTY with colors.

@@ -22,13 +24,13 @@ showType = case _ of

23 TypeApp (TypeApp (TypeConstructor

25 TypeApp (TypeApp (TypeConstructor

24 (QualifiedName { moduleNameParts: [ "Prim" ]

26 (QualifiedName { moduleNameParts: [ "Prim" ]

25− , name: "Function" }))

27+ , name: Identifier "Function" }))

26 t1)

28 t1)

27 t2 ->

29 t2 ->

28 showType t1 <> syntax " -> " <> showType t2

30 showType t1 <> syntax " -> " <> showType t2

30 TypeApp (TypeConstructor (QualifiedName { moduleNameParts: [ "Prim" ]

32 TypeApp (TypeConstructor (QualifiedName { moduleNameParts: [ "Prim" ]

31− , name: "Record" }))

33+ , name: Identifier "Record" }))

32 row ->

34 row ->

33 showRow false row

35 showRow false row

@@ -89,7 +91,7 @@ showQualifiedName

89 :: QualifiedName

91 :: QualifiedName

90 -> String

92 -> String

91showQualifiedName (QualifiedName { name })

93showQualifiedName (QualifiedName { name })

92− = name

94+ = unwrap name

95showRow

97showRow

@@ -107,7 +109,7 @@ showRow asRow =

107 opening <>

109 opening <>

108 ( Array.intercalate ", " $ Array.fromFoldable $ rows <#>

110 ( Array.intercalate ", " $ Array.fromFoldable $ rows <#>

109 \entry ->

111 \entry ->

110− entry.row <> syntax " :: " <> showType entry.ty

112+ unwrap entry.row <> syntax " :: " <> showType entry.ty

111 ) <>

113 ) <>

112

114

113 (ty >#> \ty' -> " | " <> showType ty') <>

115 (ty >#> \ty' -> " | " <> showType ty') <>

src/Docs/Search/TypeQuery.purs+33−28

@@ -13,6 +13,7 @@ where

13import Docs.Search.Config (config)

14import Docs.Search.Extra (foldl1, foldr1)

15import Docs.Search.TypeDecoder (QualifiedName(..), Type(..), joinConstraints, joinRows)

16+import Docs.Search.Types (Identifier(..))

17import Prelude

18import Prelude

@@ -41,13 +42,13 @@ import Text.Parsing.StringParser.Combinators (fix, sepBy, sepBy1, sepEndBy, sepE

41-- | We need type queries because we don't have a full-featured type parser

42-- | We need type queries because we don't have a full-featured type parser

42-- | available.

43-- | available.

43data TypeQuery

44data TypeQuery

44− = QVar String

45+ = QVar Identifier

45− | QConst String

46+ | QConst Identifier

46 | QFun TypeQuery TypeQuery

47 | QFun TypeQuery TypeQuery

47 | QApp TypeQuery TypeQuery

48 | QApp TypeQuery TypeQuery

48− | QForAll (NonEmptyList String) TypeQuery

49+ | QForAll (NonEmptyList Identifier) TypeQuery

49− | QConstraint String (List TypeQuery) TypeQuery

50+ | QConstraint Identifier (List TypeQuery) TypeQuery

50− | QRow (List (Tuple String TypeQuery))

51+ | QRow (List (Tuple Identifier TypeQuery))

52derive instance eqTypeQuery :: Eq TypeQuery

53derive instance eqTypeQuery :: Eq TypeQuery

53derive instance genericTypeQuery :: Generic TypeQuery _

54derive instance genericTypeQuery :: Generic TypeQuery _

@@ -69,7 +70,8 @@ typeQueryParser = fix \typeQuery ->

70 row = string "(" *> rowFields <* string ")"

71 row = string "(" *> rowFields <* string ")"

73+ record = QApp (QConst $ Identifier "Record") <$>

72− record = QApp (QConst "Record") <$> (string "{" *> rowFields <* string "}")

74+ (string "{" *> rowFields <* string "}")

74 binders =

76 binders =

75 string "forall" *> some space *> sepEndBy1 ident skipSpaces <* string "." <* skipSpaces

77 string "forall" *> some space *> sepEndBy1 ident skipSpaces <* string "." <* skipSpaces

@@ -111,32 +113,32 @@ concrete :: Parser TypeQuery

111concrete =

113concrete =

112 QConst <$> upperCaseIdent

114 QConst <$> upperCaseIdent

113

115

114−ident :: Parser String

116+ident :: Parser Identifier

115ident = do

117ident = do

116 head <- anyLetter

118 head <- anyLetter

117 rest <- Array.many (alphaNum <|> char '\'')

119 rest <- Array.many (alphaNum <|> char '\'')

118− pure $ fromCharArray $ pure head <> rest

120+ pure $ Identifier <$> fromCharArray $ pure head <> rest

119

121

120−upperCaseIdent :: Parser String

122+upperCaseIdent :: Parser Identifier

121upperCaseIdent = do

123upperCaseIdent = do

122 head <- upperCaseChar

124 head <- upperCaseChar

123 rest <- Array.many (alphaNum <|> char '\'')

125 rest <- Array.many (alphaNum <|> char '\'')

124− pure $ fromCharArray $ pure head <> rest

126+ pure $ Identifier $ fromCharArray $ pure head <> rest

125

127

126−lowerCaseIdent :: Parser String

128+lowerCaseIdent :: Parser Identifier

127lowerCaseIdent = do

129lowerCaseIdent = do

128 head <- lowerCaseChar

130 head <- lowerCaseChar

129 rest <- Array.many (alphaNum <|> char '\'')

131 rest <- Array.many (alphaNum <|> char '\'')

130− pure $ fromCharArray $ pure head <> rest

132+ pure $ Identifier $ fromCharArray $ pure head <> rest

131

133

132space :: Parser Char

134space :: Parser Char

133space = char ' '

135space = char ' '

134

136

135

137

136-- | Used only in `getFreeVariables`.

138-- | Used only in `getFreeVariables`.

137−data FreeVarCounterQueueEntry = Unbind (Set.Set String) | Next TypeQuery

139+data FreeVarCounterQueueEntry = Unbind (Set.Set Identifier) | Next TypeQuery

138

140

139−getFreeVariables :: TypeQuery -> Set.Set String

141+getFreeVariables :: TypeQuery -> Set.Set Identifier

140getFreeVariables query = go Set.empty Set.empty (List.singleton $ Next query)

142getFreeVariables query = go Set.empty Set.empty (List.singleton $ Next query)

141 where

143 where

142 insertIfUnbound bound var free =

144 insertIfUnbound bound var free =

@@ -172,11 +174,11 @@ getFreeVariables query = go Set.empty Set.empty (List.singleton $ Next query)

172

174

173

175

174data Substitution

176data Substitution

175− = Instantiate String Type

177+ = Instantiate Identifier Type

176− | Match String String

178+ | Match Identifier Identifier

177− | Generalize TypeQuery String

179+ | Generalize TypeQuery Identifier

178− | Substitute String String

180+ | Substitute Identifier Identifier

179− | MatchConstraints (Set String) (Set String)

181+ | MatchConstraints (Set Identifier) (Set Identifier)

180 | MissingConstraint

182 | MissingConstraint

181 | ExcessiveConstraint

183 | ExcessiveConstraint

182 | RowsMismatch Int Int

184 | RowsMismatch Int Int

@@ -225,9 +227,9 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ })

225

227

226 -- * Type variables

228 -- * Type variables

227 go acc ({ q: QVar q, t: TypeVar v } : rest) =

229 go acc ({ q: QVar q, t: TypeVar v } : rest) =

228− go (Substitute q v : acc) rest

230+ go (Substitute q (Identifier v) : acc) rest

229 go acc ({ q, t: TypeVar v } : rest ) =

231 go acc ({ q, t: TypeVar v } : rest ) =

230− go (Generalize q v : acc) rest

232+ go (Generalize q (Identifier v) : acc) rest

231 go acc ({ q: QVar v, t } : rest) =

233 go acc ({ q: QVar v, t } : rest) =

232 go (Instantiate v t : acc) rest

234 go (Instantiate v t : acc) rest

233

235

@@ -249,16 +251,16 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ })

249 go acc ({ q: QFun q1 q2

251 go acc ({ q: QFun q1 q2

250 , t: TypeApp (TypeApp (TypeConstructor

252 , t: TypeApp (TypeApp (TypeConstructor

251 (QualifiedName { moduleNameParts: [ "Prim" ]

253 (QualifiedName { moduleNameParts: [ "Prim" ]

252− , name: "Function" })) t1) t2 } : rest) =

254+ , name: Identifier "Function" })) t1) t2 } : rest) =

253 go acc ({ q: q1, t: t1 } : { q: q2, t: t2 } : rest)

255 go acc ({ q: q1, t: t1 } : { q: q2, t: t2 } : rest)

254 go acc ({ q: q@(QFun q1 q2), t } : rest) =

256 go acc ({ q: q@(QFun q1 q2), t } : rest) =

255 go (Mismatch q t : acc) rest

257 go (Mismatch q t : acc) rest

256

258

257 -- * Rows

259 -- * Rows

258− go acc ({ q: QApp (QConst "Record") (QRow qRows)

260+ go acc ({ q: QApp (QConst (Identifier "Record")) (QRow qRows)

259 , t: TypeApp (TypeConstructor

261 , t: TypeApp (TypeConstructor

260 (QualifiedName { moduleNameParts: [ "Prim" ]

262 (QualifiedName { moduleNameParts: [ "Prim" ]

261− , name: "Record" })) row } : rest) =

263+ , name: Identifier "Record" })) row } : rest) =

262 let { rows, ty } = joinRows row

264 let { rows, ty } = joinRows row

263 qRowsLength = List.length qRows

265 qRowsLength = List.length qRows

264 rowsLength = List.length rows in

266 rowsLength = List.length rows in

@@ -319,8 +321,11 @@ typeVarPenalty substs =

319 insertion v1 v2 = Map.insertWith append v1 (Set.singleton v2)

321 insertion v1 v2 = Map.insertWith append v1 (Set.singleton v2)

320

322

321 varSubstMapWith

323 varSubstMapWith

322− :: (String -> String -> Map String (Set String) -> Map String (Set String))

324+ :: (Identifier ->

323− -> Map String (Set String)

325+ Identifier ->

326+ Map Identifier (Set Identifier) ->

327+ Map Identifier (Set Identifier))

328+ -> Map Identifier (Set Identifier)

324 varSubstMapWith f =

329 varSubstMapWith f =

325 List.foldr (case _ of

330 List.foldr (case _ of

326 Substitute v1 v2 ->

331 Substitute v1 v2 ->

@@ -363,7 +368,7 @@ mismatchPenalty = go 0

363

368

364

369

365-- | Only returns a list of type class names (lists of arguments are omitted).

370-- | Only returns a list of type class names (lists of arguments are omitted).

366−joinQueryConstraints :: TypeQuery -> { constraints :: List String

371+joinQueryConstraints :: TypeQuery -> { constraints :: List Identifier

367 , ty :: TypeQuery }

372 , ty :: TypeQuery }

368joinQueryConstraints = go Nil

373joinQueryConstraints = go Nil

369 where

374 where

@@ -408,7 +413,7 @@ typeSize = go 0 <<< List.singleton

408 go (n + 1) rest

413 go (n + 1) rest

409 go n (TypeApp (TypeApp (TypeConstructor

414 go n (TypeApp (TypeApp (TypeConstructor

410 (QualifiedName { moduleNameParts: [ "Prim" ]

415 (QualifiedName { moduleNameParts: [ "Prim" ]

411− , name: "Function" })) t1) t2 : rest) =

416+ , name: Identifier "Function" })) t1) t2 : rest) =

412 go (n + 1) (t1 : t2 : rest)

417 go (n + 1) (t1 : t2 : rest)

413 go n (TypeApp q1 q2 : rest) =

418 go n (TypeApp q1 q2 : rest) =

414 go (n + 1) (q1 : q2 : rest)

419 go (n + 1) (q1 : q2 : rest)

src/Docs/Search/TypeShape.purs+2−1

@@ -5,6 +5,7 @@ module Docs.Search.TypeShape where

6import Docs.Search.TypeDecoder (QualifiedName(..), Type(..), joinForAlls, joinRows)

7import Docs.Search.TypeQuery (TypeQuery(..), getFreeVariables)

8+import Docs.Search.Types (Identifier(..))

9import Prelude

10import Prelude

@@ -102,7 +103,7 @@ shapeOfType ty = List.reverse $ go (pure ty) Nil

102 go rest (PVar : acc)

103 go rest (PVar : acc)

103

104

104 TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"]

105 TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"]

105− , name: "Function" })) t1) t2 ->

106+ , name: Identifier "Function" })) t1) t2 ->

106 go (t1 : t2 : rest) (PFun : acc)

107 go (t1 : t2 : rest) (PFun : acc)

107

108

108 TypeConstructor (QualifiedName { name }) ->

109 TypeConstructor (QualifiedName { name }) ->

src/Docs/Search/Types.purs+22−5

@@ -11,6 +11,17 @@ import Data.Generic.Rep.Show (genericShow)

11import Data.Newtype (class Newtype)

14+newtype Identifier = Identifier String

15+

16+derive instance newtypeIdentifier :: Newtype Identifier _

17+derive instance genericIdentifier :: Generic Identifier _

18+derive newtype instance eqIdentifier :: Eq Identifier

19+derive newtype instance ordIdentifier :: Ord Identifier

20+derive newtype instance showIdentifier :: Show Identifier

21+derive newtype instance decodeJsonIdentifier :: DecodeJson Identifier

22+derive newtype instance encodeJsonIdentifier :: EncodeJson Identifier

23+

24+

14newtype ModuleName = ModuleName String

25newtype ModuleName = ModuleName String

16derive instance newtypeModuleName :: Newtype ModuleName _

27derive instance newtypeModuleName :: Newtype ModuleName _

@@ -52,8 +63,14 @@ instance decodeJsonPackageInfo :: DecodeJson PackageInfo where

52instance encodeJsonPackageInfo :: EncodeJson PackageInfo where

63instance encodeJsonPackageInfo :: EncodeJson PackageInfo where

53 encodeJson = genericEncodeJson

64 encodeJson = genericEncodeJson

55−packageInfoToString :: PackageInfo -> String

66+newtype PackageScore = PackageScore Int

56−packageInfoToString (Package (PackageName p)) = p

67+

57−packageInfoToString Builtin = "<builtin>"

68+derive instance newtypePackageScore :: Newtype PackageScore _

58−packageInfoToString LocalPackage = "<local package>"

69+derive instance genericPackageScore :: Generic PackageScore _

59−packageInfoToString UnknownPackage = "<unknown package>"

70+derive newtype instance eqPackageScore :: Eq PackageScore

71+derive newtype instance ordPackageScore :: Ord PackageScore

72+derive newtype instance semiringPackageScore :: Semiring PackageScore

73+derive newtype instance ringPackageScore :: Ring PackageScore

74+derive newtype instance showPackageScore :: Show PackageScore

75+derive newtype instance decodeJsonPackageScore :: DecodeJson PackageScore

76+derive newtype instance encodeJsonPackageScore :: EncodeJson PackageScore

test/Main.purs+23−55

@@ -3,6 +3,7 @@ module Test.Main where

3import Prelude

5import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..))

6+import Docs.Search.Types

6import Test.TypeQuery as TypeQuery

7import Test.TypeQuery as TypeQuery

7import Test.IndexBuilder as IndexBuilder

8import Test.IndexBuilder as IndexBuilder

8import Test.Declarations as Declarations

9import Test.Declarations as Declarations

@@ -67,10 +68,7 @@ mainTest = do

67 """

68 """

69 assertRight (decodeJson qualifiedName)

70 assertRight (decodeJson qualifiedName)

70− (QualifiedName { moduleNameParts: ["Prim"]

71+ (qualified ["Prim"] "Type")

71− , name: "Type"

72− }

73− )

75 test "NamedKind" do

73 test "NamedKind" do

76 let namedKind = mkJson """

74 let namedKind = mkJson """

@@ -87,10 +85,7 @@ mainTest = do

87 """

85 """

89 assertRight (decodeJson namedKind)

87 assertRight (decodeJson namedKind)

90− (NamedKind $ QualifiedName { moduleNameParts: ["Prim"]

88+ (NamedKind $ qualified ["Prim"] "Type")

91− , name: "Type"

92− }

93− )

95 test "Row" do

90 test "Row" do

96 let row = mkJson """

91 let row = mkJson """

@@ -110,11 +105,7 @@ mainTest = do

110 }

105 }

111 """

106 """

112

107

113− assertRight (decodeJson row)

108+ assertRight (decodeJson row) (Row $ NamedKind $ qualified ["Prim"] "Type")

114− (Row $ NamedKind $ QualifiedName { moduleNameParts: ["Prim"]

115− , name: "Type"

116− }

117− )

118

109

119 test "FunKind" do

110 test "FunKind" do

120 let funKind = mkJson """

111 let funKind = mkJson """

@@ -154,14 +145,8 @@ mainTest = do

154 }

145 }

155 """

146 """

156 assertRight (decodeJson funKind)

147 assertRight (decodeJson funKind)

157− (FunKind (Row $ NamedKind $ QualifiedName { moduleNameParts: ["Prim"]

148+ (FunKind (Row $ NamedKind $ qualified ["Prim"] "Type")

158− , name: "Type"

159− }

160− )

161− (Row $ NamedKind $ QualifiedName { moduleNameParts: ["Prim"]

149+ (Row $ NamedKind $ qualified ["Prim"] "Type")

162− , name: "Type"

163− }

164− )

165 )

150 )

166

151

167

152

@@ -181,9 +166,7 @@ mainTest = do

181 }

166 }

182 """

167 """

183 assertRight (decodeJson constraint)

168 assertRight (decodeJson constraint)

184− (Constraint { constraintClass: QualifiedName { moduleNameParts: ["Prim"]

169+ (Constraint { constraintClass: qualified ["Prim"] "Partial"

185− , name: "Partial"

186− }

187 , constraintArgs: []

170 , constraintArgs: []

188 })

171 })

189

172

@@ -230,14 +213,12 @@ mainTest = do

230

213

231 assertRight (decodeJson typeApp1) $

214 assertRight (decodeJson typeApp1) $

232 TypeApp

215 TypeApp

233− (TypeConstructor (QualifiedName { moduleNameParts:

216+ (TypeConstructor (qualified [ "Control"

234− [ "Control"

235− , "Monad"

217+ , "Monad"

236− , "ST"

218+ , "ST"

237− , "Internal"

219+ , "Internal"

238− ],

220+ ]

239− name: "ST"

221+ "ST"

240− }

241 ))

222 ))

242 (TypeVar "h")

223 (TypeVar "h")

243

224

@@ -256,9 +237,7 @@ mainTest = do

256 }

237 }

257 """

238 """

258 assertRight (decodeJson typeOp) $

239 assertRight (decodeJson typeOp) $

259− TypeOp $ QualifiedName { moduleNameParts: [ "Data", "NaturalTransformation" ]

240+ TypeOp $ qualified [ "Data", "NaturalTransformation" ] "~>"

260− , name: "~>"

261− }

262

241

263 test "BinaryNoParens" do

242 test "BinaryNoParens" do

264 let binaryNoParens = mkJson """

243 let binaryNoParens = mkJson """

@@ -293,7 +272,7 @@ mainTest = do

293

272

294 assertRight (decodeJson binaryNoParens) $

273 assertRight (decodeJson binaryNoParens) $

295 BinaryNoParensType

274 BinaryNoParensType

296− (TypeOp $ QualifiedName { moduleNameParts: ["Data", "NaturalTransformation"], name: "~>" })

275+ (TypeOp $ qualified ["Data", "NaturalTransformation"] "~>")

297 (TypeVar "m")

276 (TypeVar "m")

298 (TypeVar "n")

277 (TypeVar "n")

299

278

@@ -335,19 +314,8 @@ mainTest = do

335 assertRight (decodeJson parensInType) $

314 assertRight (decodeJson parensInType) $

336 ParensInType $

315 ParensInType $

337 TypeApp

316 TypeApp

338− (TypeConstructor (QualifiedName { moduleNameParts:

317+ (TypeConstructor (qualified [ "Data", "Maybe" ] "Maybe"))

339− [ "Data"

318+ (TypeConstructor (qualified [ "Prim" ] "String"))

340− , "Maybe"

341− ],

342− name: "Maybe"

343− }

344− ))

345− (TypeConstructor (QualifiedName { moduleNameParts:

346− [ "Prim"

347− ],

348− name: "String"

349− }

350− ))

351 test "RCons" do

319 test "RCons" do

352

320

353 let rcons = mkJson """

321 let rcons = mkJson """

@@ -388,8 +356,8 @@ mainTest = do

388

356

389 assertRight (decodeJson rcons) $

357 assertRight (decodeJson rcons) $

390 RCons

358 RCons

391− "tail"

359+ (Identifier "tail")

392− (TypeApp (TypeConstructor $ QualifiedName { moduleNameParts: [ "Data", "Symbol" ], name: "SProxy" })

360+ (TypeApp (TypeConstructor $ qualified [ "Data", "Symbol" ] "SProxy")

393 (TypeVar "t"))

361 (TypeVar "t"))

394 REmpty

362 REmpty

395

363

@@ -545,8 +513,8 @@ mainTest = do

545 """

513 """

546 assertRight (decodeJson forallJson) $

514 assertRight (decodeJson forallJson) $

547 ForAll "f"

515 ForAll "f"

548− (Just (FunKind (NamedKind (QualifiedName { moduleNameParts: ["Prim","RowList"], name: "RowList" })) (NamedKind (QualifiedName { moduleNameParts: ["Prim"], name: "Type" }))))

516+ (Just (FunKind (NamedKind (QualifiedName { moduleNameParts: ["Prim","RowList"], name: Identifier "RowList" })) (NamedKind (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "Type" }))))

549− (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: "Function" })) (TypeApp (TypeVar "f") (TypeVar "l"))) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Data","List","Types"], name: "List" })) (ParensInType (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Data","Tuple"], name: "Tuple" })) (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: "String" }))) (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: "String" }))))))

517+ (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" }))))))

550

518

551

519

552

520

@@ -558,7 +526,7 @@ mainTest = do

558{"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]}

526{"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]}

559 """

527 """

560

528

561− 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: "And" }) }) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "l"))) (TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"], name: "Function" })) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "r"))) (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Type","Data","Boolean"], name: "BProxy" })) (TypeVar "o"))))))))

529+ 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"))))))))

562

530

563 suite "Kind encoder" do

531 suite "Kind encoder" do

564 test "FunKind" do

532 test "FunKind" do

@@ -570,4 +538,4 @@ mainTest = do

570

538

571

539

572qualified :: Array String -> String -> QualifiedName

540qualified :: Array String -> String -> QualifiedName

573−qualified moduleNameParts name = QualifiedName { moduleNameParts, name }

541+qualified moduleNameParts name = QualifiedName { moduleNameParts, name: Identifier name }

test/Test/TypeQuery.purs+122−101

@@ -3,6 +3,7 @@ module Test.TypeQuery where

3import Docs.Search.TypeDecoder (Constraint(..), QualifiedName(..), Type(..))

4import Docs.Search.TypeQuery (Substitution(..), TypeQuery(..), getFreeVariables, parseTypeQuery, penalty, typeVarPenalty)

5import Docs.Search.TypeShape (ShapeChunk(..), shapeOfType, shapeOfTypeQuery)

6+import Docs.Search.Types (Identifier(..))

7import Prelude

8import Prelude

@@ -25,193 +26,195 @@ tests = do

26 test "test #0" do

27 test "test #0" do

27 let input = "a"

28 let input = "a"

28− assertRight (parseTypeQuery input) (QVar "a")

29+ assertRight (parseTypeQuery input) (qVar "a")

30 test "test #1" do

31 test "test #1" do

31 let input = "ab"

32 let input = "ab"

32− assertRight (parseTypeQuery input) (QVar "ab")

33+ assertRight (parseTypeQuery input) (qVar "ab")

34 test "test #2" do

35 test "test #2" do

35 let input = "a b"

36 let input = "a b"

36− assertRight (parseTypeQuery input) (QApp (QVar "a") (QVar "b"))

37+ assertRight (parseTypeQuery input) (QApp (qVar "a") (qVar "b"))

38 test "test #3" do

39 test "test #3" do

39 let input = "a b c"

40 let input = "a b c"

40− assertRight (parseTypeQuery input) (QApp (QApp (QVar "a") (QVar "b")) (QVar "c"))

41+ assertRight (parseTypeQuery input) (QApp (QApp (qVar "a") (qVar "b")) (qVar "c"))

42 test "test #4" do

43 test "test #4" do

43 let input = "a -> b"

44 let input = "a -> b"

44− assertRight (parseTypeQuery input) (QFun (QVar "a") (QVar "b"))

45+ assertRight (parseTypeQuery input) (QFun (qVar "a") (qVar "b"))

46 test "test #5" do

47 test "test #5" do

47 let input = "a -> b c"

48 let input = "a -> b c"

48− assertRight (parseTypeQuery input) (QFun (QVar "a") (QApp (QVar "b") (QVar "c")))

49+ assertRight (parseTypeQuery input) (QFun (qVar "a") (QApp (qVar "b") (qVar "c")))

50 test "test #6" do

51 test "test #6" do

51 let input = "a b -> c"

52 let input = "a b -> c"

52− assertRight (parseTypeQuery input) (QFun (QApp (QVar "a") (QVar "b")) (QVar "c"))

53+ assertRight (parseTypeQuery input) (QFun (QApp (qVar "a") (qVar "b")) (qVar "c"))

54 test "test #7" do

55 test "test #7" do

55 let input = "a b"

56 let input = "a b"

56− assertRight (parseTypeQuery input) (QApp (QVar "a") (QVar "b"))

57+ assertRight (parseTypeQuery input) (QApp (qVar "a") (qVar "b"))

58 test "test #8" do

59 test "test #8" do

59 let input = "a (b c)"

60 let input = "a (b c)"

60− assertRight (parseTypeQuery input) (QApp (QVar "a") (QApp (QVar "b") (QVar "c")))

61+ assertRight (parseTypeQuery input) (QApp (qVar "a") (QApp (qVar "b") (qVar "c")))

62 test "test #9" do

63 test "test #9" do

63 let input = "(a b) (c d)"

64 let input = "(a b) (c d)"

64 assertRight (parseTypeQuery input)

65 assertRight (parseTypeQuery input)

65− (QApp (QApp (QVar "a") (QVar "b"))

66+ (QApp (QApp (qVar "a") (qVar "b"))

66− (QApp (QVar "c") (QVar "d")))

67+ (QApp (qVar "c") (qVar "d")))

68 test "test #10" do

69 test "test #10" do

69 let input = "a ( b c )"

70 let input = "a ( b c )"

70− assertRight (parseTypeQuery input) (QApp (QVar "a") (QApp (QVar "b") (QVar "c")))

71+ assertRight (parseTypeQuery input) (QApp (qVar "a") (QApp (qVar "b") (qVar "c")))

72 test "test #11" do

73 test "test #11" do

73 let input = "aaa"

74 let input = "aaa"

74− assertRight (parseTypeQuery input) (QVar "aaa")

75+ assertRight (parseTypeQuery input) (qVar "aaa")

76 test "test #12" do

77 test "test #12" do

77 let input = "aaa ( bbb ccc )"

78 let input = "aaa ( bbb ccc )"

78− assertRight (parseTypeQuery input) (QApp (QVar "aaa") (QApp (QVar "bbb") (QVar "ccc")))

79+ assertRight (parseTypeQuery input) (QApp (qVar "aaa") (QApp (qVar "bbb") (qVar "ccc")))

80 test "test #13" do

81 test "test #13" do

81 let input = "(a -> b) -> (c -> d)"

82 let input = "(a -> b) -> (c -> d)"

82− assertRight (parseTypeQuery input) (QFun (QFun (QVar "a") (QVar "b"))

83+ assertRight (parseTypeQuery input) (QFun (QFun (qVar "a") (qVar "b"))

83− (QFun (QVar "c") (QVar "d")))

84+ (QFun (qVar "c") (qVar "d")))

85 test "test #14" do

86 test "test #14" do

86 let input = "a -> b -> c -> d"

87 let input = "a -> b -> c -> d"

87− assertRight (parseTypeQuery input) (QFun (QVar "a")

88+ assertRight (parseTypeQuery input) (QFun (qVar "a")

88− (QFun (QVar "b")

89+ (QFun (qVar "b")

89− (QFun (QVar "c") (QVar "d"))))

90+ (QFun (qVar "c") (qVar "d"))))

91 test "test #15" do

92 test "test #15" do

92 let input = "a -> b -> c"

93 let input = "a -> b -> c"

93− assertRight (parseTypeQuery input) (QFun (QVar "a")

94+ assertRight (parseTypeQuery input) (QFun (qVar "a")

94− (QFun (QVar "b")

95+ (QFun (qVar "b")

95− (QVar "c")))

96+ (qVar "c")))

97 test "test #16" do

98 test "test #16" do

98 let input = "forall a b c. c"

99 let input = "forall a b c. c"

99− assertRight (parseTypeQuery input) (QForAll (nl "a" ["b", "c"]) (QVar "c"))

100+ assertRight (parseTypeQuery input) (QForAll (nl "a" ["b", "c"]) (qVar "c"))

100

101

101 test "test #17" do

102 test "test #17" do

102 let input = "forall a. Maybe a"

103 let input = "forall a. Maybe a"

103− assertRight (parseTypeQuery input) (QForAll (nl "a" $ []) (QApp (QConst "Maybe") (QVar "a")))

104+ assertRight (parseTypeQuery input) (QForAll (nl "a" $ []) (QApp (qConst "Maybe") (qVar "a")))

104

105

105 test "test #18" do

106 test "test #18" do

106 let input = "forall m a. Monad m => a -> m a"

107 let input = "forall m a. Monad m => a -> m a"

107 assertRight (parseTypeQuery input)

108 assertRight (parseTypeQuery input)

108 (QForAll (nl "m" ["a"])

109 (QForAll (nl "m" ["a"])

109− (QConstraint "Monad" (l [QVar "m"])

110+ (qConstraint "Monad" (l [qVar "m"])

110− (QFun (QVar "a")

111+ (QFun (qVar "a")

111− (QApp (QVar "m") (QVar "a")))))

112+ (QApp (qVar "m") (qVar "a")))))

112

113

113 test "test #19" do

114 test "test #19" do

114 let input = "{ a :: Int }"

115 let input = "{ a :: Int }"

115 assertRight (parseTypeQuery input)

116 assertRight (parseTypeQuery input)

116− (QApp (QConst "Record") (QRow (pure (Tuple "a" (QConst "Int")))))

117+ (QApp (qConst "Record") (QRow (pure (Tuple (Identifier "a") (qConst "Int")))))

117

118

118 test "test #20" do

119 test "test #20" do

119 let input = "{a::Int}"

120 let input = "{a::Int}"

120 assertRight (parseTypeQuery input)

121 assertRight (parseTypeQuery input)

121− (QApp (QConst "Record") (QRow (pure (Tuple "a" (QConst "Int")))))

122+ (QApp (qConst "Record") (QRow (pure (Tuple (Identifier "a") (qConst "Int")))))

122

123

123 test "test #21" do

124 test "test #21" do

124 let input = "Int"

125 let input = "Int"

125− assertRight (parseTypeQuery input) (QConst "Int")

126+ assertRight (parseTypeQuery input) (qConst "Int")

126

127

127 test "test #22" do

128 test "test #22" do

128 let input = "a->b"

129 let input = "a->b"

129− assertRight (parseTypeQuery input) (QFun (QVar "a") (QVar "b"))

130+ assertRight (parseTypeQuery input) (QFun (qVar "a") (qVar "b"))

130

131

131 test "test #23" do

132 test "test #23" do

132 let input = "forall m a. MonadRec m => Process m a -> m a"

133 let input = "forall m a. MonadRec m => Process m a -> m a"

133 assertRight (parseTypeQuery input) (QForAll (nl "m" ("a" : Nil))

134 assertRight (parseTypeQuery input) (QForAll (nl "m" ("a" : Nil))

134− (QConstraint "MonadRec" (l [QVar "m"])

135+ (qConstraint "MonadRec" (l [qVar "m"])

135− (QFun (QApp (QApp (QConst "Process")

136+ (QFun (QApp (QApp (qConst "Process")

136− (QVar "m")) (QVar "a"))

137+ (qVar "m")) (qVar "a"))

137− (QApp (QVar "m") (QVar "a")))))

138+ (QApp (qVar "m") (qVar "a")))))

138

139

139 test "test #24" do

140 test "test #24" do

140 let input = "forall t f a. Foldable1 t => Apply f => f"

141 let input = "forall t f a. Foldable1 t => Apply f => f"

141 assertRight (parseTypeQuery input) (QForAll (nl "t" ["f", "a"])

142 assertRight (parseTypeQuery input) (QForAll (nl "t" ["f", "a"])

142− (QConstraint "Foldable1" (l [QVar "t"])

143+ (qConstraint "Foldable1" (l [qVar "t"])

143− (QConstraint "Apply" (l [QVar "f"]) (QVar "f"))))

144+ (qConstraint "Apply" (l [qVar "f"]) (qVar "f"))))

144

145

145 test "test #25" do

146 test "test #25" do

146 let input = "forall m a.MonadRec m=>Process m a->m a"

147 let input = "forall m a.MonadRec m=>Process m a->m a"

147 assertRight (parseTypeQuery input) ((QForAll (nl "m" ("a" : Nil))

148 assertRight (parseTypeQuery input) ((QForAll (nl "m" ("a" : Nil))

148− (QConstraint "MonadRec" (l [QVar "m"])

149+ (qConstraint "MonadRec" (l [qVar "m"])

149− (QFun (QApp (QApp (QConst "Process")

150+ (QFun (QApp (QApp (qConst "Process")

150− (QVar "m")) (QVar "a"))

151+ (qVar "m")) (qVar "a"))

151− (QApp (QVar "m") (QVar "a"))))))

152+ (QApp (qVar "m") (qVar "a"))))))

152

153

153 test "test #26" do

154 test "test #26" do

154 let input = "m a -> (a -> m b) -> m b"

155 let input = "m a -> (a -> m b) -> m b"

155− assertRight (parseTypeQuery input) (QFun (QApp (QVar "m") (QVar "a")) (QFun (QFun (QVar "a") (QApp (QVar "m") (QVar "b"))) (QApp (QVar "m") (QVar "b"))))

156+ assertRight (parseTypeQuery input) (QFun (QApp (qVar "m") (qVar "a")) (QFun (QFun (qVar "a") (QApp (qVar "m") (qVar "b"))) (QApp (qVar "m") (qVar "b"))))

156

157

157 test "test #27" do

158 test "test #27" do

158 let input = "forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a)"

159 let input = "forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a)"

159 assertRight (parseTypeQuery input) ((QForAll (nl "f" ["a"]))

160 assertRight (parseTypeQuery input) ((QForAll (nl "f" ["a"]))

160− (QConstraint "Alternative" (l [QVar "f"])

161+ (qConstraint "Alternative" (l [qVar "f"])

161− (QConstraint "Lazy" (l [QApp (QVar "f")

162+ (qConstraint "Lazy" (l [QApp (qVar "f")

162− (QApp (QConst "List") (QVar "a"))])

163+ (QApp (qConst "List") (qVar "a"))])

163− (QFun (QApp (QVar "f") (QVar "a"))

164+ (QFun (QApp (qVar "f") (qVar "a"))

164− (QApp (QVar "f")

165+ (QApp (qVar "f")

165− (QApp (QConst "List") (QVar "a")))))))

166+ (QApp (qConst "List") (qVar "a")))))))

166

167

167 test "test #28" do

168 test "test #28" do

168 let input = "forall f a. Alternative f => Lazy(f (List a))=>f a -> f (List a)"

169 let input = "forall f a. Alternative f => Lazy(f (List a))=>f a -> f (List a)"

169 assertRight (parseTypeQuery input) ((QForAll (nl "f" ["a"]))

170 assertRight (parseTypeQuery input) ((QForAll (nl "f" ["a"]))

170− (QConstraint "Alternative" (l [QVar "f"])

171+ (qConstraint "Alternative" (l [qVar "f"])

171− (QConstraint "Lazy" (l [QApp (QVar "f")

172+ (qConstraint "Lazy" (l [QApp (qVar "f")

172− (QApp (QConst "List") (QVar "a"))])

173+ (QApp (qConst "List") (qVar "a"))])

173− (QFun (QApp (QVar "f") (QVar "a"))

174+ (QFun (QApp (qVar "f") (qVar "a"))

174− (QApp (QVar "f")

175+ (QApp (qVar "f")

175− (QApp (QConst "List") (QVar "a")))))))

176+ (QApp (qConst "List") (qVar "a")))))))

176

177

177 test "test #29" do

178 test "test #29" do

178 let input = "{a::Int,b::Int}"

179 let input = "{a::Int,b::Int}"

179 assertRight (parseTypeQuery input)

180 assertRight (parseTypeQuery input)

180− (QApp (QConst "Record") (QRow (List.fromFoldable [ Tuple "a" (QConst "Int"), Tuple "b" (QConst "Int")])))

181+ (QApp (qConst "Record") (QRow (List.fromFoldable

182+ [ Tuple (Identifier "a") (qConst "Int")

183+ , Tuple (Identifier "b") (qConst "Int")])))

181

184

182 test "test #30" do

185 test "test #30" do

183 let input = "{record''' :: Int}"

186 let input = "{record''' :: Int}"

184 assertRight (parseTypeQuery input)

187 assertRight (parseTypeQuery input)

185− (QApp (QConst "Record") (QRow (List.fromFoldable [ Tuple "record'''" (QConst "Int")])))

188+ (QApp (qConst "Record") (QRow (List.fromFoldable [ Tuple (Identifier "record'''") (qConst "Int")])))

186

189

187 test "test #31" do

190 test "test #31" do

188 let input = "(row''' :: Int)"

191 let input = "(row''' :: Int)"

189 assertRight (parseTypeQuery input)

192 assertRight (parseTypeQuery input)

190− (QRow (List.fromFoldable [ Tuple "row'''" (QConst "Int")]))

193+ (QRow (List.fromFoldable [ Tuple (Identifier "row'''") (qConst "Int")]))

191

194

192 test "test #32" do

195 test "test #32" do

193 let input = "(row1 :: Int, row2 :: (),row3::(row4::{}))"

196 let input = "(row1 :: Int, row2 :: (),row3::(row4::{}))"

194 assertRight (parseTypeQuery input)

197 assertRight (parseTypeQuery input)

195− (QRow (l [ Tuple "row1" (QConst "Int")

198+ (QRow (l [ Tuple (Identifier "row1") (qConst "Int")

196− , Tuple "row2" (QRow Nil)

199+ , Tuple (Identifier "row2") (QRow Nil)

197− , Tuple "row3" (QRow (l [ Tuple "row4" (QApp (QConst "Record") (QRow Nil)) ])) ]))

200+ , Tuple (Identifier "row3") (QRow (l [ Tuple (Identifier "row4") (QApp (qConst "Record") (QRow Nil)) ])) ]))

198

201

199 test "test #33" do

202 test "test #33" do

200 let input = "Foldable1 t => Apply f => t (f a) -> f Unit"

203 let input = "Foldable1 t => Apply f => t (f a) -> f Unit"

201 assertRight (parseTypeQuery input)

204 assertRight (parseTypeQuery input)

202− (QConstraint "Foldable1" ((QVar "t") : Nil) (QConstraint "Apply" ((QVar "f") : Nil) (QFun (QApp (QVar "t") (QApp (QVar "f") (QVar "a"))) (QApp (QVar "f") (QConst "Unit")))))

205+ (qConstraint "Foldable1" ((qVar "t") : Nil) (qConstraint "Apply" ((qVar "f") : Nil) (QFun (QApp (qVar "t") (QApp (qVar "f") (qVar "a"))) (QApp (qVar "f") (qConst "Unit")))))

203

206

204 test "test #34" do

207 test "test #34" do

205 let input = "Foldable1 t => Apply f => t (f a) -> f a"

208 let input = "Foldable1 t => Apply f => t (f a) -> f a"

206 assertRight (parseTypeQuery input)

209 assertRight (parseTypeQuery input)

207− (QConstraint "Foldable1" ((QVar "t") : Nil) (QConstraint "Apply" ((QVar "f") : Nil) (QFun (QApp (QVar "t") (QApp (QVar "f") (QVar "a"))) (QApp (QVar "f") (QVar "a")))))

210+ (qConstraint "Foldable1" ((qVar "t") : Nil) (qConstraint "Apply" ((qVar "f") : Nil) (QFun (QApp (qVar "t") (QApp (qVar "f") (qVar "a"))) (QApp (qVar "f") (qVar "a")))))

208

211

209 test "test #35" do

212 test "test #35" do

210 let input = "Generic a rep => GenericEq rep => a -> a -> Boolean"

213 let input = "Generic a rep => GenericEq rep => a -> a -> Boolean"

211 assertRight (parseTypeQuery input)

214 assertRight (parseTypeQuery input)

212− (QConstraint "Generic" ((QVar "a") : (QVar "rep") : Nil)

215+ (qConstraint "Generic" ((qVar "a") : (qVar "rep") : Nil)

213− (QConstraint "GenericEq" ((QVar "rep") : Nil)

216+ (qConstraint "GenericEq" ((qVar "rep") : Nil)

214− (QFun (QVar "a") (QFun (QVar "a") (QConst "Boolean")))))

217+ (QFun (qVar "a") (QFun (qVar "a") (qConst "Boolean")))))

215

218

216 suite "polish notation" do

219 suite "polish notation" do

217

220

@@ -246,7 +249,7 @@ tests = do

246

249

247 fun t1 t2 =

250 fun t1 t2 =

248 TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"]

251 TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"]

249− , name: "Function" })) t1) t2

252+ , name: Identifier "Function" })) t1) t2

250 type_ =

253 type_ =

251 ForAll "a" Nothing $

254 ForAll "a" Nothing $

252 ForAll "rep" Nothing $

255 ForAll "rep" Nothing $

@@ -314,70 +317,70 @@ tests = do

314 Assert.equal 0 (typeVarPenalty mempty)

317 Assert.equal 0 (typeVarPenalty mempty)

315

318

316 test "#1" do

319 test "#1" do

317− Assert.equal 0 (typeVarPenalty $ l [ Substitute "a" "b"

320+ Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "b"

318− , Substitute "b" "a"

321+ , substitute "b" "a"

319 ])

322 ])

320

323

321 test "#2" do

324 test "#2" do

322− Assert.equal 0 (typeVarPenalty $ l [ Substitute "a" "b"

325+ Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "b"

323− , Substitute "a" "b"

326+ , substitute "a" "b"

324− , Substitute "a" "b"

327+ , substitute "a" "b"

325 ])

328 ])

326

329

327 test "#3" do

330 test "#3" do

328− Assert.equal 1 (typeVarPenalty $ l [ Substitute "a" "b"

331+ Assert.equal 1 (typeVarPenalty $ l [ substitute "a" "b"

329− , Substitute "a" "c"

332+ , substitute "a" "c"

330 ])

333 ])

331

334

332 test "#4" do

335 test "#4" do

333− Assert.equal 1 (typeVarPenalty $ l [ Substitute "a" "b"

336+ Assert.equal 1 (typeVarPenalty $ l [ substitute "a" "b"

334− , Substitute "b" "a"

337+ , substitute "b" "a"

335− , Substitute "b" "c"

338+ , substitute "b" "c"

336 ])

339 ])

337

340

338 test "#5" do

341 test "#5" do

339− Assert.equal 0 (typeVarPenalty $ l [ Substitute "a" "b"

342+ Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "b"

340− , Substitute "b" "c"

343+ , substitute "b" "c"

341− , Substitute "c" "a"

344+ , substitute "c" "a"

342 ])

345 ])

343

346

344 test "#6" do

347 test "#6" do

345− Assert.equal 2 (typeVarPenalty $ l [ Substitute "a" "b"

348+ Assert.equal 2 (typeVarPenalty $ l [ substitute "a" "b"

346− , Substitute "a" "c"

349+ , substitute "a" "c"

347− , Substitute "a" "a"

350+ , substitute "a" "a"

348 ])

351 ])

349

352

350 test "#7" do

353 test "#7" do

351− Assert.equal 2 (typeVarPenalty $ l [ Substitute "a" "a"

354+ Assert.equal 2 (typeVarPenalty $ l [ substitute "a" "a"

352− , Substitute "b" "a"

355+ , substitute "b" "a"

353− , Substitute "c" "a"

356+ , substitute "c" "a"

354 ])

357 ])

355

358

356 test "#8" do

359 test "#8" do

357− Assert.equal 4 (typeVarPenalty $ l [ Substitute "a" "a"

360+ Assert.equal 4 (typeVarPenalty $ l [ substitute "a" "a"

358− , Substitute "b" "a"

361+ , substitute "b" "a"

359− , Substitute "c" "a"

362+ , substitute "c" "a"

360− , Substitute "a" "b"

363+ , substitute "a" "b"

361− , Substitute "a" "c"

364+ , substitute "a" "c"

362− , Substitute "a" "a"

365+ , substitute "a" "a"

363 ])

366 ])

364

367

365 test "#9" do

368 test "#9" do

366− Assert.equal 0 (typeVarPenalty $ l [ Substitute "a" "e"

369+ Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "e"

367− , Substitute "b" "d"

370+ , substitute "b" "d"

368− , Substitute "c" "f"

371+ , substitute "c" "f"

369 ])

372 ])

370

373

371 suite "unification" do

374 suite "unification" do

372 test "instantiation #0" do

375 test "instantiation #0" do

373− let mVarQuery = QVar "m"

376+ let mVarQuery = qVar "m"

374− unitConstQuery = QConst "Unit"

377+ unitConstQuery = qConst "Unit"

375

378

376 Assert.assert "instantiation #0" $

379 Assert.assert "instantiation #0" $

377 (penalty unitConstQuery unitType < penalty mVarQuery unitType)

380 (penalty unitConstQuery unitType < penalty mVarQuery unitType)

378

381

379 test "generalization #0" do

382 test "generalization #0" do

380− let query = QVar "m"

383+ let query = qVar "m"

381 t1 = TypeVar "m"

384 t1 = TypeVar "m"

382

385

383 Assert.assert "qeneralization #0" $

386 Assert.assert "qeneralization #0" $

@@ -387,19 +390,37 @@ tests = do

387l :: forall f. Foldable f => (forall a. f a -> List a)

390l :: forall f. Foldable f => (forall a. f a -> List a)

388l = List.fromFoldable

391l = List.fromFoldable

389

392

390−nl :: forall t5 t6. Foldable t6 => t5 -> t6 t5 -> NonEmptyList t5

393+nl

394+ :: forall t

395+ . Foldable t

396+ => Functor t

397+ => String

398+ -> t String

399+ -> NonEmptyList Identifier

391−nl x rst = NonEmptyList.cons' x $ List.fromFoldable rst

400+nl x rst = NonEmptyList.cons' (Identifier x) $ List.fromFoldable (rst <#> Identifier)

392

401

393unitType :: Type

402unitType :: Type

394unitType = TypeConstructor (QualifiedName { moduleNameParts: []

403unitType = TypeConstructor (QualifiedName { moduleNameParts: []

395− , name: "Unit"

404+ , name: Identifier "Unit"

396 })

405 })

397

406

398countFreeVars :: TypeQuery -> Int

407countFreeVars :: TypeQuery -> Int

399countFreeVars = getFreeVariables >>> Set.size

408countFreeVars = getFreeVariables >>> Set.size

400

409

401qname :: Array String -> String -> QualifiedName

410qname :: Array String -> String -> QualifiedName

402−qname m n = QualifiedName { moduleNameParts: m, name: n }

411+qname m n = QualifiedName { moduleNameParts: m, name: Identifier n }

403

412

404constr :: QualifiedName -> Array Type -> Constraint

413constr :: QualifiedName -> Array Type -> Constraint

405constr c a = Constraint { constraintClass: c, constraintArgs: a }

414constr c a = Constraint { constraintClass: c, constraintArgs: a }

415+

416+qVar :: String -> TypeQuery

417+qVar = QVar <<< Identifier

418+

419+qConst :: String -> TypeQuery

420+qConst = QConst <<< Identifier

421+

422+qConstraint :: String -> List TypeQuery -> TypeQuery -> TypeQuery

423+qConstraint = QConstraint <<< Identifier

424+

425+substitute :: String -> String -> Substitution

426+substitute a b = Substitute (Identifier a) (Identifier b)