From 7bd08a679a4968dbf34d95f4db53ed88173862c6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 3 Feb 2015 18:33:54 -0800 Subject: [PATCH] quad-ends-with --- quad/quads-typed.rkt | 17 ++++++++++++++++- quad/tests-typed.rkt | 10 ++++++++-- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/quad/quads-typed.rkt b/quad/quads-typed.rkt index b7825551..20478005 100644 --- a/quad/quads-typed.rkt +++ b/quad/quads-typed.rkt @@ -1,8 +1,10 @@ #lang typed/racket/base (require (for-syntax typed/racket/base racket/syntax racket/string)) -(require/typed racket/list [empty? (All (A) ((Listof A) -> Boolean))]) +(require/typed racket/list [empty? (All (A) ((Listof A) -> Boolean))] + [last ((Listof Any) . -> . Any)]) (require/typed sugar/list [trimf (All (A) ((Listof A) (A . -> . Boolean) -> (Listof A)))] [filter-split (All (A) ((Listof A) (A . -> . Boolean) -> (Listof (Listof A))))]) +(require/typed sugar/string [ends-with? (String String . -> . Boolean)]) (require sugar/debug) (provide (all-defined-out)) @@ -36,6 +38,7 @@ (define-type Quad quad) (define-predicate Quad? Quad) + (define quad-attr-ref (case-lambda [([q : Quad] [key : QuadAttrKey]) @@ -54,6 +57,18 @@ (define-type QuadAttrPair (Pairof QuadAttrKey QuadAttrValue)) +(: quad-ends-with? (Quad String . -> . Boolean)) +(define (quad-ends-with? q str) + (cond + [(not (empty? (quad-list q))) + (define last-item (last (quad-list q))) + (cond + [(string? last-item) (ends-with? last-item str)] + [(quad? last-item) (quad-ends-with? last-item str)] + [else #f])] + [else #f])) + + (provide gather-common-attrs) (: gather-common-attrs ((Listof Quad) . -> . (U False (Listof QuadAttrPair)))) (define (gather-common-attrs qs) diff --git a/quad/tests-typed.rkt b/quad/tests-typed.rkt index 39b778b8..3eedec1f 100644 --- a/quad/tests-typed.rkt +++ b/quad/tests-typed.rkt @@ -41,8 +41,8 @@ (check-true (quad-has-attr? (box '(foo bar)) 'foo)) (check-equal? (quad-attr-set (box '(foo bar)) 'foo 'zam) (box '(foo zam))) -(check-equal? (quad-attr-set (box '()) 'foo 'zam) (box '(foo zam))) -(check-equal? (quad-attr-set* (box '()) 'foo 'zam 'bar 'boo) (box '(foo zam bar boo))) +(check-equal? (quad-attr-set (box #f) 'foo 'zam) (box '(foo zam))) +(check-equal? (quad-attr-set* (box #f) 'foo 'zam 'bar 'boo) (box '(foo zam bar boo))) (check-equal? (quad-attr-set* (box '(foo bar)) 'foo 'zam 'bar 'boo) (box '(foo zam bar boo))) (check-equal? (quad-attr-remove (box '(foo bar zim zam)) 'foo) (box '(zim zam))) @@ -51,4 +51,10 @@ (check-equal? (quad-attr-remove* (box #f) 'zim) (box)) +(check-true (quad-ends-with? (box #f "foo") "foo")) +(check-false (quad-ends-with? (box #f "foo") "food")) +(check-false (quad-ends-with? (box #f (box #f "foo")) "food")) +(check-true (quad-ends-with? (box #f (box #f "foo")) "foo")) +(check-true (quad-ends-with? (box #f (box #f "foo")) "o")) +(check-true (quad-ends-with? (box #f (box #f (box #f (box #f (box #f "foo-"))))) "-"))