{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{- |
   Module      : Text.Pandoc.Writers.Org
   Copyright   : © 2010-2015 Puneeth Chaganti <punchagan@gmail.com>
                   2010-2022 John MacFarlane <jgm@berkeley.edu>
                   2016-2022 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to Emacs Org-Mode.

Org-Mode:  <http://orgmode.org>
-}
module Text.Pandoc.Writers.Org (writeOrg) where
import Control.Monad.State.Strict
import Data.Char (isAlphaNum, isDigit)
import Data.List (intersect, intersperse, partition, transpose)
import Data.List.NonEmpty (nonEmpty)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Map as M
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Citeproc.Locator (parseLocator, LocatorMap(..), LocatorInfo(..))
import Text.Pandoc.Writers.Shared

data WriterState =
  WriterState { WriterState -> [[Block]]
stNotes   :: [[Block]]
              , WriterState -> Bool
stHasMath :: Bool
              , WriterState -> WriterOptions
stOptions :: WriterOptions
              }

type Org = StateT WriterState

-- | Convert Pandoc to Org.
writeOrg :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeOrg :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeOrg WriterOptions
opts Pandoc
document = do
  let st :: WriterState
st = WriterState { stNotes :: [[Block]]
stNotes = [],
                         stHasMath :: Bool
stHasMath = Bool
False,
                         stOptions :: WriterOptions
stOptions = WriterOptions
opts }
  forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *). PandocMonad m => Pandoc -> Org m Text
pandocToOrg Pandoc
document) WriterState
st

-- | Return Org representation of document.
pandocToOrg :: PandocMonad m => Pandoc -> Org m Text
pandocToOrg :: forall (m :: * -> *). PandocMonad m => Pandoc -> Org m Text
pandocToOrg (Pandoc Meta
meta [Block]
blocks) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else forall a. Maybe a
Nothing
  Context Text
metadata <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
               forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg
               (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg)
               Meta
meta
  Doc Text
body <- forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
blocks
  Doc Text
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [[Block]]
stNotes) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> Org m (Doc Text)
notesToOrg
  Bool
hasMath <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasMath
  let main :: Doc Text
main = Doc Text
body forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
notes
  let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"math" Bool
hasMath
              forall a b. (a -> b) -> a -> b
$ Context Text
metadata
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Maybe (Template Text)
Nothing  -> Doc Text
main
       Just Template Text
tpl -> forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

-- | Return Org representation of notes.
notesToOrg :: PandocMonad m => [[Block]] -> Org m (Doc Text)
notesToOrg :: forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> Org m (Doc Text)
notesToOrg [[Block]]
notes =
  forall a. [Doc a] -> Doc a
vsep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> Org m (Doc Text)
noteToOrg [Int
1..] [[Block]]
notes

-- | Return Org representation of a note.
noteToOrg :: PandocMonad m => Int -> [Block] -> Org m (Doc Text)
noteToOrg :: forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> Org m (Doc Text)
noteToOrg Int
num [Block]
note = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
note
  let marker :: [Char]
marker = [Char]
"[fn:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
num forall a. [a] -> [a] -> [a]
++ [Char]
"] "
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
marker) (forall a. HasChars a => [Char] -> Doc a
text [Char]
marker) Doc Text
contents

-- | Escape special characters for Org.
escapeString :: Text -> Text
escapeString :: Text -> Text
escapeString Text
t
  | (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char
c forall a. Ord a => a -> a -> Bool
< Char
'\x2013' Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> a -> Bool
> Char
'\x2026') Text
t = Text
t
  | Bool
otherwise = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escChar Text
t
  where
   escChar :: Char -> Text
escChar Char
'\x2013' = Text
"--"
   escChar Char
'\x2014' = Text
"---"
   escChar Char
'\x2019' = Text
"'"
   escChar Char
'\x2026' = Text
"..."
   escChar Char
c        = Char -> Text
T.singleton Char
c

isRawFormat :: Format -> Bool
isRawFormat :: Format -> Bool
isRawFormat Format
f =
  Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" Bool -> Bool -> Bool
|| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex" Bool -> Bool -> Bool
|| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"org"

-- | Convert Pandoc block element to Org.
blockToOrg :: PandocMonad m
           => Block         -- ^ Block element
           -> Org m (Doc Text)
blockToOrg :: forall (m :: * -> *). PandocMonad m => Block -> Org m (Doc Text)
blockToOrg Block
Null = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToOrg (Div attr :: Attr
attr@(Text
ident,[Text]
_,[(Text, Text)]
_) [Block]
bs) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  -- Strip off bibliography if citations enabled
  if Text
ident forall a. Eq a => a -> a -> Bool
== Text
"refs" Bool -> Bool -> Bool
&& forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
     else forall (m :: * -> *).
PandocMonad m =>
Attr -> [Block] -> Org m (Doc Text)
divToOrg Attr
attr [Block]
bs
blockToOrg (Plain [Inline]
inlines) = forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
inlines
blockToOrg (SimpleFigure Attr
attr [Inline]
txt (Text
src, Text
tit)) = do
      Doc Text
capt <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
              then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
              else (Doc Text
"#+caption: " forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
txt
      Doc Text
img <- forall (m :: * -> *). PandocMonad m => Inline -> Org m (Doc Text)
inlineToOrg (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
txt (Text
src,Text
tit))
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
capt forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
img forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToOrg (Para [Inline]
inlines) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
inlines
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToOrg (LineBlock [[Inline]]
lns) = do
  let splitStanza :: [a] -> [[a]]
splitStanza [] = []
      splitStanza [a]
xs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty) [a]
xs of
        ([a]
l, [])  -> [[a]
l]
        ([a]
l, a
_:[a]
r) -> [a]
l forall a. a -> [a] -> [a]
: [a] -> [[a]]
splitStanza [a]
r
  let joinWithLinefeeds :: [Doc Text] -> Doc Text
joinWithLinefeeds  = forall a. IsString a => Doc a -> Doc a
nowrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse forall a. Doc a
cr
  let joinWithBlankLines :: [Doc a] -> Doc a
joinWithBlankLines = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse forall a. Doc a
blankline
  let prettifyStanza :: [[Inline]] -> StateT WriterState m (Doc Text)
prettifyStanza [[Inline]]
ls  = [Doc Text] -> Doc Text
joinWithLinefeeds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [[Inline]]
ls
  Doc Text
contents <- forall a. [Doc a] -> Doc a
joinWithBlankLines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
PandocMonad m =>
[[Inline]] -> StateT WriterState m (Doc Text)
prettifyStanza (forall {a}. (Eq a, Monoid a) => [a] -> [[a]]
splitStanza [[Inline]]
lns)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_verse" forall a. Doc a -> Doc a -> Doc a
$$
           forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_verse" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
blankline
blockToOrg (RawBlock Format
"html" Text
str) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_html" forall a. Doc a -> Doc a -> Doc a
$$
           forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (forall a. HasChars a => a -> Doc a
literal Text
str) forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_html" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToOrg b :: Block
b@(RawBlock Format
f Text
str)
  | Format -> Bool
isRawFormat Format
f = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise     = do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToOrg Block
HorizontalRule = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"--------------" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToOrg (Header Int
level Attr
attr [Inline]
inlines) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
inlines
  let headerStr :: Doc Text
headerStr = forall a. HasChars a => [Char] -> Doc a
text forall a b. (a -> b) -> a -> b
$ if Int
level forall a. Ord a => a -> a -> Bool
> Int
999 then [Char]
" " else forall a. Int -> a -> [a]
replicate Int
level Char
'*'
  let drawerStr :: Doc Text
drawerStr = if Attr
attr forall a. Eq a => a -> a -> Bool
== Attr
nullAttr
                  then forall a. Doc a
empty
                  else forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Attr -> Doc Text
propertiesDrawer Attr
attr
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
headerStr forall a. Semigroup a => a -> a -> a
<> Doc Text
" " forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
drawerStr forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
blockToOrg (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
kvs) Text
str) = do
  let startnum :: Text
startnum = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
x -> Text
" " forall a. Semigroup a => a -> a -> a
<> Text -> Text
trimr Text
x) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"startFrom" [(Text, Text)]
kvs
  let numberlines :: Text
numberlines = if Text
"numberLines" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                      then if Text
"continuedSourceBlock" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                             then Text
" +n" forall a. Semigroup a => a -> a -> a
<> Text
startnum
                             else Text
" -n" forall a. Semigroup a => a -> a -> a
<> Text
startnum
                      else Text
""
  let at :: [Text]
at = forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
pandocLangToOrg [Text]
classes forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Text]
orgLangIdentifiers
  let (Text
beg, [Char]
end) = case [Text]
at of
                      []    -> (Text
"#+begin_example" forall a. Semigroup a => a -> a -> a
<> Text
numberlines, [Char]
"#+end_example")
                      (Text
x:[Text]
_) -> (Text
"#+begin_src " forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
numberlines, [Char]
"#+end_src")
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
beg forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => a -> Doc a
literal Text
str forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => [Char] -> Doc a
text [Char]
end forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToOrg (BlockQuote [Block]
blocks) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
blocks
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_quote" forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_quote" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToOrg (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =  do
  let ([Inline]
caption', [Alignment]
_, [Double]
_, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
  Doc Text
caption'' <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
caption'
  let caption :: Doc Text
caption = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption'
                   then forall a. Doc a
empty
                   else Doc Text
"#+caption: " forall a. Semigroup a => a -> a -> a
<> Doc Text
caption''
  [Doc Text]
headers' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [[Block]]
headers
  [[Doc Text]]
rawRows <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg) [[[Block]]]
rows
  let numChars :: [Doc Text] -> Int
numChars = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (IsString a, HasChars a) => Doc a -> Int
offset
  -- FIXME: width is not being used.
  let widthsInChars :: [Int]
widthsInChars =
       forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Int
numChars forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose ([Doc Text]
headers' forall a. a -> [a] -> [a]
: [[Doc Text]]
rawRows)
  -- FIXME: Org doesn't allow blocks with height more than 1.
  let hpipeBlocks :: [Doc a] -> Doc a
hpipeBlocks [Doc a]
blocks = forall a. [Doc a] -> Doc a
hcat [Doc a
beg, Doc a
middle, Doc a
end]
        where sep' :: Doc a
sep'   = forall a. HasChars a => a -> Doc a
vfill a
" | "
              beg :: Doc a
beg    = forall a. HasChars a => a -> Doc a
vfill a
"| "
              end :: Doc a
end    = forall a. HasChars a => a -> Doc a
vfill a
" |"
              middle :: Doc a
middle = forall a. [Doc a] -> Doc a
hcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Doc a
sep' [Doc a]
blocks
  let makeRow :: [Doc Text] -> Doc Text
makeRow = forall {a}. HasChars a => [Doc a] -> Doc a
hpipeBlocks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. HasChars a => Int -> Doc a -> Doc a
lblock [Int]
widthsInChars
  let head' :: Doc Text
head' = [Doc Text] -> Doc Text
makeRow [Doc Text]
headers'
  [Doc Text]
rows' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[[Block]]
row -> do [Doc Text]
cols <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [[Block]]
row
                            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
makeRow [Doc Text]
cols) [[[Block]]]
rows
  let border :: Char -> Doc a
border Char
ch = forall a. HasChars a => Char -> Doc a
char Char
'|' forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
ch forall a. Semigroup a => a -> a -> a
<>
                  (forall a. [Doc a] -> Doc a
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (forall a. HasChars a => Char -> Doc a
char Char
ch forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'+' forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
ch) forall a b. (a -> b) -> a -> b
$
                          forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> forall a. HasChars a => [Char] -> Doc a
text forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
l Char
ch) [Int]
widthsInChars) forall a. Semigroup a => a -> a -> a
<>
                  forall a. HasChars a => Char -> Doc a
char Char
ch forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'|'
  let body :: Doc Text
body = forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows'
  let head'' :: Doc Text
head'' = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
                  then forall a. Doc a
empty
                  else Doc Text
head' forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => Char -> Doc a
border Char
'-'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
head'' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
blockToOrg (BulletList [[Block]]
items) = do
  [Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
bulletListItemToOrg [[Block]]
items
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if [[Block]] -> Bool
isTightList [[Block]]
items then forall a. [Doc a] -> Doc a
vcat else forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents forall a. Doc a -> Doc a -> Doc a
$$
           forall a. Doc a
blankline
blockToOrg (OrderedList (Int
start, ListNumberStyle
_, ListNumberDelim
delim) [[Block]]
items) = do
  let delim' :: ListNumberDelim
delim' = case ListNumberDelim
delim of
                    ListNumberDelim
TwoParens -> ListNumberDelim
OneParen
                    ListNumberDelim
x         -> ListNumberDelim
x
  let markers :: [Text]
markers = forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items) forall a b. (a -> b) -> a -> b
$ (Int, ListNumberStyle, ListNumberDelim) -> [Text]
orderedListMarkers
                                      (Int
start, ListNumberStyle
Decimal, ListNumberDelim
delim')
      counters :: [Maybe Int]
counters = (case Int
start of Int
1 -> forall a. Maybe a
Nothing; Int
n -> forall a. a -> Maybe a
Just Int
n) forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat forall a. Maybe a
Nothing
  [Doc Text]
contents <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\[Block]
x [Block] -> Org m (Doc Text)
f -> [Block] -> Org m (Doc Text)
f [Block]
x) [[Block]]
items forall a b. (a -> b) -> a -> b
$
              forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall (m :: * -> *).
PandocMonad m =>
Text -> Maybe Int -> [Block] -> Org m (Doc Text)
orderedListItemToOrg [Text]
markers [Maybe Int]
counters
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if [[Block]] -> Bool
isTightList [[Block]]
items then forall a. [Doc a] -> Doc a
vcat else forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents forall a. Doc a -> Doc a -> Doc a
$$
           forall a. Doc a
blankline
blockToOrg (DefinitionList [([Inline], [[Block]])]
items) = do
  [Doc Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> Org m (Doc Text)
definitionListItemToOrg [([Inline], [[Block]])]
items
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline

-- | Convert bullet list item (list of blocks) to Org.
bulletListItemToOrg :: PandocMonad m => [Block] -> Org m (Doc Text)
bulletListItemToOrg :: forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
bulletListItemToOrg [Block]
items = do
  Extensions
exts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ WriterOptions -> Extensions
writerExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg (Extensions -> [Block] -> [Block]
taskListItemToOrg Extensions
exts [Block]
items)
  -- if list item starts with non-paragraph, it must go on
  -- the next line:
  let contents' :: Doc Text
contents' = (case [Block]
items of
                    Plain{}:[Block]
_ -> forall a. Monoid a => a
mempty
                    Para{}:[Block]
_ -> forall a. Monoid a => a
mempty
                    [Block]
_ -> forall a. Doc a
cr) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a -> Doc a
chomp Doc Text
contents
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"- " Doc Text
contents' forall a. Doc a -> Doc a -> Doc a
$$
          if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| [Block] -> Bool
endsWithPlain [Block]
items
             then forall a. Doc a
cr
             else forall a. Doc a
blankline

-- | Convert ordered list item (a list of blocks) to Org.
orderedListItemToOrg :: PandocMonad m
                     => Text   -- ^ marker for list item
                     -> Maybe Int -- ^ maybe number for a counter cookie
                     -> [Block]  -- ^ list item (list of blocks)
                     -> Org m (Doc Text)
orderedListItemToOrg :: forall (m :: * -> *).
PandocMonad m =>
Text -> Maybe Int -> [Block] -> Org m (Doc Text)
orderedListItemToOrg Text
marker Maybe Int
counter [Block]
items = do
  Extensions
exts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ WriterOptions -> Extensions
writerExtensions forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg (Extensions -> [Block] -> [Block]
taskListItemToOrg Extensions
exts [Block]
items)
  -- if list item starts with non-paragraph, it must go on
  -- the next line:
  let contents' :: Doc Text
contents' = (case [Block]
items of
                    Plain{}:[Block]
_ -> forall a. Monoid a => a
mempty
                    Para{}:[Block]
_ -> forall a. Monoid a => a
mempty
                    [Block]
_ -> forall a. Doc a
cr) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a -> Doc a
chomp Doc Text
contents
  let cookie :: Doc Text
cookie = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Doc a
empty
               (\Int
n -> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"[@" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (forall a. Show a => a -> Text
tshow Int
n) forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"]")
               Maybe Int
counter
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Text -> Int
T.length Text
marker forall a. Num a => a -> a -> a
+ Int
1)
                (forall a. HasChars a => a -> Doc a
literal Text
marker forall a. Semigroup a => a -> a -> a
<> Doc Text
cookie forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space) Doc Text
contents' forall a. Doc a -> Doc a -> Doc a
$$
          if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| [Block] -> Bool
endsWithPlain [Block]
items
             then forall a. Doc a
cr
             else forall a. Doc a
blankline

-- | Convert a list item containing text starting with @U+2610 BALLOT BOX@
-- or @U+2612 BALLOT BOX WITH X@ to org checkbox syntax (e.g. @[X]@).
taskListItemToOrg :: Extensions -> [Block] -> [Block]
taskListItemToOrg :: Extensions -> [Block] -> [Block]
taskListItemToOrg = ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
handleTaskListItem [Inline] -> [Inline]
toOrg
  where
    toOrg :: [Inline] -> [Inline]
toOrg (Str Text
"☐" : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"[ ]" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    toOrg (Str Text
"☒" : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"[X]" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    toOrg [Inline]
is = [Inline]
is

-- | Convert definition list item (label, list of blocks) to Org.
definitionListItemToOrg :: PandocMonad m
                        => ([Inline], [[Block]]) -> Org m (Doc Text)
definitionListItemToOrg :: forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> Org m (Doc Text)
definitionListItemToOrg ([Inline]
label, [[Block]]
defs) = do
  Doc Text
label' <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
label
  Doc Text
contents <- forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [[Block]]
defs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"- " (Doc Text
label' forall a. Semigroup a => a -> a -> a
<> Doc Text
" :: " forall a. Semigroup a => a -> a -> a
<> Doc Text
contents) forall a. Doc a -> Doc a -> Doc a
$$
      if [[Block]] -> Bool
isTightList [[Block]]
defs
         then forall a. Doc a
cr
         else forall a. Doc a
blankline

-- | Convert list of key/value pairs to Org :PROPERTIES: drawer.
propertiesDrawer :: Attr -> Doc Text
propertiesDrawer :: Attr -> Doc Text
propertiesDrawer (Text
ident, [Text]
classes, [(Text, Text)]
kv) =
  let
    drawerStart :: Doc Text
drawerStart = forall a. HasChars a => [Char] -> Doc a
text [Char]
":PROPERTIES:"
    drawerEnd :: Doc Text
drawerEnd   = forall a. HasChars a => [Char] -> Doc a
text [Char]
":END:"
    kv' :: [(Text, Text)]
kv'  = if [Text]
classes forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty then [(Text, Text)]
kv  else (Text
"CLASS", [Text] -> Text
T.unwords [Text]
classes)forall a. a -> [a] -> [a]
:[(Text, Text)]
kv
    kv'' :: [(Text, Text)]
kv'' = if Text
ident forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty   then [(Text, Text)]
kv' else (Text
"CUSTOM_ID", Text
ident)forall a. a -> [a] -> [a]
:[(Text, Text)]
kv'
    properties :: Doc Text
properties = forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Doc Text
kvToOrgProperty [(Text, Text)]
kv''
  in
    Doc Text
drawerStart forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
properties forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
drawerEnd
 where
   kvToOrgProperty :: (Text, Text) -> Doc Text
   kvToOrgProperty :: (Text, Text) -> Doc Text
kvToOrgProperty (Text
key, Text
value) =
     forall a. HasChars a => [Char] -> Doc a
text [Char]
":" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
key forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => [Char] -> Doc a
text [Char]
": " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
value forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr

-- | The different methods to represent a Div block.
data DivBlockType
  = GreaterBlock Text Attr   -- ^ Greater block like @center@ or @quote@.
  | Drawer Text Attr         -- ^ Org drawer with of given name; keeps
                             --   key-value pairs.
  | UnwrappedWithAnchor Text -- ^ Not mapped to other type, only
                             --   identifier is retained (if any).

-- | Gives the most suitable method to render a list of blocks
-- with attributes.
divBlockType :: Attr-> DivBlockType
divBlockType :: Attr -> DivBlockType
divBlockType (Text
ident, [Text]
classes, [(Text, Text)]
kvs)
  -- if any class is named "drawer", then output as org :drawer:
  | ([Text
_], Text
drawerName:[Text]
classes') <- forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Eq a => a -> a -> Bool
== Text
"drawer") [Text]
classes
  = Text -> Attr -> DivBlockType
Drawer Text
drawerName (Text
ident, [Text]
classes', [(Text, Text)]
kvs)
  -- if any class is either @center@ or @quote@, then use a org block.
  | (Text
blockName:[Text]
classes'', [Text]
classes') <- forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Text -> Bool
isGreaterBlockClass [Text]
classes
  = Text -> Attr -> DivBlockType
GreaterBlock Text
blockName (Text
ident, [Text]
classes' forall a. Semigroup a => a -> a -> a
<> [Text]
classes'', [(Text, Text)]
kvs)
  -- if no better method is found, unwrap div and set anchor
  | Bool
otherwise
  = Text -> DivBlockType
UnwrappedWithAnchor Text
ident
 where
  isGreaterBlockClass :: Text -> Bool
  isGreaterBlockClass :: Text -> Bool
isGreaterBlockClass = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"center", Text
"quote"]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower

-- | Converts a Div to an org-mode element.
divToOrg :: PandocMonad m
         => Attr -> [Block] -> Org m (Doc Text)
divToOrg :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Block] -> Org m (Doc Text)
divToOrg Attr
attr [Block]
bs = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
bs
  case Attr -> DivBlockType
divBlockType Attr
attr of
    GreaterBlock Text
blockName Attr
attr' ->
      -- Write as greater block. The ID, if present, is added via
      -- the #+name keyword; other classes and key-value pairs
      -- are kept as #+attr_html attributes.
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ Attr -> Doc Text
attrHtml Attr
attr'
            forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
blockName
            forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
            forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
blockName forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
    Drawer Text
drawerName (Text
_,[Text]
_,[(Text, Text)]
kvs) -> do
      -- Write as drawer. Only key-value pairs are retained.
      let keys :: Doc Text
keys = forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) ->
                               Doc Text
":" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
k forall a. Semigroup a => a -> a -> a
<> Doc Text
":"
                              forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
space forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
v) [(Text, Text)]
kvs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
":" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
drawerName forall a. Semigroup a => a -> a -> a
<> Doc Text
":" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
cr
            forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
keys forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
            forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
            forall a. Doc a -> Doc a -> Doc a
$$ forall a. HasChars a => [Char] -> Doc a
text [Char]
":END:" forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline
    UnwrappedWithAnchor Text
ident -> do
      -- Unwrap the div. All attributes are discarded, except for
      -- the identifier, which is added as an anchor before the
      -- div contents.
      let contents' :: Doc Text
contents' = if Text -> Bool
T.null Text
ident
                      then Doc Text
contents
                      else  Doc Text
"<<" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
ident forall a. Semigroup a => a -> a -> a
<> Doc Text
">>" forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Doc a
blankline forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents' forall a. Doc a -> Doc a -> Doc a
$$ forall a. Doc a
blankline)

attrHtml :: Attr -> Doc Text
attrHtml :: Attr -> Doc Text
attrHtml (Text
""   , []     , []) = forall a. Monoid a => a
mempty
attrHtml (Text
ident, [Text]
classes, [(Text, Text)]
kvs) =
  let
    name :: Doc Text
name = if Text -> Bool
T.null Text
ident then forall a. Monoid a => a
mempty else Doc Text
"#+name: " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
ident forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
    keyword :: Doc Text
keyword = Doc Text
"#+attr_html"
    classKv :: (Text, Text)
classKv = (Text
"class", [Text] -> Text
T.unwords [Text]
classes)
    kvStrings :: [Text]
kvStrings = forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) -> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
k forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
v) ((Text, Text)
classKvforall a. a -> [a] -> [a]
:[(Text, Text)]
kvs)
  in Doc Text
name forall a. Semigroup a => a -> a -> a
<> Doc Text
keyword forall a. Semigroup a => a -> a -> a
<> Doc Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
kvStrings) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr

-- | Convert list of Pandoc block elements to Org.
blockListToOrg :: PandocMonad m
               => [Block]       -- ^ List of block elements
               -> Org m (Doc Text)
blockListToOrg :: forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
blocks = forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Block -> Org m (Doc Text)
blockToOrg [Block]
blocks

-- | Convert list of Pandoc inline elements to Org.
inlineListToOrg :: PandocMonad m
                => [Inline]
                -> Org m (Doc Text)
inlineListToOrg :: forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst = forall a. [Doc a] -> Doc a
hcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Inline -> Org m (Doc Text)
inlineToOrg ([Inline] -> [Inline]
fixMarkers [Inline]
lst)
  where -- Prevent note refs and list markers from wrapping, see #4171
        -- and #7132.
        fixMarkers :: [Inline] -> [Inline]
fixMarkers [] = []
        fixMarkers (Inline
Space : Inline
x : [Inline]
rest) | Inline -> Bool
shouldFix Inline
x =
          Text -> Inline
Str Text
" " forall a. a -> [a] -> [a]
: Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixMarkers [Inline]
rest
        fixMarkers (Inline
SoftBreak : Inline
x : [Inline]
rest) | Inline -> Bool
shouldFix Inline
x =
          Text -> Inline
Str Text
" " forall a. a -> [a] -> [a]
: Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixMarkers [Inline]
rest
        fixMarkers (Inline
x : [Inline]
rest) = Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixMarkers [Inline]
rest

        shouldFix :: Inline -> Bool
shouldFix Note{} = Bool
True    -- Prevent footnotes
        shouldFix (Str Text
"-") = Bool
True -- Prevent bullet list items
        shouldFix (Str Text
x)          -- Prevent ordered list items
          | Just (Text
cs, Char
c) <- Text -> Maybe (Text, Char)
T.unsnoc Text
x = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
cs Bool -> Bool -> Bool
&&
                                         (Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
')')
        shouldFix Inline
_ = Bool
False

