(use-modules (haunt asset)
             (haunt artifact)
             (haunt html)
	     (haunt post)
             (hippo builder blog-extless)
             (hippo builder atom-extless)
             (haunt builder assets)
             (haunt reader commonmark)
             (nybble reader commonmark+scm)
             (haunt site)
             (haunt publisher rsync))

;; Main layout
(define* (base-layout site body
                      #:key title extra-head big-logo)
  `((doctype "html")
    (head
     (meta (@ (charset "utf-8")))
     (meta (@ (name "viewport")
              (content "width=device-width, initial-scale=1.0")))
     (title ,(if title
                 (string-append title " — Hippo")
                 (site-title site)))
     ;; css
     (link (@ (rel "stylesheet")
              (href "/static/style.css")))

     ;; extra header content, if provided
     ,(or extra-head "")

     ;; atom feed
     (link (@ (rel "alternate")
              (title "Hippo's blog")
              (type "application/atom+xml")
              (href "/feed.xml"))))
    (body
     (header (@ (class "site-header"))
	     (a (@ (href "/")
                   (class "primary"))
                (div (@ (class "header-logo-wrapper"))
		     (img (@ (src "/static/images/hippo-logo.png")
			  (alt "Hippo"))))
	        "Hippo")
             (a (@ (href "/blog")) "Blog")
             (a (@ (href "/clog")) "Code"))

     ;; div class is to be wrapped externally
     ;; since it's mildly customisable
     ,body

     ;; TODO: Link to source.
     (div (@ (class "site-footer"))
          "Unless specified otherwise, the contents of this website are licenced under "
          (a (@ (href "https://creativecommons.org/licenses/by-nc/4.0/")
		(target "_blank"))
             "CC BY-NC 4.0 International")
          ". "
          (a (@ (href "https://git.disroot.org/badrihippo/badrihippo.thekambattu.rocks")
	     (target "blank"))
             "Source code")
          " available under the "
          (a (@ (href "https://www.gnu.org/licenses/gpl-3.0.en.html")
		(target "_blank"))
             "GNU GPL (v3 or later)")
          ". Primary font: "
	  (a (@ (href "https://indiantypefoundry.com/fonts/poppins")
		(target "blank"))
	     "Poppins")
	  ", by the Indian Type Foundry. Powered by "
          (a (@ (href "https://haunt.dthompson.us/")
		(target "blank"))
             "Haunt")
          "."))))

(define (animating-a location action content)
  `(a (@ (href ,location)
	     (class ,(string-append "link-" action))
	     (onmouseover ,(string-append "javascript:for (let el of document.getElementsByClassName('dynamic-hippo')) el.classList.add('" action "')"))
	     (onmouseout ,(string-append "javascript:for (let el of document.getElementsByClassName('dynamic-hippo')) el.classList.remove('" action "')"))
	     (target "_blank"))
	  ,content))

(define (index-head)
  `((link (@ (rel "stylesheet")
	    (href "/static/home.css")
	    (type "text/css")))

    ;; Make one preload link for each hover-image
    ,(map (lambda (activity)
	    `(link (@ (rel "preload")
	              (href ,(string-append
			      "/static/images/hippo-"
			      activity
			      ".png"))
	              (as "image")
	              (type "image/jpg"))))
	  '("reading"
	   "writing"
	   "programming"
	   "prav"
	   "snipette"
	   "thekambattu"
	   "computer"))
    ))

