diff options
Diffstat (limited to 'Text')
| -rw-r--r-- | Text/Pandoc/Definition.hs | 25 | ||||
| -rw-r--r-- | Text/Pandoc/Plugins.hs | 69 |
2 files changed, 88 insertions, 6 deletions
diff --git a/Text/Pandoc/Definition.hs b/Text/Pandoc/Definition.hs index 3c783b1b9..ed58f6b75 100644 --- a/Text/Pandoc/Definition.hs +++ b/Text/Pandoc/Definition.hs @@ -128,10 +128,23 @@ data Inline | Note [Block] -- ^ Footnote or endnote deriving (Show, Eq, Read, Typeable, Data) --- | Applies a transformation to matching elements in a Pandoc document. -processPandoc :: Typeable a => (a -> a) -> Pandoc -> Pandoc -processPandoc f = everywhere (mkT f) +-- | Applies a transformation on @a@s to matching elements in a @b@. +processIn :: (Data a, Data b) => (a -> a) -> b -> b +processIn f = everywhere (mkT f) + +-- | Like 'processIn', but with monadic transformations. +processInM :: (Monad m, Data a, Data b) => (a -> m a) -> b -> m b +processInM f = everywhereM (mkM f) + +-- | Runs a query on matching @a@ elements in a @c@. +queryIn :: (Data a, Data c) => (a -> [b]) -> c -> [b] +queryIn f = everything (++) ([] `mkQ` f) + +{-# DEPRECATED processPandoc "Use processIn instead" #-} +processPandoc :: Data a => (a -> a) -> Pandoc -> Pandoc +processPandoc = processIn + +{-# DEPRECATED queryPandoc "Use queryIn instead" #-} +queryPandoc :: Data a => (a -> [b]) -> Pandoc -> [b] +queryPandoc = queryIn --- | Runs a query on matching elements in a Pandoc document. -queryPandoc :: Typeable a => (a -> [b]) -> Pandoc -> [b] -queryPandoc f = everything (++) ([] `mkQ` f) diff --git a/Text/Pandoc/Plugins.hs b/Text/Pandoc/Plugins.hs new file mode 100644 index 000000000..5ba333faa --- /dev/null +++ b/Text/Pandoc/Plugins.hs @@ -0,0 +1,69 @@ +{- +Copyright (C) 2008 John MacFarlane <jgm@berkeley.edu> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Pluigns + Copyright : Copyright (C) 2008 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley.edu> + Stability : alpha + Portability : portable + +Support for plugins. +-} + +module Text.Pandoc.Plugins (getPlugin) +where + +import Language.Haskell.Interpreter +import Text.Pandoc +import Control.Monad (unless, liftM) +import Control.Monad.Error (throwError) +import Data.List (isInfixOf) + +-- | Returns the function named @transform@ in the specified +-- module. The module may be identified either by module name +-- or by path name. The @transform@ function should have type +-- @a -> a@ or @a -> IO a@, where @a@ is an instance of 'Data': +-- for example, @Pandoc -> Pandoc@, @Inline -> IO Inline@, +-- @Block -> Block@, or @[Inline] -> IO [Inline]@. +getPlugin :: String -> IO (Pandoc -> IO Pandoc) +getPlugin modsrc = do + res <- runInterpreter (evaluatePlugin modsrc) + case res of + Right func -> return func + Left (WontCompile xs) -> error $ "WontCompile error for plugin '" ++ modsrc ++ "'\n" ++ unlines (map errMsg xs) + Left (NotAllowed x) -> error $ "NotAllowed error for plugin '" ++ modsrc ++ "'\n" ++ x + Left (UnknownError x) -> error $ "UnknownError for plugin '" ++ modsrc ++ "'\n" ++ x + Left (GhcException x) -> error $ "GhcException for plugin '" ++ modsrc ++ "'\n" ++ x + +evaluatePlugin :: String -> Interpreter (Pandoc -> IO Pandoc) +evaluatePlugin modsrc = do + set [installedModulesInScope := False] + loadModules [modsrc] + modnames <- getLoadedModules + setTopLevelModules modnames + setImports ["Prelude", "Text.Pandoc", "Text.Pandoc.Definition"] + exports <- liftM concat $ mapM getModuleExports modnames + unless ((Fun "transform") `elem` exports) $ + throwError $ UnknownError $ "The plugin module must define a function 'transform'." + transformType <- typeOf "transform" + if "-> IO" `isInfixOf` transformType + then interpret "processInM transform" (as :: Pandoc -> IO Pandoc) + else interpret "return . (processIn transform)" (as :: Pandoc -> IO Pandoc) |