{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

module Org.Builder where

import Data.Sequence (ViewL (..), ViewR (..), viewl, viewr, (|>))
import Data.Text qualified as T
import GHC.Exts qualified
import Org.Types

newtype Many a = Many {forall a. Many a -> Seq a
unMany :: Seq a}
  deriving (Many a -> Many a -> Bool
Many a -> Many a -> Ordering
Many a -> Many a -> Many a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Many a)
forall a. Ord a => Many a -> Many a -> Bool
forall a. Ord a => Many a -> Many a -> Ordering
forall a. Ord a => Many a -> Many a -> Many a
min :: Many a -> Many a -> Many a
$cmin :: forall a. Ord a => Many a -> Many a -> Many a
max :: Many a -> Many a -> Many a
$cmax :: forall a. Ord a => Many a -> Many a -> Many a
>= :: Many a -> Many a -> Bool
$c>= :: forall a. Ord a => Many a -> Many a -> Bool
> :: Many a -> Many a -> Bool
$c> :: forall a. Ord a => Many a -> Many a -> Bool
<= :: Many a -> Many a -> Bool
$c<= :: forall a. Ord a => Many a -> Many a -> Bool
< :: Many a -> Many a -> Bool
$c< :: forall a. Ord a => Many a -> Many a -> Bool
compare :: Many a -> Many a -> Ordering
$ccompare :: forall a. Ord a => Many a -> Many a -> Ordering
Ord, Many a -> Many a -> Bool
forall a. Eq a => Many a -> Many a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Many a -> Many a -> Bool
$c/= :: forall a. Eq a => Many a -> Many a -> Bool
== :: Many a -> Many a -> Bool
$c== :: forall a. Eq a => Many a -> Many a -> Bool
Eq, Typeable, forall a. Eq a => a -> Many a -> Bool
forall a. Num a => Many a -> a
forall a. Ord a => Many a -> a
forall m. Monoid m => Many m -> m
forall a. Many a -> Bool
forall a. Many a -> Int
forall a. Many a -> [a]
forall a. (a -> a -> a) -> Many a -> a
forall m a. Monoid m => (a -> m) -> Many a -> m
forall b a. (b -> a -> b) -> b -> Many a -> b
forall a b. (a -> b -> b) -> b -> Many a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Many a -> a
$cproduct :: forall a. Num a => Many a -> a
sum :: forall a. Num a => Many a -> a
$csum :: forall a. Num a => Many a -> a
minimum :: forall a. Ord a => Many a -> a
$cminimum :: forall a. Ord a => Many a -> a
maximum :: forall a. Ord a => Many a -> a
$cmaximum :: forall a. Ord a => Many a -> a
elem :: forall a. Eq a => a -> Many a -> Bool
$celem :: forall a. Eq a => a -> Many a -> Bool
length :: forall a. Many a -> Int
$clength :: forall a. Many a -> Int
null :: forall a. Many a -> Bool
$cnull :: forall a. Many a -> Bool
toList :: forall a. Many a -> [a]
$ctoList :: forall a. Many a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Many a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Many a -> a
foldr1 :: forall a. (a -> a -> a) -> Many a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Many a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Many a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Many a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Many a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Many a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Many a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Many a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Many a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Many a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Many a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Many a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Many a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Many a -> m
fold :: forall m. Monoid m => Many m -> m
$cfold :: forall m. Monoid m => Many m -> m
Foldable, Functor Many
Foldable Many
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Many (m a) -> m (Many a)
forall (f :: * -> *) a. Applicative f => Many (f a) -> f (Many a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Many a -> m (Many b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Many a -> f (Many b)
sequence :: forall (m :: * -> *) a. Monad m => Many (m a) -> m (Many a)
$csequence :: forall (m :: * -> *) a. Monad m => Many (m a) -> m (Many a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Many a -> m (Many b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Many a -> m (Many b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Many (f a) -> f (Many a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Many (f a) -> f (Many a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Many a -> f (Many b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Many a -> f (Many b)
Traversable, forall a b. a -> Many b -> Many a
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Many b -> Many a
$c<$ :: forall a b. a -> Many b -> Many a
fmap :: forall a b. (a -> b) -> Many a -> Many b
$cfmap :: forall a b. (a -> b) -> Many a -> Many b
Functor, Int -> Many a -> ShowS
forall a. Show a => Int -> Many a -> ShowS
forall a. Show a => [Many a] -> ShowS
forall a. Show a => Many a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Many a] -> ShowS
$cshowList :: forall a. Show a => [Many a] -> ShowS
show :: Many a -> String
$cshow :: forall a. Show a => Many a -> String
showsPrec :: Int -> Many a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Many a -> ShowS
Show, ReadPrec [Many a]
ReadPrec (Many a)
ReadS [Many a]
forall a. Read a => ReadPrec [Many a]
forall a. Read a => ReadPrec (Many a)
forall a. Read a => Int -> ReadS (Many a)
forall a. Read a => ReadS [Many a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Many a]
$creadListPrec :: forall a. Read a => ReadPrec [Many a]
readPrec :: ReadPrec (Many a)
$creadPrec :: forall a. Read a => ReadPrec (Many a)
readList :: ReadS [Many a]
$creadList :: forall a. Read a => ReadS [Many a]
readsPrec :: Int -> ReadS (Many a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Many a)
Read)

instance One (Many a) where
  type OneItem (Many a) = a
  one :: OneItem (Many a) -> Many a
one = forall a. Seq a -> Many a
Many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. One x => OneItem x -> x
one

instance IsList (Many a) where
  type Item (Many a) = a
  fromList :: [Item (Many a)] -> Many a
fromList = forall a. Seq a -> Many a
Many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
fromList
  toList :: Many a -> [Item (Many a)]
toList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> Seq a
unMany

deriving instance Generic (Many a)

type OrgObjects = Many OrgObject

type OrgElements = Many OrgElement

deriving instance Semigroup OrgElements

deriving instance Monoid OrgElements

instance Semigroup OrgObjects where
  (Many Seq OrgObject
xs) <> :: OrgObjects -> OrgObjects -> OrgObjects
<> (Many Seq OrgObject
ys) =
    case (forall a. Seq a -> ViewR a
viewr Seq OrgObject
xs, forall a. Seq a -> ViewL a
viewl Seq OrgObject
ys) of
      (ViewR OrgObject
EmptyR, ViewL OrgObject
_) -> forall a. Seq a -> Many a
Many Seq OrgObject
ys
      (ViewR OrgObject
_, ViewL OrgObject
EmptyL) -> forall a. Seq a -> Many a
Many Seq OrgObject
xs
      (Seq OrgObject
xs' :> OrgObject
x, OrgObject
y :< Seq OrgObject
ys') -> forall a. Seq a -> Many a
Many (Seq OrgObject
meld forall a. Semigroup a => a -> a -> a
<> Seq OrgObject
ys')
        where
          meld :: Seq OrgObject
meld =
            case (OrgObject
x, OrgObject
y) of
              (Plain Text
t1, Plain Text
t2) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> Text -> OrgObject
Plain (Text
t1 forall a. Semigroup a => a -> a -> a
<> Text
t2)
              (Plain Text
t1, OrgObject
LineBreak) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> Text -> OrgObject
Plain (Text -> Text
T.stripEnd Text
t1) forall a. Seq a -> a -> Seq a
|> OrgObject
LineBreak
              (OrgObject
LineBreak, Plain Text
t2) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> OrgObject
LineBreak forall a. Seq a -> a -> Seq a
|> Text -> OrgObject
Plain (Text -> Text
T.stripStart Text
t2)
              (Italic [OrgObject]
i1, Italic [OrgObject]
i2) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> [OrgObject] -> OrgObject
Italic ([OrgObject]
i1 forall a. Semigroup a => a -> a -> a
<> [OrgObject]
i2)
              (Underline [OrgObject]
i1, Underline [OrgObject]
i2) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> [OrgObject] -> OrgObject
Underline ([OrgObject]
i1 forall a. Semigroup a => a -> a -> a
<> [OrgObject]
i2)
              (Bold [OrgObject]
i1, Bold [OrgObject]
i2) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> [OrgObject] -> OrgObject
Bold ([OrgObject]
i1 forall a. Semigroup a => a -> a -> a
<> [OrgObject]
i2)
              (Subscript [OrgObject]
i1, Subscript [OrgObject]
i2) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> [OrgObject] -> OrgObject
Subscript ([OrgObject]
i1 forall a. Semigroup a => a -> a -> a
<> [OrgObject]
i2)
              (Superscript [OrgObject]
i1, Superscript [OrgObject]
i2) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> [OrgObject] -> OrgObject
Superscript ([OrgObject]
i1 forall a. Semigroup a => a -> a -> a
<> [OrgObject]
i2)
              (Strikethrough [OrgObject]
i1, Strikethrough [OrgObject]
i2) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> [OrgObject] -> OrgObject
Strikethrough ([OrgObject]
i1 forall a. Semigroup a => a -> a -> a
<> [OrgObject]
i2)
              (Code Text
i1, Code Text
i2) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> Text -> OrgObject
Code (Text
i1 forall a. Semigroup a => a -> a -> a
<> Text
i2)
              (Verbatim Text
i1, Verbatim Text
i2) -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> Text -> OrgObject
Verbatim (Text
i1 forall a. Semigroup a => a -> a -> a
<> Text
i2)
              (OrgObject, OrgObject)
_ -> Seq OrgObject
xs' forall a. Seq a -> a -> Seq a
|> OrgObject
x forall a. Seq a -> a -> Seq a
|> OrgObject
y

instance Monoid OrgObjects where
  mempty :: OrgObjects
mempty = forall a. Seq a -> Many a
Many forall a. Monoid a => a
mempty
  mappend :: OrgObjects -> OrgObjects -> OrgObjects
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance IsString OrgObjects where
  fromString :: String -> OrgObjects
fromString = Text -> OrgObjects
plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance IsString OrgElements where
  fromString :: String -> OrgElements
fromString = OrgElementData -> OrgElements
element forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrgObjects -> OrgElementData
para forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> OrgObjects
plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- * Element builders

element :: OrgElementData -> OrgElements
element :: OrgElementData -> OrgElements
element = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keywords -> OrgElementData -> OrgElement
OrgElement forall a. Monoid a => a
mempty

element' :: [(Text, KeywordValue)] -> OrgElementData -> OrgElements
element' :: [(Text, KeywordValue)] -> OrgElementData -> OrgElements
element' [(Text, KeywordValue)]
aff = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keywords -> OrgElementData -> OrgElement
OrgElement (forall l. IsList l => [Item l] -> l
fromList [(Text, KeywordValue)]
aff)

para :: OrgObjects -> OrgElementData
para :: OrgObjects -> OrgElementData
para = [OrgObject] -> OrgElementData
Paragraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

export :: Text -> Text -> OrgElementData
export :: Text -> Text -> OrgElementData
export = Text -> Text -> OrgElementData
ExportBlock

example ::
  Map Text Text ->
  [SrcLine] ->
  OrgElementData
example :: Map Text Text -> [SrcLine] -> OrgElementData
example = Map Text Text -> [SrcLine] -> OrgElementData
ExampleBlock

srcBlock ::
  Text ->
  Map Text Text ->
  [(Text, Text)] ->
  [SrcLine] ->
  OrgElementData
srcBlock :: Text
-> Map Text Text -> [(Text, Text)] -> [SrcLine] -> OrgElementData
srcBlock = Text
-> Map Text Text -> [(Text, Text)] -> [SrcLine] -> OrgElementData
SrcBlock

greaterBlock ::
  GreaterBlockType ->
  OrgElements ->
  OrgElementData
greaterBlock :: GreaterBlockType -> OrgElements -> OrgElementData
greaterBlock GreaterBlockType
btype = GreaterBlockType -> [OrgElement] -> OrgElementData
GreaterBlock GreaterBlockType
btype forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

drawer ::
  Text ->
  OrgElements ->
  OrgElementData
drawer :: Text -> OrgElements -> OrgElementData
drawer Text
name = Text -> [OrgElement] -> OrgElementData
Drawer Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

latexEnvironment ::
  Text ->
  Text ->
  OrgElementData
latexEnvironment :: Text -> Text -> OrgElementData
latexEnvironment = Text -> Text -> OrgElementData
LaTeXEnvironment

listItemUnord :: Char -> OrgElements -> ListItem
listItemUnord :: Char -> OrgElements -> ListItem
listItemUnord Char
s = Bullet
-> Maybe Int
-> Maybe Checkbox
-> [OrgObject]
-> [OrgElement]
-> ListItem
ListItem (Char -> Bullet
Bullet Char
s) forall a. Maybe a
Nothing forall a. Maybe a
Nothing [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

list ::
  ListType ->
  [ListItem] ->
  OrgElementData
list :: ListType -> [ListItem] -> OrgElementData
list = ListType -> [ListItem] -> OrgElementData
PlainList

orderedList ::
  OrderedStyle ->
  Char ->
  [OrgElements] ->
  OrgElementData
orderedList :: OrderedStyle -> Char -> [OrgElements] -> OrgElementData
orderedList OrderedStyle
style Char
separator =
  ListType -> [ListItem] -> OrgElementData
PlainList (OrderedStyle -> ListType
Ordered OrderedStyle
style)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Bullet
b -> Bullet
-> Maybe Int
-> Maybe Checkbox
-> [OrgObject]
-> [OrgElement]
-> ListItem
ListItem Bullet
b forall a. Maybe a
Nothing forall a. Maybe a
Nothing [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) [Bullet]
bullets
  where
    bullets :: [Bullet]
bullets = case OrderedStyle
style of
      OrderedStyle
OrderedNum -> [Text -> Char -> Bullet
Counter (forall b a. (Show a, IsString b) => a -> b
show Int
i) Char
separator | Int
i :: Int <- [Int
1 ..]]
      OrderedStyle
OrderedAlpha -> [Text -> Char -> Bullet
Counter (forall x. One x => OneItem x -> x
one Char
a) Char
separator | Char
a <- [Char
'a' ..]]

descriptiveList ::
  [(OrgObjects, OrgElements)] ->
  OrgElementData
descriptiveList :: [(OrgObjects, OrgElements)] -> OrgElementData
descriptiveList =
  ListType -> [ListItem] -> OrgElementData
PlainList ListType
Descriptive
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(OrgObjects
tag, OrgElements
els) -> Bullet
-> Maybe Int
-> Maybe Checkbox
-> [OrgObject]
-> [OrgElement]
-> ListItem
ListItem (Char -> Bullet
Bullet Char
'-') forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgObjects
tag) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgElements
els))

parsedKeyword ::
  OrgObjects ->
  KeywordValue
parsedKeyword :: OrgObjects -> KeywordValue
parsedKeyword = [OrgObject] -> KeywordValue
ParsedKeyword forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

valueKeyword ::
  Text ->
  KeywordValue
valueKeyword :: Text -> KeywordValue
valueKeyword = Text -> KeywordValue
ValueKeyword

attrKeyword ::
  [(Text, Text)] ->
  KeywordValue
attrKeyword :: [(Text, Text)] -> KeywordValue
attrKeyword = [(Text, Text)] -> KeywordValue
BackendKeyword

keyword ::
  Text ->
  KeywordValue ->
  OrgElementData
keyword :: Text -> KeywordValue -> OrgElementData
keyword = Text -> KeywordValue -> OrgElementData
Keyword

clock :: TimestampData -> Maybe Time -> OrgElementData
clock :: TimestampData -> Maybe Time -> OrgElementData
clock = TimestampData -> Maybe Time -> OrgElementData
Clock

footnoteDef :: Text -> OrgElements -> OrgElementData
footnoteDef :: Text -> OrgElements -> OrgElementData
footnoteDef Text
l = Text -> [OrgElement] -> OrgElementData
FootnoteDef Text
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

horizontalRule :: OrgElementData
horizontalRule :: OrgElementData
horizontalRule = OrgElementData
HorizontalRule

table :: [TableRow] -> OrgElementData
table :: [TableRow] -> OrgElementData
table = [TableRow] -> OrgElementData
Table

standardRow :: [OrgObjects] -> TableRow
standardRow :: [OrgObjects] -> TableRow
standardRow = [[OrgObject]] -> TableRow
StandardRow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- * Object builders

plain :: Text -> OrgObjects
plain :: Text -> OrgObjects
plain = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> OrgObject
Plain

italic :: OrgObjects -> OrgObjects
italic :: OrgObjects -> OrgObjects
italic = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OrgObject] -> OrgObject
Italic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

underline :: OrgObjects -> OrgObjects
underline :: OrgObjects -> OrgObjects
underline = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OrgObject] -> OrgObject
Underline forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

bold :: OrgObjects -> OrgObjects
bold :: OrgObjects -> OrgObjects
bold = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OrgObject] -> OrgObject
Bold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

strikethrough :: OrgObjects -> OrgObjects
strikethrough :: OrgObjects -> OrgObjects
strikethrough = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OrgObject] -> OrgObject
Strikethrough forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

superscript :: OrgObjects -> OrgObjects
superscript :: OrgObjects -> OrgObjects
superscript = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OrgObject] -> OrgObject
Superscript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

subscript :: OrgObjects -> OrgObjects
subscript :: OrgObjects -> OrgObjects
subscript = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OrgObject] -> OrgObject
Subscript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

singleQuoted :: OrgObjects -> OrgObjects
singleQuoted :: OrgObjects -> OrgObjects
singleQuoted = QuoteType -> OrgObjects -> OrgObjects
quoted QuoteType
SingleQuote

doubleQuoted :: OrgObjects -> OrgObjects
doubleQuoted :: OrgObjects -> OrgObjects
doubleQuoted = QuoteType -> OrgObjects -> OrgObjects
quoted QuoteType
DoubleQuote

quoted :: QuoteType -> OrgObjects -> OrgObjects
quoted :: QuoteType -> OrgObjects -> OrgObjects
quoted QuoteType
qt = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteType -> [OrgObject] -> OrgObject
Quoted QuoteType
qt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

citation :: Citation -> OrgObjects
citation :: Citation -> OrgObjects
citation = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> OrgObject
Cite

citation' :: Text -> Text -> OrgObjects -> OrgObjects -> [CiteReference] -> OrgObjects
citation' :: Text
-> Text
-> OrgObjects
-> OrgObjects
-> [CiteReference]
-> OrgObjects
citation' Text
style Text
variant OrgObjects
prefix OrgObjects
suffix = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> OrgObject
Cite forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Text
-> [OrgObject]
-> [OrgObject]
-> [CiteReference]
-> Citation
Citation Text
style Text
variant (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgObjects
prefix) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgObjects
suffix)

