module Frame.View.Markdown where import Frame.View import Text.Pandoc hiding (Block (Header), Inline (Code, Strong, Image, Link)) import qualified Text.Pandoc as P (Block (Header), Inline (Code, Strong, Image, Link)) markdownToViewPart :: String -> Data markdownToViewPart m = pandocToViewPart $ readMarkdown defaultParserState $ filter (/='\r') m pandocToViewPart :: Pandoc -> Data pandocToViewPart (Pandoc _ bs) = ViewPart $ toContainers bs toContainers :: [P.Block] -> [Container] toContainers = map blockToContainer blockToContainer :: P.Block -> Container blockToContainer (Plain is) = Paragraph (inlinesToElement is) [] blockToContainer (Para is) = Paragraph (inlinesToElement is) [] blockToContainer (CodeBlock _ s) = Code s blockToContainer (RawHtml s) = Code s blockToContainer (BlockQuote bs) = Quote $ toContainers bs blockToContainer (OrderedList _ bss) = NumList (map toContainers bss) [] blockToContainer (BulletList bss) = List (map toContainers bss) [] blockToContainer (P.Header i is) = Header i $ inlinesToElement is blockToContainer HorizontalRule = Line blockToContainer _ = Empty inlinesToElement :: [P.Inline] -> [Element] inlinesToElement = map inlineToElement inlineToElement :: P.Inline -> Element inlineToElement (P.Link is t) = Link (fst t) $ Text $ concatMap inlineToString is inlineToElement (P.Image a t) = Element $ Image (fst t) $ concatMap inlineToString a inlineToElement (P.Strong is) = Strong (map inlineToElement is) inlineToElement (Emph is) = Emphasis (map inlineToElement is) inlineToElement LineBreak = Break inlineToElement i = Element $ Text $ inlineToString i inlineToString :: P.Inline -> String inlineToString Space = " " inlineToString (P.Code s) = s inlineToString Apostrophe = "'" inlineToString (Str s) = s inlineToString Ellipses = "..." inlineToString _ = ""