{-# 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 }
  StateT WriterState m Text -> WriterState -> m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Pandoc -> StateT WriterState m Text
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 <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
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 WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else Maybe Int
forall a. Maybe a
Nothing
  Context Text
metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
               [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg
               ((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg)
               Meta
meta
  Doc Text
body <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
blocks
  Doc Text
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([[Block]] -> [[Block]]
forall a. [a] -> [a]
reverse ([[Block]] -> [[Block]])
-> (WriterState -> [[Block]]) -> WriterState -> [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [[Block]]
stNotes) StateT WriterState m [[Block]]
-> ([[Block]] -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
forall a b.
StateT WriterState m a
-> (a -> StateT WriterState m b) -> StateT WriterState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Block]] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> Org m (Doc Text)
notesToOrg
  Bool
hasMath <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasMath
  let main :: Doc Text
main = Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
notes
  let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"math" Bool
hasMath
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
metadata
  Text -> Org m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Org m Text) -> Text -> Org m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
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 -> Template Text -> Context Text -> Doc Text
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 =
  [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> [Block] -> StateT WriterState m (Doc Text))
-> [Int] -> [[Block]] -> StateT WriterState m [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int -> [Block] -> StateT WriterState m (Doc Text)
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 <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
note
  let marker :: [Char]
marker = [Char]
"[fn:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] "
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
marker) ([Char] -> Doc Text
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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x2013' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
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 Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
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
  [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg ((Text, [Text], [(Text, Text)]) -> Text -> Block
CodeBlock (Text
ident, [Text]
classes [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"code"], [(Text, Text)]
kvs) Text
t Block -> [Block] -> [Block]
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
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"#+RESULTS:" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
    ([Char] -> Doc Text -> Doc Text
forall a. IsString a => [Char] -> Doc a -> Doc a
prefixed [Char]
": " (Doc Text -> Doc Text)
-> ([Text] -> Doc Text) -> [Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ([Text] -> [Doc Text]) -> [Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Doc Text) -> [Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
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 <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  -- Strip off bibliography if citations enabled
  if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"refs" Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts
     then Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
     else (Text, [Text], [(Text, Text)]) -> [Block] -> Org m (Doc Text)
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) = [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
inlines
blockToOrg (Para [Inline]
inlines) = do
  Doc Text
contents <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
inlines
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToOrg (LineBlock [[Inline]]
lns) = do
  let splitStanza :: [a] -> [[a]]
splitStanza [] = []
      splitStanza [a]
xs = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty) [a]
xs of
        ([a]
l, [])  -> [[a]
l]
        ([a]
l, a
_:[a]
r) -> [a]
l [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
splitStanza [a]
r
  let joinWithLinefeeds :: [Doc Text] -> Doc Text
joinWithLinefeeds  = Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
forall a. Doc a
cr
  let joinWithBlankLines :: [Doc a] -> Doc a
joinWithBlankLines = [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ([Doc a] -> Doc a) -> ([Doc a] -> [Doc a]) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse Doc a
forall a. Doc a
blankline
  let prettifyStanza :: [[Inline]] -> StateT WriterState m (Doc Text)
prettifyStanza [[Inline]]
ls  = [Doc Text] -> Doc Text
joinWithLinefeeds ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline] -> StateT WriterState m (Doc Text))
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [[Inline]]
ls
  Doc Text
contents <- [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
joinWithBlankLines ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> Org m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Inline]] -> Org m (Doc Text))
-> [[[Inline]]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [[Inline]] -> Org m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
[[Inline]] -> StateT WriterState m (Doc Text)
prettifyStanza ([[Inline]] -> [[[Inline]]]
forall {a}. (Eq a, Monoid a) => [a] -> [[a]]
splitStanza [[Inline]]
lns)
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_verse" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_verse" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToOrg (RawBlock Format
"html" Text
str) =
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_html" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_html" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToOrg b :: Block
b@(RawBlock Format
f Text
str)
  | Format -> Bool
isRawFormat Format
f = Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise     = do
      LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToOrg Block
HorizontalRule = Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"--------------" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
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]
_ -> (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Text -> [Text]) -> Maybe Text -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"tag-name" [(Text, Text)]
kv
        Inline
_                 -> Maybe [Text]
forall a. Maybe a
Nothing
  let ([Inline]
htext, [Inline]
tagsInlines) = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Maybe [Text] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Text] -> Bool)
-> (Inline -> Maybe [Text]) -> Inline -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Maybe [Text]
tagName) [Inline]
inlines
  Doc Text
contents <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg ([Inline] -> Org m (Doc Text)) -> [Inline] -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
Space) [Inline]
htext
  Int
columns  <- WriterOptions -> Int
writerColumns (WriterOptions -> Int)
-> StateT WriterState m WriterOptions -> StateT WriterState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let headerDoc :: Doc Text
headerDoc = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat
        [ [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc Text) -> [Char] -> Doc Text
forall a b. (a -> b) -> a -> b
$ if Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
999 then [Char]
" " else Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
level Char
'*'
        , Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "
        , Doc Text
contents
        ]
  let tags :: Text
tags = case (Inline -> Maybe [Text]) -> [Inline] -> Maybe [Text]
forall c. Monoid c => (Inline -> c) -> [Inline] -> c
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 Doc Text
forall a. Doc a
empty
                else (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
tags) (Doc Text -> Doc Text) -> (Int -> Doc Text) -> Int -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc Text) -> (Int -> [Char]) -> Int -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> [Char]
forall a. Int -> a -> [a]
`replicate` Char
' ') (Int -> [Char]) -> (Int -> Int) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Doc Text) -> Int -> Doc Text
forall a b. (a -> b) -> a -> b
$
                     Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
