{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.Haddock
   Copyright   : Copyright (C) 2013 David Lazar
   License     : GNU GPL, version 2 or above

   Maintainer  : David Lazar <lazar6@illinois.edu>,
                 John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha

Conversion of Haddock markup to 'Pandoc' document.
-}
module Text.Pandoc.Readers.Haddock
    ( readHaddock
    ) where

import Control.Monad.Except (throwError)
import Data.List (intersperse)
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (fromMaybe)
import Data.Text (Text, unpack)
import qualified Data.Text as T
import Documentation.Haddock.Parser
import Documentation.Haddock.Types as H
import Text.Pandoc.Builder (Blocks, Inlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Options
import Text.Pandoc.Shared (crFilter, splitTextBy, trim)


-- | Parse Haddock markup and return a 'Pandoc' document.
readHaddock :: PandocMonad m
            => ReaderOptions
            -> Text
            -> m Pandoc
readHaddock :: ReaderOptions -> Text -> m Pandoc
readHaddock ReaderOptions
opts Text
s = case ReaderOptions -> String -> Either PandocError Pandoc
readHaddockEither ReaderOptions
opts (Text -> String
unpack (Text -> Text
crFilter Text
s)) of
  Right Pandoc
result -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
result
  Left PandocError
e       -> PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e

readHaddockEither :: ReaderOptions -- ^ Reader options
                  -> String        -- ^ String to parse
                  -> Either PandocError Pandoc
readHaddockEither :: ReaderOptions -> String -> Either PandocError Pandoc
readHaddockEither ReaderOptions
_opts =
  Pandoc -> Either PandocError Pandoc
forall a b. b -> Either a b
Right (Pandoc -> Either PandocError Pandoc)
-> (String -> Pandoc) -> String -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Pandoc
B.doc (Blocks -> Pandoc) -> (String -> Blocks) -> String -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocH String Identifier -> Blocks
docHToBlocks (DocH String Identifier -> Blocks)
-> (String -> DocH String Identifier) -> String -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaDoc String Identifier -> DocH String Identifier
forall mod id. MetaDoc mod id -> DocH mod id
_doc (MetaDoc String Identifier -> DocH String Identifier)
-> (String -> MetaDoc String Identifier)
-> String
-> DocH String Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String -> MetaDoc String Identifier
forall mod. Maybe String -> String -> MetaDoc mod Identifier
parseParas Maybe String
forall a. Maybe a
Nothing

docHToBlocks :: DocH String Identifier -> Blocks
docHToBlocks :: DocH String Identifier -> Blocks
docHToBlocks DocH String Identifier
d' =
  case DocH String Identifier
d' of
    DocH String Identifier
DocEmpty -> Blocks
forall a. Monoid a => a
mempty
    DocAppend (DocParagraph (DocHeader Header (DocH String Identifier)
h)) (DocParagraph (DocAName String
ident)) ->
         Attr -> Int -> Inlines -> Blocks
B.headerWith (String -> Text
T.pack String
ident,[],[]) (Header (DocH String Identifier) -> Int
forall id. Header id -> Int
headerLevel Header (DocH String Identifier)
h)
            (Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
False (DocH String Identifier -> Inlines)
-> DocH String Identifier -> Inlines
forall a b. (a -> b) -> a -> b
$ Header (DocH String Identifier) -> DocH String Identifier
forall id. Header id -> id
headerTitle Header (DocH String Identifier)
h)
    DocAppend DocH String Identifier
d1 DocH String Identifier
d2 -> Blocks -> Blocks -> Blocks
forall a. Monoid a => a -> a -> a
mappend (DocH String Identifier -> Blocks
docHToBlocks DocH String Identifier
d1) (DocH String Identifier -> Blocks
docHToBlocks DocH String Identifier
d2)
    DocString String
_ -> Blocks
inlineFallback
    DocParagraph (DocAName String
h) -> Inlines -> Blocks
B.plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
False (DocH String Identifier -> Inlines)
-> DocH String Identifier -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> DocH String Identifier
forall mod id. String -> DocH mod id
DocAName String
h
    DocParagraph DocH String Identifier
x -> Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
False DocH String Identifier
x
    DocIdentifier Identifier
_ -> Blocks
inlineFallback
    DocIdentifierUnchecked String
_ -> Blocks
inlineFallback
    DocModule String
s -> Inlines -> Blocks
B.plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
False (DocH String Identifier -> Inlines)
-> DocH String Identifier -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> DocH String Identifier
forall mod id. String -> DocH mod id
DocModule String
s
    DocWarning DocH String Identifier
_ -> Blocks
forall a. Monoid a => a
mempty -- TODO
    DocEmphasis DocH String Identifier
_ -> Blocks
inlineFallback
    DocMonospaced DocH String Identifier
_ -> Blocks
inlineFallback
    DocBold DocH String Identifier
_ -> Blocks
inlineFallback
    DocMathInline String
_ -> Blocks
inlineFallback
    DocMathDisplay String
_ -> Blocks
inlineFallback
    DocHeader Header (DocH String Identifier)
h -> Int -> Inlines -> Blocks
B.header (Header (DocH String Identifier) -> Int
forall id. Header id -> Int
headerLevel Header (DocH String Identifier)
h)
                           (Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
False (DocH String Identifier -> Inlines)
-> DocH String Identifier -> Inlines
forall a b. (a -> b) -> a -> b
$ Header (DocH String Identifier) -> DocH String Identifier
forall id. Header id -> id
headerTitle Header (DocH String Identifier)
h)
    DocUnorderedList [DocH String Identifier]
items -> [Blocks] -> Blocks
B.bulletList ((DocH String Identifier -> Blocks)
-> [DocH String Identifier] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map DocH String Identifier -> Blocks
docHToBlocks [DocH String Identifier]
items)
    DocOrderedList [DocH String Identifier]
items -> [Blocks] -> Blocks
B.orderedList ((DocH String Identifier -> Blocks)
-> [DocH String Identifier] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map DocH String Identifier -> Blocks
docHToBlocks [DocH String Identifier]
items)
    DocDefList [(DocH String Identifier, DocH String Identifier)]
items -> [(Inlines, [Blocks])] -> Blocks
B.definitionList (((DocH String Identifier, DocH String Identifier)
 -> (Inlines, [Blocks]))
-> [(DocH String Identifier, DocH String Identifier)]
-> [(Inlines, [Blocks])]
forall a b. (a -> b) -> [a] -> [b]
map (\(DocH String Identifier
d,DocH String Identifier
t) ->
                               (Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
False DocH String Identifier
d,
                                [Blocks -> Blocks
consolidatePlains (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ DocH String Identifier -> Blocks
docHToBlocks DocH String Identifier
t])) [(DocH String Identifier, DocH String Identifier)]
items)
    DocCodeBlock (DocString String
s) -> Attr -> Text -> Blocks
B.codeBlockWith (Text
"",[],[]) (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocCodeBlock DocH String Identifier
d -> Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
True DocH String Identifier
d
    DocHyperlink Hyperlink (DocH String Identifier)
_ -> Blocks
inlineFallback
    DocPic Picture
_ -> Blocks
inlineFallback
    DocAName String
_ -> Blocks
inlineFallback
    DocProperty String
s -> Attr -> Text -> Blocks
B.codeBlockWith (Text
"",[Text
"property",Text
"haskell"],[]) (Text -> Text
trim (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s)
    DocExamples [Example]
es -> [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ (Example -> Blocks) -> [Example] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (\Example
e ->
       Text -> String -> [String] -> Blocks
makeExample Text
">>>" (Example -> String
exampleExpression Example
e) (Example -> [String]
exampleResult Example
e)) [Example]
es
    DocTable H.Table{ tableHeaderRows :: forall id. Table id -> [TableRow id]
tableHeaderRows = [TableRow (DocH String Identifier)]
headerRows
                    , tableBodyRows :: forall id. Table id -> [TableRow id]
tableBodyRows = [TableRow (DocH String Identifier)]
bodyRows
                    }
      -> let toCells :: TableRow (DocH String Identifier) -> [Blocks]
toCells = (TableCell (DocH String Identifier) -> Blocks)
-> [TableCell (DocH String Identifier)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (DocH String Identifier -> Blocks
docHToBlocks (DocH String Identifier -> Blocks)
-> (TableCell (DocH String Identifier) -> DocH String Identifier)
-> TableCell (DocH String Identifier)
-> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCell (DocH String Identifier) -> DocH String Identifier
forall id. TableCell id -> id
tableCellContents) ([TableCell (DocH String Identifier)] -> [Blocks])
-> (TableRow (DocH String Identifier)
    -> [TableCell (DocH String Identifier)])
-> TableRow (DocH String Identifier)
-> [Blocks]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableRow (DocH String Identifier)
-> [TableCell (DocH String Identifier)]
forall id. TableRow id -> [TableCell id]
tableRowCells
             toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Blocks] -> [Cell]) -> [Blocks] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
B.simpleCell
             toHeaderRow :: [Blocks] -> [Row]
toHeaderRow [Blocks]
l = [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
             ([Blocks]
header, [[Blocks]]
body) =
               if [TableRow (DocH String Identifier)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TableRow (DocH String Identifier)]
headerRows
                  then ([], (TableRow (DocH String Identifier) -> [Blocks])
-> [TableRow (DocH String Identifier)] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map TableRow (DocH String Identifier) -> [Blocks]
toCells [TableRow (DocH String Identifier)]
bodyRows)
                  else (TableRow (DocH String Identifier) -> [Blocks]
toCells ([TableRow (DocH String Identifier)]
-> TableRow (DocH String Identifier)
forall a. [a] -> a
head [TableRow (DocH String Identifier)]
headerRows),
                        (TableRow (DocH String Identifier) -> [Blocks])
-> [TableRow (DocH String Identifier)] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map TableRow (DocH String Identifier) -> [Blocks]
toCells ([TableRow (DocH String Identifier)]
-> [TableRow (DocH String Identifier)]
forall a. [a] -> [a]
tail [TableRow (DocH String Identifier)]
headerRows [TableRow (DocH String Identifier)]
-> [TableRow (DocH String Identifier)]
-> [TableRow (DocH String Identifier)]
forall a. [a] -> [a] -> [a]
++ [TableRow (DocH String Identifier)]
bodyRows))
             colspecs :: [(Alignment, ColWidth)]
colspecs = Int -> (Alignment, ColWidth) -> [(Alignment, ColWidth)]
forall a. Int -> a -> [a]
replicate (Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (([Blocks] -> Int) -> [[Blocks]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Blocks]]
body)))
                             (Alignment
AlignDefault, ColWidth
ColWidthDefault)
         in  Caption
-> [(Alignment, ColWidth)]
-> TableHead
-> [TableBody]
-> TableFoot
-> Blocks
B.table Caption
B.emptyCaption
                     [(Alignment, ColWidth)]
colspecs
                     (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr ([Row] -> TableHead) -> [Row] -> TableHead
forall a b. (a -> b) -> a -> b
$ [Blocks] -> [Row]
toHeaderRow [Blocks]
header)
                     [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> Row) -> [[Blocks]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Row
toRow [[Blocks]]
body]
                     (Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])

  where inlineFallback :: Blocks
inlineFallback = Inlines -> Blocks
B.plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
False DocH String Identifier
d'
        consolidatePlains :: Blocks -> Blocks
consolidatePlains = [Block] -> Blocks
forall a. [a] -> Many a
B.fromList ([Block] -> Blocks) -> (Blocks -> [Block]) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Block]
consolidatePlains' ([Block] -> [Block]) -> (Blocks -> [Block]) -> Blocks -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> [Block]
forall a. Many a -> [a]
B.toList
        consolidatePlains' :: [Block] -> [Block]
consolidatePlains' zs :: [Block]
zs@(Plain [Inline]
_ : [Block]
_) =
          let ([Block]
xs, [Block]
ys) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Block -> Bool
isPlain [Block]
zs in
          [Inline] -> Block
Para ((Block -> [Inline]) -> [Block] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Inline]
extractContents [Block]
xs) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
consolidatePlains' [Block]
ys
        consolidatePlains' (Block