timestamp :: TimestampData -> OrgObjects
timestamp :: TimestampData -> OrgObjects
timestamp = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimestampData -> OrgObject
Timestamp

-- | Plain inline code.
code :: Text -> OrgObjects
code :: Text -> OrgObjects
code = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> OrgObject
Code

-- | Inline verbatim.
verbatim :: Text -> OrgObjects
verbatim :: Text -> OrgObjects
verbatim = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> OrgObject
Verbatim

linebreak :: OrgObjects
linebreak :: OrgObjects
linebreak = forall x. One x => OneItem x -> x
one OrgObject
LineBreak

entity :: Text -> OrgObjects
entity :: Text -> OrgObjects
entity = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> OrgObject
Entity

fragment :: Text -> OrgObjects
fragment :: Text -> OrgObjects
fragment = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragmentType -> Text -> OrgObject
LaTeXFragment FragmentType
RawFragment

inlMath :: Text -> OrgObjects
inlMath :: Text -> OrgObjects
inlMath = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragmentType -> Text -> OrgObject
LaTeXFragment FragmentType
InlMathFragment

dispMath :: Text -> OrgObjects
dispMath :: Text -> OrgObjects
dispMath = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragmentType -> Text -> OrgObject
LaTeXFragment FragmentType
DispMathFragment