headerDoc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
forall a. HasChars a => a -> Int
realLength Text
tags
  let drawerStr :: Doc Text
drawerStr = if (Text, [Text], [(Text, Text)])
attr (Text, [Text], [(Text, Text)])
-> (Text, [Text], [(Text, Text)]) -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, [Text], [(Text, Text)])
nullAttr
                  then Doc Text
forall a. Doc a
empty
                  else Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (Text, [Text], [(Text, Text)]) -> Doc Text
propertiesDrawer (Text, [Text], [(Text, Text)])
attr
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text
headerDoc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
tagsDoc) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
drawerStr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
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 Doc Text
forall a. Doc a
empty
             else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"#+name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident
  let startnum :: Text
startnum = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
x -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
trimr Text
x) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"startFrom" [(Text, Text)]
kvs
  let numberlines :: Text
numberlines = if Text
"numberLines" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                      then if Text
"continuedSourceBlock" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                             then Text
" +n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
startnum
                             else Text
" -n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
startnum
                      else Text
""
  let lang :: Maybe Text
lang = case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"example",Text
"code"]) [Text]
classes of
        []  -> Maybe Text
forall a. Maybe a
Nothing
        Text
l:[Text]
_ -> if Text
"code" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes    -- check for ipynb code cell
               then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"jupyter-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
pandocLangToOrg Text
l)
               else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Text
pandocLangToOrg Text
l)
  let args :: Text
args = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
             [ Text
" :" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v
             | (Text
k, Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
numberlines, Text
"#+end_example")
        Just Text
x  -> (Text
"#+begin_src " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
numberlines Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
args, Text
"#+end_src")
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
name Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
beg Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
end Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToOrg (BlockQuote [Block]
blocks) = do
  Doc Text
contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
blocks
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_quote" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_quote" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
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'' <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
caption'
  let caption :: Doc Text
caption = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption'
                   then Doc Text
forall a. Doc a
empty
                   else Doc Text
"#+caption: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
caption''
  [Doc Text]
headers' <- ([Block] -> Org m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [[Block]]
headers
  [[Doc Text]]
rawRows <- ([[Block]] -> StateT WriterState m [Doc Text])
-> [[[Block]]] -> StateT WriterState m [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([Block] -> Org m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg) [[[Block]]]
rows
  let numChars :: [Doc Text] -> Int
numChars = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Doc Text] -> [Int]) -> [Doc Text] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Int) -> [Doc Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset
  -- FIXME: width is not being used.
  let widthsInChars :: [Int]
widthsInChars =
       ([Doc Text] -> Int) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Int
numChars ([[Doc Text]] -> [Int]) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Doc Text]] -> [[Doc Text]]
forall a. [[a]] -> [[a]]
transpose ([Doc Text]
headers' [Doc Text] -> [[Doc Text]] -> [[Doc Text]]
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 = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat [Doc a
beg, Doc a
middle, Doc a
end]
        where sep' :: Doc a
sep'   = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
" | "
              beg :: Doc a
beg    = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
"| "
              end :: Doc a
end    = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
" |"
              middle :: Doc a
middle = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse Doc a
sep' [Doc a]
blocks
  let makeRow :: [Doc Text] -> Doc Text
makeRow = [Doc Text] -> Doc Text
forall {a}. HasChars a => [Doc a] -> Doc a
hpipeBlocks ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Doc Text -> Doc Text) -> [Int] -> [Doc Text] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Doc Text -> Doc Text
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' <- ([[Block]] -> Org m (Doc Text))
-> [[[Block]]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\[[Block]]
row -> do [Doc Text]
cols <- ([Block] -> Org m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [[Block]]
row
                            Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
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 = Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'|' Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
ch Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
                  ([Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat ([Doc a] -> Doc a) -> ([Doc a] -> [Doc a]) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
ch Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'+' Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
ch) ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$
                          (Int -> Doc a) -> [Int] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> [Char] -> Doc a
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc a) -> [Char] -> Doc a
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
l Char
ch) [Int]
widthsInChars) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
                  Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
ch Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'|'
  let body :: Doc Text
body = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows'
  let head'' :: Doc Text
head'' = if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
                  then Doc Text
forall a. Doc a
empty
                  else Doc Text
head' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Char -> Doc Text
forall a. HasChars a => Char -> Doc a
border Char
'-'
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
head'' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToOrg (BulletList [[Block]]
items) = do
  [Doc Text]
contents <- ([Block] -> Org m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
bulletListItemToOrg [[Block]]
items
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if [[Block]] -> Bool
isTightList [[Block]]
items then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
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 = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items) ([Text] -> [Text]) -> [Text] -> [Text]
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 -> Maybe Int
forall a. Maybe a
Nothing; Int
n -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Maybe Int -> [Maybe Int] -> [Maybe Int]
forall a. a -> [a] -> [a]
: Maybe Int -> [Maybe Int]
forall a. a -> [a]
repeat Maybe Int
forall a. Maybe a
Nothing
  [Doc Text]
contents <- ([Block] -> ([Block] -> Org m (Doc Text)) -> Org m (Doc Text))
-> [[Block]]
-> [[Block] -> Org m (Doc Text)]
-> StateT WriterState m [Doc Text]
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 ([[Block] -> Org m (Doc Text)] -> StateT WriterState m [Doc Text])
-> [[Block] -> Org m (Doc Text)] -> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$
              (Text -> Maybe Int -> [Block] -> Org m (Doc Text))
-> [Text] -> [Maybe Int] -> [[Block] -> Org m (Doc Text)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> Maybe Int -> [Block] -> Org m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Maybe Int -> [Block] -> Org m (Doc Text)
orderedListItemToOrg [Text]
markers [Maybe Int]
counters
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if [[Block]] -> Bool
isTightList [[Block]]
items then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
forall a. Doc a
blankline
blockToOrg (DefinitionList [([Inline], [[Block]])]
items) = do
  [Doc Text]
contents <- (([Inline], [[Block]]) -> Org m (Doc Text))
-> [([Inline], [[Block]])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Inline], [[Block]]) -> Org m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> Org m (Doc Text)
definitionListItemToOrg [([Inline], [[Block]])]
items
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
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]
_ []  -> Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Doc a
empty
            Caption Maybe [Inline]
_ [Block]
cpt -> (Doc Text
"#+caption: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text) -> Org m (Doc Text) -> Org m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg ([Block] -> [Inline]
blocksToInlines [Block]
cpt)
  Doc Text
contents <-  [Block] -> Org m (Doc Text)
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 Doc Text
forall a. Doc a
empty
               else Doc Text
"<<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">>"
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
anchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
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 <- (WriterState -> Extensions) -> StateT WriterState m Extensions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> Extensions) -> StateT WriterState m Extensions)
-> (WriterState -> Extensions) -> StateT WriterState m Extensions
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Extensions
writerExtensions (WriterOptions -> Extensions)
-> (WriterState -> WriterOptions) -> WriterState -> Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
  Doc Text
