{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Lua.Module.Utils
   Copyright   : Copyright © 2017-2020 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Utility module for Lua, exposing internal helper functions.
-}
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

-- | Push the "pandoc.utils" module to the Lua stack.
pushModule :: PandocLua NumResults
pushModule :: PandocLua NumResults
pushModule = do
  Lua () -> PandocLua ()
forall a. Lua a -> PandocLua a
liftPandocLua Lua ()
Lua.newtable
  String
-> ([Block] -> Optional [Inline] -> PandocLua [Inline])
-> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"blocks_to_inlines" [Block] -> Optional [Inline] -> PandocLua [Inline]
blocksToInlines
  String
-> (AstElement -> AstElement -> PandocLua Bool) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"equals" AstElement -> AstElement -> PandocLua Bool
equals
  String -> (SimpleTable -> Lua NumResults) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"from_simple_table" SimpleTable -> Lua NumResults
from_simple_table
  String
-> (Bool -> Optional Int -> [Block] -> Lua [Block]) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"make_sections" Bool -> Optional Int -> [Block] -> Lua [Block]
makeSections
  String -> (Text -> Lua (Optional Text)) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"normalize_date" Text -> Lua (Optional Text)
normalizeDate
  String
-> (Pandoc -> String -> Optional [String] -> PandocLua Pandoc)
-> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"run_json_filter" Pandoc -> String -> Optional [String] -> PandocLua Pandoc
runJSONFilter
  String -> (ByteString -> Lua Text) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"sha1" ByteString -> Lua Text
sha1
  String -> (AstElement -> PandocLua Text) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"stringify" AstElement -> PandocLua Text
stringify
  String -> (Integer -> PandocLua Text) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"to_roman_numeral" Integer -> PandocLua Text
toRomanNumeral
  String -> (Block -> Lua NumResults) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"to_simple_table" Block -> Lua NumResults
to_simple_table
  String -> (Version -> Lua Version) -> PandocLua ()
forall a. ToHaskellFunction a => String -> a -> PandocLua ()
addFunction String
"Version" (Version -> Lua Version
forall (m :: * -> *) a. Monad m => a -> m a
return :: Version -> Lua Version)
  NumResults -> PandocLua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return NumResults
1

-- | Squashes a list of blocks into inlines.
blocksToInlines :: [Block] -> Lua.Optional [Inline] -> PandocLua [Inline]
blocksToInlines :: [Block] -> Optional [Inline] -> PandocLua [Inline]
blocksToInlines [Block]
blks Optional [Inline]
optSep = Lua [Inline] -> PandocLua [Inline]
forall a. Lua a -> PandocLua a
liftPandocLua (Lua [Inline] -> PandocLua [Inline])
-> Lua [Inline] -> PandocLua [Inline]
forall a b. (a -> b) -> a -> b
$ do
  let sep :: Inlines
sep = Inlines -> ([Inline] -> Inlines) -> Maybe [Inline] -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inlines
Shared.defaultBlocksSeparator [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList
            (Maybe [Inline] -> Inlines) -> Maybe [Inline] -> Inlines
forall a b. (a -> b) -> a -> b
$ Optional [Inline] -> Maybe [Inline]
forall a. Optional a -> Maybe a
Lua.fromOptional Optional [Inline]
optSep
  [Inline] -> Lua [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> Lua [Inline]) -> [Inline] -> Lua [Inline]
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Block] -> Inlines
Shared.blocksToInlinesWithSep Inlines
sep [Block]
blks)

-- | Convert list of Pandoc blocks into sections using Divs.
makeSections :: Bool -> Lua.Optional Int -> [Block] -> Lua [Block]
makeSections :: Bool -> Optional Int -> [Block] -> Lua [Block]
makeSections Bool
number Optional Int
baselevel =
  [Block] -> Lua [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> Lua [Block])
