35bcbe8 · rowtype-yoga/purescript-docs-search

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

on master help sign in

added: proper sorting for type queries

35bcbe8klntsky7 years ago

src/Docs/Search/App.purs+4

compare with master

unifiedsplit

@@ -63,6 +63,10 @@ insertStyle doc = do

63 .result__body .keyword, .result__body .syntax {

64 color: #0B71B4;

65 }

66+ .badge {

67+ /* Add a margin between badge icons and package/module names. */

68+ margin-right: 0.25em;

69+ }

66 """

70 """

67 mbHead <-

71 mbHead <-

68 ParentNode.querySelector (wrap "head") (Document.toParentNode doc)

72 ParentNode.querySelector (wrap "head") (Document.toParentNode doc)

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

@@ -628,5 +628,5 @@ sortByDistance typeQuery results =

628 where

629 comparePenalties r1 r2 = compare r1.penalty r2.penalty

630 resultsWithPenalties = results <#>

631− \result -> { penalty: typeOf (unwrap result).info >>= penalty typeQuery

631+ \result -> { penalty: typeOf (unwrap result).info <#> penalty typeQuery

632 , result }

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

@@ -22,12 +22,14 @@ config =

22 \(partId :: Int) -> "../index/declarations/" <> show partId <> ".js"

23 , resultsCount: 25

24 -- ^ How many results to show by default?

25− , penalties: { typeVars: 2

25+ , penalties: { typeVars: 6

26 , match: 2

27− , matchConstraint: 2

27+ , matchConstraint: 1

28− , instantiate: 3

28+ , instantiate: 1

29− , generalize: 1

29+ , generalize: 4

30+ , rowsMismatch: 6

31+ , mismatch: 10

30 , missingConstraint: 1

32 , missingConstraint: 1

31− , excessiveConstraint: 5

33+ , excessiveConstraint: 1

32 }

34 }

33 }

35 }

src/Docs/Search/TypeDecoder.purs+11−2

@@ -9,12 +9,12 @@ import Data.Array ((!!))

9import Data.Either (Either(..))

10import Data.Generic.Rep (class Generic)

11import Data.Generic.Rep.Show (genericShow)

12+import Data.List (List(..), (:))

13+import Data.List as List

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

14import Data.Maybe (Maybe(..), fromMaybe)

13import Data.Newtype (class Newtype)

15import Data.Newtype (class Newtype)

14import Data.Tuple (Tuple(..))

16import Data.Tuple (Tuple(..))

15import Foreign.Object as Object

17import Foreign.Object as Object

16−import Data.List (List(..), (:))

17−import Data.List as List

19derive instance eqQualifiedName :: Eq QualifiedName

20derive instance genericQualifiedName :: Generic QualifiedName _

@@ -372,3 +372,12 @@ joinRows = go Nil

372 REmpty -> Nothing

373 ty' -> Just ty'

374 }

375+

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

377+joinConstraints :: Type -> { constraints :: List String

378+ , ty :: Type }

379+joinConstraints = go Nil

380+ where

381+ go acc (ConstrainedType (Constraint { constraintClass: QualifiedName { name } }) ty) =

382+ go (name : acc) ty

383+ go acc ty = { constraints: List.sort acc, ty }

src/Docs/Search/TypeQuery.purs+79−29

@@ -11,8 +11,9 @@ where

12import Prelude

14−import Docs.Search.TypeDecoder

15import Docs.Search.Config

14import Docs.Search.Config

15+import Docs.Search.DocsJson

16+import Docs.Search.TypeDecoder

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

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

18import Data.Array as Array

19import Data.Array as Array

@@ -183,20 +184,24 @@ data Substitution

183 | Match String String

184 | Match String String

184 | Generalize TypeQuery String

185 | Generalize TypeQuery String

185 | Substitute String String

186 | Substitute String String

186− | MatchConstraints String String

187+ | MatchConstraints (Set String) (Set String)

187 | MissingConstraint

188 | MissingConstraint

188 | ExcessiveConstraint

189 | ExcessiveConstraint

190+ | RowsMismatch Int Int

191+ | Mismatch

