#lang racket

(require html-parsing
         sxml
         (only-in srfi/13 string-delete)
         (only-in srfi/14 char-set-adjoin char-set:whitespace))

;; パス設定
(define *base*
  (path->directory-path
   ;; 以下は変更してO.K.
   ;; 特に、PCUSERはWindowsのユーザー名に書き換える事
   "C:\\Users\\PCUSER\\pictures"))

;; デフォルトフォルダ名
(define *sub*
  (path->directory-path
   ;; 以下は変更してO.K.
   "goo_blog"))

;; Windowsのフォルダ名で使えない文字
(define cs
  (char-set-adjoin char-set:whitespace
                   #\\ #\/ #\: #\* #\? #\" #\< #\> #\|))

;; DOSコマンド生成関数
(define (command url p)
  (format "curl.exe --ssl-no-revoke -L \"~a\" -o \"~a\"" url (path->string (build-path p (last (string-split url "/"))))))

;; ダウンローダー本体
(define (downloader fname)
  ;; 基本のパスを組み立てる
  (let ((p (build-path *base* *sub*)))
    ;; 引っ越しデータファイル(fname)を開く
    (with-input-from-file fname
      (lambda ()
        ;; ファイルを一行づつ(read-line)読みながら繰り返し
        (let loop ((c (read-line)) (html '()) (p1 p))
          ;; 空行の場合例外が投げられるのでキャッチして次の処理へ
          (with-handlers ((exn:fail:contract?
                           (lambda (e) (loop (read-line) html p1))))
            ;; ファイル末尾で処理を終了する
            (unless (eof-object? c)
              ;; 読み込んだ行をコロン(:)で分割
              (let ((lst (string-split c ":")))
                ;; 先頭(head)と残り全て(tail)へと分ける
                (let ((head (string-trim (car lst)))
                      (tail (string-trim (string-join (cdr lst)))))
                  (case head
                    ;; スキップするheadは纏めて、次の処理へ
                    (("AUTHOR" "PRIMARY CATEGORY" "STATUS" "ALLOW COMMENTS" "CONVERT BREAKS" "-----")
                     (loop (read-line) html p1))
                    ;; TITLEはフォルダを作成し次の処理へ
                    (("TITLE") (let ((p2 (build-path p1 (string-delete cs tail))))
                                 (unless (directory-exists? p2)
                                   (make-directory p2))
                                 (loop (read-line) html p2)))
                    ;; DATEはフォルダを作成し次の処理へ
                    (("DATE") (let ((p3 (build-path p1 (string-delete cs tail))))
                                (unless (directory-exists? p3)
                                  (make-directory p3))
                                (loop (read-line) html p3)))
                    ;; BODYは後続(空文字列)だけどhtmlへ積む
                    (("BODY") (loop (read-line) (cons tail html) p1))
                    ;; 一つの記事が終了
                    ;; EyeCatchフォルダへのパスを作成
                    (("--------") (let ((p4 (build-path p1 "EyeCatch"))
                                        ;; 写真アドレスを取り出してリストへ纏める
                                        (urls
                                         (map cadr
                                              ((sxpath '(// img @ src))
                                               (html->xexp (string-join (reverse html)))))))
                                    ;; EyeCatchフォルダを作成
                                    (unless (directory-exists? p4)
                                      (make-directory p4))
                                    ;; 1枚めの写真をEyeCatchフォルダへダウンロード
                                    (system (car urls) p4)
                                    ;; 残りはそのままダウンロード
                                    (for-each
                                     (lambda (url)
                                       (system (command url p1)))
                                     (cdr urls))
                                    (loop (read-line) '() p)))
                    ;; 残りはHTML情報なんで一行丸ごとhtmlへと追加する
                    (else (loop (read-line) (cons c html) p1))))))))))))
        
(module+ main
  (let ((p (build-path *base* *sub*)))
    (unless (directory-exists? p)
      (make-directory p)))
  (downloader (vector-ref (current-command-line-arguments) 0)))