@@ -15,6 +15,10 @@ You should have received a copy of the GNU General Public License
1515along with this program; if not, write to the Free Software
1616Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
1717-}
18+{-# LANGUAGE CPP #-}
19+#if !MIN_VERSION_hslua(0,9,0)
20+{-# OPTIONS_GHC -fno-warn-orphans #-}
21+#endif
1822{- |
1923 Module : Text.Pandoc.Lua.PandocModule
2024 Copyright : Copyright © 2017 Albert Krewinkel
@@ -25,28 +29,37 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2529
2630Pandoc module for lua.
2731-}
28−module Text.Pandoc.Lua.PandocModule ( pushPandocModule ) where
32+module Text.Pandoc.Lua.PandocModule
33+ ( pushPandocModule
34+ , pushMediaBagModule
35+ ) where
2936
30−import Control.Monad (unless)
37+import Control.Monad (unless, zipWithM_)
3138import Data.ByteString.Char8 (unpack)
3239import Data.Default (Default (..))
40+import Data.IORef
3341import Data.Text (pack)
34−import Foreign.Lua (Lua, Status (OK), NumResults, call, loadstring, liftIO,
35− push, pushHaskellFunction, rawset)
36−import Text.Pandoc.Class (readDataFile, runIO, runIOorExplode, setUserDataDir)
42+import Foreign.Lua (Lua, FromLuaStack, ToLuaStack, NumResults, liftIO)
43+import Text.Pandoc.Class (fetchMediaResource, readDataFile, runIO,
44+ runIOorExplode, setUserDataDir)
3745import Text.Pandoc.Options (ReaderOptions(readerExtensions))
3846import Text.Pandoc.Lua.StackInstances ()
3947import 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
4053
4154-- | Push the "pandoc" on the lua stack.
4255pushPandocModule :: Maybe FilePath -> Lua ()
4356pushPandocModule datadir = do
4457 script <- liftIO (pandocModuleScript datadir)
45− status <- loadstring script
46− unless (status /= OK) $ call 0 1
47− push "__read"
48− pushHaskellFunction readDoc
49− rawset (-3)
58+ status <- Lua.loadstring script
59+ unless (status /= Lua.OK) $ Lua.call 0 1
60+ Lua.push "__read"
61+ Lua.pushHaskellFunction readDoc
62+ Lua.rawset (-3)
5063
5164-- | Get the string representation of the pandoc module
5265pandocModuleScript :: Maybe FilePath -> IO String
@@ -56,14 +69,98 @@ pandocModuleScript datadir = unpack <$>
5669readDoc :: String -> String -> Lua NumResults
5770readDoc formatSpec content = do
5871 case getReader formatSpec of
59− Left s -> push s -- Unknown reader
72+ Left s -> Lua.push s -- Unknown reader
6073 Right (reader, es) ->
6174 case reader of
6275 TextReader r -> do
6376 res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content)
6477 case res of
65− Left s -> push $ show s -- error while reading
66− Right pd -> push pd -- success, push Pandoc
67− _ -> push "Only string formats are supported at the moment."
78+ Left s -> Lua.push $ show s -- error while reading
79+ Right pd -> Lua.push pd -- success, push Pandoc
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
68127 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
69163
164+instance FromLuaStack BL.ByteString where
165+ peek = fmap BL.fromStrict . Lua.peek
166+#endif