-> ([Block] -> [Block]) -> [Block] -> Lua [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe Int -> [Block] -> [Block]
Shared.makeSections Bool
number (Optional Int -> Maybe Int
forall a. Optional a -> Maybe a
Lua.fromOptional Optional Int
baselevel)

-- | Parse a date and convert (if possible) to "YYYY-MM-DD" format. We
-- limit years to the range 1601-9999 (ISO 8601 accepts greater than
-- or equal to 1583, but MS Word only accepts dates starting 1601).
-- Returns nil instead of a string if the conversion failed.
normalizeDate :: T.Text -> Lua (Lua.Optional T.Text)
normalizeDate :: Text -> Lua (Optional Text)
normalizeDate = Optional Text -> Lua (Optional Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Optional Text -> Lua (Optional Text))
-> (Text -> Optional Text) -> Text -> Lua (Optional Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Optional Text
forall a. Maybe a -> Optional a
Lua.Optional (Maybe Text -> Optional Text)
-> (Text -> Maybe Text) -> Text -> Optional Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
Shared.normalizeDate

-- | Run a JSON filter on the given document.
runJSONFilter :: Pandoc
              -> FilePath
              -> Lua.Optional [String]
              -> PandocLua Pandoc
runJSONFilter :: Pandoc -> String -> Optional [String] -> PandocLua Pandoc
runJSONFilter Pandoc
doc String
filterFile Optional [String]
optArgs = do
  [String]
args <- case Optional [String] -> Maybe [String]
forall a. Optional a -> Maybe a
Lua.fromOptional Optional [String]
optArgs of
            Just [String]
x -> [String] -> PandocLua [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
x
            Maybe [String]
Nothing -> Lua [String] -> PandocLua [String]
forall a. Lua a -> PandocLua a
liftPandocLua (Lua [String] -> PandocLua [String])
-> Lua [String] -> PandocLua [String]
forall a b. (a -> b) -> a -> b
$ do
              String -> Lua ()
Lua.getglobal String
"FORMAT"
              (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> Lua String -> Lua [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lua String
forall a. Peekable a => Lua a
Lua.popValue
  ReaderOptions -> [String] -> String -> Pandoc -> PandocLua Pandoc
forall (m :: * -> *).
MonadIO m =>
ReaderOptions -> [String] -> String -> Pandoc -> m Pandoc
JSONFilter.apply ReaderOptions
forall a. Default a => a
def [String]
args String
filterFile Pandoc
doc

-- | Calculate the hash of the given contents.
sha1 :: BSL.ByteString
     -> Lua T.Text
sha1 :: ByteString -> Lua Text
sha1 = Text -> Lua Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Lua Text)
-> (ByteString -> Text) -> ByteString -> Lua Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA1State -> String
forall t. Digest t -> String
SHA.showDigest (Digest SHA1State -> String)
-> (ByteString -> Digest SHA1State) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
SHA.sha1

-- | Convert pandoc structure to a string with formatting removed.
-- Footnotes are skipped (since we don't want their contents in link
-- labels).
stringify :: AstElement -> PandocLua T.Text
stringify :: AstElement -> PandocLua Text
stringify AstElement
el = Text -> PandocLua Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> PandocLua Text) -> Text -> PandocLua Text
forall a b. (a -> b) -> a -> b
$ case AstElement
el of
  PandocElement Pandoc
pd -> Pandoc -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify Pandoc
pd
  InlineElement Inline
i  -> Inline -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify Inline
i
  BlockElement Block
b   -> Block -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify Block
b
  MetaElement Meta
m    -> Meta -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify Meta
m
  CitationElement Citation
c  -> Citation -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify Citation
c
  MetaValueElement MetaValue
m -> MetaValue -> Text
stringifyMetaValue MetaValue
m
  AstElement
_                  -> Text
forall a. Monoid a => a
mempty

stringifyMetaValue :: MetaValue -> T.Text
stringifyMetaValue :: MetaValue -> Text
stringifyMetaValue MetaValue
mv = case MetaValue
mv of
  MetaBool Bool
b   -> Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Bool -> String
forall a. Show a => a -> String
show Bool
b)
  MetaString Text
s -> Text
s
  MetaValue
_            -> MetaValue -> Text
forall a. Walkable Inline a => a -> Text
Shared.stringify MetaValue
mv

equals :: AstElement -> AstElement -> PandocLua Bool
equals :: AstElement -> AstElement -> PandocLua Bool
equals AstElement
e1 AstElement
e2 = Bool -> PandocLua Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (AstElement
e1 AstElement -> AstElement -> Bool
forall a. Eq a => a -> a -> Bool
== AstElement
e2)

data AstElement
  = PandocElement Pandoc
  | MetaElement Meta
  | BlockElement Block
  | InlineElement Inline
  | MetaValueElement MetaValue
  | AttrElement Attr
  | ListAttributesElement ListAttributes
  | CitationElement Citation
  deriving (AstElement -> AstElement -> Bool
(AstElement -> AstElement -> Bool)
-> (AstElement -> AstElement -> Bool) -> Eq AstElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AstElement -> AstElement -> Bool
$c/= :: AstElement -> AstElement -> Bool
== :: AstElement -> AstElement -> Bool
$c== :: AstElement -> AstElement -> Bool
Eq, Int -> AstElement -> ShowS
[AstElement] -> ShowS
AstElement -> String
(Int -> AstElement -> ShowS)
-> (AstElement -> String)
-> ([AstElement] -> ShowS)
-> Show AstElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AstElement] -> ShowS
$cshowList :: [AstElement] -> ShowS
show :: AstElement -> String
$cshow :: AstElement -> String
showsPrec :: Int -> AstElement -> ShowS
$cshowsPrec :: Int -> AstElement -> ShowS
Show)

instance Peekable AstElement where
  peek :: StackIndex -> Lua AstElement
peek StackIndex
idx  = do
    Either PandocError AstElement
res <- Lua AstElement -> Lua (Either PandocError AstElement)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (Lua AstElement -> Lua (Either PandocError AstElement))
-> Lua AstElement -> Lua (Either PandocError AstElement)
forall a b. (a -> b) -> a -> b
$  (Pandoc -> AstElement
PandocElement (Pandoc -> AstElement) -> Lua Pandoc -> Lua AstElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Pandoc
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)
              Lua AstElement -> Lua AstElement -> Lua AstElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Inline -> AstElement
InlineElement (Inline -> AstElement) -> Lua Inline -> Lua AstElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Inline
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)
              Lua AstElement -> Lua AstElement -> Lua AstElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Block -> AstElement