189

192

190derive instance genericSubstitution :: Generic Substitution _

193derive instance genericSubstitution :: Generic Substitution _

191

194

192instance showSubstitution :: Show Substitution where

195instance showSubstitution :: Show Substitution where

193 show x = genericShow x

196 show x = genericShow x

194

197

195−unify :: TypeQuery -> Type -> Maybe (List Substitution)

198+unify :: TypeQuery -> Type -> List Substitution

196unify query type_ = go Nil (List.singleton { q: query, t: type_ })

199unify query type_ = go Nil (List.singleton { q: query, t: type_ })

197 where

200 where

198− go :: List Substitution -> List { q :: TypeQuery, t :: Type } -> Maybe (List Substitution)

201+ go :: List Substitution -> List { q :: TypeQuery, t :: Type } -> List Substitution

199− go acc Nil = Just acc

202+ go acc Nil = acc

203+ go acc ({ q, t: ParensInType t } : rest) =

204+ go acc ({ q, t } : rest)

200

205

201 -- * ForAll

206 -- * ForAll

202 go acc ({ q: (QForAll queryBinders q), t:type_1@(ForAll _ _ _) } : rest) =

207 go acc ({ q: (QForAll queryBinders q), t:type_1@(ForAll _ _ _) } : rest) =

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

218 -- * Names

223 -- * Names

219 go acc ({ q: QConst qname, t: TypeConstructor (QualifiedName { name }) } : rest) =

224 go acc ({ q: QConst qname, t: TypeConstructor (QualifiedName { name }) } : rest) =

220 go (Match qname name : acc) rest

225 go (Match qname name : acc) rest

226+ go acc ({ q: QConst qname, t } : rest) =

227+ go (Mismatch : acc) rest

228+ go acc ({ q, t: TypeConstructor (QualifiedName { name }) } : rest) =

229+ go (Mismatch : acc) rest

230+

231+ -- type operators can't appear in type queries: this is always a mismatch

232+ go acc ({ q, t: TypeOp (QualifiedName { name }) } : rest) =

233+ go (Mismatch : acc) rest

234+ go acc ({ q, t: BinaryNoParensType _ _ _ } : rest) =

235+ go (Mismatch : acc) rest

221

236

222 -- * Functions

237 -- * Functions

223 go acc ({ q: QFun q1 q2

238 go acc ({ q: QFun q1 q2

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

225 (QualifiedName { moduleName: [ "Prim" ]

240 (QualifiedName { moduleName: [ "Prim" ]

226 , name: "Function" })) t1) t2 } : rest) =

241 , name: "Function" })) t1) t2 } : rest) =

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

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

243+ go acc ({ q: QFun q1 q2, t } : rest) =

244+ go (Mismatch : acc) rest

228

245

229 -- * Constraints

246 -- * Constraints

230− go acc ({ q: QConstraint className args q

247+ go acc ({ q: q@(QConstraint _ _ _)

231− , t: ConstrainedType cnstr t } : rest) =

248+ , t: t@(ConstrainedType _ _) } : rest) =

249+ let qcs = Set.fromFoldable (joinQueryConstraints q).constraints

250+ tcs = Set.fromFoldable (joinConstraints t).constraints

251+ in

252+ -- TODO: use edit distance instead

232− go (MatchConstraints className typeClassName : acc) ({ q, t } : rest)

253+ go (MatchConstraints qcs tcs : acc) rest

233− where typeClassName = (unwrap (unwrap cnstr).constraintClass).name

234− go acc ({ q: QConstraint _ _ q

254+ go acc ({ q: QConstraint _ _ q, t } : rest) =

235− , t } : rest) =

236 go (ExcessiveConstraint : acc) ({ q, t } : rest)

255 go (ExcessiveConstraint : acc) ({ q, t } : rest)

237− go acc ({ q

238− , t: ConstrainedType cnstr t } : rest) =

256+ go acc ({ q, t: ConstrainedType _ t } : rest) =

239 go (MissingConstraint : acc) ({ q, t } : rest)

257 go (MissingConstraint : acc) ({ q, t } : rest)

