{-# LANGUAGE OverloadedStrings, RecordWildCards #-}

module Vendor.FontAwesome.Core (
    FontAwesomeIcons,
    fontAwesome,
    loadFontAwesome
) where

import           Data.Aeson                 (FromJSON (..), decode, withObject,
                                             (.!=), (.:), (.:?))
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.HashMap.Strict        as M
import           System.Process             (readProcess)
import           Text.HTML.TagSoup          (Attribute)
import           Text.HTML.TagSoup.Tree     (TagTree (..))

data Elem = Elem { Elem -> String
tag :: String, Elem -> [Attribute String]
attr :: [Attribute String], Elem -> [Elem]
child :: [Elem] } deriving Int -> Elem -> ShowS
[Elem] -> ShowS
Elem -> String
(Int -> Elem -> ShowS)
-> (Elem -> String) -> ([Elem] -> ShowS) -> Show Elem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Elem -> ShowS
showsPrec :: Int -> Elem -> ShowS
$cshow :: Elem -> String
show :: Elem -> String
$cshowList :: [Elem] -> ShowS
showList :: [Elem] -> ShowS
Show

instance FromJSON Elem where
    parseJSON :: Value -> Parser Elem
parseJSON = String -> (Object -> Parser Elem) -> Value -> Parser Elem
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Element" ((Object -> Parser Elem) -> Value -> Parser Elem)
-> (Object -> Parser Elem) -> Value -> Parser Elem
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        String
tag <- Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag"
        [Attribute String]
attr <- HashMap String String -> [Attribute String]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap String String -> [Attribute String])
-> Parser (HashMap String String) -> Parser [Attribute String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe (HashMap String String))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"attributes" Parser (Maybe (HashMap String String))
-> HashMap String String -> Parser (HashMap String String)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap String String
forall k v. HashMap k v
M.empty
        [Elem]
child <- Object
obj Object -> Key -> Parser (Maybe [Elem])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"children" Parser (Maybe [Elem]) -> [Elem] -> Parser [Elem]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
        Elem -> Parser Elem
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Elem {String
[Attribute String]
[Elem]
tag :: String
attr :: [Attribute String]
child :: [Elem]
tag :: String
attr :: [Attribute String]
child :: [Elem]
..}

type FontAwesomeIcons = M.HashMap String (M.HashMap String Elem)

loadFontAwesome :: IO (Maybe FontAwesomeIcons)
loadFontAwesome :: IO (Maybe FontAwesomeIcons)
loadFontAwesome = ByteString -> Maybe FontAwesomeIcons
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe FontAwesomeIcons)
-> (String -> ByteString) -> String -> Maybe FontAwesomeIcons
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack (String -> Maybe FontAwesomeIcons)
-> IO String -> IO (Maybe FontAwesomeIcons)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"npx" [String
"tsx", String
"./tools/fontawesome.ts"] String
""

fontAwesome :: FontAwesomeIcons -> String -> String -> Maybe (TagTree String)
fontAwesome :: FontAwesomeIcons -> String -> String -> Maybe (TagTree String)
fontAwesome FontAwesomeIcons
db String
prefix String
name = Elem -> TagTree String
toTagTree (Elem -> TagTree String) -> Maybe Elem -> Maybe (TagTree String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> FontAwesomeIcons -> Maybe (HashMap String Elem)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup String
prefix FontAwesomeIcons
db Maybe (HashMap String Elem)
-> (HashMap String Elem -> Maybe Elem) -> Maybe Elem
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> HashMap String Elem -> Maybe Elem
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup String
name)

toTagTree :: Elem -> TagTree String
toTagTree :: Elem -> TagTree String
toTagTree = String -> [Attribute String] -> [TagTree String] -> TagTree String
forall str. str -> [Attribute str] -> [TagTree str] -> TagTree str
TagBranch (String
 -> [Attribute String] -> [TagTree String] -> TagTree String)
-> (Elem -> String)
-> Elem
-> [Attribute String]
-> [TagTree String]
-> TagTree String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Elem -> String
tag (Elem -> [Attribute String] -> [TagTree String] -> TagTree String)
-> (Elem -> [Attribute String])
-> Elem
-> [TagTree String]
-> TagTree String
forall a b. (Elem -> a -> b) -> (Elem -> a) -> Elem -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Elem -> [Attribute String]
attr (Elem -> [TagTree String] -> TagTree String)
-> (Elem -> [TagTree String]) -> Elem -> TagTree String
forall a b. (Elem -> a -> b) -> (Elem -> a) -> Elem -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Elem -> TagTree String) -> [Elem] -> [TagTree String]
forall a b. (a -> b) -> [a] -> [b]
map Elem -> TagTree String
toTagTree ([Elem] -> [TagTree String])
-> (Elem -> [Elem]) -> Elem -> [TagTree String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elem -> [Elem]
child