{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
module Text.Pandoc.Emoji.TH ( genEmojis ) where
import Prelude
import Data.Aeson
import qualified Data.ByteString.Lazy as B
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (addDependentFile)
genEmojis :: FilePath -> Q Exp
genEmojis :: FilePath -> Q Exp
genEmojis fp :: FilePath
fp = do
FilePath -> Q ()
addDependentFile FilePath
fp
ByteString
bs <- IO ByteString -> Q ByteString
forall a. IO a -> Q a
runIO (IO ByteString -> Q ByteString) -> IO ByteString -> Q ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile FilePath
fp
case ByteString -> Either FilePath [Emoji]
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
bs of
Left e :: FilePath
e -> FilePath -> Q Exp
forall a. HasCallStack => FilePath -> a
error FilePath
e
Right ([Emoji]
emoji :: [Emoji]) -> [| emojis |]
where emojis :: [(FilePath, FilePath)]
emojis = [ (FilePath
alias, FilePath
txt)
| Emoji txt :: FilePath
txt aliases :: [FilePath]
aliases <- [Emoji]
emoji
, FilePath
alias <- [FilePath]
aliases
]
data Emoji = Emoji String [String]
deriving Int -> Emoji -> ShowS
[Emoji] -> ShowS
Emoji -> FilePath
(Int -> Emoji -> ShowS)
-> (Emoji -> FilePath) -> ([Emoji] -> ShowS) -> Show Emoji
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Emoji] -> ShowS
$cshowList :: [Emoji] -> ShowS
show :: Emoji -> FilePath
$cshow :: Emoji -> FilePath
showsPrec :: Int -> Emoji -> ShowS
$cshowsPrec :: Int -> Emoji -> ShowS
Show
instance FromJSON Emoji where
parseJSON :: Value -> Parser Emoji
parseJSON = FilePath -> (Object -> Parser Emoji) -> Value -> Parser Emoji
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject "Emoji" ((Object -> Parser Emoji) -> Value -> Parser Emoji)
-> (Object -> Parser Emoji) -> Value -> Parser Emoji
forall a b. (a -> b) -> a -> b
$ \v :: Object
v -> FilePath -> [FilePath] -> Emoji
Emoji
(FilePath -> [FilePath] -> Emoji)
-> Parser FilePath -> Parser ([FilePath] -> Emoji)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser FilePath
forall a. FromJSON a => Object -> Text -> Parser a
.: "emoji"
Parser ([FilePath] -> Emoji) -> Parser [FilePath] -> Parser Emoji
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [FilePath]
forall a. FromJSON a => Object -> Text -> Parser a
.: "aliases"