#lang racket/base
(require file/sha1
pollen/core
pollen/file
pollen/setup
(only-in racket/function identity)
racket/match
racket/path
racket/string
threading
txexpr)
(provide (all-defined-out))
;; Convert a string into all lowercase, delete all non-alphanum chars, replace spaces with ‘-’
(define (normalize-key str)
(~> (string-downcase str)
(regexp-replace #rx"ies$" _ "y")
(string-trim "s" #:left? #f)
(regexp-replace* #rx"[^A-Za-z0-9 ]" _ "")
(string-normalize-spaces #px"\\s+" "-")))
;; ~~ Metas reference and updating ~~~~~~~~~~~~~~~
;; Computes a unique string key for the current Pollen source and stashes it in the metas
(define (here-key [suffix ""])
(define metas (current-metas))
(define (set-here-key!)
(set-meta 'here-key
(~> (hash-ref metas 'here-path)
string->bytes/utf-8
sha1-bytes
bytes->hex-string
(substring 0 8))))
(string-append (hash-ref metas 'here-key set-here-key!) suffix))
(define (here-source-path #:string? [string? #t])
(define proc (if string? path->string identity))
(cond
[(current-metas)
(proc (find-relative-path (current-project-root) (hash-ref (current-metas) 'here-path)))]
[else "."]))
(define (here-output-path #:string? [string? #t])
(define proc (if string? path->string identity))
(proc (->output-path (here-source-path #:string? #f))))
(define (meta-set? key)
(and (hash-ref (current-metas) key #f) #t))
(define (set-meta key val)
(current-metas (hash-set (current-metas) key val))
val)
(define (cons-to-metas-list key val)
(define consed (cons val (hash-ref (current-metas) key '())))
(current-metas (hash-set (current-metas) key consed))
consed)
(define (update-metas-subhash key subkey val [proc (λ (v) v)])
(define metas (current-metas))
(define subhash (hash-ref metas key hasheq))
(set-meta key (hash-set subhash subkey (proc val))))
(define (get-metas-subhash key subkey)
(hash-ref (hash-ref (current-metas) key #hasheq()) subkey #f))
;; Returns a function will test if a txexpr's tag matches the given symbol and
;; (optionally) contains all given attributes.
(define (tx-is? t #:has-attrs [a '()])
(define tags (if (list? t) tags (list t)))
(define attrs (if (list? a) a (list a)))
(lambda (v)
(and (txexpr? v)
(member (get-tag v) tags)
(andmap (λ (attr) (attrs-have-key? a attr)) attrs)
#t)))
