{-# 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 :: Bool
-> TOC
-> Bool
-> Bool
-> Highlighting
-> SectionStyling
-> Maybe Char
-> OrgStyle
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
_ Html ()
a Html ()
b -> Html ()
a Html () -> Html () -> Html ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html ()
b
  , separator :: Maybe Char
separator = Char -> Maybe Char
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 -> Html ()
html OrgStyle
os o :: OrgFile
o@(OrgFile Map Text Text
m OrgDoc
_) = Html () -> Html ()
forall arg result. Term arg result => arg -> result
html_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
  Html () -> Html ()
forall arg result. Term arg result => arg -> result
head_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Html () -> Html ()
forall arg result. Term arg result => arg -> result
title_ (Html () -> (Text -> Html ()) -> Maybe Text -> Html ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html ()
"" Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (Maybe Text -> Html ()) -> Maybe Text -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"TITLE" Map Text Text
m)
  Html () -> Html ()
forall arg result. Term arg result => arg -> result
body_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ OrgStyle -> OrgFile -> Html ()
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 -> Html ()
body OrgStyle
os (OrgFile Map Text Text
m OrgDoc
od) = do
  Bool -> Html () -> Html ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OrgStyle -> Bool
includeTitle OrgStyle
os) (Html () -> Html ())
-> (Maybe Text -> Html ()) -> Maybe Text -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Html ()) -> Maybe Text -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ([Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
h1_ [Text -> Attribute
class_ Text
"title"] (Html () -> Html ()) -> (Text -> Html ()) -> Text -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) (Maybe Text -> Html ()) -> Maybe Text -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"TITLE" Map Text Text
m
  OrgStyle -> OrgDoc -> Html ()
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> (NonEmpty Words -> Text) -> NonEmpty Words -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (NonEmpty Words -> String) -> NonEmpty Words -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
6 (String -> String)
-> (NonEmpty Words -> String) -> NonEmpty Words -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%x" (Int -> String)
-> (NonEmpty Words -> Int) -> NonEmpty Words -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Words -> Int
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 -> Html ()
toc OrgStyle
os (OrgFile Map Text Text
_ OrgDoc
od) = OrgStyle -> TOC -> Word -> OrgDoc -> Html ()
toc' OrgStyle
os (OrgStyle -> TOC
tableOfContents OrgStyle
os) Word
1 OrgDoc
od

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

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

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

-- | Section timestamps and properties are ignored.
sectionHTML :: OrgStyle -> Int -> Section -> Html ()
sectionHTML :: OrgStyle -> Int -> Section -> Html ()
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 Html ()
theHead Html ()
theBody
  where
    theHead :: Html ()
    theHead :: Html ()
theHead = [Attribute] -> Html () -> Html ()
heading [Text -> Attribute
id_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ NonEmpty Words -> Text
tocLabel NonEmpty Words
ws] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ OrgStyle -> NonEmpty Words -> Html ()
paragraphHTML OrgStyle
os NonEmpty Words
ws

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

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

blockHTML :: OrgStyle -> Block -> Html ()
blockHTML :: OrgStyle -> Block -> Html ()
blockHTML OrgStyle
os Block
b = case Block
b of
  Quote Text
t                  -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
blockquote_ (Html () -> Html ()) -> ([Text] -> Html ()) -> [Text] -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Html ()) -> [Text] -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Html () -> Html ()
forall arg result. Term arg result => arg -> result
p_ (Html () -> Html ()) -> (Text -> Html ()) -> Text -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) ([Text] -> Html ()) -> [Text] -> Html ()
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 -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
pre_ [Text -> Attribute
class_ Text
"example"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
            | OrgStyle -> Bool
bulma OrgStyle
os     -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
pre_ [Text -> Attribute
class_ Text
"box"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t
            | Bool
otherwise    -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
pre_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
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 -> Html ()
listItemsHTML OrgStyle
os ListItems
is
  Table NonEmpty Row
rw                 -> OrgStyle -> NonEmpty Row -> Html ()
tableHTML OrgStyle
os NonEmpty Row
rw
  Paragraph NonEmpty Words
ws             -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
p_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ OrgStyle -> NonEmpty Words -> Html ()
paragraphHTML OrgStyle
os NonEmpty Words
ws

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

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

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

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

tableHTML :: OrgStyle -> NonEmpty Row -> Html ()
tableHTML :: OrgStyle -> NonEmpty Row -> Html ()
tableHTML OrgStyle
os NonEmpty Row
rs = [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
table_ [Attribute]
tblClasses (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
  [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
thead_ [Attribute]
headClasses Html ()
toprow
  Html () -> Html ()
forall arg result. Term arg result => arg -> result
tbody_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ (Row -> Html ()) -> [Row] -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Row -> Html ()
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 :: Html ()
toprow = Html () -> Html ()
forall arg result. Term arg result => arg -> result
tr_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ (NonEmpty Column -> Html ()) -> Maybe (NonEmpty Column) -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Column -> Html ()) -> NonEmpty Column -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Column -> Html ()
g) Maybe (NonEmpty Column)
h
    (Maybe (NonEmpty Column)
h, [Row]
rest) = [Row] -> (Maybe (NonEmpty Column), [Row])
j ([Row] -> (Maybe (NonEmpty Column), [Row]))
-> [Row] -> (Maybe (NonEmpty Column), [Row])
forall a b. (a -> b) -> a -> b
$ NonEmpty Row -> [Row]
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 []           = (Maybe (NonEmpty Column)
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) = (NonEmpty Column -> Maybe (NonEmpty Column)
forall a. a -> Maybe a
Just NonEmpty Column
cs, [Row]
r)

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

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

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

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