-- |
-- Description: Rules for collections of links.
-- Copyright: Copyright (C) 2023 Yoo Chung
-- License: All rights reserved
-- Maintainer: web@chungyc.org
--
-- Exports the rules for collections of links.
module Web.Site.Rules.Link (rules, items) where

import Hakyll
import System.FilePath (dropExtension, takeDirectory)
import Web.Site.Compilers

-- |
-- Rules related to collections of links.
--
-- These are basically public bookmarks for myself.
rules :: Rules ()
rules :: Rules ()
rules = do
  Pattern -> Rules () -> Rules ()
match Pattern
"links/**" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ (Identifier -> String) -> Routes
customRoute Identifier -> String
toIndexFilePath
    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item String)
linksCompiler

  Pattern -> Rules () -> Rules ()
match Pattern
"links.markdown" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> Routes
constRoute String
"links/index.html"
    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item String)
linksCompiler

-- |
-- Pattern for files matched or created in this module.
--
-- These will be used to generate the sitemap.
items :: Pattern
items :: Pattern
items = Pattern
"links/**" Pattern -> Pattern -> Pattern
.||. Pattern
"links.markdown"

-- |
-- From the given identifier, return the path to the index HTML file
-- as if the original file was actually a directory.
--
-- I.e., all of the files in @links/@ will be turned into @index.html@ files
-- in a directory so that their URLs will end with the directory.
-- E.g., @links/fun.markdown@ would have the URL ending with @links/fun/@.
-- This allows them to have sub-categories without using separate names
-- or having to include the HTML file name extension in the URL.
toIndexFilePath :: Identifier -> FilePath
toIndexFilePath :: Identifier -> String
toIndexFilePath Identifier
identifier = String -> String
dropExtension String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/index.html"
  where
    path :: String
path = Identifier -> String
toFilePath Identifier
identifier

-- |
-- Compiles a page with links to also link to its sub-categories and parent.
linksCompiler :: Compiler (Item String)
linksCompiler :: Compiler (Item String)
linksCompiler = do
  String
path <- String -> String
dropExtension (String -> String)
-> (Identifier -> String) -> Identifier -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> String
toFilePath (Identifier -> String) -> Compiler Identifier -> Compiler String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler Identifier
getUnderlying
  [Item String]
subcategories <- Pattern -> String -> Compiler [Item String]
forall a.
(Binary a, Typeable a) =>
Pattern -> String -> Compiler [Item a]
loadAllSnapshots (String -> Pattern
fromGlob (String -> Pattern) -> String -> Pattern
forall a b. (a -> b) -> a -> b
$ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/*") (String -> Compiler [Item String])
-> String -> Compiler [Item String]
forall a b. (a -> b) -> a -> b
$ String
"links:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path

  let parent :: String
parent = String -> String
takeDirectory String
path

  let applyParent :: Context a -> Context a
applyParent
        | String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"links" = Context a -> Context a
forall a. a -> a
id
        | Bool
otherwise = Context a -> Context a -> Context a
forall a. Semigroup a => a -> a -> a
(<>) (Context a -> Context a -> Context a)
-> Context a -> Context a -> Context a
forall a b. (a -> b) -> a -> b
$ String -> String -> Context a
forall a. String -> String -> Context a
constField String
"parent-url" (String -> Context a) -> String -> Context a
forall a b. (a -> b) -> a -> b
$ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
parent String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"

  let applySubcategories :: Context b -> Context b
applySubcategories
        | [Item String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Item String]
subcategories = Context b -> Context b
forall a. a -> a
id
        | Bool
otherwise = Context b -> Context b -> Context b
forall a. Semigroup a => a -> a -> a
(<>) (Context b -> Context b -> Context b)
-> Context b -> Context b -> Context b
forall a b. (a -> b) -> a -> b
$ String -> Context String -> Compiler [Item String] -> Context b
forall a b. String -> Context a -> Compiler [Item a] -> Context b
listField String
"subcategories" Context String
siteContext ([Item String] -> Compiler [Item String]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return [Item String]
subcategories)

  let linksContext :: Context String
linksContext = Context String -> Context String
forall {a}. Context a -> Context a
applyParent (Context String -> Context String)
-> (Context String -> Context String)
-> Context String
-> Context String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context String -> Context String
forall {a}. Context a -> Context a
applySubcategories (Context String -> Context String)
-> Context String -> Context String
forall a b. (a -> b) -> a -> b
$ Context String
siteContext

  Compiler (Item String)
pandocCompiler
    Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Item String -> Compiler (Item String)
forall a.
(Binary a, Typeable a) =>
String -> Item a -> Compiler (Item a)
saveSnapshot (String
"links:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
parent)
    Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/links.html" Context String
linksContext
    Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/default.html" Context String
linksContext