-- | Rules for the assets: styles, media, and tables
module MathiasSM.Rules.Assets (processAssets) where

import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import Data.String (fromString)
import Hakyll (
    Item (itemBody),
    Pattern,
    Routes,
    Rules,
    compile,
    composeRoutes,
    compressCssCompiler,
    copyFileCompiler,
    create,
    customRoute,
    getResourceLBS,
    getResourceString,
    idRoute,
    loadAll,
    makeItem,
    match,
    route,
    setExtension,
    templateBodyCompiler,
    toFilePath,
    unixFilterLBS,
    version,
    (.||.),
 )
import Hakyll.Web.CompressCss (compressCss)
import MathiasSM.Config (SiteConfig, assetsDir, contentCssPattern, dataPattern, dataSchemaPattern, highlightStyle, mediaDir, socialsPattern)
import MathiasSM.Rules.Favicon (faviconRules)
import MathiasSM.Yaml.Website (toPandocStyle)
import System.FilePath.Posix (addTrailingPathSeparator, (</>))
import Text.Pandoc.Highlighting (styleToCss)

-- | Processes all assets (media, styles, data files) into the final site
processAssets :: SiteConfig -> Rules ()
processAssets :: SiteConfig -> Rules ()
processAssets SiteConfig
cfg = do
    SiteConfig -> Rules ()
processCss SiteConfig
cfg
    SiteConfig -> Rules ()
processSvgImages SiteConfig
cfg
    SiteConfig -> Rules ()
processDotImages SiteConfig
cfg
    SiteConfig -> Rules ()
processFavicon SiteConfig
cfg
    Pattern -> Routes -> Rules ()
justCopy (SiteConfig -> [Char] -> [[Char]] -> Pattern
mediaPattern SiteConfig
cfg [Char]
"photos" [[Char]
"jpg", [Char]
"png", [Char]
"gif"]) ([Char] -> Routes
mediaRoute (SiteConfig -> [Char]
mediaDir SiteConfig
cfg))
    SiteConfig -> Rules ()
processDataFiles SiteConfig
cfg

-- | Makes the data files (YAML) and their schemas loadable; they are not routed
processDataFiles :: SiteConfig -> Rules ()
processDataFiles :: SiteConfig -> Rules ()
processDataFiles SiteConfig
cfg = do
    Pattern -> Rules () -> Rules ()
match (SiteConfig -> Pattern
socialsPattern SiteConfig
cfg Pattern -> Pattern -> Pattern
.||. SiteConfig -> Pattern
dataPattern SiteConfig
cfg) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item [Char]) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item [Char])
getResourceString
    Pattern -> Rules () -> Rules ()
match (SiteConfig -> Pattern
dataSchemaPattern SiteConfig
cfg) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item [Char]) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item [Char])
getResourceString

-- | Compress all CSS as one file
processCss :: SiteConfig -> Rules ()
processCss :: SiteConfig -> Rules ()
processCss SiteConfig
cfg = do
    Pattern -> Rules () -> Rules ()
match (SiteConfig -> Pattern
cssFiles SiteConfig
cfg) (Compiler (Item [Char]) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item [Char])
compressCssCompiler)
    Pattern -> Rules () -> Rules ()
match (SiteConfig -> Pattern
contentCssPattern SiteConfig
cfg) (Compiler (Item [Char]) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item [Char])
compressCssCompiler)
    [Identifier] -> Rules () -> Rules ()
create [Identifier
"styles.css"] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
        Routes -> Rules ()
route Routes
idRoute
        Compiler (Item [Char]) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item [Char]) -> Rules ())
-> Compiler (Item [Char]) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
            vendored <- Pattern -> Compiler [Item [Char]]
forall a. (Binary a, Typeable a) => Pattern -> Compiler [Item a]
loadAll (Pattern -> Compiler [Item [Char]])
-> Pattern -> Compiler [Item [Char]]
forall a b. (a -> b) -> a -> b
$ SiteConfig -> Pattern
cssFiles SiteConfig
cfg
            content <- loadAll $ contentCssPattern cfg
            makeItem $
                unlines (map itemBody (vendored ++ content))
                    ++ compressCss (styleToCss (toPandocStyle (highlightStyle cfg)))

-- | Uses unix external filter (dot) to compile them as png
processDotImages :: SiteConfig -> Rules ()
processDotImages :: SiteConfig -> Rules ()
processDotImages SiteConfig
cfg = Pattern -> Rules () -> Rules ()
match (SiteConfig -> [Char] -> [[Char]] -> Pattern
mediaPattern SiteConfig
cfg [Char]
"photos" [[Char]
"dot"]) (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
$ [Char] -> Routes
mediaRoute (SiteConfig -> [Char]
mediaDir SiteConfig
cfg) Routes -> Routes -> Routes
`composeRoutes` [Char] -> Routes
setExtension [Char]
"png"
    Compiler (Item ByteString) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item ByteString) -> Rules ())