-- | Convert Pandoc inline element to Org.
inlineToOrg :: PandocMonad m => Inline -> Org m (Doc Text)
inlineToOrg :: forall (m :: * -> *). PandocMonad m => Inline -> Org m (Doc Text)
inlineToOrg (Span (Text
uid, [], []) []) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"<<" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
uid forall a. Semigroup a => a -> a -> a
<> Doc Text
">>"
inlineToOrg (Span Attr
_ [Inline]
lst) =
  forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Emph [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"/" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"/"
inlineToOrg (Underline [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"_" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"_"
inlineToOrg (Strong [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"*" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"*"
inlineToOrg (Strikeout [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"+" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"+"
inlineToOrg (Superscript [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"^{" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"}"
inlineToOrg (Subscript [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"_{" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"}"
inlineToOrg (SmallCaps [Inline]
lst) = forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"'" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"'"
inlineToOrg (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"\"" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
inlineToOrg (Cite [Citation]
cs [Inline]
lst) = do
  WriterOptions
opts <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts
     then do
       let renderCiteItem :: Citation -> StateT WriterState m (Doc Text)
renderCiteItem Citation
c = do
             Doc Text
citePref <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg (Citation -> [Inline]
citationPrefix Citation
c)
             let (Maybe LocatorInfo
locinfo, [Inline]
suffix) = LocatorMap -> [Inline] -> (Maybe LocatorInfo, [Inline])
parseLocator LocatorMap
locmap (Citation -> [Inline]
citationSuffix Citation
c)
             Doc Text
citeSuff <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
suffix
             let locator :: Doc Text
locator = case Maybe LocatorInfo
locinfo of
                            Just LocatorInfo
info -> forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$
                              Text -> Text -> Text -> Text
T.replace Text
"\160" Text
" " forall a b. (a -> b) -> a -> b
$
                              Text -> Text -> Text -> Text
T.replace Text
"{" Text
"" forall a b. (a -> b) -> a -> b
$
                              Text -> Text -> Text -> Text
T.replace Text
"}" Text
"" forall a b. (a -> b) -> a -> b
$ LocatorInfo -> Text
locatorRaw LocatorInfo
info
                            Maybe LocatorInfo
Nothing -> forall a. Monoid a => a
mempty
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
hsep [ Doc Text
citePref
                           , (Doc Text
"@" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (Citation -> Text
citationId Citation
c))
                           , Doc Text
locator
                           , Doc Text
citeSuff ]
       Doc Text
citeItems <- forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Doc Text
"; " forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
PandocMonad m =>
Citation -> StateT WriterState m (Doc Text)
renderCiteItem [Citation]
cs
       let sty :: Doc Text
sty = case [Citation]
cs of
                   (Citation
d:[Citation]
_)
                     | Citation -> CitationMode
citationMode Citation
d forall a. Eq a => a -> a -> Bool
== CitationMode
AuthorInText
                     -> forall a. HasChars a => a -> Doc a
literal Text
"/t"
                   [Citation
d]
                     | Citation -> CitationMode
citationMode Citation
d forall a. Eq a => a -> a -> Bool
== CitationMode
SuppressAuthor
                     -> forall a. HasChars a => a -> Doc a
literal Text
"/na"
                   [Citation]
_ -> forall a. Monoid a => a
mempty
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[cite" forall a. Semigroup a => a -> a -> a
<> Doc Text
sty forall a. Semigroup a => a -> a -> a
<> Doc Text
":" forall a. Semigroup a => a -> a -> a
<> Doc Text
citeItems forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
     else forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Code Attr
_ Text
str) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"=" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> Doc Text
"="
inlineToOrg (Str Text
str) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeString Text
str
inlineToOrg (Math MathType
t Text
str) = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasMath :: Bool
stHasMath = Bool
True }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if MathType
t forall a. Eq a => a -> a -> Bool
== MathType
InlineMath
              then Doc Text
"\\(" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\)"
              else Doc Text
"\\[" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\]"
inlineToOrg il :: Inline
il@(RawInline Format
f Text
str)
  | forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Format
f [Format
"tex", Format
"latex"] Bool -> Bool -> Bool
&& Text -> Text -> Bool
T.isPrefixOf Text
"\\begin" Text
str =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr
  | Format -> Bool
isRawFormat Format
f = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise     = do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
inlineToOrg Inline
LineBreak = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. HasChars a => [Char] -> Doc a
text [Char]
"\\\\" forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr)
inlineToOrg Inline
Space = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
inlineToOrg Inline
SoftBreak = do
  WrapOption
wrapText <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WriterOptions -> WrapOption
writerWrapText forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions)
  case WrapOption
wrapText of
       WrapOption
WrapPreserve -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
cr
       WrapOption
WrapAuto     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
       WrapOption
WrapNone     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
inlineToOrg (Link Attr
_ [Inline]
txt (Text
src, Text
_)) =
  case [Inline]
txt of
        [Str Text
x] | Text -> Text
escapeURI Text
x forall a. Eq a => a -> a -> Bool
== Text
src ->  -- autolink
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (Text -> Text
orgPath Text
x) forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
        [Inline]
_ -> do Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
txt
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (Text -> Text
orgPath Text
src) forall a. Semigroup a => a -> a -> a
<> Doc Text
"][" forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
inlineToOrg (Image Attr
_ [Inline]
_ (Text
source, Text
_)) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal (Text -> Text
orgPath Text
source) forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
inlineToOrg (Note [Block]
contents) = do
  -- add to notes in state
  [[Block]]
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNotes :: [[Block]]
stNotes = [Block]
contentsforall a. a -> [a] -> [a]
:[[Block]]
notes }
  let ref :: Text
ref = forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
notes forall a. Num a => a -> a -> a
+ Int
1
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"[fn:" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
ref forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"

orgPath :: Text -> Text
orgPath :: Text -> Text
orgPath Text
src = case Text -> Maybe (Char, Text)
T.uncons Text
src of
  Maybe (Char, Text)
Nothing            -> Text
""             -- wiki link
  Just (Char
'#', Text
_)      -> Text
src            -- internal link
  Maybe (Char, Text)
_ | Text -> Bool
isUrl Text
src      -> Text
src
  Maybe (Char, Text)
_ | Text -> Bool
isFilePath Text
src -> Text
src
  Maybe (Char, Text)
_                  -> Text
"file:" forall a. Semigroup a => a -> a -> a
<> Text
src
  where
    isFilePath :: Text -> Bool
    isFilePath :: Text -> Bool
isFilePath Text
cs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isPrefixOf` Text
cs) [Text
"/", Text
"./", Text
"../", Text
"file:"]

    isUrl :: Text -> Bool
    isUrl :: Text -> Bool
isUrl Text
cs =
      let (Text
scheme, Text
path) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
':') Text
cs
      in (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Text -> Bool
`elemText` Text
".-") Text
scheme
         Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
path)

-- | Translate from pandoc's programming language identifiers to those used by
-- org-mode.
pandocLangToOrg :: Text -> Text
pandocLangToOrg :: Text -> Text
pandocLangToOrg Text
cs =
  case Text
cs of
    Text
"c"          -> Text
"C"
    Text
"commonlisp" -> Text
"lisp"
    Text
"r"          -> Text
"R"
    Text
"bash"       -> Text
"sh"
    Text
_            -> Text
cs

-- | List of language identifiers recognized by org-mode.
-- See <https://orgmode.org/manual/Languages.html>.
orgLangIdentifiers :: [Text]
orgLangIdentifiers :: [Text]
orgLangIdentifiers =
  [ Text
"asymptote"
  , Text
"lisp"
  , Text
"awk"
  , Text
"lua"
  , Text
"C"
  , Text
"matlab"
  , Text
"C++"
  , Text
"mscgen"
  , Text
"clojure"
  , Text
"ocaml"
  , Text
"css"
  , Text
"octave"
  , Text
"D"
  , Text
"org"
  , Text
"ditaa"
  , Text
"oz"
  , Text
"calc"
  , Text
"perl"
  , Text
"emacs-lisp"
  , Text
"plantuml"
  , Text
"eshell"
  , Text
"processing"
  , Text
"fortran"
  , Text
"python"
  , Text
"gnuplot"
  , Text
"R"
  , Text
"screen"
  , Text
"ruby"
  , Text
"dot"
  , Text
"sass"
  , Text
"haskell"
  , Text
"scheme"
  , Text
"java"
  , Text
"sed"
  , Text
"js"
  , Text
"sh"
  , Text
"latex"
  , Text
"sql"
  , Text
"ledger"
  , Text
"sqlite"
  , Text
"lilypond"
  , Text
"vala" ]

-- taken from oc-csl.el in the org source tree:
locmap :: LocatorMap
locmap :: LocatorMap
locmap = Map Text Text -> LocatorMap
LocatorMap forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"bk."       , Text
"book")
  , (Text
"bks."      , Text
"book")
  , (Text
"book"      , Text
"book")
  , (Text
"chap."     , Text
"chapter")
  , (Text
"chaps."    , Text
"chapter")
  , (Text
"chapter"   , Text
"chapter")
  , (Text
"col."      , Text
"column")
  , (Text
"cols."     , Text
"column")
  , (Text
"column"    , Text
"column")
  , (Text
"figure"    , Text
"figure")
  , (Text
"fig."      , Text
"figure")
  , (Text
"figs."     , Text
"figure")
  , (Text
"folio"     , Text
"folio")
  , (Text
"fol."      , Text
"folio")
  , (Text
"fols."     , Text
"folio")
  , (Text
"number"    , Text
"number")
  , (Text
"no."       , Text
"number")
  , (Text
"nos."      , Text
"number")
  , (Text
"line"      , Text
"line")
  , (Text
"l."        , Text
"line")
  , (Text
"ll."       , Text
"line")
  , (Text
"note"      , Text
"note")
  , (Text
"n."        , Text
"note")
  , (Text
"nn."       , Text
"note")
  , (Text
"opus"      , Text
"opus")
  , (Text
"op."       , Text
"opus")
  , (Text
"opp."      , Text
"opus")
  , (Text
"page"      , Text
"page")
  , (Text
"p"         , Text
"page")
  , (Text
"p."        , Text
"page")
  , (Text
"pp."       , Text
"page")
  , (Text
"paragraph" , Text
"paragraph")
  , (Text
"para."     , Text
"paragraph")
  , (Text
"paras."    , Text
"paragraph")
  , (Text
"¶"         , Text
"paragraph")
  , (Text
"¶¶"        , Text
"paragraph")
  , (Text
"part"      , Text
"part")
  , (Text
"pt."       , Text
"part")
  , (Text
"pts."      , Text
"part")
  , (Text
"§"         , Text
"section")
  , (Text
"§§"        , Text
"section")
  , (Text
"section"   , Text
"section")
  , (Text
"sec."      , Text
"section")
  , (Text
"secs."     , Text
"section")
  , (Text
"sub verbo" , Text
"sub verbo")
  , (Text
"s.v."      , Text
"sub verbo")
  , (Text
"s.vv."     , Text
"sub verbo")
  , (Text
"verse"     , Text
"verse")
  , (Text
"v."        , Text
"verse")
  , (Text
"vv."       , Text
"verse")
  , (Text
"volume"    , Text
"volume")
  , (Text
"vol."      , Text
"volume")
  , (Text
"vols."     , Text
"volume") ]