pandocTools/convert.hs

   1 -- discardText.hs
   2 import Text.Pandoc
   3 import Text.HTML.TagSoup
   4 import System.IO
   5 import System.Environment (getArgs)
   6 import Data.List.Utils
   7
   8 readDoc :: String -> Pandoc
   9 readDoc = readHtml defaultParserState{
  10                         stateParseRaw=True
  11                    }
  12
  13 writeDoc :: Pandoc -> String
  14 writeDoc = writeLaTeX defaultWriterOptions
  15
  16
  17 convertAll :: Pandoc -> Pandoc
  18 convertAll = processWith convertInline
  19
  20 --convertInline :: [Inline] -> [Inline]
  21 --convertInline (HtmlInline s : xs) = tag2latex $ parseTags s : convertInline xs
  22 --convertInline (x : xs)     = x : convertInline xs
  23 --convertInline []           = []
  24
  25 convertInline :: Inline -> Inline
  26 convertInline (HtmlInline s) = tag2latex $ parseTags s
  27 convertInline x = x
  28
  29 tag2latex :: [Tag String] -> Inline
  30 tag2latex [TagOpen str attr]
  31         | str == "latex" = TeX (attr2latex attr)
  32         | startswith "env" str = TeX
  33                 ("\\begin{" ++ (drop 3 str) ++ "}" ++ (attr2latex attr))
  34         | otherwise = TeX ""
  35 tag2latex [TagClose str]
  36         | str == "latex" = TeX "}"
  37         | startswith "env" str = TeX ("\\end{" ++ (drop 3 str) ++ "}")
  38         | otherwise = TeX ""
  39 tag2latex (t:ts) = TeX (strTex (tag2latex [t]) ++ strTex (tag2latex ts))
  40         where strTex (TeX s) = s
  41 tag2latex _ = TeX ""
  42
  43 attr2latex :: [(String, String)] -> String
  44 attr2latex (("command", c) : as) = '\\' : (c ++ (attr2latex as) ++ "{")
  45 attr2latex (("optarg", a) : as) = '[' : (a ++ "]")
  46 attr2latex ((_, a) : as) = '{' : (a ++ "}")
  47 attr2latex []   = []
  48
  49 convert :: String -> String
  50 convert = writeDoc . convertAll . readDoc
  51
  52 processFile :: String -> IO ()
  53 processFile fn = catch (readFile fn >>= ((writeFile $ newName fn) . convert))
  54                         (\_ -> hPutStr stderr ("Error processing: " ++ fn))
  55         where newName n = (fst . break (== '.')) n ++ ".tex"
  56
  57 run :: [String] -> IO ()
  58 run (x:xs) = do
  59         processFile x
  60         run xs
  61 run []  = return ()
  62
  63 main :: IO ()
  64 main = do
  65         args <- getArgs
  66         if null args
  67                 then interact convert
  68                 else run args