contents <- [Block] -> Org m (Doc Text)
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]
_ -> Doc Text
forall a. Monoid a => a
mempty
                    Para{}:[Block]
_ -> Doc Text
forall a. Monoid a => a
mempty
                    [Block]
_ -> Doc Text
forall a. Doc a
cr) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
contents
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"- " Doc Text
contents' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
          if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| [Block] -> Bool
endsWithPlain [Block]
items
             then Doc Text
forall a. Doc a
cr
             else Doc Text
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 <- (WriterState -> Extensions) -> StateT WriterState m Extensions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> Extensions) -> StateT WriterState m Extensions)
-> (WriterState -> Extensions) -> StateT WriterState m Extensions
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Extensions
writerExtensions (WriterOptions -> Extensions)
-> (WriterState -> WriterOptions) -> WriterState -> Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
  Doc Text
contents <- [Block] -> Org m (Doc Text)
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]
_ -> Doc Text
forall a. Monoid a => a
mempty
                    Para{}:[Block]
_ -> Doc Text
forall a. Monoid a => a
mempty
                    [Block]
_ -> Doc Text
forall a. Doc a
cr) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
contents
  let cookie :: Doc Text
cookie = Doc Text -> (Int -> Doc Text) -> Maybe Int -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Doc a
empty
               (\Int
n -> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[@" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
n) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"]")
               Maybe Int
counter
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Text -> Int
T.length Text
marker Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
cookie Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space) Doc Text
contents' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
          if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| [Block] -> Bool
endsWithPlain [Block]
items
             then Doc Text