exportSnippet :: Text -> Text -> OrgObjects
exportSnippet :: Text -> Text -> OrgObjects
exportSnippet Text
backend = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> OrgObject
ExportSnippet Text
backend

inlBabel :: Text -> Text -> Text -> Text -> OrgObjects
inlBabel :: Text -> Text -> Text -> Text -> OrgObjects
inlBabel Text
name Text
h1 Text
h2 Text
args = forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ BabelCall -> OrgObject
InlBabelCall (Text -> Text -> Text -> Text -> BabelCall
BabelCall Text
name Text
h1 Text
h2 Text
args)

macro :: Text -> [Text] -> OrgObjects
macro :: Text -> [Text] -> OrgObjects
macro = (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> OrgObject
Macro

inlSrc :: Text -> Text -> Text -> OrgObjects
inlSrc :: Text -> Text -> Text -> OrgObjects
inlSrc Text
name Text
headers = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> OrgObject
Src Text
name Text
headers

link :: LinkTarget -> OrgObjects -> OrgObjects
link :: LinkTarget -> OrgObjects -> OrgObjects
link LinkTarget
tgt = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkTarget -> [OrgObject] -> OrgObject
Link LinkTarget
tgt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

uriLink :: Text -> Text -> OrgObjects -> OrgObjects
uriLink :: Text -> Text -> OrgObjects -> OrgObjects
uriLink Text
protocol Text
tgt = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkTarget -> [OrgObject] -> OrgObject
Link (Text -> Text -> LinkTarget
URILink Text
protocol Text
tgt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

target :: Id -> Text -> OrgObjects
target :: Text -> Text -> OrgObjects
target Text
a = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> OrgObject
Target Text
a

footnoteLabel :: Text -> OrgObjects
footnoteLabel :: Text -> OrgObjects
footnoteLabel = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. FootnoteRefData -> OrgObject
FootnoteRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FootnoteRefData
FootnoteRefLabel

footnoteInlDef :: Maybe Text -> OrgObjects -> OrgObjects
footnoteInlDef :: Maybe Text -> OrgObjects -> OrgObjects
footnoteInlDef Maybe Text
l = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. FootnoteRefData -> OrgObject
FootnoteRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> [OrgObject] -> FootnoteRefData
FootnoteRefDef Maybe Text
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

statisticCookie :: Either (Int, Int) Int -> OrgObjects
statisticCookie :: Either Time Int -> OrgObjects
statisticCookie = forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Time Int -> OrgObject
StatisticCookie