BlockElement (Block -> AstElement) -> Lua Block -> Lua AstElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Block
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)
              Lua AstElement -> Lua AstElement -> Lua AstElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Attr -> AstElement
AttrElement (Attr -> AstElement) -> Lua Attr -> Lua AstElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Attr
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)
              Lua AstElement -> Lua AstElement -> Lua AstElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ListAttributes -> AstElement
ListAttributesElement (ListAttributes -> AstElement)
-> Lua ListAttributes -> Lua AstElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua ListAttributes
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)
              Lua AstElement -> Lua AstElement -> Lua AstElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Meta -> AstElement
MetaElement (Meta -> AstElement) -> Lua Meta -> Lua AstElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua Meta
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)
              Lua AstElement -> Lua AstElement -> Lua AstElement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (MetaValue -> AstElement
MetaValueElement (MetaValue -> AstElement) -> Lua MetaValue -> Lua AstElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StackIndex -> Lua MetaValue
forall a. Peekable a => StackIndex -> Lua a
Lua.peek StackIndex
idx)
    case Either PandocError AstElement
res of
      Right AstElement
x -> AstElement -> Lua AstElement
forall (m :: * -> *) a. Monad m => a -> m a
return AstElement
x
      Left (PandocError
_ :: PandocError) -> String -> Lua AstElement
forall a. String -> Lua a
Lua.throwMessage
        String