forall a. Doc a
cr
             else Doc Text
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
"[ ]" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    toOrg (Str Text
"☒" : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"[X]" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
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' <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
label
  Doc Text
contents <- [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> Org m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> Org m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [[Block]]
defs
  Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"- " (Doc Text
label' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" :: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
      if [[Block]] -> Bool
isTightList [[Block]]
defs
         then Doc Text
forall a. Doc a
cr
         else Doc Text
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 = [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
":PROPERTIES:"
    drawerEnd :: Doc Text
drawerEnd   = [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
":END:"
    kv' :: [(Text, Text)]
kv'  = if [Text]
classes [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
forall a. Monoid a => a
mempty then [(Text, Text)]
kv  else (Text
"CLASS", [Text] -> Text
T.unwords [Text]
classes)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kv
    kv'' :: [(Text, Text)]
kv'' = if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall a. Monoid a => a
mempty   then [(Text, Text)]
kv' else (Text
"CUSTOM_ID", Text
ident)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kv'
    properties :: Doc Text
properties = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Doc Text) -> [(Text, Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Doc Text
kvToOrgProperty [(Text, Text)]
kv''
  in
    Doc Text
drawerStart Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
properties Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
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) =
     [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
key Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
": " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
value Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
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') <- (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Text -> Text -> Bool
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') <- (Text -> Bool) -> [Text] -> ([Text], [Text])
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' [Text] -> [Text] -> [Text]
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 = (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"center", Text
"quote"]) (Text -> Bool) -> (Text -> Text) -> Text -> Bool
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 <- [Block] -> Org m (Doc Text)
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.
      Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (Text, [Text], [(Text, Text)]) -> Doc Text
attrHtml (Text, [Text], [(Text, Text)])
attr'
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
blockName
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
blockName Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
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 = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Doc Text) -> [(Text, Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) ->
                               Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
k Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":"
                              Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
v) [(Text, Text)]
kvs
      Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
drawerName Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
cr
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
keys Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
            Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
":END:" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
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
"<<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">>" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
      Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline)

attrHtml :: Attr -> Doc Text
attrHtml :: (Text, [Text], [(Text, Text)]) -> Doc Text
attrHtml (Text
""   , []     , []) = Doc 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 Doc Text
forall a. Monoid a => a
mempty else Doc Text
"#+name: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
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 = ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v) ((Text, Text)
classKv(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs)
  in Doc Text
name Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
keyword Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
": " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
kvStrings) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
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 = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> StateT WriterState m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> StateT WriterState m (Doc Text)
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 = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> StateT WriterState m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Inline -> StateT WriterState m (Doc Text)
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
" " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
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
" " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixMarkers [Inline]
rest
        fixMarkers (Inline
x : [Inline]
rest) = Inline
x Inline -> [Inline] -> [Inline]
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
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, [], []) []) =
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"<<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
uid Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">>"
inlineToOrg (Span (Text, [Text], [(Text, Text)])
_ [Inline]
lst) =
  [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Emph [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"/" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"/"
inlineToOrg (Underline [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"_" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"_"
inlineToOrg (Strong [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"*" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"*"
inlineToOrg (Strikeout [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"+" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"+"
inlineToOrg (Superscript [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"^{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"}"
inlineToOrg (Subscript [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"_{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"}"
inlineToOrg (SmallCaps [Inline]
lst) = [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"'" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"'"
inlineToOrg (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
inlineToOrg (Cite [Citation]
cs [Inline]
lst) = do
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  if Extension -> WriterOptions -> Bool
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 <- [Inline] -> StateT WriterState m (Doc Text)
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 <- [Inline] -> StateT WriterState m (Doc Text)
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 -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
                              HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\160" Text
" " (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                              HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"{" Text
"" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                              HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"}" Text
"" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ LocatorInfo -> Text
locatorRaw LocatorInfo
info
                            Maybe LocatorInfo
Nothing -> Doc Text
forall a. Monoid a => a
mempty
             Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep [ Doc Text
citePref
                           , (Doc Text
"@" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Citation -> Text
citationId Citation
c))
                           , Doc Text
locator
                           , Doc Text
citeSuff ]
       Doc Text
citeItems <- [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
"; " ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Citation -> StateT WriterState m (Doc Text))
-> [Citation] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Citation -> StateT WriterState m (Doc Text)
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 CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
AuthorInText
                     -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"/t"
                   [Citation
d]
                     | Citation -> CitationMode
citationMode Citation
d CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
SuppressAuthor
                     -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"/na"
                   [Citation]
_ -> Doc Text
forall a. Monoid a => a
mempty
       Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[cite" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sty Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
citeItems Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
     else [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Code (Text, [Text], [(Text, Text)])
_ Text
str) = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"="
inlineToOrg (Str Text
str) = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> (Text -> Doc Text) -> Text -> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> StateT WriterState m (Doc Text))
-> Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeString Text
str
inlineToOrg (Math MathType
t Text
str) = do
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasMath :: Bool
stHasMath = Bool
True }
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if MathType
t MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
InlineMath
              then Doc Text
"\\(" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\)"
              else Doc Text
"\\[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\]"
inlineToOrg il :: Inline
il@(RawInline Format
f Text
str)
  | Format -> [Format] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 =
    Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
  | Format -> Bool
isRawFormat Format
f = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise     = do
      LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToOrg Inline
LineBreak = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
"\\\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr)
inlineToOrg Inline
Space = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToOrg Inline
SoftBreak = do
  WrapOption
wrapText <- (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions)
  case WrapOption
wrapText of
       WrapOption
WrapPreserve -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
       WrapOption
WrapAuto     -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
       WrapOption
WrapNone     -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src ->  -- autolink
             Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
orgPath Text
x) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
        [Inline]
_ -> do Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
txt
                Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
orgPath Text
src) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"][" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
inlineToOrg (Image (Text, [Text], [(Text, Text)])
_ [Inline]
_ (Text
source, Text
_)) =
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
orgPath Text
source) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
inlineToOrg (Note [Block]
contents) = do
  -- add to notes in state
  [[Block]]
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNotes :: [[Block]]
stNotes = [Block]
contents[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
notes }
  let ref :: Text
ref = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
notes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[fn:" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ref Doc Text -> Doc Text -> Doc Text
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:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src
  where
    isFilePath :: Text -> Bool
    isFilePath :: Text -> Bool
isFilePath Text
cs = (Text -> Bool) -> [Text] -> Bool
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 (Char -> Char -> Bool
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 (Char -> Char -> Bool
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 (Map Text Text -> LocatorMap) -> Map Text Text -> LocatorMap
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Map Text Text
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") ]