{-# LANGUAGE OverloadedStrings #-}
module Config.Program (
    contentsRoot
  , templatesRoot
  , tmBlogRoot
  , hakyllConfig
  , readerOptions
  , writerOptions
  , writerPreviewOptions
  , tagSoupOption
) where

import           Control.Monad       (liftM2)
import           Data.Char           (toLower)
import           Data.List           (isPrefixOf, isSuffixOf)
import           Hakyll
import           System.FilePath     (takeFileName, (</>))
import qualified Text.HTML.TagSoup   as T
import           Text.Pandoc.Options (Extension (..),
                                      HTMLMathMethod (KaTeX, MathJax),
                                      ReaderOptions (..), WriterOptions (..),
                                      disableExtension, enableExtension)

contentsRoot :: FilePath
contentsRoot :: [Char]
contentsRoot = [Char]
"contents"

templatesRoot :: FilePath
templatesRoot :: [Char]
templatesRoot = [Char]
contentsRoot [Char] -> [Char] -> [Char]
</> [Char]
"templates"

tmBlogRoot :: FilePath
tmBlogRoot :: [Char]
tmBlogRoot = [Char]
templatesRoot [Char] -> [Char] -> [Char]
</> [Char]
"blog"

hakyllConfig :: Configuration
hakyllConfig :: Configuration
hakyllConfig = Configuration
defaultConfiguration {
    destinationDirectory = "docs"
  , storeDirectory = ".cache"
  , tmpDirectory = ".cache/tmp"
  , previewHost = "127.0.0.1"
  , previewPort = 8888
  , inMemoryCache = True
  , ignoreFile = ignoreFile'
  }
  where
    ignoreFile' :: [Char] -> Bool
ignoreFile' = (([Char] -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool)
-> [[Char] -> Bool] -> [Char] -> Bool
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 ((Bool -> Bool -> Bool)
-> ([Char] -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Bool -> Bool -> Bool
(||))
        [[Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
".", [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"#", [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char]
"~", [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char]
".swp"] ([Char] -> Bool) -> ([Char] -> [Char]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeFileName

writerOptions :: WriterOptions
writerOptions :: WriterOptions
writerOptions = WriterOptions
defaultHakyllWriterOptions {
    writerHTMLMathMethod = KaTeX mempty
  }

writerPreviewOptions :: WriterOptions
writerPreviewOptions :: WriterOptions
writerPreviewOptions = WriterOptions
defaultHakyllWriterOptions {
    writerHTMLMathMethod = MathJax mempty
 }

readerOptions :: ReaderOptions
readerOptions :: ReaderOptions
readerOptions = ReaderOptions
defaultHakyllReaderOptions {
    readerExtensions = enableExtension Ext_east_asian_line_breaks $
        enableExtension Ext_emoji $
        enableExtension Ext_tex_math_double_backslash $
        disableExtension Ext_citations $
        readerExtensions defaultHakyllReaderOptions
    }

tagSoupOption :: T.RenderOptions String
tagSoupOption :: RenderOptions [Char]
tagSoupOption = T.RenderOptions {
    optRawTag :: [Char] -> Bool
T.optRawTag = ([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"script", [Char]
"style"]) ([Char] -> Bool) -> ([Char] -> [Char]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
  , optMinimize :: [Char] -> Bool
T.optMinimize = ([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
minimize) ([Char] -> Bool) -> ([Char] -> [Char]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
  , optEscape :: [Char] -> [Char]
T.optEscape = [Char] -> [Char]
forall str. StringLike str => str -> str
T.escapeHTML
  }
  where
    minimize :: [[Char]]
minimize = [[Char]
"area", [Char]
"br", [Char]
"col", [Char]
"embed", [Char]
"hr", [Char]
"img", [Char]
"input", [Char]
"meta", [Char]
"link", [Char]
"param"]