240

258

241 -- * Rows

259 -- * Rows

@@ -243,25 +261,45 @@ unify query type_ = go Nil (List.singleton { q: query, t: type_ })

243 , t: TypeApp (TypeConstructor

261 , t: TypeApp (TypeConstructor

244 (QualifiedName { moduleName: [ "Prim" ]

262 (QualifiedName { moduleName: [ "Prim" ]

245 , name: "Record" })) row } : rest) =

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

246− let { rows, ty } = joinRows row in

264+ let { rows, ty } = joinRows row

247− if List.length rows == List.length qRows then

265+ qRowsLength = List.length qRows

266+ rowsLength = List.length rows in

267+ if rowsLength == qRowsLength then

248 let

268 let

249 sortedQRows = List.sortBy (\x y -> compare (fst x) (fst y)) qRows

269 sortedQRows = List.sortBy (\x y -> compare (fst x) (fst y)) qRows

250 sortedRows = List.sortBy (\x y -> compare x.row y.row) rows in

270 sortedRows = List.sortBy (\x y -> compare x.row y.row) rows in

251− go acc $

271+ go

272+ -- match row names

273+ (List.zipWith (\(Tuple qRowName _) { row: rowName } ->

274+ Match qRowName rowName) sortedQRows sortedRows <> acc)

275+ -- match row types

276+ (List.zipWith (\(Tuple _ q) { ty: t } ->

252− (List.zipWith (\(Tuple _ q) { ty: t } -> { q, t }) sortedQRows sortedRows <> rest)

277+ { q, t }) sortedQRows sortedRows <> rest)

253 else

278 else

254− Nothing

279+ go (RowsMismatch qRowsLength rowsLength : acc) rest

280+

281+ go acc ({ q: QRow _ } : rest) =

282+ go (Mismatch : acc) rest

255

283

256 -- * Type application

284 -- * Type application

257 go acc ({ q: QApp q1 q2, t: TypeApp t1 t2 } : rest) =

285 go acc ({ q: QApp q1 q2, t: TypeApp t1 t2 } : rest) =

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

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

259

287

260− go acc _ = Nothing

288+ go acc ({ q, t: TypeLevelString _ } : rest) =

289+ go (Mismatch : acc) rest

290+

291+ go acc ({ q, t: TypeWildcard } : rest) =

292+ go (Mismatch : acc) rest

261

293

294+ go acc ({ q, t: RCons _ _ _ } : rest) =

295+ go (Mismatch : acc) rest

296+

297+ go acc ({ q, t: REmpty } : rest) =

298+ go (Mismatch : acc) rest

299+

262−penalty :: TypeQuery -> Type -> Maybe Int

300+penalty :: TypeQuery -> Type -> Int

263penalty typeQuery ty =

301penalty typeQuery ty =

264− unify typeQuery ty <#> \substs ->

302+ let substs = unify typeQuery ty in

265 typeVarPenalty substs * config.penalties.typeVars +

303 typeVarPenalty substs * config.penalties.typeVars +

266 namesPenalty substs +

304 namesPenalty substs +

267 mismatchPenalty substs

305 mismatchPenalty substs

@@ -293,14 +331,17 @@ typeVarPenalty substs =

293namesPenalty :: List Substitution -> Int

331namesPenalty :: List Substitution -> Int

294namesPenalty = go 0

332namesPenalty = go 0

295 where

333 where

296− go n Nil = n

334+ go p Nil = p

335+ go p (Mismatch : rest) = go (p + config.penalties.mismatch) rest

297− go n (Match a b : rest)

336+ go p (Match a b : rest)

298− | a == b = go n rest

337+ | a == b = go p rest

299− | otherwise = go (n + config.penalties.match) rest

338+ | otherwise = go (p + config.penalties.match) rest

300− go n (MatchConstraints a b : rest)

339+ go p (MatchConstraints qcs tcs : rest)

301− | a == b = go n rest

340+ = let p' = Set.size (Set.union qcs tcs) -

341+ Set.size (Set.intersection qcs tcs) in

302− | otherwise = go (n + config.penalties.matchConstraint) rest

342+ go (p + config.penalties.matchConstraint * p') rest

343+ go p (RowsMismatch n m : rest) = go (config.penalties.rowsMismatch * abs (n - m)) rest

303− go n (_ : rest) = go n rest

344+ go p (_ : rest) = go p rest

304

345

305-- | Penalty for generalization and instantiation.

346-- | Penalty for generalization and instantiation.

306mismatchPenalty :: List Substitution -> Int

347mismatchPenalty :: List Substitution -> Int

@@ -312,3 +353,12 @@ mismatchPenalty = go 0

312 go n (ExcessiveConstraint : rest) = go (n + config.penalties.excessiveConstraint) rest

353 go n (ExcessiveConstraint : rest) = go (n + config.penalties.excessiveConstraint) rest

313 go n (MissingConstraint : rest) = go (n + config.penalties.missingConstraint) rest

354 go n (MissingConstraint : rest) = go (n + config.penalties.missingConstraint) rest

314 go n (_ : rest) = go n rest

355 go n (_ : rest) = go n rest

356+

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

358+joinQueryConstraints :: TypeQuery -> { constraints :: List String

359+ , ty :: TypeQuery }

360+joinQueryConstraints = go Nil

361+ where

362+ go acc (QConstraint name _ query) =

363+ go (name : acc) query

364+ go acc ty = { constraints: List.sort acc, ty }

test/Test/TypeQuery.purs+32−2

@@ -2,9 +2,9 @@ module Test.TypeQuery where

3import Prelude

5−

6−import Docs.Search.TypeQuery (TypeQuery(..), Substitution(..), getFreeVariables, parseTypeQuery, typeVarPenalty)

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

7import Docs.Search.TypeShape (ShapeChunk(..), shapeOfTypeQuery)

6import Docs.Search.TypeShape (ShapeChunk(..), shapeOfTypeQuery)

7+import Docs.Search.TypeDecoder (QualifiedName(..), Type(..))

9import Data.Either (Either(..))

10import Data.Foldable (class Foldable)

@@ -195,6 +195,15 @@ tests = do

195 , Tuple "row2" (QRow Nil)

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

197

198+ test "test #33" do

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

200+ assertRight (parseTypeQuery input)

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

202+

203+ test "test #34" do

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

205+ assertRight (parseTypeQuery input)

206+ (QConstraint "Foldable1" ((QVar "t") : Nil) (QConstraint "Apply" ((QVar "f") : Nil) (QFun (QApp (QVar "t") (QApp (QVar "f") (QVar "a"))) (QApp (QVar "f") (QVar "a")))))

198

207

199 suite "polish notation" do

208 suite "polish notation" do

200

209

@@ -332,12 +341,33 @@ tests = do

332 , Substitute "c" "f"

341 , Substitute "c" "f"

333 ])

342 ])

334

343

344+ suite "unification" do

345+ test "instantiation #0" do

346+ let mVarQuery = QVar "m"

347+ unitConstQuery = QConst "Unit"

348+

349+ Assert.assert "instantiation #0" $

350+ (penalty unitConstQuery unitType < penalty mVarQuery unitType)

351+

352+ test "generalization #0" do

353+ let query = QVar "m"

354+ t1 = TypeVar "m"

355+

356+ Assert.assert "qeneralization #0" $

357+ (penalty query unitType > penalty query t1)

358+

359+

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

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

336l = List.fromFoldable

361l = List.fromFoldable

337

362

338nl :: forall t5 t6. Foldable t6 => t5 -> t6 t5 -> NonEmptyList t5

363nl :: forall t5 t6. Foldable t6 => t5 -> t6 t5 -> NonEmptyList t5

339nl x rst = NonEmptyList.cons' x $ List.fromFoldable rst

364nl x rst = NonEmptyList.cons' x $ List.fromFoldable rst

340

365

366+unitType :: Type

367+unitType = TypeConstructor (QualifiedName { moduleName: []

368+ , name: "Unit"

369+ })

370+

341assertRight

371assertRight

342 :: forall a b

372 :: forall a b

343 . Show a

373 . Show a