x : [Block]
xs) = Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
consolidatePlains' [Block]
xs
        consolidatePlains' [] = []
        isPlain :: Block -> Bool
isPlain (Plain [Inline]
_) = Bool
True
        isPlain Block
_         = Bool
False
        extractContents :: Block -> [Inline]
extractContents (Plain [Inline]
xs) = [Inline]
xs
        extractContents Block
_          = []

docHToInlines :: Bool -> DocH String Identifier -> Inlines
docHToInlines :: Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
isCode DocH String Identifier
d' =
  case DocH String Identifier
d' of
    DocH String Identifier
DocEmpty -> Inlines
forall a. Monoid a => a
mempty
    DocAppend DocH String Identifier
d1 DocH String Identifier
d2 -> Inlines -> Inlines -> Inlines
forall a. Monoid a => a -> a -> a
mappend (Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
isCode DocH String Identifier
d1)
                               (Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
isCode DocH String Identifier
d2)
    DocString String
s
      | Bool
isCode -> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.linebreak
                              ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
B.code ([Text] -> [Inlines]) -> [Text] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
splitTextBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
      | Bool
otherwise  -> Text -> Inlines
B.text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocParagraph DocH String Identifier
_ -> Inlines
forall a. Monoid a => a
mempty
    DocIdentifier Identifier
