Very rough draft of a Pandoc filter for docs

haddock2latex.hs

#!/usr/bin/env stack
-- stack --resolver lts-13.21 --install-ghc runghc --package pandoc --package pandoc-types

{-# OPTIONS_GHC -Wall #-}

import Text.Pandoc
import Text.Pandoc.JSON
import Data.Foldable
import Debug.Trace

isGoodInline :: Inline -> Bool
isGoodInline (Link (_, ["link"], _) _ _) = False
isGoodInline (Link (_, ["selflink"], _) _ _) = False
isGoodInline _ = True

processInlineSrc :: Inline -> String
processInlineSrc (Str s) = s
processInlineSrc Space = " "
processInlineSrc (Span _ els) = fold . map processInlineSrc $ els
processInlineSrc (Link _ els _) = fold . map processInlineSrc $ els
processInlineSrc a = error . show $ a

processSrc :: Block -> String
processSrc (Para pEls) = fold . map processInlineSrc $ pEls
processSrc (Plain pEls) = fold . map processInlineSrc $ pEls
processSrc (CodeBlock _ code) = code
processSrc a = error . show $ a

processListElement :: [Block] -> Block
processListElement [src, doc] = Div nullAttr [CodeBlock nullAttr (processSrc src), doc]
processListElement [Div _ els] = processListElement els
processListElement [src] = Div nullAttr [CodeBlock nullAttr (processSrc src)]
processListElement c = error . show $ c

bar :: Block -> Block
bar (Div ("package-header", _, _) _) = Null
bar (Div ("module-header", _, _) (_:(Para a):_)) = Header 2 nullAttr a
bar (Div ("synopsis", _, _) _) = Null
bar (Div ("footer", _, _) _) = Null
bar d@(Div (_, ["doc"], _) _) = d
bar (Div (_, ["top"], _) (src@(Para _):rest)) = Div nullAttr [CodeBlock nullAttr (processSrc src), (bar $ Div ("", ["top"], []) rest)]
bar (Div (_, ["top"], _) (docs@(Div (_, ["doc"], _) _):rest)) = Div nullAttr [docs, (bar $ Div ("", ["top"], []) rest)]
-- bar (Div (_, ["top"], _) (docs@(Div (_, ["subs", "constructors"], _) (els)):rest)) = Div nullAttr [BulletList $ map (pure . processListElement) els, (bar $ Div nullAttr rest)]
bar (Div (_, ["subs", "fields"], _) [_, BulletList (els)]) = Div nullAttr [Header 4 nullAttr [Str "Поля"], BulletList $ map (pure . processListElement) els]
bar (Div (_, ["subs", "constructors"], _) [_, BulletList els]) = Div nullAttr [Header 3 nullAttr [Str "Конструкторы"], BulletList $ map (pure . processListElement . traceShowId) els]
bar d@(Div (_, ["subs", "constructors"], _) (_:els)) = Div nullAttr [Header 3 nullAttr [Str "Конструкторы"],BulletList $ [[processListElement els]]]
-- bar d@(Div (_, classes, _) _) =
--     if "subs" `elem` classes
--         then Null
--         else d
-- bar (Div (_, _, _) [_, BulletList _]) = Null
-- bar (Div (_, ["subs", "fields"], _) [_, Table _ _ _ _ els]) = BulletList $ map (pure . processListElement . concat . traceShowId) els
-- bar (Div (_, ["top"], _) (docs@(Div (_, ["subs", "fields"], _) els):rest)) = (head . traceShowId) els -- Div nullAttr [BulletList $ map (pure . processListElement) els, (bar $ Div nullAttr rest)]
-- bar (Div (_, ["top"], _) (el:rest)) = traceShow el $ Div nullAttr [bar $ Div nullAttr rest]
-- bar (Div (_, ["top"], _) (src:doc:_)) = Div nullAttr [CodeBlock nullAttr (processSrc src), doc]
-- bar (Div (_, ["top"], _) [src]) = Div nullAttr [CodeBlock nullAttr (processSrc src), Para [Str "NO DOCS"]]
bar (Header _ _ _) = Null
bar d@(Table _ _ _ _ els) = BulletList $ map (pure . processListElement . concat) els
-- bar (Para [Str "Constructors"]) = Header 3 nullAttr [Str "Конструкторы"]
bar (Para els) = Para . filter isGoodInline $ els
bar a = a

main :: IO ()
main = toJSONFilter bar