#lang racket/base
(require scribble/base)
(require scribble/core)
(require scribble/decode)
(require scribble/manual)
(require scribble/private/defaults)
(require scribble/html-properties)
(require scribble/latex-properties)
(require racket/class)
(require racket/draw)
(require racket/system)
(require racket/port)
(require racket/vector)
(require racket/file)
(require racket/cmdline)

(provide (all-defined-out))

(define tb-mode (make-parameter 'apt))
(define doc-mode (make-parameter 'html))
(define include-ga (make-parameter #f))
(define geni-lib-dir (make-parameter null))

(command-line
  #:program "testbed-manual"
  #:once-any
  ["--apt" "Compile manual for Apt" (tb-mode 'apt)]
  ["--clab" "Compile manual for CloudLab" (tb-mode 'clab)]
  ["--pnet" "Compile manual for PhantomNet" (tb-mode 'pnet)]
  ["--powder" "Compile manual for Powder" (tb-mode 'powder)]
  ["--elab" "Compile manual for Emulab" (tb-mode 'elab)]
  #:once-each
  ["--pdf"  "Compile PDF version of the manual" (doc-mode 'pdf)]
  ["--ga"   "Include Google Analytics code" (include-ga #t)]
  ["--geni-lib-dir" gld  "Give the path to geni-lib" (geni-lib-dir gld)]
)

(define (apt?) (if (equal? (tb-mode) 'apt) #t #f))
(define (clab?)  (if (equal? (tb-mode) 'clab) #t #f))
(define (pnet?)  (if (equal? (tb-mode) 'pnet) #t #f))
(define (powder?)  (if (equal? (tb-mode) 'powder) #t #f))
(define (elab?)  (if (equal? (tb-mode) 'elab) #t #f))

(define main-style
  (make-style "main-body"
              (list (js-style-addition "highlight.pack.js")
                    (js-style-addition "download-code.js")
                    (if (and (clab?) (include-ga)) (js-style-addition "ga-cloudlab.js") null)
                    (make-css-addition "highlight-default.css"))))


(define (apt-vs-clab #:apt [apt-version (list)] #:clab [clab-version (list)] #:pnet [pnet-version (list)] #:powder [powder-version (list)] #:elab [elab-version (list)])
  (case (tb-mode)
	('apt apt-version)
	('clab clab-version)
	('pnet pnet-version)
	('powder powder-version)
	('elab elab-version)))

(define (apt-vs-clab* #:apt [apt-version ""] #:clab [clab-version ""] #:pnet [pnet-version ""] #:powder [powder-version ""] #:elab [elab-version ""])
  (decode-flow (list (case (tb-mode)
			   ('apt apt-version)
			   ('clab clab-version)
			   ('pnet pnet-version)
			   ('powder powder-version)
			   ('elab elab-version)))))

(define (apt-only . stuff)
  (apt-vs-clab #:apt stuff))

(define (clab-only . stuff)
  (apt-vs-clab #:clab stuff))

(define (pnet-only . stuff)
  (apt-vs-clab #:pnet stuff))

(define (powder-only . stuff)
  (apt-vs-clab #:powder stuff))

(define (elab-only . stuff)
  (apt-vs-clab #:elab stuff))

(define (wireless-only . stuff)
  (apt-vs-clab #:pnet stuff #:powder stuff))

(define apt-base-url
  (case (tb-mode)
	('apt "https://www.aptlab.net/")
	('clab "https://www.cloudlab.us/")
	('pnet "https://www.phantomnet.org/")
	('powder "https://www.powderwireless.net/")
	('elab "https://www.emulab.net/portal/")))

(define apt-doc-url
  (case (tb-mode)
	('apt "http://docs.aptlab.net/")
	('clab "http://docs.cloudlab.us/")
	('pnet "http://docs.phantomnet.org/")
	('powder "http://docs.powderwireless.net/")
	('elab "http://docs.emulab.net/")))

(define forum-url
  (case (tb-mode)
	('apt "https://groups.google.com/forum/#!forum/apt-users")
	('clab "https://groups.google.com/forum/#!forum/cloudlab-users")
	('pnet "https://groups.google.com/forum/#!forum/phantomnet-users")
	('powder "https://groups.google.com/forum/#!forum/phantomnet-users")
	('elab "https://groups.google.com/forum/#!forum/emulab-users")))

(define tb (lambda () (case (tb-mode)
			    ('apt "Apt")
			    ('clab "CloudLab")
			    ('pnet "PhantomNet")
			    ('powder "Powder")
			    ('elab "Emulab"))))

; We want the 'version' to be the date of the most recent commit
(define apt-version
  (with-output-to-string
    (lambda () (system "git show -s --date=short --format='%cd (%h)' HEAD"))))

; Arbitrary width that works reasonably well with the manual class's main
; column width
(define screenshot-width 650)

(define apturl
  (case-lambda
    [() apt-base-url]
    [(page) (string-append apt-base-url page)]))

(define (TODO . what)
  (bold "TODO: " (decode-content what)))

(define nodetype
  (lambda (typename howmany summary . properties)
          (tabular #:style 'boxed #:sep (hspace 3)
                   (cons
                     (list (bold typename)
                           (string-append (number->string howmany) " nodes" " (" summary ")"))
                     properties))))

(define (screenshot path)
  (let* ([aptpath (string-append "screenshots/apt/" path)]
         [clabpath (string-append "screenshots/clab/" path)]
         [pnetpath (string-append "screenshots/pnet/" path)]
         [powderpath (string-append "screenshots/powder/" path)]
         [elabpath (string-append "screenshots/elab/" path)]
         [fullpath (case (tb-mode)
			 ('apt aptpath)
			 ('clab
			  (if (file-exists? clabpath)
			      clabpath
			    (cdr (cons (displayln (string-append "WARNING: CloudLab missing screenshot " path)) aptpath))))
			 ('pnet
			  (if (file-exists? pnetpath)
			      pnetpath
			    (cdr (cons (displayln (string-append "WARNING: PhantomNet missing screenshot " path)) aptpath))))
			 ('powder
			  (if (file-exists? powderpath)
			      powderpath
			    (cdr (cons (displayln (string-append "WARNING: Powder missing screenshot " path)) aptpath))))
			 ('elab
			  (if (file-exists? elabpath)
			      elabpath
			    (cdr (cons (displayln (string-append "WARNING: Emulab missing screenshot " path)) aptpath)))))]
         [b (make-object bitmap% fullpath)]
         [width (send b get-width)]
         [scale-factor (* 1.0 (/ screenshot-width width))])
    (list (image #:scale scale-factor fullpath fullpath) (linebreak))))

(define (instructionstep step #:screenshot [screenshot-path #f] . body)
  (item (bold (decode-content (list step)))
        (linebreak)
        (decode-flow body)
        (if screenshot-path
          (screenshot  screenshot-path)
          (void))))

(define (read-sphinx-inventory directory)
  (let ([inv-file (string-append directory "/objects.inv")])
    (if (file-exists? inv-file)
        (with-output-to-string (lambda () (system (string-append "/usr/bin/env python -msphinx.ext.intersphinx " inv-file))))
        (exit (string-append inv-file) " doesn't exist!"))))

(define geni-lib-hash null)
(define (parse-sphinx-inventory directory)
  (set! geni-lib-hash (make-hash (filter pair? (map (lambda (x) (let ([match (regexp-match #px"\\s+([^\\s]+)[\\s:]+([^\\s]+)$" x)]) (if match (cdr match) #f))) (regexp-split #px"\n" (read-sphinx-inventory directory)))))))

;  (regexp-match #px"(?m:^\\s+([^\\s]+)\\s+([^\\s]+)$)"
;                (read-sphinx-inventory directory)))
    
(define (geni-lib-link identifier)
  (if (not identifier)
    "geni-lib/index.html"
    (let* ([fullid (if (regexp-match #rx"^geni\\." identifier) identifier (string-append "geni." identifier))])
         (string-append "geni-lib/" (car (hash-ref geni-lib-hash fullid))))))

(define (last-token identifier)
  (car (regexp-match #px"[^\\.]*$" identifier)))

(define (geni-lib [identifier #f] [display #f])
  (hyperlink (geni-lib-link identifier)
             (bold (code (cond
                           [(not identifier) "geni-lib"]
                           [(string? display) display]
                           [(equal? display 'func) (string-append (last-token identifier) "()")]
                           [(equal? display 'id) (string-append (last-token identifier))]
                           [else identifier])))))

(define (under-construction)
  (bold "This section is under construction"))

(define (future-work tag)
  (margin-note "There are planned features relating to this section: see \""
               (secref tag)
               "\" for more details."))

(define (ssh)
  (tt "ssh"))

(define code-sample-style
  (make-style "code-sample"
              (list (make-css-addition "code-sample.css")
                    (make-tex-addition "code-sample.tex"))))

(define downloadable-code-sample-style
  (make-style "downloadable-code-sample"
              (list (make-css-addition "downloadable-code-sample.css")
                    (make-tex-addition "downloadable-code-sample.tex"))))

(define (profile-url project profile)
  (apturl (string-append "p/" project "/" profile)))

(define (profile-code-sample project profile)
  (let
    ([filename (string-append "profile/" project "/" profile ".py")])
    (list
      (code-sample filename)
      (smaller (emph (hyperlink (profile-url project profile)
                 (string-append "Open this profile on " (tb))))))))

(define (code-sample filename)
  ; We include the code sample twice; the second time, it's hidden. This is
  ; so that we get to keep a 'clean' copy for the download button
  (list
    (elem #:style code-sample-style (file->string (string-append "code-samples/" filename)))
    (elem #:style downloadable-code-sample-style (file->string (string-append "code-samples/" filename)))))