{-# LANGUAGE FlexibleContexts, Rank2Types #-}
module Text.Pandoc.CrossRef.Util.Meta (
getMetaList
, getMetaBool
, getMetaInlines
, getMetaBlock
, getMetaString
, getList
, toString
, toInlines
, tryCapitalizeM
) where
import Text.Pandoc.CrossRef.Util.Util
import Text.Pandoc.Definition
import Text.Pandoc.Builder
import Data.Default
import Text.Pandoc.Walk
import Text.Pandoc.Shared hiding (capitalize, toString)
import qualified Data.Text as T
getMetaList :: (Default a) => (MetaValue -> a) -> T.Text -> Meta -> Int -> a
getMetaList f name meta i = maybe def f $ lookupMeta name meta >>= getList i
getMetaBool :: T.Text -> Meta -> Bool
getMetaBool = getScalar toBool
getMetaInlines :: T.Text -> Meta -> [Inline]
getMetaInlines = getScalar toInlines
getMetaBlock :: T.Text -> Meta -> [Block]
getMetaBlock = getScalar toBlocks
getMetaString :: T.Text -> Meta -> T.Text
getMetaString = getScalar toString
getScalar :: Def b => (T.Text -> MetaValue -> b) -> T.Text -> Meta -> b
getScalar conv name meta = maybe def' (conv name) $ lookupMeta name meta
class Def a where
def' :: a
instance Def Bool where
def' = False
instance Def [a] where
def' = []
instance Def T.Text where
def' = T.empty
unexpectedError :: forall a. String -> T.Text -> MetaValue -> a
unexpectedError e n x = error $ "Expected " <> e <> " in metadata field " <> T.unpack n <> " but got " <> g x
where
g (MetaBlocks _) = "blocks"
g (MetaString _) = "string"
g (MetaInlines _) = "inlines"
g (MetaBool _) = "bool"
g (MetaMap _) = "map"
g (MetaList _) = "list"
toInlines :: T.Text -> MetaValue -> [Inline]
toInlines _ (MetaBlocks s) = blocksToInlines s
toInlines _ (MetaInlines s) = s
toInlines _ (MetaString s) = toList $ text s
toInlines n x = unexpectedError "inlines" n x
toBool :: T.Text -> MetaValue -> Bool
toBool _ (MetaBool b) = b
toBool n x = unexpectedError "bool" n x
toBlocks :: T.Text -> MetaValue -> [Block]
toBlocks _ (MetaBlocks bs) = bs
toBlocks _ (MetaInlines ils) = [Plain ils]
toBlocks _ (MetaString s) = toList $ plain $ text s
toBlocks n x = unexpectedError "blocks" n x
toString :: T.Text -> MetaValue -> T.Text
toString _ (MetaString s) = s
toString _ (MetaBlocks b) = stringify b
toString _ (MetaInlines i) = stringify i
toString n x = unexpectedError "string" n x
getList :: Int -> MetaValue -> Maybe MetaValue
getList i (MetaList l) = l !!? i
where
list !!? index | index >= 0 && index < length list = Just $ list !! index
| not $ null list = Just $ last list
| otherwise = Nothing
getList _ x = Just x
tryCapitalizeM :: (Functor m, Monad m, Walkable Inline a, Default a, Eq a) =>
(T.Text -> m a) -> T.Text -> Bool -> m a
tryCapitalizeM f varname capitalize
| capitalize = do
res <- f (capitalizeFirst varname)
case res of
xs | xs == def -> f varname >>= walkM capStrFst
| otherwise -> return xs
| otherwise = f varname
where
capStrFst (Str s) = return $ Str $ capitalizeFirst s
capStrFst x = return x