{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{- |
   Module      : Text.Pandoc.Emoji.TH
   Copyright   : Copyright (C) 2019 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Code generation for emoji list in Text.Pandoc.Emoji.
-}
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"