-> Compiler (Item ByteString) -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item ByteString)
getResourceLBS Compiler (Item ByteString)
-> (Item ByteString -> Compiler (Item ByteString))
-> Compiler (Item ByteString)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> Compiler ByteString)
-> Item ByteString -> Compiler (Item ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Item a -> f (Item b)
traverse ([Char] -> [[Char]] -> ByteString -> Compiler ByteString
unixFilterLBS [Char]
"dot" [[Char]
"-Tpng"])

-- | Compiles branding and icons into context (for inlining), and copies them as images
processSvgImages :: SiteConfig -> Rules ()
processSvgImages :: SiteConfig -> Rules ()
processSvgImages SiteConfig
cfg = do
    -- Branding SVGs (e.g. the logo) are inlined via $partial$, so compile them as templates
    Pattern -> Rules () -> Rules ()
match (SiteConfig -> [Char] -> [[Char]] -> Pattern
mediaPattern SiteConfig
cfg [Char]
"branding" [[Char]
"svg"]) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item Template) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item Template)
templateBodyCompiler
    -- Icon SVGs are inlined via the data files' $iconRaw$, so load them as raw strings
    Pattern -> Rules () -> Rules ()
match (SiteConfig -> [Char] -> [[Char]] -> Pattern
mediaPattern SiteConfig
cfg [Char]
"icons" [[Char]
"svg"]) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item [Char]) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item [Char])
getResourceString
    -- Allows importing as img with src="<...>.svg"
    Pattern -> Rules () -> Rules ()
match Pattern
svgFiles (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> Rules () -> Rules ()
version [Char]
"svg" (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
$ [Char] -> Routes
mediaRoute (SiteConfig -> [Char]
mediaDir SiteConfig
cfg) Routes -> Routes -> Routes
`composeRoutes` [Char] -> Routes
setExtension [Char]
"svg"
            Compiler (Item CopyFile) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item CopyFile)
copyFileCompiler
  where
    svgFiles :: Pattern
svgFiles = (Pattern -> Pattern -> Pattern) -> [Pattern] -> Pattern
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Pattern -> Pattern -> Pattern
(.||.) [SiteConfig -> [Char] -> [[Char]] -> Pattern
mediaPattern SiteConfig
cfg [Char]
"branding" [[Char]
"svg"], SiteConfig -> [Char] -> [[Char]] -> Pattern
mediaPattern SiteConfig
cfg [Char]
"icons" [[Char]
"svg"]]

-- | Generates the favicons from the logo
processFavicon :: SiteConfig -> Rules ()
processFavicon :: SiteConfig -> Rules ()
processFavicon SiteConfig
cfg = do
    Pattern -> Rules ()
faviconRules (Pattern -> Rules ()) -> Pattern -> Rules ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Pattern
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ SiteConfig -> [Char]
mediaDir SiteConfig
cfg [Char] -> [Char] -> [Char]
</> [Char]
"branding" [Char] -> [Char] -> [Char]
</> [Char]
"logo.svg"

-- | Rule to copy files
justCopy :: Pattern -> Routes -> Rules ()
justCopy :: Pattern -> Routes -> Rules ()
justCopy Pattern
something Routes
routes = Pattern -> Rules () -> Rules ()
match Pattern
something (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> Rules () -> Rules ()
version [Char]
"raw" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
        Routes -> Rules ()
route Routes
routes
        Compiler (Item CopyFile) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item CopyFile)
copyFileCompiler

-- | Where the site's own stylesheets live (see 'assetsDir')
cssFiles :: SiteConfig -> Pattern
cssFiles :: SiteConfig -> Pattern
cssFiles SiteConfig
cfg = [Char] -> Pattern
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ SiteConfig -> [Char]
assetsDir SiteConfig
cfg [Char] -> [Char] -> [Char]
</> [Char]
"css" [Char] -> [Char] -> [Char]
</> [Char]
"*.css"

-- | Files with one of the extensions, anywhere under a media category
mediaPattern :: SiteConfig -> String -> [String] -> Pattern
mediaPattern :: SiteConfig -> [Char] -> [[Char]] -> Pattern
mediaPattern SiteConfig
cfg [Char]
category [[Char]]
extensions =
    (Pattern -> Pattern -> Pattern) -> [Pattern] -> Pattern
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Pattern -> Pattern -> Pattern
(.||.) [[Char] -> Pattern
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ SiteConfig -> [Char]
mediaDir SiteConfig
cfg [Char] -> [Char] -> [Char]
</> [Char]
category [Char] -> [Char] -> [Char]
</> ([Char]
"**." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ext) | [Char]
ext <- [[Char]]
extensions]

{- | Publishes `media/<category>/x` as `images/<category>/x`, except @branding@
which is published at the `images/` root (so the logo stays `images/logo.svg`).
-}
mediaRoute :: FilePath -> Routes
mediaRoute :: [Char] -> Routes
mediaRoute [Char]
mediaDir' = (Identifier -> [Char]) -> Routes
customRoute ((Identifier -> [Char]) -> Routes)
-> (Identifier -> [Char]) -> Routes
forall a b. (a -> b) -> a -> b
$ \Identifier
ident ->
    let path :: [Char]
path = Identifier -> [Char]
toFilePath Identifier
ident
        rest :: [Char]
rest = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
path ([Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ([Char] -> [Char]
addTrailingPathSeparator [Char]
mediaDir') [Char]
path)
     in [Char]
"images" [Char] -> [Char] -> [Char]
</> [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
rest ([Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"branding/" [Char]
rest)