#! /usr/bin/env racket -tm
#lang racket/base

;; Usage: run
;;   ./xcheck PathToSpecification
;; at the top-level of a repo. It checks whether the repo is organized
;; according to the Spec found in PathToSpecification.  

#; {type Spec = Symbol u .* u [** Symbol] u [Cons Symbol [Listof Spec]]}
;; Symbol is a name, .* means "any file", [** Symbol] means optional;
;; (S . Spec) is the specification for sub-directory S

(provide main #;{PathString to Specification of required file/dir org})

(require racket/match racket/set racket/format)

(define (main lvl) (check-spec (with-input-from-file lvl read)))

#; {Spec -> Void}
(define (check-spec sp [path "."])
  (define-values (must may) (level->set sp))
  (check-1-level (member '|.*| sp) must may path)
  (define dirs
    (for/list ([l sp] #:when (and (pair? l) (set-member? must (~n (car l)))))
      l))
  (for* ([m dirs][dir (in-value (~n (car m)))])
    (when (directory-exists? dir)
      (parameterize ((current-directory dir))
        (check-spec (cdr m) (~a path "/" dir))))))

#; {Boolean [Setof String] [Setof String] PathString -> Void}
(define (check-1-level any must may P)
  (define all (map path->string (directory-list)))
  (for ([m must] #:unless (matched? m all)) (displayln `[,m missing at ,P]))
  (unless any (extras all (set-union must may) P)))

#; {[Listof String] [Listof String] PathString -> Void}
(define (extras F Pats Path)
  (define (match-one f) (for/or ([p Pats]) (matched? p (list f))))
  (define xtra (for/list ([f F] #:unless (match-one f)) f))
  (when (pair? xtra) (displayln `[,xtra should not exist at ,Path])))

#;{Spec -> (values [Setof String] [Setof String])}
(define (level->set lvl)
  (define-values (man opt)
    (for/fold ([man '()][opt '()]) ([l lvl])
      (match l
        [`[** ,k]     (values man (cons (~n k) opt))]
        [`[,d ,_ ...] (values (cons (~n d) man) opt)]
        [_            (values (cons (~n l) man) opt)])))
  (values (apply set man) (apply set opt)))

#; {String [Listof String] -> Boolean}
(define (matched? p all) (for/or ([a all]) (regexp-match p a)))

#; {Symbol -> String}
(define (~n s) (cond [(regexp-match "(.*)/" (~a s)) => cadr] [else (~a s)]))