panpipe: 6c64985fe84959e2880008f1f54dbd4deba5ebae

     1: {-# LANGUAGE OverloadedStrings #-}
     2: module PanPipe where
     3: 
     4: import Control.Applicative
     5: import Data.List
     6: import Data.Text (pack, Text, unpack)
     7: import System.Exit
     8: import System.IO
     9: import System.IO.Temp (withSystemTempDirectory)
    10: import System.Posix
    11: import System.Process
    12: import Text.Pandoc
    13: import Text.Pandoc.JSON   (toJSONFilter)
    14: import Text.Pandoc.Shared (inDirectory)
    15: import Text.Pandoc.Walk   (walkM)
    16: 
    17: pipeBWith :: (Functor m, Monad m) => (FilePath -> Text -> m Text)
    18:                                   -> Block
    19:                                   -> m Block
    20: pipeBWith f (CodeBlock as s)
    21:           |  Just (as', p) <- partPipes as = CodeBlock as' <$> f (unpack p) s
    22: pipeBWith f x = walkM (pipeIWith f) x
    23: 
    24: pipeB = pipeBWith readShell
    25: 
    26: pipeIWith :: (Functor m, Monad m) => (FilePath -> Text -> m Text)
    27:                                   -> Inline
    28:                                   -> m Inline
    29: pipeIWith f (Code as s)
    30:           |  Just (as', p) <- partPipes as = Code as' <$> f (unpack p) s
    31: pipeIWith f x = return x
    32: 
    33: pipeI = pipeIWith readShell
    34: 
    35: readShell :: FilePath -> Text -> IO Text
    36: readShell path stdin = pack <$> readProcess "sh" ["-c", path] (unpack stdin)
    37: 
    38: partPipes :: Attr -> Maybe (Attr, Text)
    39: partPipes (x, y, zs) = case partition (("pipe" ==) . fst) zs of
    40:                             ((_, p):_, zs') -> Just ((x, y, zs'), p)
    41:                             _               -> Nothing
    42: 
    43: transform :: Pandoc -> IO Pandoc
    44: transform doc = do cwd <-getWorkingDirectory
    45:                    withSystemTempDirectory
    46:                        "panpipe"
    47:                        (\dir -> do createSymbolicLink cwd (dir ++ "/root")
    48:                                    inDirectory dir (transformDoc doc))
    49: 
    50: transformDoc :: Pandoc -> IO Pandoc
    51: transformDoc = walkM pipeB
    52: 
    53: panpipeMain = toJSONFilter transform