diff options
Diffstat (limited to 'Pancake')
| -rw-r--r-- | Pancake/Printing.hs | 35 | ||||
| -rw-r--r-- | Pancake/Rendering.hs | 16 |
2 files changed, 43 insertions, 8 deletions
diff --git a/Pancake/Printing.hs b/Pancake/Printing.hs index a385751..2e0aee5 100644 --- a/Pancake/Printing.hs +++ b/Pancake/Printing.hs @@ -25,12 +25,13 @@ propertize :: Terminal -> Styled -> TermOutput propertize _ (Plain s) = termText s propertize t (Fg clr s) = maybe id (\f -> f clr) (getCapability t withForegroundColor) $ propertize t s -propertize t (Pancake.Rendering.Bold s) = +propertize t (Bold s) = maybe id id (getCapability t withBold) $ propertize t s -propertize t (Pancake.Rendering.Emph s) = +propertize t (Emph s) = maybe id id (getCapability t withStandout) $ propertize t s -propertize t (Pancake.Rendering.Underline s) = +propertize t (Underline s) = maybe id id (getCapability t withUnderline) $ propertize t s +propertize t (Denote _ s) = propertize t s -- | Prints rendered lines. showLines :: MonadIO m => [StyledLine] -> m () @@ -57,7 +58,7 @@ showSexps uri ro = -- abandoned, and the task is simple enough to do it here putSexpLn [ "render" , list $ "lines" : - map (list . pure . concat . intersperse " " . map showSexp) + map (list . pure . concat . intersperse " " . map showSexp . mergeStyled) (rLines ro) , list $ "identifiers" : map (\(i, l) -> list [encodeStr i, show l]) (rIdentifiers ro) @@ -76,3 +77,29 @@ showSexps uri ro = showSexp (Bold s) = list ["style", "bold", showSexp s] showSexp (Underline s) = list ["style", "underline", showSexp s] showSexp (Emph s) = list ["style", "italic", showSexp s] + showSexp (Denote d s) = list [ "denotation" + , showDenotation d + , showSexp s] + showDenotation :: Denotation -> String + showDenotation (Link u) = list ["link", ".", encodeStr $ show u] + showDenotation (Math m) = list ["math", ".", encodeStr m] + +mergeStyled :: [Styled] -> [Styled] +mergeStyled = foldr mergeStyled' [] + where + mergeStyled' :: Styled -> [Styled] -> [Styled] + mergeStyled' s [] = [s] + mergeStyled' s (s':rest) = maybe (s:s':rest) (: rest) (tryMerge s s') + +tryMerge :: Styled -> Styled -> Maybe Styled +tryMerge (Plain s) (Plain s') = pure $ Plain $ s ++ s' +tryMerge (Fg clr s) (Fg clr' s') + | clr == clr' = Fg clr <$> tryMerge s s' + | otherwise = mzero +tryMerge (Bold s) (Bold s') = Bold <$> tryMerge s s' +tryMerge (Underline s) (Underline s') = Underline <$> tryMerge s s' +tryMerge (Emph s) (Emph s') = Emph <$> tryMerge s s' +tryMerge (Denote d s) (Denote d' s') + | d == d' = Denote d <$> tryMerge s s' + | otherwise = mzero +tryMerge _ _ = mzero diff --git a/Pancake/Rendering.hs b/Pancake/Rendering.hs index 76a9769..2af0ec4 100644 --- a/Pancake/Rendering.hs +++ b/Pancake/Rendering.hs @@ -9,7 +9,8 @@ Document rendering: conversion from 'Pandoc' to 'RendererOutput'. {-# LANGUAGE OverloadedStrings #-} -module Pancake.Rendering ( Styled(..) +module Pancake.Rendering ( Denotation(..) + , Styled(..) , StyledLine , RendererOutput(..) , rLinks @@ -34,12 +35,17 @@ data Listing = Bulleted | Ordered Int deriving (Show, Eq) +data Denotation = Link URI + | Math String + deriving (Show, Eq) + -- | A styled string. data Styled = Plain String | Underline Styled | Bold Styled | Emph Styled | Fg Color Styled + | Denote Denotation Styled deriving (Show, Eq) -- | Just for convenience. @@ -173,6 +179,7 @@ unstyled = concatMap unstyled' unstyled' (Bold s) = unstyled' s unstyled' (Emph s) = unstyled' s unstyled' (Fg _ s) = unstyled' s + unstyled' (Denote _ s) = unstyled' s -- | Fits words into terminal lines of a given width. fitLines :: Int @@ -193,6 +200,7 @@ fitLines maxLen inlineBits = concatMap (map reverse . fitWords [] 0) inlineBits splitStyled (Bold s) = map Bold $ splitStyled s splitStyled (Emph s) = map Emph $ splitStyled s splitStyled (Fg c s) = map (Fg c) $ splitStyled s + splitStyled (Denote d s) = map (Denote d) $ splitStyled s fitWords :: [Styled] -> Int -> [Styled] -> [StyledLine] fitWords curLine curLen (w:ws) -- handle newline characters @@ -253,7 +261,7 @@ readInline (P.Code attr s) = do readInline P.Space = pure [" "] readInline P.SoftBreak = pure [" "] readInline P.LineBreak = pure ["\n"] -readInline (P.Math _ s) = pure [fromString s] +readInline (P.Math _ s) = pure [Denote (Math s) $ fromString s] readInline (P.RawInline _ s) = pure [fromString s] readInline (P.Link attr alt (url, title)) = do storeAttr attr @@ -269,7 +277,7 @@ readInline (P.Link attr alt (url, title)) = do let color = case uri of (URI "" Nothing "" "" ('#':_)) -> Magenta _ -> Cyan - pure $ (map $ Fg color) t ++ + pure $ (map $ Denote (Link uri) . Fg color) t ++ [Fg Blue $ fromString (concat ["[", show cnt, "]"])] Nothing -> pure [fromString title] readInline (P.Image attr alt (url, title)) = do @@ -284,7 +292,7 @@ readInline (P.Image attr alt (url, title)) = do (title', []) -> [fromString title'] (_, alt') -> alt' cnt <- storeLink uri - pure $ (map $ Fg Cyan) t ++ + pure $ (map $ Denote (Link uri) . Fg Cyan) t ++ [Fg Blue $ fromString (concat ["[", show cnt, "]"])] readInline (P.Note _) = pure . pure $ "(note: todo)" readInline (P.Span attr i) = do |