{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{- |
   Module      : Text.Pandoc.Writers.Org
   Copyright   : © 2010-2015 Puneeth Chaganti <punchagan@gmail.com>
                   2010-2025 John MacFarlane <jgm@berkeley.edu>
                   2016-2025 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.Citeproc.Locator (parseLocator, LocatorMap(..), LocatorInfo(..))
import Text.Pandoc.Walk (query)
import Text.Pandoc.Writers.Shared

data WriterState =
  WriterState { WriterState -> [[Block]]
stNotes   :: [[Block]]
              , WriterState -> Int
stNoteNum :: Int
              , 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 = [],
                         stNoteNum :: Int
stNoteNum = Int
0,
                         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
  metadata <- metaToContext opts
               blockListToOrg
               (fmap chomp . inlineListToOrg)
               meta
  body <- blockListToOrg blocks
  notes <- 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) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Map Text Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"options"
                         ([(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                          ((if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart_quotes WriterOptions
opts
                            then ((Text
"'", Text
"t")(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:)
                            else [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id) ([(Text, Text)] -> [(Text, Text)])
-> ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           (if Bool -> Bool
not (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_special_strings WriterOptions
opts)
                            then ((Text
"-", Text
"nil")(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:)
                            else [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id)
                           ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ ([] :: [(Text, Text)])))
              (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
"option-special-strings"
                         (Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_special_strings WriterOptions
opts)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
metadata
  return $ renderWithTemplate opts context main

-- | Return Org representation of the collected notes. Rendering a
-- note may add further notes to the state (notes nested inside
-- notes); keep going until all of them have been rendered.
notesToOrg :: PandocMonad m => Org m (Doc Text)
notesToOrg :: forall (m :: * -> *). PandocMonad m => Org m (Doc Text)
notesToOrg = [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 -> StateT WriterState m [Doc Text]
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT WriterState m [Doc Text]
go Int
0
  where
    go :: Int -> StateT WriterState m [Doc Text]
go Int
done = do
      notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int -> [[Block]] -> [[Block]]
forall a. Int -> [a] -> [a]
drop Int
done ([[Block]] -> [[Block]])
-> (WriterState -> [[Block]]) -> WriterState -> [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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)
      if null notes
        then return []
        else do
          docs <- zipWithM noteToOrg [done + 1 ..] notes
          (docs ++) <$> go (done + length 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

-- | Replace Unicode characters with their ASCII representation
replaceSpecialStrings :: Text -> Text
replaceSpecialStrings :: Text -> Text
replaceSpecialStrings =
  let expand :: Char -> Text
expand Char
c = case Char
c of
        Char
'\x00ad' -> Text
"\\-"
        Char
'\x2013' -> Text
"--"
        Char
'\x2014' -> Text
"---"
        Char
'\x2019' -> Text
"'"
        Char
'\x2026' -> Text
"..."
        Char
_        -> Char -> Text
T.singleton Char
c
  in (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
expand

-- | Escape special characters for Org.
escapeString :: Text -> Doc Text
escapeString :: Text -> Doc Text
escapeString Text
t =
  case (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isSpecial Text
t of
    (Text
_, Text
"") -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
t
    (Text
pre, Text
post) ->
      case Text -> Maybe (Char, Text)
T.uncons Text
post of
        -- escape special chars with ZERO WIDTH SPACE as org manual
        -- suggests
        Just (Char
c, Text
rest) -> (if Text -> Bool
T.null Text
pre then Doc Text
forall a. Monoid a => a
mempty else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
pre)
                          Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. Text -> Doc a
afterBreak Text
"\x200B" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
c
                          Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
escapeString Text
rest
        Maybe (Char, Text)
Nothing -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
pre  -- not reachable
  where
    isSpecial :: Char -> Bool
isSpecial 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
'#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|'

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_export 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_export" 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 by prepending a comma. Like Emacs'
  -- org-escape-code-in-region, escape all lines consisting of
  -- indentation, then any number of commas, then "*" or "#+"; this
  -- keeps lines that already start with commas intact when the block
  -- is unescaped again.
  let needsEscape :: Text -> Bool
needsEscape Text
t = let t' :: Text
t' = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
t
                      in Text -> Text -> Bool
T.isPrefixOf Text
"#+" Text
t' Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf Text
"*" Text
t'
  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 if Text -> Bool
needsEscape Text
code
           then Text
spaces Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
T.cons Char
',' Text
code
           else Text
line
  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'
  let rows' = ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Doc Text
makeRow [[Doc Text]]
rawRows
  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 = Bool -> Bool
not (Text -> Bool
T.null Text
cs) Bool -> Bool -> Bool
&&
                                         (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, [], []) []) | Bool -> Bool
not (Text -> Bool
T.null 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
  opts <- gets stOptions
  return $
    if isEnabled Ext_smart opts || isEnabled Ext_smart_quotes opts
    then "'" <> contents <> "'"
    else "‘" <> 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
  opts <- gets stOptions
  return $
    if isEnabled Ext_smart opts || isEnabled Ext_smart_quotes opts
    then "\"" <> contents <> "\""
    else "“" <> 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
$
  -- Org offers no escape mechanism inside verbatim text; if the
  -- content contains the delimiter, fall back to the other verbatim
  -- delimiter.
  if Text
"=" Text -> Text -> Bool
`T.isInfixOf` Text
str Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"~" Text -> Text -> Bool
`T.isInfixOf` Text
str)
     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 (Str Text
str) = do
  opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let str' = if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts Bool -> Bool -> Bool
|| Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_special_strings WriterOptions
opts
             then Text -> Text
replaceSpecialStrings Text
str
             else Text
str
  return $ escapeString 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
escapeLinkTarget (Text -> Text
orgPath Text
x)) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
        [Inline]
_ -> do descr <- Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> (Doc Text -> Doc Text) -> Doc Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Text)
-> StateT WriterState m (Doc Text) -> StateT WriterState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
txt
                return $ "[[" <> literal (escapeLinkTarget (orgPath src)) <>
                         "][" <> literal (escapeLinkDescription descr) <> "]]"
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
escapeLinkTarget (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
  (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 = contents : stNotes st
                     , stNoteNum = stNoteNum st + 1 }
  ref <- (WriterState -> Text) -> StateT WriterState m Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> (WriterState -> Int) -> WriterState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> Int
stNoteNum)
  return $ "[fn:" <> literal ref <> "]"

-- | Escape a link target like Emacs' @org-link-escape@:
-- backslash-escape square brackets, and double any run of backslashes
-- occurring directly before a bracket or at the end of the target.
escapeLinkTarget :: Text -> Text
escapeLinkTarget :: Text -> Text
escapeLinkTarget Text
t =
  let (Text
pre, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break (\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
'[' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']') Text
t
  in Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Text -> Maybe (Char, Text)
T.uncons Text
rest of
       Maybe (Char, Text)
Nothing -> Text
""
       Just (Char
'\\', Text
_) ->
         let (Text
bs, Text
rest') = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') Text
rest
         in case Text -> Maybe (Char, Text)
T.uncons Text
rest' of
              Maybe (Char, Text)
Nothing -> Text
bs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bs
              Just (Char
c, Text
rest'')
                | 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
bs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
T.cons Char
c (Text -> Text
escapeLinkTarget Text
rest'')
                | Bool
otherwise -> Text
bs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
T.cons Char
c (Text -> Text
escapeLinkTarget Text
rest'')
       Just (Char
c, Text
rest') -> Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
T.cons Char
c (Text -> Text
escapeLinkTarget Text
rest')

-- | Make a link description safe: it must not contain @]]@ or end
-- with @]@. Like Emacs' @org-link-make-string@, insert a zero-width
-- space to break up the offending brackets.
escapeLinkDescription :: Text -> Text
escapeLinkDescription :: Text -> Text
escapeLinkDescription = Text -> Text
fixEnd (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
fixDouble
  where
    fixDouble :: Text -> Text
fixDouble Text
t | Text
"]]" Text -> Text -> Bool
`T.isInfixOf` Text
t
                            = Text -> Text
fixDouble (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"]]" Text
"]\x200B]" Text
t
                | Bool
otherwise = Text
t
    fixEnd :: Text -> Text
fixEnd Text
t = case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
                 Just (Text
t', Char
']') -> Text
t' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x200B]"
                 Maybe (Text, Char)
_              -> Text
t

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