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

   Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>
   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
  opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let 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
  metadata <- metaToContext opts
               blockListToOrg
               (fmap chomp . inlineListToOrg)
               meta
  body <- blockListToOrg blocks
  notes <- gets (reverse . stNotes) >>= notesToOrg
  hasMath <- gets stHasMath
  let main = Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
notes
  let 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
  return $ render colwidth $
    case writerTemplate 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
  contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
note
  let marker = String
"[fn:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
num String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] "
  return $ hang (length marker) (text marker) contents

-- | Escape special characters for Org.
escapeString :: Text -> Doc Text
escapeString :: Text -> Doc Text
escapeString Text
t
  | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
t = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
t
  | Bool
otherwise = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Char -> Doc Text) -> String -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Doc Text
forall {a}. HasChars a => Char -> Doc a
escChar (Text -> String
T.unpack Text
t)
  where
   escChar :: Char -> Doc a
escChar Char
'\x2013' = Doc a
"--"
   escChar Char
'\x2014' = Doc a
"---"
   escChar Char
'\x2019' = Doc a
"'"
   escChar Char
'\x2026' = Doc a
"..."
   escChar Char
c
     -- escape special chars with ZERO WIDTH SPACE as org manual suggests
     | 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
'#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|' = Text -> Doc a
forall a. Text -> Doc a
afterBreak Text
"\x200B" 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
c
     | Bool
otherwise = Char -> Doc a
forall {a}. HasChars a => Char -> Doc a
char 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
$$
    (String -> Doc Text -> Doc Text
forall a. IsString a => String -> Doc a -> Doc a
prefixed String
": " (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
  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 ident == "refs" && isEnabled Ext_citations opts
     then return mempty
     else divToOrg attr 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
  contents <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
inlines
  return $ contents <> 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
  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)
  return $ blankline $$ "#+begin_verse" $$
           nest 2 contents $$ "#+end_verse" <> 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
  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
  columns  <- writerColumns <$> gets stOptions
  let headerDoc = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> 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 String
" " else Int -> Char -> String
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 = 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 = 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
. String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> (Int -> String) -> Int -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> String
forall a. Int -> a -> [a]
`replicate` Char
' ') (Int -> String) -> (Int -> Int) -> Int -> String
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 = 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
  return $ nowrap (headerDoc <> tagsDoc) <> drawerStr <> 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")
  -- escape special lines
  let escape_line :: Text -> Text
escape_line Text
line =
        let (Text
spaces, Text
code) = (Char -> Bool) -> Text -> (Text, Text)
T.span (\Char
c -> 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
'\t') Text
line
        in Text
spaces Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           (if Text -> Text -> Bool
T.isPrefixOf Text
"#+" Text
code Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf Text
"*" Text
code
            then Char -> Text -> Text
T.cons Char
',' Text
code
            else Text
code)
  let escaped :: Text
escaped = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
escape_line ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ 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
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
escaped 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
  contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
blocks
  return $ blankline $$ "#+begin_quote" $$
           chomp contents $$ "#+end_quote" $$ 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
  caption'' <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
caption'
  let 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''
  headers' <- mapM blockListToOrg headers
  rawRows <- mapM (mapM blockListToOrg) rows
  let 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 =
       ([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]
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
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] -> Doc Text
makeRow [Doc Text]
headers'
  rows' <- mapM (\[[Block]]
row -> do 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
                            return $ makeRow cols) rows
  let 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 -> String -> Doc a
forall a. HasChars a => String -> Doc a
text (String -> Doc a) -> String -> Doc a
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
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] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows'
  let 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
'-'
  return $ head'' $$ body $$ caption $$ blankline
blockToOrg (BulletList [[Block]]
items) = do
  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
  return $ (if isTightList items then vcat else vsep) contents $$
           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
  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
  return $ (if isTightList items then vcat else vsep) contents $$
           blankline
blockToOrg (DefinitionList [([Inline], [[Block]])]
items) = do
  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
  return $ vcat contents $$ 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.
  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)
  contents <-  blockListToOrg body
  let 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