(define (index-content posts)
  `(div (@ (class "main home-page"))
    ;; Main intro
	(div (@ (class "dynamic-hippo")))
    (h1 "Hi, I'm Badri Sunderarajan "
	(small "(a.k.a \"Hippo\")"))
    (p "I live in "
       ,(animating-a "https://thekambattu.rocks" "thekambattu" "Thekambattu")
       " and when I'm not busy "
       ,(animating-a "https://biblio.thekambattu.rocks/user/badrihippo" "reading" "reading")
       ", I write in both "
       ,(animating-a "https://snipettemag.com/author/badri" "writing" "prose")
       " and "
       ,(animating-a "https://git.disroot.org/badrihippo" "programming" "code")
       ".")
    (p "I'm a volunteer for the locally-owned, decentralised-messaging"
       " focused "
       ,(animating-a "https://prav.app" "prav" "Prav")
       " project; and also the co-founding editor and former tech support"
       " for the erstwhile "
       ,(animating-a "https://snipettemag.com" "snipette" "Snipette")
       " magazine.")
    (p "You can find me online as "
       (strong "@badrihippo")
       " or read my "
       ,(animating-a "/blog/" "computer" "blog")
       " and "
       ,(animating-a "/clog/" "computer" "code blog")
       ".")
    ))

;; Home Page
(define (index-page site posts)
  (serialized-artifact
   "index.html"
   (base-layout site
                (index-content posts)
		#:extra-head (index-head)
                #:big-logo #t)
   sxml->html))

;; We'll need this to compare the beginnings
;; of strings
(define (string-head string length)
  (list->string (list-head (string->list string) length)))

(define (string-starts-with? string match)
  (let ((match-length (string-length match)))
    (if (< (string-length string) match-length)
      #f
      (equal? (string-head string match-length) match))))

;; Blog contents
(define* (post-template post #:key post-link)
  `((div (@ (class "main"))
         (h1 ,(post-ref post 'title))
         (h2 "by " ,(post-ref post 'author)
	     " · "
	     ,(date->string* (post-date post)))
         (div ,(post-sxml post)))))

(define (collection-template site title posts prefix)
  (define (post-url post)
    (string-append (or prefix "") "/"
		   (site-post-slug site post) "/"))
  `((div (@ (class "main"))
         (h1 ,title)
         (ul (@ (class "post-list"))
          ,@(map (lambda (post)
	           `(li
                     (div (@ (class "post"))
		          (h2
		            (a (@ (href ,(post-url post)))
			       ,(post-ref post 'title)))
		          (h3 ,(post-ref post 'author)
			  " · "
			  ,(date->string* (post-date post)))
                          (div ,(or (post-ref post 'summary))))))
	    posts)))))

;; Different slug for code and normal blog
(define (code-post? post)
  (string-starts-with? (post-file-name post) "posts/clog/"))

(define (post-slug-category post)
  (let ((clog-or-blog (if (code-post? post)
                          "clog/"
                          "blog/")))
    (string-append clog-or-blog (post-slug-v2 post))))

(define (posts/blog posts)
  (filter (lambda (post) (not (code-post? post)))
          posts))

(define (posts/clog posts)
  (filter code-post? posts))

(define hippo-haunt-theme
  (theme #:name "Hippo"
	 #:layout
	 (lambda (site title body)
	   (base-layout
	    site body
	    #:title title))
	 #:post-template post-template
	 #:collection-template collection-template))

(define (extend-file-filter filter patterns)
  "Extend an existing file filter by also filtering out
the given additional patterns"
  (let ((new-filter (make-file-filter patterns)))
    (lambda (file-name)
      (and (filter file-name) (new-filter file-name)))))

(define (exclude-images filter)
  (extend-file-filter filter '("\\.(jpg|png)$")))

(define (exclude-posts filter)
  (extend-file-filter filter '("\\.(scmd|md|html?|sxml)$")))

(define* (inline-images site posts)
  "Recursively copy all images that are inside the site's
posts-directory, so that they are deployed to the live
site as well. This uses a custom regex since the main
site filter has to filter out images too"
  (directory-assets (site-posts-directory site)
                    (exclude-posts default-file-filter)
                    "/"))

(define* (static-directory-alt
          directory
          #:optional (dest directory)
          #:key (file-filter #f))
  (lambda (site posts)
    (directory-assets directory
                      (if file-filter
                          file-filter
                          (site-file-filter site))
                      dest)))

(site #:title "Hippo"
      #:domain "badrihippo.thekambattu.rocks"
      #:default-metadata
      '((author . "Badri Sunderarajan")
        (email  . "badrihippo@disroot.org"))
      #:posts-directory "posts"
      #:file-filter (exclude-images default-file-filter)
      #:make-slug post-slug-category
      #:readers (list commonmark-reader commonmark+scm-reader)
      #:builders (list (blog #:prefix ""
		             #:theme hippo-haunt-theme
                             #:collections
                             `(("Latest Posts"
                                "blog/index.html"
                                ,(lambda (posts)
                                   (posts/reverse-chronological
                                    (posts/blog posts))))
                               ("Code Blog"
                                "clog/index.html"
                                ,(lambda (posts)
                                   (posts/reverse-chronological
                                    (posts/clog posts))))))
                       index-page
                       (atom-feed)
                       (atom-feeds-by-tag)
                       inline-images
                       (static-directory-alt "static" #:file-filter default-file-filter))
      #:publishers (list (rsync-publisher
                          #:destination
                            "badrihippo.thekambattu.rocks/www"
                          #:host
                            "thekambattu"))
      #:build-directory "www")