{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.Pandoc.Lua.Module.Utils
( pushModule
) where
import Control.Applicative ((<|>))
import Control.Monad.Catch (try)
import Data.Data (showConstr, toConstr)
import Data.Default (def)
import Data.Version (Version)
import Foreign.Lua (Peekable, Lua, NumResults (..))
import Text.Pandoc.Definition
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Marshaling.SimpleTable
( SimpleTable (..)
, pushSimpleTable
)
import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua)
import qualified Data.Digest.Pure.SHA as SHA
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Builder as B
import qualified Text.Pandoc.Filter.JSON as JSONFilter
import qualified Text.Pandoc.Shared as Shared
import qualified Text.Pandoc.Writers.Shared as Shared
pushModule :: PandocLua NumResults
pushModule = do
liftPandocLua Lua.newtable
addFunction "blocks_to_inlines" blocksToInlines
addFunction "equals" equals
addFunction "from_simple_table" from_simple_table
addFunction "make_sections" makeSections
addFunction "normalize_date" normalizeDate
addFunction "run_json_filter" runJSONFilter
addFunction "sha1" sha1
addFunction "stringify" stringify
addFunction "to_roman_numeral" toRomanNumeral
addFunction "to_simple_table" to_simple_table
addFunction "Version" (return :: Version -> Lua Version)
return 1
blocksToInlines :: [Block] -> Lua.Optional [Inline] -> PandocLua [Inline]
blocksToInlines blks optSep = liftPandocLua $ do
let sep = maybe Shared.defaultBlocksSeparator B.fromList
$ Lua.fromOptional optSep
return $ B.toList (Shared.blocksToInlinesWithSep sep blks)
makeSections :: Bool -> Lua.Optional Int -> [Block] -> Lua [Block]
makeSections number baselevel =
return . Shared.makeSections number (Lua.fromOptional baselevel)
normalizeDate :: T.Text -> Lua (Lua.Optional T.Text)
normalizeDate = return . Lua.Optional . Shared.normalizeDate
runJSONFilter :: Pandoc
-> FilePath
-> Lua.Optional [String]
-> PandocLua Pandoc
runJSONFilter doc filterFile optArgs = do
args <- case Lua.fromOptional optArgs of
Just x -> return x
Nothing -> liftPandocLua $ do
Lua.getglobal "FORMAT"
(:[]) <$> Lua.popValue
JSONFilter.apply def args filterFile doc
sha1 :: BSL.ByteString
-> Lua T.Text
sha1 = return . T.pack . SHA.showDigest . SHA.sha1
stringify :: AstElement -> PandocLua T.Text
stringify el = return $ case el of
PandocElement pd -> Shared.stringify pd
InlineElement i -> Shared.stringify i
BlockElement b -> Shared.stringify b
MetaElement m -> Shared.stringify m
CitationElement c -> Shared.stringify c
MetaValueElement m -> stringifyMetaValue m
_ -> mempty
stringifyMetaValue :: MetaValue -> T.Text
stringifyMetaValue mv = case mv of
MetaBool b -> T.toLower $ T.pack (show b)
MetaString s -> s
_ -> Shared.stringify mv
equals :: AstElement -> AstElement -> PandocLua Bool
equals e1 e2 = return (e1 == e2)
data AstElement
= PandocElement Pandoc
| MetaElement Meta
| BlockElement Block
| InlineElement Inline
| MetaValueElement MetaValue
| AttrElement Attr
| ListAttributesElement ListAttributes
| CitationElement Citation
deriving (Eq, Show)
instance Peekable AstElement where
peek idx = do
res <- try $ (PandocElement <$> Lua.peek idx)
<|> (InlineElement <$> Lua.peek idx)
<|> (BlockElement <$> Lua.peek idx)
<|> (AttrElement <$> Lua.peek idx)
<|> (ListAttributesElement <$> Lua.peek idx)
<|> (MetaElement <$> Lua.peek idx)
<|> (MetaValueElement <$> Lua.peek idx)
case res of
Right x -> return x
Left (_ :: PandocError) -> Lua.throwMessage
"Expected an AST element, but could not parse value as such."
from_simple_table :: SimpleTable -> Lua NumResults
from_simple_table (SimpleTable capt aligns widths head' body) = do
Lua.push $ Table
nullAttr
(Caption Nothing [Plain capt])
(zipWith (\a w -> (a, toColWidth w)) aligns widths)
(TableHead nullAttr [blockListToRow head'])
[TableBody nullAttr 0 [] $ map blockListToRow body]
(TableFoot nullAttr [])
return (NumResults 1)
where
blockListToRow :: [[Block]] -> Row
blockListToRow = Row nullAttr . map (B.simpleCell . B.fromList)
toColWidth :: Double -> ColWidth
toColWidth 0 = ColWidthDefault
toColWidth w = ColWidth w
to_simple_table :: Block -> Lua NumResults
to_simple_table = \case
Table _attr caption specs thead tbodies tfoot -> do
let (capt, aligns, widths, headers, rows) =
Shared.toLegacyTable caption specs thead tbodies tfoot
pushSimpleTable $ SimpleTable capt aligns widths headers rows
return (NumResults 1)
blk ->
Lua.throwMessage $
"Expected Table, got " <> showConstr (toConstr blk) <> "."
toRomanNumeral :: Lua.Integer -> PandocLua T.Text
toRomanNumeral = return . Shared.toRomanNumeral . fromIntegral