">>"
  return (capt $$ anchor $$ contents $$ 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
  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
  contents <- blockListToOrg (taskListItemToOrg exts items)
  -- if list item starts with non-paragraph, it must go on
  -- the next line:
  let 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
  return $ hang 2 "- " contents' $$
          if null items || endsWithPlain items
             then cr
             else 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
  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
  contents <- blockListToOrg (taskListItemToOrg exts items)
  -- if list item starts with non-paragraph, it must go on
  -- the next line:
  let 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 -> (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
  return $ hang (T.length marker + 1)
                (literal marker <> cookie <> space) contents' $$
          if null items || endsWithPlain items
             then cr
             else 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
  label' <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
label
  contents <- vcat <$> mapM blockListToOrg defs
  return $ hang 2 "- " (label' <> " :: " <> contents) $$
      if isTightList defs
         then cr
         else 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 = String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
":PROPERTIES:"
    drawerEnd :: Doc Text
drawerEnd   = String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
":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) =
     String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
":" 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
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
": " 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).
  deriving (Int -> DivBlockType -> String -> String
[DivBlockType] -> String -> String
DivBlockType -> String
(Int -> DivBlockType -> String -> String)
-> (DivBlockType -> String)
-> ([DivBlockType] -> String -> String)
-> Show DivBlockType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DivBlockType -> String -> String
showsPrec :: Int -> DivBlockType -> String -> String
$cshow :: DivBlockType -> String
show :: DivBlockType -> String
$cshowList :: [DivBlockType] -> String -> String
showList :: [DivBlockType] -> String -> String
Show)

-- | 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
t = case Text -> Text
T.toLower Text
t of
                            Text
"center" -> Bool
True
                            Text
"quote" -> Bool
True
                            Text
x -> Text -> Bool
isAdmonition Text
x

isAdmonition :: Text -> Bool
isAdmonition :: Text -> Bool
isAdmonition Text
"warning" = Bool
True
isAdmonition Text
"important" = Bool
True
isAdmonition Text
"tip" = Bool
True
isAdmonition Text
"note" = Bool
True
isAdmonition Text
"caution" = Bool
True
isAdmonition Text
_ = Bool
False

-- | 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
  case (Text, [Text], [(Text, Text)]) -> DivBlockType
divBlockType (Text, [Text], [(Text, Text)])
attr of
    GreaterBlock Text
blockName (Text, [Text], [(Text, Text)])
attr' -> do
      -- 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.
      contents <- case [Block]
bs of
                    (Div (Text
"",[Text
"title"],[]) [Block]
_ : [Block]
bs')
                      | Text -> Bool
isAdmonition Text
blockName -> [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
bs'
                    [Block]
_ -> [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
bs
      return $ blankline
            $$ attrHtml attr'
            $$ "#+begin_" <> literal blockName
            $$ chomp contents
            $$ "#+end_" <> literal blockName $$ blankline
    Drawer Text
drawerName (Text
_,[Text]
_,[(Text, Text)]
kvs) -> do
      contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
bs
      -- Write as drawer. Only key-value pairs are retained.
      let 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
      return $ ":" <> literal drawerName <> ":" $$ cr
            $$ keys $$ blankline
            $$ contents $$ blankline
            $$ text ":END:" $$ blankline
    UnwrappedWithAnchor Text
ident -> do
      contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
bs
      -- Unwrap the div. All attributes are discarded, except for
      -- the identifier, which is added as an anchor before the
      -- div contents.
      let 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
      return (blankline $$ contents' $$ 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"
    addClassKv :: [(Text, Text)] -> [(Text, Text)]
addClassKv = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
                    then [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id
                    else ((Text
"class", [Text] -> Text
T.unwords [Text]
classes)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:)
    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)] -> [(Text, Text)]
addClassKv [(Text, Text)]
kvs)
  in Doc Text
name Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
kvStrings
                then Doc Text
forall a. Monoid a => a
mempty
                else 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
  contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  return $ "/" <> contents <> "/"
inlineToOrg (Underline [Inline]
lst) = do
  contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  return $ "_" <> contents <> "_"
inlineToOrg (Strong [Inline]
lst) = do
  contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  return $ "*" <> contents <> "*"
inlineToOrg (Strikeout [Inline]
lst) = do
  contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  return $ "+" <> contents <> "+"
inlineToOrg (Superscript [Inline]
lst) = do
  contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  return $ "^{" <> contents <> "}"
inlineToOrg (Subscript [Inline]
lst) = do
  contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  return $ "_{" <> contents <> "}"
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
  contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  return $ "'" <> contents <> "'"
inlineToOrg (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
  return $ "\"" <> contents <> "\""
inlineToOrg (Cite [Citation]
cs [Inline]
lst) = do
  opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  if isEnabled Ext_citations opts
     then do
       let renderCiteItem Citation
c = do
             citePref <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg (Citation -> [Inline]
citationPrefix Citation
c)
             let (locinfo, suffix) = parseLocator locmap (citationSuffix c)
             citeSuff <- inlineListToOrg suffix
             let 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
             return $ hsep [ citePref
                           , ("@" <> literal (citationId c))
                           , locator
                           , citeSuff ]
       citeItems <- mconcat . intersperse "; " <$> mapM renderCiteItem cs
       let 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
       return $ "[cite" <> sty <> ":" <> citeItems <> "]"
     else inlineListToOrg 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))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc 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 = 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 (String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\\\" 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
  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 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 contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
txt
                return $ "[[" <> literal (orgPath src) <> "][" <> contents <> "]]"
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
  notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
  modify $ \WriterState
st -> WriterState
st { stNotes = contents:notes }
  let 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
  return $ "[fn:" <> literal ref <> "]"

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