mirror of
https://github.com/sdiehl/write-you-a-haskell.git
synced 2024-08-16 15:11:06 +03:00
65 lines
2.0 KiB
Haskell
65 lines
2.0 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
import Text.Read
|
|
import Control.Monad.State
|
|
import Control.Monad
|
|
import Text.Pandoc
|
|
import Data.Monoid
|
|
import Control.Applicative
|
|
|
|
import Text.Pandoc.JSON
|
|
import Text.Pandoc.Walk
|
|
|
|
slice :: Int -> Int -> [a] -> [a]
|
|
slice from to xs = take (to - from + 1) (drop from xs)
|
|
|
|
doSlice :: Block -> IO Block
|
|
doSlice cb@(CodeBlock (id, classes, namevals) contents) = do
|
|
res <- return $ do
|
|
upper <- readMaybe =<< lookup "upper" namevals
|
|
lower <- readMaybe =<< lookup "lower" namevals
|
|
file <- lookup "slice" namevals
|
|
return (upper, lower, file)
|
|
|
|
case res of
|
|
Nothing -> return cb
|
|
Just (upper, lower, f) -> do
|
|
contents <- readFile f
|
|
let lns = unlines $ slice lower upper (lines contents)
|
|
return (CodeBlock (id, classes, namevals) lns)
|
|
doSlice x = return x
|
|
|
|
doInclude :: Block -> IO Block
|
|
doInclude cb@(CodeBlock (id, classes, namevals) contents) =
|
|
case lookup "include" namevals of
|
|
Just f -> return . (CodeBlock (id, classes, namevals)) =<< readFile f
|
|
Nothing -> return cb
|
|
doInclude x = return x
|
|
|
|
doHtml :: Block -> IO Block
|
|
doHtml cb@(CodeBlock (id, classes, namevals) contents) =
|
|
case lookup "literal" namevals of
|
|
Just f -> return . (RawBlock "html") =<< readFile f
|
|
Nothing -> return cb
|
|
doHtml x = return x
|
|
|
|
injectLatexMacros :: Maybe Format -> Pandoc -> IO Pandoc
|
|
injectLatexMacros (Just fmt) p = do
|
|
macros <- readFile "latex_macros"
|
|
let block =
|
|
case fmt of
|
|
Format "html" ->
|
|
Div ("",[],[("style","display:none")]) . (:[])
|
|
. Para . (:[]) . Math DisplayMath $ macros
|
|
Format "latex" -> RawBlock "latex" macros
|
|
Format "epub" -> RawBlock "latex" macros
|
|
return (Pandoc nullMeta [block] <> p)
|
|
injectLatexMacros _ _ = return mempty
|
|
|
|
main :: IO ()
|
|
main = toJSONFilter
|
|
((\fmt -> injectLatexMacros fmt
|
|
>=> walkM doInclude
|
|
>=> walkM doSlice
|
|
>=> walkM doHtml) :: Maybe Format -> Pandoc -> IO Pandoc)
|