diff --git a/src/Text/Pandoc/JSON.hs b/src/Text/Pandoc/JSON.hs index 8dd105a..8f9c525 100644 --- a/src/Text/Pandoc/JSON.hs +++ b/src/Text/Pandoc/JSON.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-} {- Copyright (c) 2013-2019, John MacFarlane @@ -74,6 +74,7 @@ module Text.Pandoc.JSON ( module Text.Pandoc.Definition where import Text.Pandoc.Definition import Text.Pandoc.Walk +import Control.Monad.IO.Class(MonadIO(liftIO)) import Data.Maybe (listToMaybe) import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T @@ -99,32 +100,33 @@ import System.Environment (getArgs) -- provides the target format as argument when scripts are called using -- the `--filter` option. -class ToJSONFilter a where - toJSONFilter :: a -> IO () +class ToJSONFilter m a where + toJSONFilter :: a -> m () -instance (Walkable a Pandoc) => ToJSONFilter (a -> a) where +instance (Walkable a Pandoc) => ToJSONFilter IO (a -> a) where toJSONFilter f = BL.getContents >>= BL.putStr . encode . (walk f :: Pandoc -> Pandoc) . either error id . eitherDecode' -instance (Walkable a Pandoc) => ToJSONFilter (a -> IO a) where - toJSONFilter f = BL.getContents >>= - (walkM f :: Pandoc -> IO Pandoc) . either error id . eitherDecode' >>= - BL.putStr . encode +instance (Walkable a Pandoc, MonadIO m) => ToJSONFilter m (a -> m a) where + toJSONFilter f = do + c <- liftIO BL.getContents + r <- walkM f (either error id (eitherDecode' c) :: Pandoc) + liftIO (BL.putStr (encode (r :: Pandoc))) -instance (Walkable [a] Pandoc) => ToJSONFilter (a -> [a]) where +instance (Walkable [a] Pandoc) => ToJSONFilter IO (a -> [a]) where toJSONFilter f = BL.getContents >>= BL.putStr . encode . (walk (concatMap f) :: Pandoc -> Pandoc) . either error id . eitherDecode' -instance (Walkable [a] Pandoc) => ToJSONFilter (a -> IO [a]) where - toJSONFilter f = BL.getContents >>= - (walkM (fmap concat . mapM f) :: Pandoc -> IO Pandoc) . - either error id . eitherDecode' >>= - BL.putStr . encode +instance (Walkable [a] Pandoc, MonadIO m) => ToJSONFilter m (a -> m [a]) where + toJSONFilter f = do + c <- liftIO BL.getContents + r <- (walkM (fmap concat . mapM f)) (either error id (eitherDecode' c) :: Pandoc) + liftIO (BL.putStr (encode (r :: Pandoc))) -instance (ToJSONFilter a) => ToJSONFilter ([String] -> a) where - toJSONFilter f = getArgs >>= toJSONFilter . f +instance (ToJSONFilter m a, MonadIO m) => ToJSONFilter m ([String] -> a) where + toJSONFilter f = liftIO getArgs >>= toJSONFilter . f -instance (ToJSONFilter a) => ToJSONFilter (Maybe Format -> a) where - toJSONFilter f = getArgs >>= toJSONFilter . f . fmap (Format . T.pack) . listToMaybe +instance (ToJSONFilter m a, MonadIO m) => ToJSONFilter m (Maybe Format -> a) where + toJSONFilter f = liftIO getArgs >>= toJSONFilter . f . fmap (Format . T.pack) . listToMaybe