ident ->
        case DocH Any Identifier -> DocH Any String
forall mod. DocH mod Identifier -> DocH mod String
toRegular (Identifier -> DocH Any Identifier
forall mod id. id -> DocH mod id
DocIdentifier Identifier
ident) of
          DocIdentifier String
s -> Attr -> Text -> Inlines
B.codeWith (Text
"",[Text
"haskell",Text
"identifier"],[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
          DocH Any String
_               -> Inlines
forall a. Monoid a => a
mempty
    DocIdentifierUnchecked String
s -> Attr -> Text -> Inlines
B.codeWith (Text
"",[Text
"haskell",Text
"identifier"],[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocModule String
s -> Attr -> Text -> Inlines
B.codeWith (Text
"",[Text
"haskell",Text
"module"],[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocWarning DocH String Identifier
_ -> Inlines
forall a. Monoid a => a
mempty -- TODO
    DocEmphasis DocH String Identifier
d -> Inlines -> Inlines
B.emph (Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
isCode DocH String Identifier
d)
    DocMonospaced (DocString String
s) -> Text -> Inlines
B.code (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocMonospaced DocH String Identifier
d -> Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
True DocH String Identifier
d
    DocBold DocH String Identifier
d -> Inlines -> Inlines
B.strong (Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
isCode DocH String Identifier
d)
    DocMathInline String
s -> Text -> Inlines
B.math (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocMathDisplay String
s -> Text -> Inlines
B.displayMath (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocHeader Header (DocH String Identifier)
_ -> Inlines
forall a. Monoid a => a
mempty
    DocUnorderedList [DocH String Identifier]
_ -> Inlines
forall a. Monoid a => a
mempty
    DocOrderedList [DocH String Identifier]
_ -> Inlines
forall a. Monoid a => a
mempty
    DocDefList [(DocH String Identifier, DocH String Identifier)]
_ -> Inlines
forall a. Monoid a => a
mempty
    DocCodeBlock DocH String Identifier
_ -> Inlines
forall a. Monoid a => a
mempty
    DocHyperlink Hyperlink (DocH String Identifier)
h -> Text -> Text -> Inlines -> Inlines
B.link (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Hyperlink (DocH String Identifier) -> String
forall id. Hyperlink id -> String
hyperlinkUrl Hyperlink (DocH String Identifier)
h) (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Hyperlink (DocH String Identifier) -> String
forall id. Hyperlink id -> String
hyperlinkUrl Hyperlink (DocH String Identifier)
h)
             (Inlines
-> (DocH String Identifier -> Inlines)
-> Maybe (DocH String Identifier)
-> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Inlines
B.text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Hyperlink (DocH String Identifier) -> String
forall id. Hyperlink id -> String
hyperlinkUrl Hyperlink (DocH String Identifier)
h) (Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
isCode)
               (Hyperlink (DocH String Identifier)
-> Maybe (DocH String Identifier)
forall id. Hyperlink id -> Maybe id
hyperlinkLabel Hyperlink (DocH String Identifier)
h))
    DocPic Picture
p -> Text -> Text -> Inlines -> Inlines
B.image (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Picture -> String
pictureUri Picture
p) (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Picture -> String
pictureUri Picture
p) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Picture -> Maybe String
pictureTitle Picture
p)
                        (Inlines -> (String -> Inlines) -> Maybe String -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inlines
forall a. Monoid a => a
mempty (Text -> Inlines
B.text (Text -> Inlines) -> (String -> Text) -> String -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Maybe String -> Inlines) -> Maybe String -> Inlines
forall a b. (a -> b) -> a -> b
$ Picture -> Maybe String
pictureTitle Picture
p)
    DocAName String
s -> Attr -> Inlines -> Inlines
B.spanWith (String -> Text
T.pack String
s,[Text
"anchor"],[]) Inlines
forall a. Monoid a => a
mempty
    DocProperty String
_ -> Inlines
forall a. Monoid a => a
mempty
    DocExamples [Example]
_ -> Inlines
forall a. Monoid a => a
mempty
    DocTable Table (DocH String Identifier)
_ -> Inlines
forall a. Monoid a => a
mempty

-- | Create an 'Example', stripping superfluous characters as appropriate
makeExample :: T.Text -> String -> [String] -> Blocks
makeExample :: Text -> String -> [String] -> Blocks
makeExample Text
prompt String
expression [String]
result =
    Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
B.codeWith (Text
"",[Text
"prompt"],[]) Text
prompt
        Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.space
        Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Attr -> Text -> Inlines
B.codeWith (Text
"", [Text
"haskell",Text
"expr"], []) (Text -> Text
trim (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
expression)
        Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.linebreak
        Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat (Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.linebreak ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
coder [Text]
result')
  where
    -- 1. drop trailing whitespace from the prompt, remember the prefix
    prefix :: Text
prefix = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t" :: String)) Text
prompt

    -- 2. drop, if possible, the exact same sequence of whitespace
    -- characters from each result line
    --
    -- 3. interpret lines that only contain the string "<BLANKLINE>" as an
    -- empty line
    result' :: [Text]
result' = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
forall p. (Eq p, IsString p) => p -> p
substituteBlankLine (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
tryStripPrefix Text
prefix (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String]
result
      where
        tryStripPrefix :: Text -> Text -> Text
tryStripPrefix Text
xs Text
ys = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
ys (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
xs Text
ys

        substituteBlankLine :: p -> p
substituteBlankLine p
"<BLANKLINE>" = p
""
        substituteBlankLine p
line          = p
line
    coder :: Text -> Inlines
coder = Attr -> Text -> Inlines
B.codeWith (Text
"", [Text
"result"], [])