"Expected an AST element, but could not parse value as such."

-- | Converts an old/simple table into a normal table block element.
from_simple_table :: SimpleTable -> Lua NumResults
from_simple_table :: SimpleTable -> Lua NumResults
from_simple_table (SimpleTable [Inline]
capt [Alignment]
aligns [Double]
widths [[Block]]
head' [[[Block]]]
body) = do
  Block -> Lua ()
forall a. Pushable a => a -> Lua ()
Lua.push (Block -> Lua ()) -> Block -> Lua ()
forall a b. (a -> b) -> a -> b
$ Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table
    Attr
nullAttr
    (Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
forall a. Maybe a
Nothing [[Inline] -> Block
Plain [Inline]
capt])
    ((Alignment -> Double -> ColSpec)
-> [Alignment] -> [Double] -> [ColSpec]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Alignment
a Double
w -> (Alignment
a, Double -> ColWidth
toColWidth Double
w)) [Alignment]
aligns [Double]
widths)
    (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr [[[Block]] -> Row
blockListToRow [[Block]]
head'])
    [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([[Block]] -> Row) -> [[[Block]]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [[Block]] -> Row
blockListToRow [[[Block]]]
body]
    (Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])
  NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
1)
  where
    blockListToRow :: [[Block]] -> Row
    blockListToRow :: [[Block]] -> Row
blockListToRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([[Block]] -> [Cell]) -> [[Block]] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> Cell) -> [[Block]] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map (Blocks -> Cell
B.simpleCell (Blocks -> Cell) -> ([Block] -> Blocks) -> [Block] -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Blocks
forall a. [a] -> Many a
B.fromList)

    toColWidth :: Double -> ColWidth
    toColWidth :: Double -> ColWidth
toColWidth Double
0 = ColWidth
ColWidthDefault
    toColWidth Double
w = Double -> ColWidth
ColWidth Double
w

-- | Converts a table into an old/simple table.
to_simple_table :: Block -> Lua NumResults
to_simple_table :: Block -> Lua NumResults
to_simple_table = \case
  Table Attr
_attr Caption
caption [ColSpec]
specs TableHead
thead [TableBody]
tbodies TableFoot
tfoot -> do
    let ([Inline]
capt, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) =
          Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
Shared.toLegacyTable Caption
caption [ColSpec]
specs TableHead
thead [TableBody]
tbodies TableFoot
tfoot
    SimpleTable -> Lua ()
pushSimpleTable (SimpleTable -> Lua ()) -> SimpleTable -> Lua ()
forall a b. (a -> b) -> a -> b
$ [Inline]
-> [Alignment]
-> [Double]
-> [[Block]]
-> [[[Block]]]
-> SimpleTable
SimpleTable [Inline]
capt [Alignment]
aligns [Double]
widths [[Block]]
headers [[[Block]]]
rows
    NumResults -> Lua NumResults
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> NumResults
NumResults CInt
1)
  Block
blk ->
    String -> Lua NumResults
forall a. String -> Lua a
Lua.throwMessage (String -> Lua NumResults) -> String -> Lua NumResults
forall a b. (a -> b) -> a -> b
$
      String
"Expected Table, got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Constr -> String
showConstr (Block -> Constr
forall a. Data a => a -> Constr
toConstr Block
blk) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."

-- | Convert a number < 4000 to uppercase roman numeral.
toRomanNumeral :: Lua.Integer -> PandocLua T.Text
toRomanNumeral :: Integer -> PandocLua Text
toRomanNumeral = Text -> PandocLua Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> PandocLua Text)
-> (Integer -> Text) -> Integer -> PandocLua Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
Shared.toRomanNumeral (Int -> Text) -> (Integer -> Int) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral