{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module    : Data.Org.Lucid
-- Copyright : (c) Colin Woodbury, 2020 - 2021
-- License   : BSD3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- This library converts `OrgFile` values into `Html` structures from the Lucid
-- library. This allows one to generate valid, standalone HTML pages from an Org
-- file, but also to inject that HTML into a preexisting Lucid `Html` structure,
-- such as a certain section of a web page.

module Data.Org.Lucid
  ( -- * HTML Conversion
    -- | Consider `defaultStyle` as the style to pass to these functions.
    html
  , body
  , toc
    -- * Styling
  , OrgStyle(..)
  , defaultStyle
  , TOC(..)
  , Highlighting
  , SectionStyling
  , codeHTML
  ) where

import           Control.Monad (when)
import           Data.Foldable (traverse_)
import           Data.Hashable (hash)
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map.Strict as M
import           Data.Org
import qualified Data.Text as T
import           Lucid
import           Text.Printf (printf)

--------------------------------------------------------------------------------
-- HTML Generation

-- | Rendering options.
data OrgStyle = OrgStyle
  { OrgStyle -> Bool
includeTitle    :: Bool
    -- ^ Whether to include the @#+TITLE: ...@ value as an @<h1>@ tag at the top
    -- of the document.
  , OrgStyle -> TOC
tableOfContents :: TOC
    -- ^ Settings for the generated Table of Contents. The displayed depth is
    -- configurable.
  , OrgStyle -> Bool
bootstrap       :: Bool
    -- ^ Whether to add Twitter Bootstrap classes to certain elements.
  , OrgStyle -> Bool
bulma           :: Bool
    -- ^ Whether to add Bulma classes to certain elements.
  , OrgStyle -> Highlighting
highlighting    :: Highlighting
    -- ^ A function to give @\<code\>@ blocks syntax highlighting.
  , OrgStyle -> SectionStyling
sectionStyling  :: SectionStyling
  , OrgStyle -> Maybe Char
separator       :: Maybe Char
    -- ^ `Char` to insert between elements during rendering, for example having
    -- a space between words. Asian languages, for instance, might want this to
    -- be `Nothing`.
  }

-- | Options for rendering a Table of Contents in the document.
newtype TOC = TOC
  { TOC -> Word
tocDepth :: Word
    -- ^ The number of levels to give the TOC.
  }

-- | A function to give @\<code\>@ blocks syntax highlighting.
type Highlighting = Maybe Language -> T.Text -> Html ()

-- | A post-processing function to apply to a `Section` to give it extra
-- formatting. The `Int` is the header depth.
type SectionStyling = Int -> Html () -> Html () -> Html ()

-- | Include the title and 3-level TOC named @Table of Contents@, don't include
-- Twitter Bootstrap classes, use no custom syntax highlighting, separate words
-- with a whitespace character, and don't insert an @\<hr\>@ between major
-- sections. This mirrors the behaviour of Emacs' native HTML export
-- functionality.
defaultStyle :: OrgStyle
defaultStyle :: OrgStyle
defaultStyle = OrgStyle
  { includeTitle :: Bool
includeTitle = Bool
True
  , tableOfContents :: TOC
tableOfContents = Word -> TOC
TOC Word
3
  , bootstrap :: Bool
bootstrap = Bool
False
  , bulma :: Bool
bulma = Bool
False
  , highlighting :: Highlighting
highlighting = Highlighting
codeHTML
  , sectionStyling :: SectionStyling
sectionStyling = \Int
_ HtmlT Identity ()
a HtmlT Identity ()
b -> HtmlT Identity ()
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HtmlT Identity ()
b
  , separator :: Maybe Char
separator = forall a. a -> Maybe a
Just Char
' ' }

-- | Convert a parsed `OrgFile` into a full HTML document readable in a browser.
html :: OrgStyle -> OrgFile -> Html ()
html :: OrgStyle -> OrgFile -> HtmlT Identity ()
html OrgStyle
os o :: OrgFile
o@(OrgFile Map Text Text
m OrgDoc
_) = forall arg result. Term arg result => arg -> result
html_ forall a b. (a -> b) -> a -> b
$ do
  forall arg result. Term arg result => arg -> result
head_ forall a b. (a -> b) -> a -> b
$ forall arg result. Term arg result => arg -> result
title_ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT Identity ()
"" forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"TITLE" Map Text Text
m)
  forall arg result. Term arg result => arg -> result
body_ forall a b. (a -> b) -> a -> b
$ OrgStyle -> OrgFile -> HtmlT Identity ()
body OrgStyle
os OrgFile
o

-- | Convert a parsed `OrgFile` into the body of an HTML document, so that it
-- could be injected into other Lucid `Html` structures.
--
-- Does __not__ wrap contents in a @\<body\>@ tag.
body :: OrgStyle -> OrgFile -> Html ()
body :: OrgStyle -> OrgFile -> HtmlT Identity ()
body OrgStyle
os (OrgFile Map Text Text
m OrgDoc
od) = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OrgStyle -> Bool
includeTitle OrgStyle
os) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall arg result. Term arg result => arg -> result
h1_ [Text -> Attribute
class_ Text
"title"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"TITLE" Map Text Text
m
  OrgStyle -> OrgDoc -> HtmlT Identity ()
orgHTML OrgStyle
os OrgDoc
od

-- | A unique identifier that can be used as an HTML @id@ attribute.
tocLabel :: NonEmpty Words -> T.Text
tocLabel :: NonEmpty Words -> Text
tocLabel = (Text
"org" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
6 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => [Char] -> r
printf [Char]
"%x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashable a => a -> Int
hash

-- | Generate a Table of Contents that matches some `Html` produced by `html` or
-- `body`.
toc :: OrgStyle -> OrgFile -> Html ()
toc :: OrgStyle -> OrgFile -> HtmlT Identity ()
toc OrgStyle
os (OrgFile Map Text Text
_ OrgDoc
od) = OrgStyle -> TOC -> Word -> OrgDoc -> HtmlT Identity ()
toc' OrgStyle
os (OrgStyle -> TOC
tableOfContents OrgStyle
os) Word
1 OrgDoc
od

toc' :: OrgStyle -> TOC -> Word -> OrgDoc -> Html ()
toc' :: OrgStyle -> TOC -> Word -> OrgDoc -> HtmlT Identity ()
toc' OrgStyle
_ TOC
_ Word
_ (OrgDoc [Block]
_ []) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
toc' OrgStyle
os TOC
t Word
depth (OrgDoc [Block]
_ [Section]
ss)
  | Word
depth forall a. Ord a => a -> a -> Bool
> TOC -> Word
tocDepth TOC
t = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = forall arg result. Term arg result => arg -> result
ul_ forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Section -> HtmlT Identity ()
f [Section]
ss
  where
    f :: Section -> Html ()
    f :: Section -> HtmlT Identity ()
f (Section Maybe Todo
_ Maybe Priority
_ NonEmpty Words
ws [Text]
_ Maybe OrgDateTime
_ Maybe OrgDateTime
_ Maybe OrgDateTime
_ Maybe OrgDateTime
_ Map Text Text
_ OrgDoc
od) = do
      forall arg result. Term arg result => arg -> result
li_ forall a b. (a -> b) -> a -> b
$ forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
href_ forall a b. (a -> b) -> a -> b
$ Text
"#" forall a. Semigroup a => a -> a -> a
<> NonEmpty Words -> Text
tocLabel NonEmpty Words
ws] forall a b. (a -> b) -> a -> b
$ OrgStyle -> NonEmpty Words -> HtmlT Identity ()
paragraphHTML OrgStyle
os NonEmpty Words
ws
      OrgStyle -> TOC -> Word -> OrgDoc -> HtmlT Identity ()
toc' OrgStyle
os TOC
t (forall a. Enum a => a -> a
succ Word
depth) OrgDoc
od

orgHTML :: OrgStyle -> OrgDoc -> Html ()
orgHTML :: OrgStyle -> OrgDoc -> HtmlT Identity ()
orgHTML OrgStyle
os = OrgStyle -> Int -> OrgDoc -> HtmlT Identity ()
orgHTML' OrgStyle
os Int
1

orgHTML' :: OrgStyle -> Int -> OrgDoc -> Html ()
orgHTML' :: OrgStyle -> Int -> OrgDoc -> HtmlT Identity ()
orgHTML' OrgStyle
os Int
depth (OrgDoc [Block]
bs [Section]
ss) = do
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (OrgStyle -> Block -> HtmlT Identity ()
blockHTML OrgStyle
os) [Block]
bs
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (OrgStyle -> Int -> Section -> HtmlT Identity ()
sectionHTML OrgStyle
os Int
depth) [Section]
ss

-- | Section timestamps and properties are ignored.
sectionHTML :: OrgStyle -> Int -> Section -> Html ()
sectionHTML :: OrgStyle -> Int -> Section -> HtmlT Identity ()
sectionHTML OrgStyle
os Int
depth (Section Maybe Todo
_ Maybe Priority
_ NonEmpty Words
ws [Text]
_ Maybe OrgDateTime
_ Maybe OrgDateTime
_ Maybe OrgDateTime
_ Maybe OrgDateTime
_ Map Text Text
_ OrgDoc
od) = OrgStyle -> SectionStyling
sectionStyling OrgStyle
os Int
depth HtmlT Identity ()
theHead HtmlT Identity ()
theBody
  where
    theHead :: Html ()
    theHead :: HtmlT Identity ()
theHead = [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
heading [Text -> Attribute
id_ forall a b. (a -> b) -> a -> b
$ NonEmpty Words -> Text
tocLabel NonEmpty Words
ws] forall a b. (a -> b) -> a -> b
$ OrgStyle -> NonEmpty Words -> HtmlT Identity ()
paragraphHTML OrgStyle
os NonEmpty Words
ws

    theBody :: Html ()
    theBody :: HtmlT Identity ()
theBody = OrgStyle -> Int -> OrgDoc -> HtmlT Identity ()
orgHTML' OrgStyle
os (forall a. Enum a => a -> a
succ Int
depth) OrgDoc
od

    heading :: [Attribute] -> Html () -> Html ()
    heading :: [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
heading [Attribute]
as HtmlT Identity ()
h = case Int
depth of
      Int
1 -> forall arg result. Term arg result => arg -> result
h2_ [Attribute]
as HtmlT Identity ()
h
      Int
2 -> forall arg result. Term arg result => arg -> result
h3_ [Attribute]
as HtmlT Identity ()
h
      Int
3 -> forall arg result. Term arg result => arg -> result
h4_ [Attribute]
as HtmlT Identity ()
h
      Int
4 -> forall arg result. Term arg result => arg -> result
h5_ [Attribute]
as HtmlT Identity ()
h
      Int
5 -> forall arg result. Term arg result => arg -> result
h6_ [Attribute]
as HtmlT Identity ()
h
      Int
_ -> HtmlT Identity ()
h

blockHTML :: OrgStyle -> Block -> Html ()
blockHTML :: OrgStyle -> Block -> HtmlT Identity ()
blockHTML OrgStyle
os Block
b = case Block
b of
  Quote Text
t                  -> forall arg result. Term arg result => arg -> result
blockquote_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall arg result. Term arg result => arg -> result
p_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"\n\n" Text
t
  Example Text
t | OrgStyle -> Bool
bootstrap OrgStyle
os -> forall arg result. Term arg result => arg -> result
pre_ [Text -> Attribute
class_ Text
"example"] forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
            | OrgStyle -> Bool
bulma OrgStyle
os     -> forall arg result. Term arg result => arg -> result
pre_ [Text -> Attribute
class_ Text
"box"] forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
            | Bool
otherwise    -> forall arg result. Term arg result => arg -> result
pre_ forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
  Code Maybe Language
l Text
t                 -> OrgStyle -> Highlighting
highlighting OrgStyle
os Maybe Language
l Text
t
  List ListItems
is                  -> OrgStyle -> ListItems -> HtmlT Identity ()
listItemsHTML OrgStyle
os ListItems
is
  Table NonEmpty Row
rw                 -> OrgStyle -> NonEmpty Row -> HtmlT Identity ()
tableHTML OrgStyle
os NonEmpty Row
rw
  Paragraph NonEmpty Words
ws             -> forall arg result. Term arg result => arg -> result
p_ forall a b. (a -> b) -> a -> b
$ OrgStyle -> NonEmpty Words -> HtmlT Identity ()
paragraphHTML OrgStyle
os NonEmpty Words
ws

-- | Mimicks the functionality of Emacs' native HTML export.
codeHTML :: Highlighting
codeHTML :: Highlighting
codeHTML Maybe Language
l Text
t = forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class_ Text
"org-src-container"]
  forall a b. (a -> b) -> a -> b
$ forall arg result. Term arg result => arg -> result
pre_ [[Text] -> Attribute
classes_ forall a b. (a -> b) -> a -> b
$ Text
"src" forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(Language Text
l') -> [Text
"src-" forall a. Semigroup a => a -> a -> a
<> Text
l']) Maybe Language
l]
  forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t

paragraphHTML :: OrgStyle -> NonEmpty Words -> Html ()
paragraphHTML :: OrgStyle -> NonEmpty Words -> HtmlT Identity ()
paragraphHTML OrgStyle
os (Words
h :| [Words]
t) = Words -> HtmlT Identity ()
wordsHTML Words
h forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> HtmlT Identity ()
para Words
h [Words]
t
  where
    sep :: Html ()
    sep :: HtmlT Identity ()
sep = forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT Identity ()
"" (forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) forall a b. (a -> b) -> a -> b
$ OrgStyle -> Maybe Char
separator OrgStyle
os

    para :: Words -> [Words] -> Html ()
    para :: Words -> [Words] -> HtmlT Identity ()
para Words
_ [] = HtmlT Identity ()
""
    para Words
pr (Words
w:[Words]
ws) = case Words
pr of
      Punct Char
'(' -> Words -> HtmlT Identity ()
wordsHTML Words
w forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> HtmlT Identity ()
para Words
w [Words]
ws
      Words
_ -> case Words
w of
        Punct Char
'(' -> HtmlT Identity ()
sep forall a. Semigroup a => a -> a -> a
<> Words -> HtmlT Identity ()
wordsHTML Words
w forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> HtmlT Identity ()
para Words
w [Words]
ws
        Punct Char
_   -> Words -> HtmlT Identity ()
wordsHTML Words
w forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> HtmlT Identity ()
para Words
w [Words]
ws
        Words
_         -> HtmlT Identity ()
sep forall a. Semigroup a => a -> a -> a
<> Words -> HtmlT Identity ()
wordsHTML Words
w forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> HtmlT Identity ()
para Words
w [Words]
ws

listItemsHTML :: OrgStyle -> ListItems -> Html ()
listItemsHTML :: OrgStyle -> ListItems -> HtmlT Identity ()
listItemsHTML OrgStyle
os (ListItems ListType
t NonEmpty Item
is) = [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
orderedOrNot [Text -> Attribute
class_ Text
"org-ul"] forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Item -> HtmlT Identity ()
f NonEmpty Item
is
  where
    f :: Item -> Html ()
    f :: Item -> HtmlT Identity ()
f (Item NonEmpty Words
ws Maybe ListItems
next) = forall arg result. Term arg result => arg -> result
li_ forall a b. (a -> b) -> a -> b
$ OrgStyle -> NonEmpty Words -> HtmlT Identity ()
paragraphHTML OrgStyle
os NonEmpty Words
ws forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (OrgStyle -> ListItems -> HtmlT Identity ()
listItemsHTML OrgStyle
os) Maybe ListItems
next

    orderedOrNot :: [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
orderedOrNot = case ListType
t of
      ListType
Numbered -> forall arg result. Term arg result => arg -> result
ol_
      ListType
Bulleted -> forall arg result. Term arg result => arg -> result
ul_
      ListType
Plussed  -> forall arg result. Term arg result => arg -> result
ul_

tableHTML :: OrgStyle -> NonEmpty Row -> Html ()
tableHTML :: OrgStyle -> NonEmpty Row -> HtmlT Identity ()
tableHTML OrgStyle
os NonEmpty Row
rs = forall arg result. Term arg result => arg -> result
table_ [Attribute]
tblClasses forall a b. (a -> b) -> a -> b
$ do
  forall arg result. Term arg result => arg -> result
thead_ [Attribute]
headClasses HtmlT Identity ()
toprow
  forall arg result. Term arg result => arg -> result
tbody_ forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Row -> HtmlT Identity ()
f [Row]
rest
  where
    tblClasses :: [Attribute]
tblClasses
      | OrgStyle -> Bool
bootstrap OrgStyle
os = [[Text] -> Attribute
classes_ [Text
"table", Text
"table-bordered", Text
"table-hover"]]
      | Bool
otherwise = []

    headClasses :: [Attribute]
headClasses
      | OrgStyle -> Bool
bootstrap OrgStyle
os = [Text -> Attribute
class_ Text
"thead-dark"]
      | Bool
otherwise = []

    toprow :: HtmlT Identity ()
toprow = forall arg result. Term arg result => arg -> result
tr_ forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Column -> HtmlT Identity ()
g) Maybe (NonEmpty Column)
h
    (Maybe (NonEmpty Column)
h, [Row]
rest) = [Row] -> (Maybe (NonEmpty Column), [Row])
j forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Row
rs

    -- | Restructure the input such that the first `Row` is not a `Break`.
    j :: [Row] -> (Maybe (NonEmpty Column), [Row])
    j :: [Row] -> (Maybe (NonEmpty Column), [Row])
j []           = (forall a. Maybe a
Nothing, [])
    j (Row
Break : [Row]
r)  = [Row] -> (Maybe (NonEmpty Column), [Row])
j [Row]
r
    j (Row NonEmpty Column
cs : [Row]
r) = (forall a. a -> Maybe a
Just NonEmpty Column
cs, [Row]
r)

    -- | Potentially render a `Row`.
    f :: Row -> Html ()
    f :: Row -> HtmlT Identity ()
f Row
Break    = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    f (Row NonEmpty Column
cs) = forall arg result. Term arg result => arg -> result
tr_ forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Column -> HtmlT Identity ()
k NonEmpty Column
cs

    -- | Render a header row.
    g :: Column -> Html ()
    g :: Column -> HtmlT Identity ()
g Column
Empty       = forall arg result. Term arg result => arg -> result
th_ [Text -> Attribute
scope_ Text
"col"] HtmlT Identity ()
""
    g (Column NonEmpty Words
ws) = forall arg result. Term arg result => arg -> result
th_ [Text -> Attribute
scope_ Text
"col"] forall a b. (a -> b) -> a -> b
$ OrgStyle -> NonEmpty Words -> HtmlT Identity ()
paragraphHTML OrgStyle
os NonEmpty Words
ws

    -- | Render a normal row.
    k :: Column -> Html ()
    k :: Column -> HtmlT Identity ()
k Column
Empty       = forall arg result. Term arg result => arg -> result
td_ HtmlT Identity ()
""
    k (Column NonEmpty Words
ws) = forall arg result. Term arg result => arg -> result
td_ forall a b. (a -> b) -> a -> b
$ OrgStyle -> NonEmpty Words -> HtmlT Identity ()
paragraphHTML OrgStyle
os NonEmpty Words
ws

wordsHTML :: Words -> Html ()
wordsHTML :: Words -> HtmlT Identity ()
wordsHTML Words
ws = case Words
ws of
  Bold Text
t          -> forall arg result. Term arg result => arg -> result
b_ forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
  Italic Text
t        -> forall arg result. Term arg result => arg -> result
i_ forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
  Highlight Text
t     -> forall arg result. Term arg result => arg -> result
code_ [Text -> Attribute
class_ Text
"org-highlight"] forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
  Underline Text
t     -> forall arg result. Term arg result => arg -> result
span_ [forall arg result. TermRaw arg result => arg -> result
style_ Text
"text-decoration: underline;"] forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
  Verbatim Text
t      -> forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
  Strike Text
t        -> forall arg result. Term arg result => arg -> result
span_ [forall arg result. TermRaw arg result => arg -> result
style_ Text
"text-decoration: line-through;"] forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
  Link (URL Text
u) Maybe Text
mt -> forall arg result. Term arg result => arg -> result
a_ [Text -> Attribute
href_ Text
u] forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT Identity ()
"" forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Maybe Text
mt
  Image (URL Text
u)   -> forall arg result. Term arg result => arg -> result
figure_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
img_ [Text -> Attribute
src_ Text
u]
  Punct Char
c         -> forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
  Plain Text
t         -> forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t