module Vendor.FontAwesome.Compiler (
    render
) where

import qualified Data.HashMap.Strict     as M
import           Data.Maybe              (fromMaybe)
import           Hakyll
import qualified Text.HTML.TagSoup.Tree  as TT

import           Config                  (tagSoupOption)
import           Vendor.FontAwesome.Core

render :: FontAwesomeIcons -> Item String -> Compiler (Item String)
render :: FontAwesomeIcons -> Item String -> Compiler (Item String)
render FontAwesomeIcons
icons = Item String -> Compiler (Item String)
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (Item String -> Compiler (Item String))
-> (Item String -> Item String)
-> Item String
-> Compiler (Item String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> Item String -> Item String
forall a b. (a -> b) -> Item a -> Item b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (RenderOptions String -> [TagTree String] -> String
forall str.
StringLike str =>
RenderOptions str -> [TagTree str] -> str
TT.renderTreeOptions RenderOptions String
tagSoupOption ([TagTree String] -> String)
-> (String -> [TagTree String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TagTree String -> [TagTree String])
-> [TagTree String] -> [TagTree String]
forall str.
(TagTree str -> [TagTree str]) -> [TagTree str] -> [TagTree str]
TT.transformTree TagTree String -> [TagTree String]
render' ([TagTree String] -> [TagTree String])
-> (String -> [TagTree String]) -> String -> [TagTree String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [TagTree String]
forall str. StringLike str => str -> [TagTree str]
TT.parseTree)
    where
        render' :: TagTree String -> [TagTree String]
render' tag :: TagTree String
tag@(TT.TagBranch String
"i" [Attribute String]
as []) = case [String] -> Maybe (TagTree String)
toFontAwesome ([String] -> Maybe (TagTree String))
-> [String] -> Maybe (TagTree String)
forall a b. (a -> b) -> a -> b
$ [Attribute String] -> [String]
classes [Attribute String]
as of
            Just TagTree String
tree -> [TagTree String
tree]
            Maybe (TagTree String)
Nothing   -> [TagTree String
tag]
        render' TagTree String
tag = [TagTree String
tag]

        toFontAwesome :: [String] -> Maybe (TagTree String)
toFontAwesome (String
p:(Char
'f':Char
'a':Char
'-':String
name):[String]
cs) = (TagTree String -> [String] -> TagTree String
`appendClasses` [String]
cs) (TagTree String -> TagTree String)
-> Maybe (TagTree String) -> Maybe (TagTree String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FontAwesomeIcons -> String -> String -> Maybe (TagTree String)
fontAwesome FontAwesomeIcons
icons String
p String
name
        toFontAwesome [String]
_ = Maybe (TagTree String)
forall a. Maybe a
Nothing

        appendClasses :: TagTree String -> [String] -> TagTree String
appendClasses TagTree String
t [] = TagTree String
t
        appendClasses (TT.TagBranch String
x [Attribute String]
y [TagTree String]
z) [String]
cs =
            let as1 :: HashMap String String
as1 = [Attribute String] -> HashMap String String
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [Attribute String]
y
                as2 :: HashMap String String
as2 = String -> String -> HashMap String String
forall k v. Hashable k => k -> v -> HashMap k v
M.singleton String
"class" (String -> HashMap String String)
-> String -> HashMap String String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
cs
                y' :: [Attribute String]
y' = HashMap String String -> [Attribute String]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap String String -> [Attribute String])
-> HashMap String String -> [Attribute String]
forall a b. (a -> b) -> a -> b
$ (String -> String -> String)
-> HashMap String String
-> HashMap String String
-> HashMap String String
forall k v.
Eq k =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
M.unionWith (\String
l String
r -> String
l String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
r) HashMap String String
as1 HashMap String String
as2
            in String -> [Attribute String] -> [TagTree String] -> TagTree String
forall str. str -> [Attribute str] -> [TagTree str] -> TagTree str
TT.TagBranch String
x [Attribute String]
y' [TagTree String]
z
        appendClasses TagTree String
t [String]
_ = TagTree String
t

        classes :: [Attribute String] -> [String]
classes = String -> [String]
words (String -> [String])
-> ([Attribute String] -> String) -> [Attribute String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> ([Attribute String] -> Maybe String)
-> [Attribute String]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Attribute String] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"class"