{- | Resolving content-provided themes: templates and styles that override the
vendored defaults, file by file.
-}
module MathiasSM.Theme (
    discoverContentTemplateNames,
    rewritePartials,
    rewritingTemplateCompiler,
    applyContentAsTemplate,
) where

import Control.Monad (filterM)
import Data.List (isPrefixOf, stripPrefix)
import Hakyll (
    Compiler,
    Context,
    Item,
    Template,
    applyAsTemplate,
    compileTemplateItem,
    getResourceString,
    toFilePath,
 )
import MathiasSM.Config (SiteConfig, resolveTemplate, templatesDir)
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
import System.FilePath.Posix (addTrailingPathSeparator, (</>))

-- | Lists the template names a content dir provides (empty when the dir is absent).
discoverContentTemplateNames :: FilePath -> IO [FilePath]
discoverContentTemplateNames :: [Char] -> IO [[Char]]
discoverContentTemplateNames [Char]
dir = do
    present <- [Char] -> IO Bool
doesDirectoryExist [Char]
dir
    if not present
        then pure []
        else filterM (doesFileExist . (dir </>)) =<< listDirectory dir

{- | Compiles a template, rewriting its @$partial("templates/…")$@ paths through
the override map so content-provided partials are picked up.
-}
rewritingTemplateCompiler :: SiteConfig -> Compiler (Item Template)
rewritingTemplateCompiler :: SiteConfig -> Compiler (Item Template)
rewritingTemplateCompiler SiteConfig
cfg = do
    item <- Compiler (Item [Char])
getResourceString
    tpl <- compileTemplateItem (fmap (rewritePartials cfg) item)
    pure (fmap (const tpl) item)

{- | Applies a content body as a template, rewriting its @$partial("templates/…")$@
paths through the override map first, so templated posts and pages resolve
content-provided partials just like template files do.
-}
applyContentAsTemplate :: SiteConfig -> Context String -> Item String -> Compiler (Item String)
applyContentAsTemplate :: SiteConfig
-> Context [Char] -> Item [Char] -> Compiler (Item [Char])
applyContentAsTemplate SiteConfig
cfg Context [Char]
ctx = Context [Char] -> Item [Char] -> Compiler (Item [Char])
applyAsTemplate Context [Char]
ctx (Item [Char] -> Compiler (Item [Char]))
-> (Item [Char] -> Item [Char])
-> Item [Char]
-> Compiler (Item [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> Item [Char] -> Item [Char]
forall a b. (a -> b) -> Item a -> Item b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SiteConfig -> [Char] -> [Char]
rewritePartials SiteConfig
cfg)

{- | Rewrites every @$partial("templates/<name>")$@ to the identifier 'resolveTemplate'
picks; any other @$partial$@ (e.g. @$partial("content/…")$@) is left untouched.
-}
rewritePartials :: SiteConfig -> String -> String
rewritePartials :: SiteConfig -> [Char] -> [Char]
rewritePartials SiteConfig
cfg = [Char] -> [Char]
go
  where
    open :: [Char]
open = [Char]
"$partial(\""
    vendoredPrefix :: [Char]
vendoredPrefix = [Char] -> [Char]
addTrailingPathSeparator (SiteConfig -> [Char]
templatesDir SiteConfig
cfg)

    go :: [Char] -> [Char]
go [] = []
    go s :: [Char]
s@(Char
c : [Char]
cs)
        | [Char]
open [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
s =
            let body :: [Char]
body = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
open) [Char]
s
                ([Char]
path, [Char]
afterQuote) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"') [Char]
body
                rest :: [Char]
rest = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
afterQuote
                rewritten :: [Char]
rewritten = case [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
vendoredPrefix [Char]
path of
                    Just [Char]
name -> Identifier -> [Char]
toFilePath (SiteConfig -> [Char] -> Identifier
resolveTemplate SiteConfig
cfg [Char]
name)
                    Maybe [Char]
Nothing -> [Char]
path
             in [Char]
open [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
rewritten [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
go [Char]
rest
        | Bool
otherwise = Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
go [Char]
cs