git.iko.soy/rowtype-yoga/purescript-docs-search
on master help sign in
Wrap package scores and identifiers in newtypes
commitfee7abefc0bf7e2d742939c9794dfa89341acb53 authorklntsky <klntsky@gmail.com> dateMon 27 Jul 2020, 22:24 (6 years ago) parent5bf02c2
15 files changed+299−275
compare with master
unifiedsplit
src/Docs/Search/App/SearchResults.purs+25−25 src/Docs/Search/Declarations.purs+4−4 src/Docs/Search/Engine.purs+11−4 src/Docs/Search/Interactive.purs+25−25 src/Docs/Search/ModuleIndex.purs+5−4 src/Docs/Search/PackageIndex.purs+2−2 src/Docs/Search/Score.purs+9−9 src/Docs/Search/SearchResult.purs+3−3 src/Docs/Search/TypeDecoder.purs+6−4 src/Docs/Search/TypePrinter.purs+7−5 src/Docs/Search/TypeQuery.purs+33−28 src/Docs/Search/TypeShape.purs+2−1 src/Docs/Search/Types.purs+22−5 test/Main.purs+23−55 test/Test/TypeQuery.purs+122−101
src/Docs/Search/App/SearchResults.purs+25−25
@@ -6,7 +6,7 @@ import Docs.Search.BrowserEngine (PartialIndex, browserSearchEngine)
66import Docs.Search.Config (config)
77import Docs.Search.Declarations (DeclLevel(..), declLevelToHashAnchor)
88import Docs.Search.DocsJson (DataDeclType(..))
9−import Docs.Search.Engine (Result(..))
9+import Docs.Search.Engine (Result(..), packageInfoToString)
1010import Docs.Search.Engine as Engine
1111import Docs.Search.Extra (homePageFromRepository, (>#>))
1212import Docs.Search.ModuleIndex (ModuleResult)
@@ -14,7 +14,7 @@ import Docs.Search.PackageIndex (PackageResult)
1414import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))
1515import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
1616import Docs.Search.TypeIndex (TypeIndex)
17−import Docs.Search.Types (ModuleName(..), packageInfoToString)
17+import Docs.Search.Types (ModuleName(..), Identifier(..))
1818
1919import Prelude
2020
@@ -302,9 +302,9 @@ renderSearchResult markdownIt (SearchResult result) =
302302 , HE.onClick $ const $ Just $ SearchResultClicked result.moduleName
303303 , HP.href $
304304 unwrap result.moduleName <> ".html#" <>
305− result.hashAnchor <> ":" <> result.name
305+ result.hashAnchor <> ":" <> unwrap result.name
306306 ]
307− [ HH.text result.name ]
307+ [ HH.text $ unwrap result.name ]
308308 ]
309309 ]
310310
@@ -341,7 +341,7 @@ renderSearchResult markdownIt (SearchResult result) =
341341renderResultType
342342 :: forall a rest
343343 . { info :: ResultInfo
344− , name :: String
344+ , name :: Identifier
345345 , moduleName :: ModuleName
346346 | rest
347347 }
@@ -373,7 +373,7 @@ renderResultType result =
373373renderValueSignature
374374 :: forall a rest
375375 . { moduleName :: ModuleName
376− , name :: String
376+ , name :: Identifier
377377 | rest
378378 }
379379 -> Type
@@ -381,7 +381,7 @@ renderValueSignature
381381renderValueSignature result ty =
382382 [ HH.a [ makeHref ValueLevel false result.moduleName result.name
383383 , HE.onClick $ const $ Just $ SearchResultClicked result.moduleName ]
384− [ HH.text result.name ]
384+ [ HH.text $ unwrap result.name ]
385385 , HH.text " :: "
386386 , renderType ty ]
387387
@@ -392,7 +392,7 @@ renderTypeClassSignature
392392 , arguments :: Array TypeArgument
393393 , superclasses :: Array Constraint
394394 }
395− -> { name :: String, moduleName :: ModuleName | rest }
395+ -> { name :: Identifier, moduleName :: ModuleName | rest }
396396 -> Array (HH.HTML a Action)
397397renderTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName } =
398398 [ keyword "class"
@@ -414,7 +414,7 @@ renderTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName
414414 , HE.onClick $ const $ Just $
415415 SearchResultClicked moduleName
416416 ]
417− [ HH.text name ]
417+ [ HH.text $ unwrap name ]
418418 , space
419419 ] <> (
420420 Array.intercalate [ space ] $
@@ -444,10 +444,10 @@ renderTypeClassMemberSignature
444444 , typeClass :: QualifiedName
445445 , typeClassArguments :: Array TypeArgument
446446 }
447− -> { name :: String | rest }
447+ -> { name :: Identifier | rest }
448448 -> Array (HH.HTML a Action)
449449renderTypeClassMemberSignature { type: ty, typeClass, typeClassArguments } result =
450− [ HH.text result.name
450+ [ HH.text $ unwrap result.name
451451 , HH.text " :: "
452452 , renderType ty
453453 ]
@@ -457,7 +457,7 @@ renderDataSignature
457457 :: forall a rest
458458 . { typeArguments :: Array TypeArgument
459459 , dataDeclType :: DataDeclType }
460− -> { name :: String | rest }
460+ -> { name :: Identifier | rest }
461461 -> Array (HH.HTML a Action)
462462renderDataSignature { typeArguments, dataDeclType } { name } =
463463 [ keyword
@@ -465,7 +465,7 @@ renderDataSignature { typeArguments, dataDeclType } { name } =
465465 NewtypeDataDecl -> "newtype"
466466 DataDataDecl -> "data"
467467 , space
468− , HH.text name
468+ , HH.text $ unwrap name
469469 , space
470470 , HH.span_ $
471471 Array.intercalate [ space ] $
@@ -478,12 +478,12 @@ renderTypeSynonymSignature
478478 . { type :: Type
479479 , arguments :: Array TypeArgument
480480 }
481− -> { name :: String | rest }
481+ -> { name :: Identifier | rest }
482482 -> Array (HH.HTML a Action)
483483renderTypeSynonymSignature { type: ty, arguments } { name } =
484484 [ keyword "type"
485485 , space
486− , HH.text name
486+ , HH.text $ unwrap name
487487 , space
488488 , HH.span_ $
489489 Array.intercalate [ space ] $
@@ -499,10 +499,10 @@ renderTypeArgument :: forall a. TypeArgument -> Array (HH.HTML a Action)
499499renderTypeArgument (TypeArgument { name, mbKind }) =
500500 case mbKind of
501501 Nothing ->
502− [ HH.text name ]
502+ [ HH.text $ name ]
503503 Just kind ->
504504 [ HH.text "("
505− , HH.text name
505+ , HH.text $ name
506506 , HH.text " :: "
507507 , renderKind kind
508508 , HH.text ")"
@@ -522,14 +522,14 @@ renderType = case _ of
522522
523523 TypeApp (TypeApp (TypeConstructor
524524 (QualifiedName { moduleNameParts: [ "Prim" ]
525− , name: "Function" })) t1) t2 ->
525+ , name: Identifier "Function" })) t1) t2 ->
526526 HH.span_ [ renderType t1
527527 , syntax " -> "
528528 , renderType t2
529529 ]
530530
531531 TypeApp (TypeConstructor (QualifiedName { moduleNameParts: [ "Prim" ]
532− , name: "Record" }))
532+ , name: Identifier "Record" }))
533533 row ->
534534 renderRow false row
535535
@@ -624,7 +624,7 @@ renderRow asRow =
624624
625625 ( Array.intercalate [ HH.text ", " ] $ Array.fromFoldable $ rows <#>
626626 \entry ->
627− [ HH.span_ [ HH.text $ entry.row <> " :: "
627+ [ HH.span_ [ HH.text $ unwrap entry.row <> " :: "
628628 , renderType entry.ty ] ]
629629 ) <>
630630
@@ -637,7 +637,7 @@ renderRow asRow =
637637 closing = if asRow then " )" else " }"
638638
639639 primRecord :: QualifiedName
640− primRecord = QualifiedName { moduleNameParts: [ "Prim" ], name: "Record" }
640+ primRecord = QualifiedName { moduleNameParts: [ "Prim" ], name: Identifier "Record" }
641641
642642
643643renderConstraint
@@ -658,13 +658,13 @@ renderQualifiedName
658658 -> HH.HTML a Action
659659renderQualifiedName isInfix level (QualifiedName { moduleNameParts, name })
660660 = if isBuiltIn then
661− HH.text name
661+ HH.text $ unwrap name
662662 else
663663 HH.a [ HE.onClick $ const $ Just $
664664 SearchResultClicked $ moduleName
665665 , makeHref level isInfix moduleName name
666666 ]
667− [ HH.text name ]
667+ [ HH.text $ unwrap name ]
668668 where
669669 moduleName = ModuleName $ Array.intercalate "." $ moduleNameParts
670670 isBuiltIn = moduleNameParts !! 0 == Just "Prim"
@@ -686,13 +686,13 @@ makeHref
686686 . DeclLevel
687687 -> Boolean
688688 -> ModuleName
689− -> String
689+ -> Identifier
690690 -> HH.IProp ( href :: String | rest ) t
691691makeHref level isInfix moduleName name =
692692 HP.href $
693693 unwrap moduleName <> ".html#" <>
694694 declLevelToHashAnchor level <> ":" <>
695− if isInfix then "type (" <> name <> ")" else name
695+ if isInfix then "type (" <> unwrap name <> ")" else unwrap name
696696
697697
698698keyword
src/Docs/Search/Declarations.purs+4−4
@@ -4,7 +4,7 @@ import Docs.Search.DocsJson (ChildDeclType(..), ChildDeclaration(..), DeclType(.
44import Docs.Search.Score (Scores, getPackageScore, getPackageScoreForPackageName)
55import Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))
66import 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(..))
88
99import Prelude
1010
@@ -83,14 +83,14 @@ resultsForDeclaration scores moduleName indexEntry@(Declaration entry) =
8383 case mkInfo declLevel indexEntry of
8484 Nothing -> mempty
8585 Just info' ->
86− let result = SearchResult { name: title
86+ let result = SearchResult { name: Identifier title
8787 , comments
8888 , hashAnchor: declLevelToHashAnchor declLevel
8989 , moduleName
9090 , sourceSpan
9191 , packageInfo
9292 , score:
93− fromMaybe 0 $ getPackageScoreForPackageName scores <$> mbPackageName
93+ fromMaybe zero $ getPackageScoreForPackageName scores <$> mbPackageName
9494 , info: info'
9595 }
9696 in
@@ -219,7 +219,7 @@ resultsForChildDeclaration scores packageInfo moduleName parentResult
219219 child@(ChildDeclaration { title, info, comments, mbSourceSpan })
220220 | Just resultInfo <- mkChildInfo parentResult child =
221221 { path: title
222− , result: SearchResult { name: title
222+ , result: SearchResult { name: Identifier title
223223 , comments
224224 -- `ChildDeclaration`s are always either data
225225 -- constructors, type class members or instances.
src/Docs/Search/Engine.purs+11−4
@@ -5,7 +5,7 @@ import Docs.Search.PackageIndex (PackageIndex, PackageResult)
55import Docs.Search.Score (Scores)
66import Docs.Search.SearchResult (SearchResult, typeOfResult)
77import Docs.Search.TypeQuery (TypeQuery(..), parseTypeQuery, penalty)
8−import Docs.Search.Types (PackageInfo(..), PackageName(..), ModuleName(..))
8+import Docs.Search.Types (PackageInfo(..), ModuleName(..), PackageName(..), PackageScore)
99
1010import Prelude
1111
@@ -66,7 +66,7 @@ data Result
6666 | MdlResult ModuleResult
6767
6868
69−getResultScore :: Result -> Int
69+getResultScore :: Result -> PackageScore
7070getResultScore (DeclResult r) = (unwrap r).score
7171getResultScore (TypeResult r) = (unwrap r).score
7272getResultScore (PackResult r) = r.score
@@ -88,8 +88,8 @@ getResultModuleName (MdlResult r) = r.name
8888
8989
9090getResultName :: Result -> String
91−getResultName (DeclResult r) = (unwrap r).name
92−getResultName (TypeResult r) = (unwrap r).name
91+getResultName (DeclResult r) = unwrap (unwrap r).name
92+getResultName (TypeResult r) = unwrap (unwrap r).name
9393getResultName (PackResult r) = unwrap r.name
9494getResultName (MdlResult r) = unwrap r.name
9595
@@ -158,3 +158,10 @@ sortByDistance
158158 -> Array SearchResult
159159sortByDistance typeQuery =
160160 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
33
44import Docs.Search.Declarations (Declarations, mkDeclarations)
55import Docs.Search.DocsJson (DataDeclType(..))
6−import Docs.Search.Engine (mkEngineState, Result(..))
6+import Docs.Search.Engine (mkEngineState, packageInfoToString, Result(..))
77import Docs.Search.Engine as Engine
88import Docs.Search.Extra (listToString, stringToList, (>#>))
99import Docs.Search.IndexBuilder as IndexBuilder
@@ -16,7 +16,7 @@ import Docs.Search.Terminal (bold, cyan, green, yellow)
1616import Docs.Search.TypeDecoder (Constraint, FunDeps, Kind, QualifiedName, Type, TypeArgument)
1717import Docs.Search.TypeIndex (resultsWithTypes)
1818import 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)
2020
2121import Prelude
2222
@@ -150,19 +150,19 @@ showModuleResult { name, package } =
150150 bold (cyan "module") <> " " <> bold (green $ unwrap name)
151151
152152
153−showSignature ::
154− forall rest.
155− { name :: String
156− , moduleName :: ModuleName
157− , packageInfo :: PackageInfo
158− , info :: ResultInfo
159− | rest
160− }
153+showSignature
154+ :: forall rest
155+ . { name :: Identifier
156+ , moduleName :: ModuleName
157+ , packageInfo :: PackageInfo
158+ , info :: ResultInfo
159+ | rest
160+ }
161161 -> String
162162showSignature result@{ name, info } =
163163 case info of
164164 ValueResult { type: ty } ->
165− yellow name <> syntax " :: " <> showType ty
165+ yellow (unwrap name) <> syntax " :: " <> showType ty
166166
167167 TypeClassResult info' ->
168168 showTypeClassSignature info' result
@@ -180,9 +180,9 @@ showSignature result@{ name, info } =
180180 showExternDataSignature info' result
181181
182182 ValueAliasResult ->
183− yellow ("(" <> name <> ")")
183+ yellow ("(" <> unwrap name <> ")")
184184
185− _ -> yellow name
185+ _ -> yellow $ unwrap name
186186
187187
188188showTypeClassSignature
@@ -191,7 +191,7 @@ showTypeClassSignature
191191 , arguments :: Array TypeArgument
192192 , superclasses :: Array Constraint
193193 }
194− -> { name :: String, moduleName :: ModuleName | rest }
194+ -> { name :: Identifier, moduleName :: ModuleName | rest }
195195 -> String
196196showTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName } =
197197
@@ -210,7 +210,7 @@ showTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName }
210210 syntax "<="
211211 ) <>
212212 space <>
213− yellow name <>
213+ yellow (unwrap name) <>
214214 space <> (
215215 Array.intercalate space $
216216 arguments <#> showTypeArgument
@@ -221,14 +221,14 @@ showTypeClassSignature { fundeps, arguments, superclasses } { name, moduleName }
221221
222222showTypeClassMemberSignature
223223 :: forall rest
224− . { type :: Type
224+ . { "type" :: Type
225225 , typeClass :: QualifiedName
226226 , typeClassArguments :: Array TypeArgument
227227 }
228− -> { name :: String | rest }
228+ -> { name :: Identifier | rest }
229229 -> String
230−showTypeClassMemberSignature { type: ty, typeClass, typeClassArguments } result =
231− yellow result.name <>
230+showTypeClassMemberSignature { "type": ty, typeClass, typeClassArguments } result =
231+ yellow (unwrap result.name) <>
232232 syntax " :: " <>
233233 showType ty
234234
@@ -237,7 +237,7 @@ showDataSignature
237237 :: forall rest
238238 . { typeArguments :: Array TypeArgument
239239 , dataDeclType :: DataDeclType }
240− -> { name :: String | rest }
240+ -> { name :: Identifier | rest }
241241 -> String
242242showDataSignature { typeArguments, dataDeclType } { name } =
243243 ( keyword
@@ -246,7 +246,7 @@ showDataSignature { typeArguments, dataDeclType } { name } =
246246 DataDataDecl -> "data"
247247 ) <>
248248 space <>
249− yellow name <>
249+ yellow (unwrap name) <>
250250 space <> (
251251 Array.intercalate space $
252252 typeArguments <#> showTypeArgument
@@ -258,12 +258,12 @@ showTypeSynonymSignature
258258 . { type :: Type
259259 , arguments :: Array TypeArgument
260260 }
261− -> { name :: String | rest }
261+ -> { name :: Identifier | rest }
262262 -> String
263263showTypeSynonymSignature { type: ty, arguments } { name } =
264264 keyword "type" <>
265265 space <>
266− yellow name <>
266+ yellow (unwrap name) <>
267267 space <> (
268268 Array.intercalate space $
269269 arguments <#> showTypeArgument
@@ -277,12 +277,12 @@ showTypeSynonymSignature { type: ty, arguments } { name } =
277277showExternDataSignature
278278 :: forall rest
279279 . { kind :: Kind }
280− -> { name :: String | rest }
280+ -> { name :: Identifier | rest }
281281 -> String
282282showExternDataSignature { kind } { name } =
283283 keyword "foreign data" <>
284284 space <>
285− yellow name <>
285+ yellow (unwrap name) <>
286286 space <>
287287 syntax " :: " <>
288288 showKind kind
src/Docs/Search/ModuleIndex.purs+5−4
@@ -3,9 +3,9 @@ module Docs.Search.ModuleIndex where
33import Docs.Search.Config (config)
44import Docs.Search.Declarations (Declarations(..))
55import Docs.Search.SearchResult (SearchResult(..))
6−import Docs.Search.Types (ModuleName, PackageName, PackageInfo(..))
6+import Docs.Search.Types (ModuleName, PackageName, PackageInfo(..), PackageScore)
77import Docs.Search.Extra (stringToList)
8−import Docs.Search.Score (Scores)
8+import Docs.Search.Score (Scores, getPackageScoreForPackageName)
99
1010import Prelude
1111
@@ -50,7 +50,7 @@ type ModuleIndex = { packageModules :: Map PackageName (Set ModuleName)
5050type ModuleResult
5151 = { name :: ModuleName
5252 , package :: PackageName
53− , score :: Int
53+ , score :: PackageScore
5454 }
5555
5656
@@ -86,7 +86,8 @@ queryModuleIndex scores { index, modulePackages } query =
8686 Array.nub <#>
8787 (\name -> do
8888 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 }) #
9091 Array.catMaybes
9192
9293
src/Docs/Search/PackageIndex.purs+2−2
@@ -3,7 +3,7 @@ module Docs.Search.PackageIndex where
33import Docs.Search.Config (config)
44import Docs.Search.Extra (stringToList)
55import Docs.Search.Score (Scores, getPackageScoreForPackageName, normalizePackageName)
6−import Docs.Search.Types (PackageName, RawPackageName(..))
6+import Docs.Search.Types (PackageName, RawPackageName(..), PackageScore)
77
88import Prelude
99
@@ -26,7 +26,7 @@ import Web.Bower.PackageMeta (PackageMeta(..))
2626type PackageResult
2727 = { name :: PackageName
2828 , description :: Maybe String
29− , score :: Int
29+ , score :: PackageScore
3030 , dependencies :: Array PackageName
3131 , repository :: Maybe String
3232 }
src/Docs/Search/Score.purs+9−9
@@ -1,6 +1,6 @@
11module Docs.Search.Score where
22
3−import Docs.Search.Types (RawPackageName(..), PackageName(..), PackageInfo(..))
3+import Docs.Search.Types (RawPackageName(..), PackageName(..), PackageInfo(..), PackageScore(..))
44
55import Prelude
66
@@ -13,7 +13,7 @@ import Data.String.CodeUnits as String
1313import Web.Bower.PackageMeta (Dependencies, PackageMeta)
1414
1515
16−type Scores = Map PackageName Int
16+type Scores = Map PackageName PackageScore
1717
1818normalizePackageName :: RawPackageName -> PackageName
1919normalizePackageName (RawPackageName p) =
@@ -35,18 +35,18 @@ mkScores =
3535 updateScoresFor :: Dependencies -> Scores -> Scores
3636 updateScoresFor deps scores =
3737 Array.foldr
38− (\dep -> Map.insertWith add dep 1)
38+ (\dep -> Map.insertWith add dep one)
3939 scores
4040 (deps # unwrap >>> map (_.packageName >>> RawPackageName >>> normalizePackageName))
4141
4242
43−getPackageScore :: Scores -> PackageInfo -> Int
43+getPackageScore :: Scores -> PackageInfo -> PackageScore
4444getPackageScore scores = case _ of
4545 Package p -> getPackageScoreForPackageName scores p
46− Builtin -> 100000
47− LocalPackage -> 200000
48− UnknownPackage -> 0
46+ Builtin -> PackageScore 100000
47+ LocalPackage -> PackageScore 200000
48+ UnknownPackage -> zero
4949
5050
51−getPackageScoreForPackageName :: Scores -> PackageName -> Int
52−getPackageScoreForPackageName scores p = fromMaybe 0 $ Map.lookup p scores
51+getPackageScoreForPackageName :: Scores -> PackageName -> PackageScore
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
22
33import Docs.Search.DocsJson (DataDeclType)
44import 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)
66
77import Prelude
88
@@ -57,12 +57,12 @@ typeOf _ = Nothing
5757-- | Common metadata for all types of search results.
5858newtype SearchResult
5959 = SearchResult
60− { name :: String
60+ { name :: Identifier
6161 , comments :: Maybe String
6262 , hashAnchor :: String
6363 , moduleName :: ModuleName
6464 , packageInfo :: PackageInfo
65− , score :: Int
65+ , score :: PackageScore
6666 , sourceSpan :: Maybe { start :: Array Int
6767 , end :: Array Int
6868 , name :: String
src/Docs/Search/TypeDecoder.purs+6−4
@@ -1,5 +1,7 @@
11module Docs.Search.TypeDecoder where
22
3+import Docs.Search.Types (Identifier)
4+
35import Prelude
46
57import Control.Alt ((<|>))
@@ -26,7 +28,7 @@ instance showQualifiedName :: Show QualifiedName where
2628
2729newtype QualifiedName
2830 = QualifiedName { moduleNameParts :: Array String
29− , name :: String
31+ , name :: Identifier
3032 }
3133
3234instance decodeJsonQualifiedName :: DecodeJson QualifiedName where
@@ -149,7 +151,7 @@ data Type
149151 -- | An empty row
150152 | REmpty
151153 -- | A non-empty row
152− | RCons String Type Type
154+ | RCons Identifier Type Type
153155 {-
154156 -- | A type with a kind annotation
155157 | Kinded Type Kind
@@ -412,7 +414,7 @@ joinForAlls ty = go Nil ty
412414 go ({ name, mbKind } : acc) ty'
413415 go acc ty' = { binders: acc, ty: ty' }
414416
415−joinRows :: Type -> { rows :: List { row :: String
417+joinRows :: Type -> { rows :: List { row :: Identifier
416418 , ty :: Type
417419 }
418420 , ty :: Maybe Type }
@@ -428,7 +430,7 @@ joinRows = go Nil
428430 }
429431
430432-- | 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
432434 , ty :: Type }
433435joinConstraints = go Nil
434436 where
src/Docs/Search/TypePrinter.purs+7−5
@@ -5,10 +5,12 @@ import Prelude
55import Docs.Search.Extra ((>#>))
66import Docs.Search.Terminal (cyan)
77import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..), TypeArgument(..), joinForAlls, joinRows)
8+import Docs.Search.Types (Identifier(..))
89
9−import Data.Maybe (Maybe(..), fromMaybe)
1010import Data.Array as Array
1111import Data.List as List
12+import Data.Maybe (Maybe(..), fromMaybe)
13+import Data.Newtype (unwrap)
1214
1315
1416-- | A pretty-printer for types, for TTY with colors.
@@ -22,13 +24,13 @@ showType = case _ of
2224
2325 TypeApp (TypeApp (TypeConstructor
2426 (QualifiedName { moduleNameParts: [ "Prim" ]
25− , name: "Function" }))
27+ , name: Identifier "Function" }))
2628 t1)
2729 t2 ->
2830 showType t1 <> syntax " -> " <> showType t2
2931
3032 TypeApp (TypeConstructor (QualifiedName { moduleNameParts: [ "Prim" ]
31− , name: "Record" }))
33+ , name: Identifier "Record" }))
3234 row ->
3335 showRow false row
3436
@@ -89,7 +91,7 @@ showQualifiedName
8991 :: QualifiedName
9092 -> String
9193showQualifiedName (QualifiedName { name })
92− = name
94+ = unwrap name
9395
9496
9597showRow
@@ -107,7 +109,7 @@ showRow asRow =
107109 opening <>
108110 ( Array.intercalate ", " $ Array.fromFoldable $ rows <#>
109111 \entry ->
110− entry.row <> syntax " :: " <> showType entry.ty
112+ unwrap entry.row <> syntax " :: " <> showType entry.ty
111113 ) <>
112114
113115 (ty >#> \ty' -> " | " <> showType ty') <>
src/Docs/Search/TypeQuery.purs+33−28
@@ -13,6 +13,7 @@ where
1313import Docs.Search.Config (config)
1414import Docs.Search.Extra (foldl1, foldr1)
1515import Docs.Search.TypeDecoder (QualifiedName(..), Type(..), joinConstraints, joinRows)
16+import Docs.Search.Types (Identifier(..))
1617
1718import Prelude
1819
@@ -41,13 +42,13 @@ import Text.Parsing.StringParser.Combinators (fix, sepBy, sepBy1, sepEndBy, sepE
4142-- | We need type queries because we don't have a full-featured type parser
4243-- | available.
4344data TypeQuery
44− = QVar String
45− | QConst String
45+ = QVar Identifier
46+ | QConst Identifier
4647 | QFun TypeQuery TypeQuery
4748 | QApp TypeQuery TypeQuery
48− | QForAll (NonEmptyList String) TypeQuery
49− | QConstraint String (List TypeQuery) TypeQuery
50− | QRow (List (Tuple String TypeQuery))
49+ | QForAll (NonEmptyList Identifier) TypeQuery
50+ | QConstraint Identifier (List TypeQuery) TypeQuery
51+ | QRow (List (Tuple Identifier TypeQuery))
5152
5253derive instance eqTypeQuery :: Eq TypeQuery
5354derive instance genericTypeQuery :: Generic TypeQuery _
@@ -69,7 +70,8 @@ typeQueryParser = fix \typeQuery ->
6970
7071 row = string "(" *> rowFields <* string ")"
7172
72− record = QApp (QConst "Record") <$> (string "{" *> rowFields <* string "}")
73+ record = QApp (QConst $ Identifier "Record") <$>
74+ (string "{" *> rowFields <* string "}")
7375
7476 binders =
7577 string "forall" *> some space *> sepEndBy1 ident skipSpaces <* string "." <* skipSpaces
@@ -111,32 +113,32 @@ concrete :: Parser TypeQuery
111113concrete =
112114 QConst <$> upperCaseIdent
113115
114−ident :: Parser String
116+ident :: Parser Identifier
115117ident = do
116118 head <- anyLetter
117119 rest <- Array.many (alphaNum <|> char '\'')
118− pure $ fromCharArray $ pure head <> rest
120+ pure $ Identifier <$> fromCharArray $ pure head <> rest
119121
120−upperCaseIdent :: Parser String
122+upperCaseIdent :: Parser Identifier
121123upperCaseIdent = do
122124 head <- upperCaseChar
123125 rest <- Array.many (alphaNum <|> char '\'')
124− pure $ fromCharArray $ pure head <> rest
126+ pure $ Identifier $ fromCharArray $ pure head <> rest
125127
126−lowerCaseIdent :: Parser String
128+lowerCaseIdent :: Parser Identifier
127129lowerCaseIdent = do
128130 head <- lowerCaseChar
129131 rest <- Array.many (alphaNum <|> char '\'')
130− pure $ fromCharArray $ pure head <> rest
132+ pure $ Identifier $ fromCharArray $ pure head <> rest
131133
132134space :: Parser Char
133135space = char ' '
134136
135137
136138-- | Used only in `getFreeVariables`.
137−data FreeVarCounterQueueEntry = Unbind (Set.Set String) | Next TypeQuery
139+data FreeVarCounterQueueEntry = Unbind (Set.Set Identifier) | Next TypeQuery
138140
139−getFreeVariables :: TypeQuery -> Set.Set String
141+getFreeVariables :: TypeQuery -> Set.Set Identifier
140142getFreeVariables query = go Set.empty Set.empty (List.singleton $ Next query)
141143 where
142144 insertIfUnbound bound var free =
@@ -172,11 +174,11 @@ getFreeVariables query = go Set.empty Set.empty (List.singleton $ Next query)
172174
173175
174176data Substitution
175− = Instantiate String Type
176− | Match String String
177− | Generalize TypeQuery String
178− | Substitute String String
179− | MatchConstraints (Set String) (Set String)
177+ = Instantiate Identifier Type
178+ | Match Identifier Identifier
179+ | Generalize TypeQuery Identifier
180+ | Substitute Identifier Identifier
181+ | MatchConstraints (Set Identifier) (Set Identifier)
180182 | MissingConstraint
181183 | ExcessiveConstraint
182184 | RowsMismatch Int Int
@@ -225,9 +227,9 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ })
225227
226228 -- * Type variables
227229 go acc ({ q: QVar q, t: TypeVar v } : rest) =
228− go (Substitute q v : acc) rest
230+ go (Substitute q (Identifier v) : acc) rest
229231 go acc ({ q, t: TypeVar v } : rest ) =
230− go (Generalize q v : acc) rest
232+ go (Generalize q (Identifier v) : acc) rest
231233 go acc ({ q: QVar v, t } : rest) =
232234 go (Instantiate v t : acc) rest
233235
@@ -249,16 +251,16 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ })
249251 go acc ({ q: QFun q1 q2
250252 , t: TypeApp (TypeApp (TypeConstructor
251253 (QualifiedName { moduleNameParts: [ "Prim" ]
252− , name: "Function" })) t1) t2 } : rest) =
254+ , name: Identifier "Function" })) t1) t2 } : rest) =
253255 go acc ({ q: q1, t: t1 } : { q: q2, t: t2 } : rest)
254256 go acc ({ q: q@(QFun q1 q2), t } : rest) =
255257 go (Mismatch q t : acc) rest
256258
257259 -- * Rows
258− go acc ({ q: QApp (QConst "Record") (QRow qRows)
260+ go acc ({ q: QApp (QConst (Identifier "Record")) (QRow qRows)
259261 , t: TypeApp (TypeConstructor
260262 (QualifiedName { moduleNameParts: [ "Prim" ]
261− , name: "Record" })) row } : rest) =
263+ , name: Identifier "Record" })) row } : rest) =
262264 let { rows, ty } = joinRows row
263265 qRowsLength = List.length qRows
264266 rowsLength = List.length rows in
@@ -319,8 +321,11 @@ typeVarPenalty substs =
319321 insertion v1 v2 = Map.insertWith append v1 (Set.singleton v2)
320322
321323 varSubstMapWith
322− :: (String -> String -> Map String (Set String) -> Map String (Set String))
323− -> Map String (Set String)
324+ :: (Identifier ->
325+ Identifier ->
326+ Map Identifier (Set Identifier) ->
327+ Map Identifier (Set Identifier))
328+ -> Map Identifier (Set Identifier)
324329 varSubstMapWith f =
325330 List.foldr (case _ of
326331 Substitute v1 v2 ->
@@ -363,7 +368,7 @@ mismatchPenalty = go 0
363368
364369
365370-- | 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
367372 , ty :: TypeQuery }
368373joinQueryConstraints = go Nil
369374 where
@@ -408,7 +413,7 @@ typeSize = go 0 <<< List.singleton
408413 go (n + 1) rest
409414 go n (TypeApp (TypeApp (TypeConstructor
410415 (QualifiedName { moduleNameParts: [ "Prim" ]
411− , name: "Function" })) t1) t2 : rest) =
416+ , name: Identifier "Function" })) t1) t2 : rest) =
412417 go (n + 1) (t1 : t2 : rest)
413418 go n (TypeApp q1 q2 : rest) =
414419 go (n + 1) (q1 : q2 : rest)
src/Docs/Search/TypeShape.purs+2−1
@@ -5,6 +5,7 @@ module Docs.Search.TypeShape where
55
66import Docs.Search.TypeDecoder (QualifiedName(..), Type(..), joinForAlls, joinRows)
77import Docs.Search.TypeQuery (TypeQuery(..), getFreeVariables)
8+import Docs.Search.Types (Identifier(..))
89
910import Prelude
1011
@@ -102,7 +103,7 @@ shapeOfType ty = List.reverse $ go (pure ty) Nil
102103 go rest (PVar : acc)
103104
104105 TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"]
105− , name: "Function" })) t1) t2 ->
106+ , name: Identifier "Function" })) t1) t2 ->
106107 go (t1 : t2 : rest) (PFun : acc)
107108
108109 TypeConstructor (QualifiedName { name }) ->
src/Docs/Search/Types.purs+22−5
@@ -11,6 +11,17 @@ import Data.Generic.Rep.Show (genericShow)
1111import Data.Newtype (class Newtype)
1212
1313
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+
1425newtype ModuleName = ModuleName String
1526
1627derive instance newtypeModuleName :: Newtype ModuleName _
@@ -52,8 +63,14 @@ instance decodeJsonPackageInfo :: DecodeJson PackageInfo where
5263instance encodeJsonPackageInfo :: EncodeJson PackageInfo where
5364 encodeJson = genericEncodeJson
5465
55−packageInfoToString :: PackageInfo -> String
56−packageInfoToString (Package (PackageName p)) = p
57−packageInfoToString Builtin = "<builtin>"
58−packageInfoToString LocalPackage = "<local package>"
59−packageInfoToString UnknownPackage = "<unknown package>"
66+newtype PackageScore = PackageScore Int
67+
68+derive instance newtypePackageScore :: Newtype PackageScore _
69+derive instance genericPackageScore :: Generic PackageScore _
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
33import Prelude
44
55import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..))
6+import Docs.Search.Types
67import Test.TypeQuery as TypeQuery
78import Test.IndexBuilder as IndexBuilder
89import Test.Declarations as Declarations
@@ -67,10 +68,7 @@ mainTest = do
6768 """
6869
6970 assertRight (decodeJson qualifiedName)
70− (QualifiedName { moduleNameParts: ["Prim"]
71− , name: "Type"
72− }
73− )
71+ (qualified ["Prim"] "Type")
7472
7573 test "NamedKind" do
7674 let namedKind = mkJson """
@@ -87,10 +85,7 @@ mainTest = do
8785 """
8886
8987 assertRight (decodeJson namedKind)
90− (NamedKind $ QualifiedName { moduleNameParts: ["Prim"]
91− , name: "Type"
92− }
93− )
88+ (NamedKind $ qualified ["Prim"] "Type")
9489
9590 test "Row" do
9691 let row = mkJson """
@@ -110,11 +105,7 @@ mainTest = do
110105 }
111106 """
112107
113− assertRight (decodeJson row)
114− (Row $ NamedKind $ QualifiedName { moduleNameParts: ["Prim"]
115− , name: "Type"
116− }
117− )
108+ assertRight (decodeJson row) (Row $ NamedKind $ qualified ["Prim"] "Type")
118109
119110 test "FunKind" do
120111 let funKind = mkJson """
@@ -154,14 +145,8 @@ mainTest = do
154145 }
155146 """
156147 assertRight (decodeJson funKind)
157− (FunKind (Row $ NamedKind $ QualifiedName { moduleNameParts: ["Prim"]
158− , name: "Type"
159− }
160− )
161− (Row $ NamedKind $ QualifiedName { moduleNameParts: ["Prim"]
162− , name: "Type"
163− }
164− )
148+ (FunKind (Row $ NamedKind $ qualified ["Prim"] "Type")
149+ (Row $ NamedKind $ qualified ["Prim"] "Type")
165150 )
166151
167152
@@ -181,9 +166,7 @@ mainTest = do
181166 }
182167 """
183168 assertRight (decodeJson constraint)
184− (Constraint { constraintClass: QualifiedName { moduleNameParts: ["Prim"]
185− , name: "Partial"
186− }
169+ (Constraint { constraintClass: qualified ["Prim"] "Partial"
187170 , constraintArgs: []
188171 })
189172
@@ -230,14 +213,12 @@ mainTest = do
230213
231214 assertRight (decodeJson typeApp1) $
232215 TypeApp
233− (TypeConstructor (QualifiedName { moduleNameParts:
234− [ "Control"
235− , "Monad"
236− , "ST"
237− , "Internal"
238− ],
239− name: "ST"
240− }
216+ (TypeConstructor (qualified [ "Control"
217+ , "Monad"
218+ , "ST"
219+ , "Internal"
220+ ]
221+ "ST"
241222 ))
242223 (TypeVar "h")
243224
@@ -256,9 +237,7 @@ mainTest = do
256237 }
257238 """
258239 assertRight (decodeJson typeOp) $
259− TypeOp $ QualifiedName { moduleNameParts: [ "Data", "NaturalTransformation" ]
260− , name: "~>"
261− }
240+ TypeOp $ qualified [ "Data", "NaturalTransformation" ] "~>"
262241
263242 test "BinaryNoParens" do
264243 let binaryNoParens = mkJson """
@@ -293,7 +272,7 @@ mainTest = do
293272
294273 assertRight (decodeJson binaryNoParens) $
295274 BinaryNoParensType
296− (TypeOp $ QualifiedName { moduleNameParts: ["Data", "NaturalTransformation"], name: "~>" })
275+ (TypeOp $ qualified ["Data", "NaturalTransformation"] "~>")
297276 (TypeVar "m")
298277 (TypeVar "n")
299278
@@ -335,19 +314,8 @@ mainTest = do
335314 assertRight (decodeJson parensInType) $
336315 ParensInType $
337316 TypeApp
338− (TypeConstructor (QualifiedName { moduleNameParts:
339− [ "Data"
340− , "Maybe"
341− ],
342− name: "Maybe"
343− }
344− ))
345− (TypeConstructor (QualifiedName { moduleNameParts:
346− [ "Prim"
347− ],
348− name: "String"
349− }
350− ))
317+ (TypeConstructor (qualified [ "Data", "Maybe" ] "Maybe"))
318+ (TypeConstructor (qualified [ "Prim" ] "String"))
351319 test "RCons" do
352320
353321 let rcons = mkJson """
@@ -388,8 +356,8 @@ mainTest = do
388356
389357 assertRight (decodeJson rcons) $
390358 RCons
391− "tail"
392− (TypeApp (TypeConstructor $ QualifiedName { moduleNameParts: [ "Data", "Symbol" ], name: "SProxy" })
359+ (Identifier "tail")
360+ (TypeApp (TypeConstructor $ qualified [ "Data", "Symbol" ] "SProxy")
393361 (TypeVar "t"))
394362 REmpty
395363
@@ -545,8 +513,8 @@ mainTest = do
545513 """
546514 assertRight (decodeJson forallJson) $
547515 ForAll "f"
548− (Just (FunKind (NamedKind (QualifiedName { moduleNameParts: ["Prim","RowList"], name: "RowList" })) (NamedKind (QualifiedName { moduleNameParts: ["Prim"], name: "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" }))))))
516+ (Just (FunKind (NamedKind (QualifiedName { moduleNameParts: ["Prim","RowList"], name: Identifier "RowList" })) (NamedKind (QualifiedName { moduleNameParts: ["Prim"], name: Identifier "Type" }))))
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" }))))))
550518
551519
552520
@@ -558,7 +526,7 @@ mainTest = do
558526{"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]}
559527 """
560528
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"))))))))
562530
563531 suite "Kind encoder" do
564532 test "FunKind" do
@@ -570,4 +538,4 @@ mainTest = do
570538
571539
572540qualified :: 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
33import Docs.Search.TypeDecoder (Constraint(..), QualifiedName(..), Type(..))
44import Docs.Search.TypeQuery (Substitution(..), TypeQuery(..), getFreeVariables, parseTypeQuery, penalty, typeVarPenalty)
55import Docs.Search.TypeShape (ShapeChunk(..), shapeOfType, shapeOfTypeQuery)
6+import Docs.Search.Types (Identifier(..))
67
78import Prelude
89
@@ -25,193 +26,195 @@ tests = do
2526
2627 test "test #0" do
2728 let input = "a"
28− assertRight (parseTypeQuery input) (QVar "a")
29+ assertRight (parseTypeQuery input) (qVar "a")
2930
3031 test "test #1" do
3132 let input = "ab"
32− assertRight (parseTypeQuery input) (QVar "ab")
33+ assertRight (parseTypeQuery input) (qVar "ab")
3334
3435 test "test #2" do
3536 let input = "a b"
36− assertRight (parseTypeQuery input) (QApp (QVar "a") (QVar "b"))
37+ assertRight (parseTypeQuery input) (QApp (qVar "a") (qVar "b"))
3738
3839 test "test #3" do
3940 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"))
4142
4243 test "test #4" do
4344 let input = "a -> b"
44− assertRight (parseTypeQuery input) (QFun (QVar "a") (QVar "b"))
45+ assertRight (parseTypeQuery input) (QFun (qVar "a") (qVar "b"))
4546
4647 test "test #5" do
4748 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")))
4950
5051 test "test #6" do
5152 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"))
5354
5455 test "test #7" do
5556 let input = "a b"
56− assertRight (parseTypeQuery input) (QApp (QVar "a") (QVar "b"))
57+ assertRight (parseTypeQuery input) (QApp (qVar "a") (qVar "b"))
5758
5859 test "test #8" do
5960 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")))
6162
6263 test "test #9" do
6364 let input = "(a b) (c d)"
6465 assertRight (parseTypeQuery input)
65− (QApp (QApp (QVar "a") (QVar "b"))
66− (QApp (QVar "c") (QVar "d")))
66+ (QApp (QApp (qVar "a") (qVar "b"))
67+ (QApp (qVar "c") (qVar "d")))
6768
6869 test "test #10" do
6970 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")))
7172
7273 test "test #11" do
7374 let input = "aaa"
74− assertRight (parseTypeQuery input) (QVar "aaa")
75+ assertRight (parseTypeQuery input) (qVar "aaa")
7576
7677 test "test #12" do
7778 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")))
7980
8081 test "test #13" do
8182 let input = "(a -> b) -> (c -> d)"
82− assertRight (parseTypeQuery input) (QFun (QFun (QVar "a") (QVar "b"))
83− (QFun (QVar "c") (QVar "d")))
83+ assertRight (parseTypeQuery input) (QFun (QFun (qVar "a") (qVar "b"))
84+ (QFun (qVar "c") (qVar "d")))
8485
8586 test "test #14" do
8687 let input = "a -> b -> c -> d"
87− assertRight (parseTypeQuery input) (QFun (QVar "a")
88− (QFun (QVar "b")
89− (QFun (QVar "c") (QVar "d"))))
88+ assertRight (parseTypeQuery input) (QFun (qVar "a")
89+ (QFun (qVar "b")
90+ (QFun (qVar "c") (qVar "d"))))
9091
9192 test "test #15" do
9293 let input = "a -> b -> c"
93− assertRight (parseTypeQuery input) (QFun (QVar "a")
94− (QFun (QVar "b")
95− (QVar "c")))
94+ assertRight (parseTypeQuery input) (QFun (qVar "a")
95+ (QFun (qVar "b")
96+ (qVar "c")))
9697
9798 test "test #16" do
9899 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"))
100101
101102 test "test #17" do
102103 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")))
104105
105106 test "test #18" do
106107 let input = "forall m a. Monad m => a -> m a"
107108 assertRight (parseTypeQuery input)
108109 (QForAll (nl "m" ["a"])
109− (QConstraint "Monad" (l [QVar "m"])
110− (QFun (QVar "a")
111− (QApp (QVar "m") (QVar "a")))))
110+ (qConstraint "Monad" (l [qVar "m"])
111+ (QFun (qVar "a")
112+ (QApp (qVar "m") (qVar "a")))))
112113
113114 test "test #19" do
114115 let input = "{ a :: Int }"
115116 assertRight (parseTypeQuery input)
116− (QApp (QConst "Record") (QRow (pure (Tuple "a" (QConst "Int")))))
117+ (QApp (qConst "Record") (QRow (pure (Tuple (Identifier "a") (qConst "Int")))))
117118
118119 test "test #20" do
119120 let input = "{a::Int}"
120121 assertRight (parseTypeQuery input)
121− (QApp (QConst "Record") (QRow (pure (Tuple "a" (QConst "Int")))))
122+ (QApp (qConst "Record") (QRow (pure (Tuple (Identifier "a") (qConst "Int")))))
122123
123124 test "test #21" do
124125 let input = "Int"
125− assertRight (parseTypeQuery input) (QConst "Int")
126+ assertRight (parseTypeQuery input) (qConst "Int")
126127
127128 test "test #22" do
128129 let input = "a->b"
129− assertRight (parseTypeQuery input) (QFun (QVar "a") (QVar "b"))
130+ assertRight (parseTypeQuery input) (QFun (qVar "a") (qVar "b"))
130131
131132 test "test #23" do
132133 let input = "forall m a. MonadRec m => Process m a -> m a"
133134 assertRight (parseTypeQuery input) (QForAll (nl "m" ("a" : Nil))
134− (QConstraint "MonadRec" (l [QVar "m"])
135− (QFun (QApp (QApp (QConst "Process")
136− (QVar "m")) (QVar "a"))
137− (QApp (QVar "m") (QVar "a")))))
135+ (qConstraint "MonadRec" (l [qVar "m"])
136+ (QFun (QApp (QApp (qConst "Process")
137+ (qVar "m")) (qVar "a"))
138+ (QApp (qVar "m") (qVar "a")))))
138139
139140 test "test #24" do
140141 let input = "forall t f a. Foldable1 t => Apply f => f"
141142 assertRight (parseTypeQuery input) (QForAll (nl "t" ["f", "a"])
142− (QConstraint "Foldable1" (l [QVar "t"])
143− (QConstraint "Apply" (l [QVar "f"]) (QVar "f"))))
143+ (qConstraint "Foldable1" (l [qVar "t"])
144+ (qConstraint "Apply" (l [qVar "f"]) (qVar "f"))))
144145
145146 test "test #25" do
146147 let input = "forall m a.MonadRec m=>Process m a->m a"
147148 assertRight (parseTypeQuery input) ((QForAll (nl "m" ("a" : Nil))
148− (QConstraint "MonadRec" (l [QVar "m"])
149− (QFun (QApp (QApp (QConst "Process")
150− (QVar "m")) (QVar "a"))
151− (QApp (QVar "m") (QVar "a"))))))
149+ (qConstraint "MonadRec" (l [qVar "m"])
150+ (QFun (QApp (QApp (qConst "Process")
151+ (qVar "m")) (qVar "a"))
152+ (QApp (qVar "m") (qVar "a"))))))
152153
153154 test "test #26" do
154155 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"))))
156157
157158 test "test #27" do
158159 let input = "forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a)"
159160 assertRight (parseTypeQuery input) ((QForAll (nl "f" ["a"]))
160− (QConstraint "Alternative" (l [QVar "f"])
161− (QConstraint "Lazy" (l [QApp (QVar "f")
162− (QApp (QConst "List") (QVar "a"))])
163− (QFun (QApp (QVar "f") (QVar "a"))
164− (QApp (QVar "f")
165− (QApp (QConst "List") (QVar "a")))))))
161+ (qConstraint "Alternative" (l [qVar "f"])
162+ (qConstraint "Lazy" (l [QApp (qVar "f")
163+ (QApp (qConst "List") (qVar "a"))])
164+ (QFun (QApp (qVar "f") (qVar "a"))
165+ (QApp (qVar "f")
166+ (QApp (qConst "List") (qVar "a")))))))
166167
167168 test "test #28" do
168169 let input = "forall f a. Alternative f => Lazy(f (List a))=>f a -> f (List a)"
169170 assertRight (parseTypeQuery input) ((QForAll (nl "f" ["a"]))
170− (QConstraint "Alternative" (l [QVar "f"])
171− (QConstraint "Lazy" (l [QApp (QVar "f")
172− (QApp (QConst "List") (QVar "a"))])
173− (QFun (QApp (QVar "f") (QVar "a"))
174− (QApp (QVar "f")
175− (QApp (QConst "List") (QVar "a")))))))
171+ (qConstraint "Alternative" (l [qVar "f"])
172+ (qConstraint "Lazy" (l [QApp (qVar "f")
173+ (QApp (qConst "List") (qVar "a"))])
174+ (QFun (QApp (qVar "f") (qVar "a"))
175+ (QApp (qVar "f")
176+ (QApp (qConst "List") (qVar "a")))))))
176177
177178 test "test #29" do
178179 let input = "{a::Int,b::Int}"
179180 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")])))
181184
182185 test "test #30" do
183186 let input = "{record''' :: Int}"
184187 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")])))
186189
187190 test "test #31" do
188191 let input = "(row''' :: Int)"
189192 assertRight (parseTypeQuery input)
190− (QRow (List.fromFoldable [ Tuple "row'''" (QConst "Int")]))
193+ (QRow (List.fromFoldable [ Tuple (Identifier "row'''") (qConst "Int")]))
191194
192195 test "test #32" do
193196 let input = "(row1 :: Int, row2 :: (),row3::(row4::{}))"
194197 assertRight (parseTypeQuery input)
195− (QRow (l [ Tuple "row1" (QConst "Int")
196− , Tuple "row2" (QRow Nil)
197− , Tuple "row3" (QRow (l [ Tuple "row4" (QApp (QConst "Record") (QRow Nil)) ])) ]))
198+ (QRow (l [ Tuple (Identifier "row1") (qConst "Int")
199+ , Tuple (Identifier "row2") (QRow Nil)
200+ , Tuple (Identifier "row3") (QRow (l [ Tuple (Identifier "row4") (QApp (qConst "Record") (QRow Nil)) ])) ]))
198201
199202 test "test #33" do
200203 let input = "Foldable1 t => Apply f => t (f a) -> f Unit"
201204 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")))))
203206
204207 test "test #34" do
205208 let input = "Foldable1 t => Apply f => t (f a) -> f a"
206209 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")))))
208211
209212 test "test #35" do
210213 let input = "Generic a rep => GenericEq rep => a -> a -> Boolean"
211214 assertRight (parseTypeQuery input)
212− (QConstraint "Generic" ((QVar "a") : (QVar "rep") : Nil)
213− (QConstraint "GenericEq" ((QVar "rep") : Nil)
214− (QFun (QVar "a") (QFun (QVar "a") (QConst "Boolean")))))
215+ (qConstraint "Generic" ((qVar "a") : (qVar "rep") : Nil)
216+ (qConstraint "GenericEq" ((qVar "rep") : Nil)
217+ (QFun (qVar "a") (QFun (qVar "a") (qConst "Boolean")))))
215218
216219 suite "polish notation" do
217220
@@ -246,7 +249,7 @@ tests = do
246249
247250 fun t1 t2 =
248251 TypeApp (TypeApp (TypeConstructor (QualifiedName { moduleNameParts: ["Prim"]
249− , name: "Function" })) t1) t2
252+ , name: Identifier "Function" })) t1) t2
250253 type_ =
251254 ForAll "a" Nothing $
252255 ForAll "rep" Nothing $
@@ -314,70 +317,70 @@ tests = do
314317 Assert.equal 0 (typeVarPenalty mempty)
315318
316319 test "#1" do
317− Assert.equal 0 (typeVarPenalty $ l [ Substitute "a" "b"
318− , Substitute "b" "a"
320+ Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "b"
321+ , substitute "b" "a"
319322 ])
320323
321324 test "#2" do
322− Assert.equal 0 (typeVarPenalty $ l [ Substitute "a" "b"
323− , Substitute "a" "b"
324− , Substitute "a" "b"
325+ Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "b"
326+ , substitute "a" "b"
327+ , substitute "a" "b"
325328 ])
326329
327330 test "#3" do
328− Assert.equal 1 (typeVarPenalty $ l [ Substitute "a" "b"
329− , Substitute "a" "c"
331+ Assert.equal 1 (typeVarPenalty $ l [ substitute "a" "b"
332+ , substitute "a" "c"
330333 ])
331334
332335 test "#4" do
333− Assert.equal 1 (typeVarPenalty $ l [ Substitute "a" "b"
334− , Substitute "b" "a"
335− , Substitute "b" "c"
336+ Assert.equal 1 (typeVarPenalty $ l [ substitute "a" "b"
337+ , substitute "b" "a"
338+ , substitute "b" "c"
336339 ])
337340
338341 test "#5" do
339− Assert.equal 0 (typeVarPenalty $ l [ Substitute "a" "b"
340− , Substitute "b" "c"
341− , Substitute "c" "a"
342+ Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "b"
343+ , substitute "b" "c"
344+ , substitute "c" "a"
342345 ])
343346
344347 test "#6" do
345− Assert.equal 2 (typeVarPenalty $ l [ Substitute "a" "b"
346− , Substitute "a" "c"
347− , Substitute "a" "a"
348+ Assert.equal 2 (typeVarPenalty $ l [ substitute "a" "b"
349+ , substitute "a" "c"
350+ , substitute "a" "a"
348351 ])
349352
350353 test "#7" do
351− Assert.equal 2 (typeVarPenalty $ l [ Substitute "a" "a"
352− , Substitute "b" "a"
353− , Substitute "c" "a"
354+ Assert.equal 2 (typeVarPenalty $ l [ substitute "a" "a"
355+ , substitute "b" "a"
356+ , substitute "c" "a"
354357 ])
355358
356359 test "#8" do
357− Assert.equal 4 (typeVarPenalty $ l [ Substitute "a" "a"
358− , Substitute "b" "a"
359− , Substitute "c" "a"
360− , Substitute "a" "b"
361− , Substitute "a" "c"
362− , Substitute "a" "a"
360+ Assert.equal 4 (typeVarPenalty $ l [ substitute "a" "a"
361+ , substitute "b" "a"
362+ , substitute "c" "a"
363+ , substitute "a" "b"
364+ , substitute "a" "c"
365+ , substitute "a" "a"
363366 ])
364367
365368 test "#9" do
366− Assert.equal 0 (typeVarPenalty $ l [ Substitute "a" "e"
367− , Substitute "b" "d"
368− , Substitute "c" "f"
369+ Assert.equal 0 (typeVarPenalty $ l [ substitute "a" "e"
370+ , substitute "b" "d"
371+ , substitute "c" "f"
369372 ])
370373
371374 suite "unification" do
372375 test "instantiation #0" do
373− let mVarQuery = QVar "m"
374− unitConstQuery = QConst "Unit"
376+ let mVarQuery = qVar "m"
377+ unitConstQuery = qConst "Unit"
375378
376379 Assert.assert "instantiation #0" $
377380 (penalty unitConstQuery unitType < penalty mVarQuery unitType)
378381
379382 test "generalization #0" do
380− let query = QVar "m"
383+ let query = qVar "m"
381384 t1 = TypeVar "m"
382385
383386 Assert.assert "qeneralization #0" $
@@ -387,19 +390,37 @@ tests = do
387390l :: forall f. Foldable f => (forall a. f a -> List a)
388391l = List.fromFoldable
389392
390−nl :: forall t5 t6. Foldable t6 => t5 -> t6 t5 -> NonEmptyList t5
391−nl x rst = NonEmptyList.cons' x $ List.fromFoldable rst
393+nl
394+ :: forall t
395+ . Foldable t
396+ => Functor t
397+ => String
398+ -> t String
399+ -> NonEmptyList Identifier
400+nl x rst = NonEmptyList.cons' (Identifier x) $ List.fromFoldable (rst <#> Identifier)
392401
393402unitType :: Type
394403unitType = TypeConstructor (QualifiedName { moduleNameParts: []
395− , name: "Unit"
404+ , name: Identifier "Unit"
396405 })
397406
398407countFreeVars :: TypeQuery -> Int
399408countFreeVars = getFreeVariables >>> Set.size
400409
401410qname :: Array String -> String -> QualifiedName
402−qname m n = QualifiedName { moduleNameParts: m, name: n }
411+qname m n = QualifiedName { moduleNameParts: m, name: Identifier n }
403412
404413constr :: QualifiedName -> Array Type -> Constraint
405414constr 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)