-- |
-- Description: Rules for generating stylesheets from Haskell code.
-- Copyright: Copyright (C) 2023 Yoo Chung
-- License: All rights reserved
-- Maintainer: web@chungyc.org
--
-- Exports rules for generating the stylesheets for the web site.
module Web.Site.Rules.Stylesheet (rules) where

import Data.List (intercalate)
import Hakyll
import Text.Pandoc.Highlighting (pygments, styleToCss, zenburn)
import Web.Site.Compilers

-- |
-- Rules related to stylesheets generated from Haskell code.
--
-- Except for a few stylesheets which are not expected to change,
-- the stylesheets are generated from Haskell code via standard output.
-- While theoretically this can use any framework for generating
-- stylesheets, this web site uses [Clay](http://fvisser.nl/clay/).
rules :: Rules ()
rules :: Rules ()
rules = do
  Pattern -> Rules () -> Rules ()
match Pattern
"css/**.css" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route Routes
idRoute
    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item String)
compressCssCompiler

  Pattern -> Rules () -> Rules ()
match Pattern
"css/**.hs" (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
setExtension String
"css"
    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
$ [String] -> Compiler (Item ByteString)
haskellCompiler []

  Pattern -> Rules () -> Rules ()
match Pattern
"css/**.lhs" (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
setExtension String
"css"
    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
$ [String] -> Compiler (Item ByteString)
haskellCompiler []

  -- Stylesheet for supporting syntax highlighting.
  -- This will import the actual stylesheet according to the preferred color scheme.
  [Identifier] -> Rules () -> Rules ()
create [Identifier
"css/syntax.css"] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route Routes
idRoute
    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$
      String -> Compiler (Item String)
forall a. a -> Compiler (Item a)
makeItem (String -> Compiler (Item String))
-> String -> Compiler (Item String)
forall a b. (a -> b) -> a -> b
$
        String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
          String
"\n"
          [ String
"@import \"syntax-light.css\" all and (prefers-color-scheme: light);",
            String
"@import \"syntax-dark.css\" all and (prefers-color-scheme: dark);",
            String
""
          ]

  -- Syntax highlighting in light mode.
  [Identifier] -> Rules () -> Rules ()
create [Identifier
"css/syntax-light.css"] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route Routes
idRoute
    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> Compiler (Item String)
forall a. a -> Compiler (Item a)
makeItem (String -> Compiler (Item String))
-> String -> Compiler (Item String)
forall a b. (a -> b) -> a -> b
$ Style -> String
styleToCss Style
pygments

  -- Syntax highlighting in dark mode.
  [Identifier] -> Rules () -> Rules ()
create [Identifier
"css/syntax-dark.css"] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route Routes
idRoute
    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> Compiler (Item String)
forall a. a -> Compiler (Item a)
makeItem (String -> Compiler (Item String))
-> String -> Compiler (Item String)
forall a b. (a -> b) -> a -> b
$ Style -> String
styleToCss Style
zenburn