{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{- |
   Module      : Text.Pandoc.Writers.Org
   Copyright   : © 2010-2015 Puneeth Chaganti <punchagan@gmail.com>
                   2010-2023 John MacFarlane <jgm@berkeley.edu>
                   2016-2023 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 (zipWithM)
import Control.Monad.State.Strict
    ( StateT, gets, modify, evalStateT )
import Data.Char (isAlphaNum, isDigit)
import Data.List (intersperse, partition, dropWhileEnd, transpose)
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Map as M
import Text.DocLayout
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.URI
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Citeproc.Locator (parseLocator, LocatorMap(..), LocatorInfo(..))
import Text.Pandoc.Walk (query)
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 (Div (Text
_, [Text
"cell", Text
"code"], [(Text, Text)]
_) (CodeBlock (Text, [Text], [(Text, Text)])
attr Text
t : [Block]
bs)) = do
  -- ipynb code cell
  let (Text
ident, [Text]
classes, [(Text, Text)]
kvs) = (Text, [Text], [(Text, Text)])
attr
  forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg ((Text, [Text], [(Text, Text)]) -> Text -> Block
CodeBlock (Text
ident, [Text]
classes forall a. [a] -> [a] -> [a]
++ [Text
"code"], [(Text, Text)]
kvs) Text
t forall a. a -> [a] -> [a]
: [Block]
bs)
blockToOrg (Div (Text
_, [Text
"output", Text
"execute_result"], [(Text, Text)]
_) [CodeBlock (Text, [Text], [(Text, Text)])
_attr Text
t]) = do
  -- ipynb code result
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
"#+RESULTS:" forall a. Doc a -> Doc a -> Doc a
$$
    (forall a. IsString a => [Char] -> Doc a -> Doc a
prefixed [Char]
": " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t)
blockToOrg (Div attr :: (Text, [Text], [(Text, Text)])
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 =>
(Text, [Text], [(Text, Text)]) -> [Block] -> Org m (Doc Text)
divToOrg (Text, [Text], [(Text, Text)])
attr [Block]
bs
blockToOrg (Plain [Inline]
inlines) = forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
inlines
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 (Text, [Text], [(Text, Text)])
attr [Inline]
inlines) = do
  let tagName :: Inline -> Maybe [Text]
tagName Inline
inline = case Inline
inline of
        Span (Text
_, [Text]
_, [(Text, Text)]
kv) [Inline]
_ -> (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"tag-name" [(Text, Text)]
kv
        Inline
_                 -> forall a. Maybe a
Nothing
  let ([Inline]
htext, [Inline]
tagsInlines) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Maybe [Text]
tagName) [Inline]
inlines
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Inline
Space) [Inline]
htext
  Int
columns  <- WriterOptions -> Int
writerColumns forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let headerDoc :: Doc Text
headerDoc = forall a. Monoid a => [a] -> a
mconcat
        [ 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
'*'
        , forall a. HasChars a => a -> Doc a
literal Text
" "
        , Doc Text
contents
        ]
  let tags :: Text
tags = case forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Maybe [Text]
tagName [Inline]
tagsInlines of
               Maybe [Text]
Nothing -> Text
""
               Just [Text]
ts -> Char -> Text -> Text
T.cons Char
':' (Text -> [Text] -> Text
T.intercalate Text
":" [Text]
ts) Text -> Char -> Text
`T.snoc` Char
':'
  let tagsDoc :: Doc Text
tagsDoc = if Text -> Bool
T.null Text
tags
                then forall a. Doc a
empty
                else (forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
tags) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => [Char] -> Doc a
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Int -> a -> [a]
`replicate` Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$
                     Int
columns forall a. Num a => a -> a -> a
- forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
headerDoc forall a. Num a => a -> a -> a
- forall a. HasChars a => a -> Int
realLength Text
tags
  let drawerStr :: Doc Text
drawerStr = if (Text, [Text], [(Text, Text)])
attr forall a. Eq a => a -> a -> Bool
== (Text, [Text], [(Text, Text)])
nullAttr
                  then forall a. Doc a
empty
                  else forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> (Text, [Text], [(Text, Text)]) -> Doc Text
propertiesDrawer (Text, [Text], [(Text, Text)])
attr
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text
headerDoc forall a. Semigroup a => a -> a -> a
<> Doc Text
tagsDoc) 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
ident,[Text]
classes,[(Text, Text)]
kvs) Text
str) = do
  let name :: Doc Text
name = if Text -> Bool
T.null Text
ident
             then forall a. Doc a
empty
             else forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text
"#+name: " forall a. Semigroup a => a -> a -> a
<> Text
ident
  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 lang :: Maybe Text
lang = case forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"example",Text
"code"]) [Text]
classes of
        []  -> forall a. Maybe a
Nothing
        Text
l:[Text]
_ -> if Text
"code" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes    -- check for ipynb code cell
               then forall a. a -> Maybe a
Just (Text
"jupyter-" forall a. Semigroup a => a -> a -> a
<> Text -> Text
pandocLangToOrg Text
l)
               else forall a. a -> Maybe a
Just (Text -> Text
pandocLangToOrg Text
l)
  let args :: Text
args = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
             [ 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
k, Text
v) <- [(Text, Text)]
kvs, Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"startFrom", Text
"org-language"]]
  let (Text
beg, Text
end) = case Maybe Text
lang of
        Maybe Text
Nothing -> (Text
"#+begin_example" forall a. Semigroup a => a -> a -> a
<> Text
numberlines, Text
"#+end_example")
        Just Text
x  -> (Text
"#+begin_src " forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
numberlines forall a. Semigroup a => a -> a -> a
<> Text
args, Text
"#+end_src")
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
name forall a. Doc a -> Doc a -> Doc a
$$ 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 => a -> Doc a
literal Text
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 (Text, [Text], [(Text, Text)])
_ 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
blockToOrg (Figure (Text
ident, [Text]
_, [(Text, Text)]
_) Caption
caption [Block]
body) = do
  -- Represent the figure as content that can be internally linked from other
  -- parts of the document.
  Doc Text
capt <- case Caption
caption of
            Caption Maybe [Inline]
_ []  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Doc a
empty
            Caption Maybe [Inline]
_ [Block]
cpt -> (Doc Text
"#+caption: " forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg ([Block] -> [Inline]
blocksToInlines [Block]
cpt)
  Doc Text
contents <-  forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
body
  let anchor :: Doc Text
anchor = if Text -> Bool
T.null Text
ident
               then forall a. Doc a
empty
               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 (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
capt forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
anchor forall a. Doc a -> Doc a -> Doc a
$$ 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 :: (Text, [Text], [(Text, Text)]) -> 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 :: (Text, [Text], [(Text, Text)]) -> 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 -> (Text, [Text], [(Text, Text)]) -> 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 -> (Text, [Text], [(Text, Text)]) -> 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 =>
(Text, [Text], [(Text, Text)]) -> [Block] -> Org m (Doc Text)
divToOrg (Text, [Text], [(Text, Text)])
attr [Block]
bs = do
  Doc Text
contents <- forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
bs
  case (Text, [Text], [(Text, Text)]) -> DivBlockType
divBlockType (Text, [Text], [(Text, Text)])
attr of
    GreaterBlock Text
blockName (Text, [Text], [(Text, Text)])
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
$$ (Text, [Text], [(Text, Text)]) -> Doc Text
attrHtml (Text, [Text], [(Text, Text)])
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 :: (Text, [Text], [(Text, Text)]) -> 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 (Text, [Text], [(Text, Text)])
_ [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 (Text, [Text], [(Text, Text)])
_ 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 (Text, [Text], [(Text, Text)])
_ [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 (Text, [Text], [(Text, Text)])
_ [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 -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
c) 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

-- 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") ]