{-# LANGUAGE NoImplicitPrelude #-}
{-# 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 Prelude
import Control.Monad.Except (throwError)
import Data.List (intersperse)
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)
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 opts :: ReaderOptions
opts s :: Text
s = case ReaderOptions -> String -> Either PandocError Pandoc
readHaddockEither ReaderOptions
opts (Text -> String
unpack (Text -> Text
crFilter Text
s)) of
  Right result :: Pandoc
result -> Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
result
  Left e :: 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 _opts :: 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 d' :: DocH String Identifier
d' =
  case DocH String Identifier
d' of
    DocEmpty -> Blocks
forall a. Monoid a => a
mempty
    DocAppend (DocParagraph (DocHeader h :: Header (DocH String Identifier)
h)) (DocParagraph (DocAName ident :: 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 d1 :: DocH String Identifier
d1 d2 :: 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 _ -> Blocks
inlineFallback
    DocParagraph (DocAName h :: 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 x :: 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 _ -> Blocks
inlineFallback
    DocIdentifierUnchecked _ -> Blocks
inlineFallback
    DocModule s :: 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 _ -> Blocks
forall a. Monoid a => a
mempty -- TODO
    DocEmphasis _ -> Blocks
inlineFallback
    DocMonospaced _ -> Blocks
inlineFallback
    DocBold _ -> Blocks
inlineFallback
    DocMathInline _ -> Blocks
inlineFallback
    DocMathDisplay _ -> Blocks
inlineFallback
    DocHeader h :: 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 items :: [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 items :: [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 items :: [(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 (\(d :: DocH String Identifier
d,t :: 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 s :: String
s) -> Attr -> Text -> Blocks
B.codeBlockWith ("",[],[]) (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocCodeBlock d :: 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 _ -> Blocks
inlineFallback
    DocPic _ -> Blocks
inlineFallback
    DocAName _ -> Blocks
inlineFallback
    DocProperty s :: String
s -> Attr -> Text -> Blocks
B.codeBlockWith ("",["property","haskell"],[]) (Text -> Text
trim (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s)
    DocExamples es :: [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 (\e :: Example
e ->
       Text -> String -> [String] -> Blocks
makeExample ">>>" (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
             (header :: [Blocks]
header, body :: [[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, Double)]
colspecs = Int -> (Alignment, Double) -> [(Alignment, Double)]
forall a. Int -> a -> [a]
replicate ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([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, 0.0)
         in  Inlines
-> [(Alignment, Double)] -> [Blocks] -> [[Blocks]] -> Blocks
B.table Inlines
forall a. Monoid a => a
mempty [(Alignment, Double)]
colspecs [Blocks]
header [[Blocks]]
body

  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 _ : _) =
          let (xs :: [Block]
xs, ys :: [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' (x :: Block
x : xs :: [Block]
xs) = Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block] -> [Block]
consolidatePlains' [Block]
xs
        consolidatePlains' [] = []
        isPlain :: Block -> Bool
isPlain (Plain _) = Bool
True
        isPlain _         = Bool
False
        extractContents :: Block -> [Inline]
extractContents (Plain xs :: [Inline]
xs) = [Inline]
xs
        extractContents _          = []

docHToInlines :: Bool -> DocH String Identifier -> Inlines
docHToInlines :: Bool -> DocH String Identifier -> Inlines
docHToInlines isCode :: Bool
isCode d' :: DocH String Identifier
d' =
  case DocH String Identifier
d' of
    DocEmpty -> Inlines
forall a. Monoid a => a
mempty
    DocAppend d1 :: DocH String Identifier
d1 d2 :: 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 s :: 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
=='\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 _ -> Inlines
forall a. Monoid a => a
mempty
    DocIdentifier ident :: 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 s :: String
s -> Attr -> Text -> Inlines
B.codeWith ("",["haskell","identifier"],[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
          _               -> Inlines
forall a. Monoid a => a
mempty
    DocIdentifierUnchecked s :: String
s -> Attr -> Text -> Inlines
B.codeWith ("",["haskell","identifier"],[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocModule s :: String
s -> Attr -> Text -> Inlines
B.codeWith ("",["haskell","module"],[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocWarning _ -> Inlines
forall a. Monoid a => a
mempty -- TODO
    DocEmphasis d :: DocH String Identifier
d -> Inlines -> Inlines
B.emph (Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
isCode DocH String Identifier
d)
    DocMonospaced (DocString s :: String
s) -> Text -> Inlines
B.code (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocMonospaced d :: DocH String Identifier
d -> Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
True DocH String Identifier
d
    DocBold d :: DocH String Identifier
d -> Inlines -> Inlines
B.strong (Bool -> DocH String Identifier -> Inlines
docHToInlines Bool
isCode DocH String Identifier
d)
    DocMathInline s :: String
s -> Text -> Inlines
B.math (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocMathDisplay s :: String
s -> Text -> Inlines
B.displayMath (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
    DocHeader _ -> Inlines
forall a. Monoid a => a
mempty
    DocUnorderedList _ -> Inlines
forall a. Monoid a => a
mempty
    DocOrderedList _ -> Inlines
forall a. Monoid a => a
mempty
    DocDefList _ -> Inlines
forall a. Monoid a => a
mempty
    DocCodeBlock _ -> Inlines
forall a. Monoid a => a
mempty
    DocHyperlink h :: 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 p :: 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 s :: String
s -> Attr -> Inlines -> Inlines
B.spanWith (String -> Text
T.pack String
s,["anchor"],[]) Inlines
forall a. Monoid a => a
mempty
    DocProperty _ -> Inlines
forall a. Monoid a => a
mempty
    DocExamples _ -> Inlines
forall a. Monoid a => a
mempty
    DocTable _ -> 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 prompt :: Text
prompt expression :: String
expression result :: [String]
result =
    Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
B.codeWith ("",["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 ("", ["haskell","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` (" \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 xs :: Text
xs ys :: 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 "<BLANKLINE>" = ""
        substituteBlankLine line :: p
line          = p
line
    coder :: Text -> Inlines
coder = Attr -> Text -> Inlines
B.codeWith ("", ["result"], [])