2f47e04 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Text.Pandoc.Lua: add mediabag submodule

2f47e04Albert Krewinkel9 years ago

src/Text/Pandoc/App.hs+6−7

compare with master

unifiedsplit

@@ -850,16 +850,15 @@ expandFilterPath mbDatadir fp = liftIO $ do

850 else return fp

851 _ -> return fp

852

853−applyLuaFilters :: MonadIO m

854− => Maybe FilePath -> [FilePath] -> String -> Pandoc

853+applyLuaFilters :: Maybe FilePath -> [FilePath] -> String -> Pandoc

855− -> m Pandoc

854+ -> PandocIO Pandoc

856applyLuaFilters mbDatadir filters format d = do

855applyLuaFilters mbDatadir filters format d = do

857 expandedFilters <- mapM (expandFilterPath mbDatadir) filters

856 expandedFilters <- mapM (expandFilterPath mbDatadir) filters

858− let go f d' = liftIO $ do

857+ let go f d' = do

859− res <- E.try (runLuaFilter mbDatadir f format d')

858+ res <- runLuaFilter mbDatadir f format d'

860 case res of

859 case res of

861− Right x -> return x

860+ Right x -> return x

862− Left (LuaException s) -> E.throw (PandocFilterError f s)

861+ Left (LuaException s) -> E.throw (PandocFilterError f s)

863 foldrM ($) d $ map go expandedFilters

862 foldrM ($) d $ map go expandedFilters

864

863

865applyFilters :: MonadIO m

864applyFilters :: MonadIO m

src/Text/Pandoc/Class.hs+19−9

@@ -79,6 +79,7 @@ module Text.Pandoc.Class ( PandocMonad(..)

79 , runPure

80 , readDefaultDataFile

81 , readDataFile

82+ , fetchMediaResource

82 , fillMediaBag

83 , fillMediaBag

83 , extractMedia

84 , extractMedia

84 , toLang

85 , toLang

@@ -246,9 +247,9 @@ getMediaBag = getsCommonState stMediaBag

246

247

247insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()

248insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()

248insertMedia fp mime bs = do

249insertMedia fp mime bs = do

249− mb <- getsCommonState stMediaBag

250+ mb <- getMediaBag

250 let mb' = MB.insertMedia fp mime bs mb

251 let mb' = MB.insertMedia fp mime bs mb

251− modifyCommonState $ \st -> st{stMediaBag = mb' }

252+ setMediaBag mb'

252

253

253getInputFiles :: PandocMonad m => m (Maybe [FilePath])

254getInputFiles :: PandocMonad m => m (Maybe [FilePath])

254getInputFiles = getsCommonState stInputFiles

255getInputFiles = getsCommonState stInputFiles

@@ -633,6 +634,20 @@ withPaths (p:ps) action fp =

633 catchError (action (p </> fp))

634 catchError (action (p </> fp))

634 (\_ -> withPaths ps action fp)

635 (\_ -> withPaths ps action fp)

635

636

637+-- | Fetch local or remote resource (like an image) and provide data suitable

638+-- for adding it to the MediaBag.

639+fetchMediaResource :: PandocMonad m

640+ => Maybe String -> String

641+ -> m (FilePath, Maybe MimeType, BL.ByteString)

642+fetchMediaResource sourceUrl src = do

643+ (bs, mt) <- downloadOrRead sourceUrl src

644+ let ext = fromMaybe (takeExtension src)

645+ (mt >>= extensionFromMimeType)

646+ let bs' = BL.fromChunks [bs]

647+ let basename = showDigest $ sha1 bs'

648+ let fname = basename <.> ext

649+ return (fname, mt, bs')

650+

636-- | Traverse tree, filling media bag for any images that

651-- | Traverse tree, filling media bag for any images that

637-- aren't already in the media bag.

652-- aren't already in the media bag.

638fillMediaBag :: PandocMonad m => Maybe String -> Pandoc -> m Pandoc

653fillMediaBag :: PandocMonad m => Maybe String -> Pandoc -> m Pandoc

@@ -643,13 +658,8 @@ fillMediaBag sourceURL d = walkM handleImage d

643 case lookupMedia src mediabag of

658 case lookupMedia src mediabag of

644 Just (_, _) -> return $ Image attr lab (src, tit)

659 Just (_, _) -> return $ Image attr lab (src, tit)

645 Nothing -> do

660 Nothing -> do

646− (bs, mt) <- downloadOrRead sourceURL src

661+ (fname, mt, bs) <- fetchMediaResource sourceURL src

647− let ext = fromMaybe (takeExtension src)

648− (mt >>= extensionFromMimeType)

649− let bs' = BL.fromChunks [bs]

650− let basename = showDigest $ sha1 bs'

651− let fname = basename <.> ext

652− insertMedia fname mt bs'

662+ insertMedia fname mt bs

653 return $ Image attr lab (fname, tit))

663 return $ Image attr lab (fname, tit))

654 (\e ->

664 (\e ->

655 case e of

665 case e of

src/Text/Pandoc/Lua.hs+30−6

@@ -39,26 +39,40 @@ import Control.Monad.Trans (MonadIO (..))

39import Data.Data (DataType, Data, toConstr, showConstr, dataTypeOf,

40 dataTypeConstrs, dataTypeName, tyconUQname)

41import Data.Foldable (foldrM)

42+import Data.IORef (IORef, newIORef, readIORef)

42import Data.Map (Map)

43import Data.Map (Map)

43import Data.Maybe (isJust)

44import Data.Maybe (isJust)

44import Foreign.Lua (Lua, FromLuaStack (peek), LuaException (..), StackIndex,

45import Foreign.Lua (Lua, FromLuaStack (peek), LuaException (..), StackIndex,

45 Status (OK), ToLuaStack (push))

46 Status (OK), ToLuaStack (push))

47+import Text.Pandoc.Class (PandocIO, getMediaBag, setMediaBag)

48+import Text.Pandoc.MediaBag (MediaBag)

46import Text.Pandoc.Definition

49import Text.Pandoc.Definition

47−import Text.Pandoc.Lua.PandocModule (pushPandocModule)

50+import Text.Pandoc.Lua.PandocModule (pushPandocModule, pushMediaBagModule)

48import Text.Pandoc.Walk (walkM)

51import Text.Pandoc.Walk (walkM)

50import qualified Data.Map as Map

53import qualified Data.Map as Map

51import qualified Foreign.Lua as Lua

54import qualified Foreign.Lua as Lua

53−runLuaFilter :: (MonadIO m)

56+runLuaFilter :: Maybe FilePath -> FilePath -> String

54− => Maybe FilePath -> FilePath -> String -> Pandoc -> m Pandoc

57+ -> Pandoc -> PandocIO (Either LuaException Pandoc)

55−runLuaFilter datadir filterPath format pd = liftIO . Lua.runLua $ do

58+runLuaFilter datadir filterPath format pd = do

59+ mediaBag <- getMediaBag

60+ mediaBagRef <- liftIO (newIORef mediaBag)

61+ res <- liftIO . Lua.runLuaEither $

62+ runLuaFilter' datadir filterPath format mediaBagRef pd

63+ newMediaBag <- liftIO (readIORef mediaBagRef)

64+ setMediaBag newMediaBag

65+ return res

66+

67+runLuaFilter' :: Maybe FilePath -> FilePath -> String -> IORef MediaBag

68+ -> Pandoc -> Lua Pandoc

69+runLuaFilter' datadir filterPath format mbRef pd = do

56 Lua.openlibs

70 Lua.openlibs

57 -- store module in global "pandoc"

71 -- store module in global "pandoc"

58 pushPandocModule datadir

72 pushPandocModule datadir

59 Lua.setglobal "pandoc"

73 Lua.setglobal "pandoc"

60− push format

74+ addMediaBagModule

61− Lua.setglobal "FORMAT"

75+ registerFormat

62 top <- Lua.gettop

76 top <- Lua.gettop

63 stat <- Lua.dofile filterPath

77 stat <- Lua.dofile filterPath

64 if stat /= OK

78 if stat /= OK

@@ -71,6 +85,16 @@ runLuaFilter datadir filterPath format pd = liftIO . Lua.runLua $ do

71 when (newtop - top < 1) pushGlobalFilter

85 when (newtop - top < 1) pushGlobalFilter

72 luaFilters <- peek (-1)

86 luaFilters <- peek (-1)

73 runAll luaFilters pd

87 runAll luaFilters pd

88+ where

89+ addMediaBagModule = do

90+ Lua.getglobal "pandoc"

91+ push "mediabag"

92+ pushMediaBagModule mbRef

93+ Lua.rawset (-3)

94+ registerFormat = do

95+ push format

96+ Lua.setglobal "FORMAT"

97+

75pushGlobalFilter :: Lua ()

99pushGlobalFilter :: Lua ()

76pushGlobalFilter = do

100pushGlobalFilter = do

src/Text/Pandoc/Lua/PandocModule.hs+111−14

@@ -15,6 +15,10 @@ You should have received a copy of the GNU General Public License

15along with this program; if not, write to the Free Software

16Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

17-}

18+{-# LANGUAGE CPP #-}

19+#if !MIN_VERSION_hslua(0,9,0)

20+{-# OPTIONS_GHC -fno-warn-orphans #-}

21+#endif

18{- |

22{- |

19 Module : Text.Pandoc.Lua.PandocModule

23 Module : Text.Pandoc.Lua.PandocModule

@@ -25,28 +29,37 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

26Pandoc module for lua.

30Pandoc module for lua.

27-}

31-}

28−module Text.Pandoc.Lua.PandocModule ( pushPandocModule ) where

32+module Text.Pandoc.Lua.PandocModule

33+ ( pushPandocModule

34+ , pushMediaBagModule

35+ ) where

30−import Control.Monad (unless)

37+import Control.Monad (unless, zipWithM_)

31import Data.ByteString.Char8 (unpack)

38import Data.ByteString.Char8 (unpack)

32import Data.Default (Default (..))

39import Data.Default (Default (..))

40+import Data.IORef

33import Data.Text (pack)

41import Data.Text (pack)

34−import Foreign.Lua (Lua, Status (OK), NumResults, call, loadstring, liftIO,

42+import Foreign.Lua (Lua, FromLuaStack, ToLuaStack, NumResults, liftIO)

35− push, pushHaskellFunction, rawset)

36−import Text.Pandoc.Class (readDataFile, runIO, runIOorExplode, setUserDataDir)

43+import Text.Pandoc.Class (fetchMediaResource, readDataFile, runIO,

44+ runIOorExplode, setUserDataDir)

37import Text.Pandoc.Options (ReaderOptions(readerExtensions))

45import Text.Pandoc.Options (ReaderOptions(readerExtensions))

38import Text.Pandoc.Lua.StackInstances ()

46import Text.Pandoc.Lua.StackInstances ()

39import Text.Pandoc.Readers (Reader (..), getReader)

47import Text.Pandoc.Readers (Reader (..), getReader)

48+import Text.Pandoc.MIME (MimeType)

49+

50+import qualified Foreign.Lua as Lua

51+import qualified Data.ByteString.Lazy as BL

52+import qualified Text.Pandoc.MediaBag as MB

41-- | Push the "pandoc" on the lua stack.

54-- | Push the "pandoc" on the lua stack.

42pushPandocModule :: Maybe FilePath -> Lua ()

55pushPandocModule :: Maybe FilePath -> Lua ()

43pushPandocModule datadir = do

56pushPandocModule datadir = do

44 script <- liftIO (pandocModuleScript datadir)

57 script <- liftIO (pandocModuleScript datadir)

45− status <- loadstring script

58+ status <- Lua.loadstring script

46− unless (status /= OK) $ call 0 1

59+ unless (status /= Lua.OK) $ Lua.call 0 1

47− push "__read"

60+ Lua.push "__read"

48− pushHaskellFunction readDoc

61+ Lua.pushHaskellFunction readDoc

49− rawset (-3)

62+ Lua.rawset (-3)

51-- | Get the string representation of the pandoc module

64-- | Get the string representation of the pandoc module

52pandocModuleScript :: Maybe FilePath -> IO String

65pandocModuleScript :: Maybe FilePath -> IO String

@@ -56,14 +69,98 @@ pandocModuleScript datadir = unpack <$>

56readDoc :: String -> String -> Lua NumResults

69readDoc :: String -> String -> Lua NumResults

57readDoc formatSpec content = do

70readDoc formatSpec content = do

58 case getReader formatSpec of

71 case getReader formatSpec of

59− Left s -> push s -- Unknown reader

72+ Left s -> Lua.push s -- Unknown reader

60 Right (reader, es) ->

73 Right (reader, es) ->

61 case reader of

74 case reader of

62 TextReader r -> do

75 TextReader r -> do

63 res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content)

76 res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content)

64 case res of

77 case res of

65− Left s -> push $ show s -- error while reading

78+ Left s -> Lua.push $ show s -- error while reading

66− Right pd -> push pd -- success, push Pandoc

79+ Right pd -> Lua.push pd -- success, push Pandoc

67− _ -> push "Only string formats are supported at the moment."

80+ _ -> Lua.push "Only string formats are supported at the moment."

81+ return 1

82+

83+--

84+-- MediaBag submodule

85+--

86+pushMediaBagModule :: IORef MB.MediaBag -> Lua ()

87+pushMediaBagModule mediaBagRef = do

88+ Lua.newtable

89+ addFunction "insert" (insertMediaFn mediaBagRef)

90+ addFunction "lookup" (lookupMediaFn mediaBagRef)

91+ addFunction "list" (mediaDirectoryFn mediaBagRef)

92+ addFunction "fetch" (insertResource mediaBagRef)

93+ return ()

94+ where

95+ addFunction name fn = do

96+ Lua.push name

97+ Lua.pushHaskellFunction fn

98+ Lua.rawset (-3)

99+

100+insertMediaFn :: IORef MB.MediaBag

101+ -> FilePath

102+ -> OrNil MimeType

103+ -> BL.ByteString

104+ -> Lua NumResults

105+insertMediaFn mbRef fp nilOrMime contents = do

106+ liftIO . modifyIORef' mbRef $ MB.insertMedia fp (toMaybe nilOrMime) contents

107+ return 0

108+

109+lookupMediaFn :: IORef MB.MediaBag

110+ -> FilePath

111+ -> Lua NumResults

112+lookupMediaFn mbRef fp = do

113+ res <- MB.lookupMedia fp <$> liftIO (readIORef mbRef)

114+ case res of

115+ Nothing -> Lua.pushnil *> return 1

116+ Just (mimeType, contents) -> do

117+ Lua.push mimeType

118+ Lua.push contents

119+ return 2

120+

121+mediaDirectoryFn :: IORef MB.MediaBag

122+ -> Lua NumResults

123+mediaDirectoryFn mbRef = do

124+ dirContents <- MB.mediaDirectory <$> liftIO (readIORef mbRef)

125+ Lua.newtable

126+ zipWithM_ addEntry [1..] dirContents

68 return 1

127 return 1

128+ where

129+ addEntry :: Int -> (FilePath, MimeType, Int) -> Lua ()

130+ addEntry idx (fp, mimeType, contentLength) = do

131+ Lua.newtable

132+ Lua.push "path" *> Lua.push fp *> Lua.rawset (-3)

133+ Lua.push "type" *> Lua.push mimeType *> Lua.rawset (-3)

134+ Lua.push "length" *> Lua.push contentLength *> Lua.rawset (-3)

135+ Lua.rawseti (-2) idx

136+

137+insertResource :: IORef MB.MediaBag

138+ -> String

139+ -> OrNil String

140+ -> Lua NumResults

141+insertResource mbRef src sourceUrlOrNil = do

142+ (fp, mimeType, bs) <- liftIO . runIOorExplode $

143+ fetchMediaResource (toMaybe sourceUrlOrNil) src

144+ liftIO $ print (fp, mimeType)

145+ insertMediaFn mbRef fp (OrNil mimeType) bs

146+

147+--

148+-- Helper types and orphan instances

149+--

150+

151+newtype OrNil a = OrNil { toMaybe :: Maybe a }

152+

153+instance FromLuaStack a => FromLuaStack (OrNil a) where

154+ peek idx = do

155+ noValue <- Lua.isnil idx

156+ if noValue

157+ then return (OrNil Nothing)

158+ else OrNil . Just <$> Lua.peek idx

159+

160+#if !MIN_VERSION_hslua(0,9,0)

161+instance ToLuaStack BL.ByteString where

162+ push = Lua.push . BL.toStrict

163

164+instance FromLuaStack BL.ByteString where

165+ peek = fmap BL.fromStrict . Lua.peek

166+#endif

test/Tests/Lua.hs+7−3

@@ -7,10 +7,11 @@ import Test.Tasty (TestTree, localOption)

7import Test.Tasty.HUnit (Assertion, assertEqual, testCase)

8import Test.Tasty.QuickCheck (ioProperty, testProperty, QuickCheckTests(..))

9import Text.Pandoc.Arbitrary ()

10−import Text.Pandoc.Definition (Block, Inline, Meta, Pandoc)

11import Text.Pandoc.Builder ( (<>), bulletList, doc, doubleQuoted, emph

10import Text.Pandoc.Builder ( (<>), bulletList, doc, doubleQuoted, emph

12 , linebreak, rawBlock, singleQuoted, para, plain

11 , linebreak, rawBlock, singleQuoted, para, plain

13 , space, str, strong)

12 , space, str, strong)

13+import Text.Pandoc.Class (runIOorExplode)

14+import Text.Pandoc.Definition (Block, Inline, Meta, Pandoc)

14import Text.Pandoc.Lua

15import Text.Pandoc.Lua

16import Foreign.Lua

17import Foreign.Lua

@@ -80,8 +81,11 @@ tests = map (localOption (QuickCheckTests 20))

81assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion

82assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion

82assertFilterConversion msg filterPath docIn docExpected = do

83assertFilterConversion msg filterPath docIn docExpected = do

84+ docEither <- runIOorExplode $

83− docRes <- runLuaFilter (Just "../data") ("lua" </> filterPath) [] docIn

85+ runLuaFilter (Just "../data") ("lua" </> filterPath) [] docIn

86+ case docEither of

87+ Left _ -> fail "lua filter failed"

84− assertEqual msg docExpected docRes

88+ Right docRes -> assertEqual msg docExpected docRes

86roundtripEqual :: (Eq a, FromLuaStack a, ToLuaStack a) => a -> IO Bool

90roundtripEqual :: (Eq a, FromLuaStack a, ToLuaStack a) => a -> IO Bool

87roundtripEqual x = (x ==) <$> roundtripped

91roundtripEqual x = (x ==) <$> roundtripped