{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
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
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
pandocToOrg :: PandocMonad m => Pandoc -> Org m Text
pandocToOrg :: forall (m :: * -> *). PandocMonad m => Pandoc -> Org m Text
pandocToOrg (Pandoc Meta
meta [Block]
blocks) = do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
Context Text
metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
[Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg
((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg)
Meta
meta
Doc Text
body <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
blocks
Doc Text
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([[Block]] -> [[Block]]
forall a. [a] -> [a]
reverse ([[Block]] -> [[Block]])
-> (WriterState -> [[Block]]) -> WriterState -> [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> [[Block]]
stNotes) StateT WriterState m [[Block]]
-> ([[Block]] -> StateT WriterState m (Doc Text))
-> StateT WriterState m (Doc Text)
forall a b.
StateT WriterState m a
-> (a -> StateT WriterState m b) -> StateT WriterState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Block]] -> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> Org m (Doc Text)
notesToOrg
Bool
hasMath <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stHasMath
let main :: Doc Text
main = Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
notes
let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
(Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"math" Bool
hasMath
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
metadata
Text -> Org m Text
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Org m Text) -> Text -> Org m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Maybe (Template Text)
Nothing -> Doc Text
main
Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
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
noteToOrg :: PandocMonad m => Int -> [Block] -> Org m (Doc Text)
noteToOrg :: forall (m :: * -> *).
PandocMonad m =>
Int -> [Block] -> Org m (Doc Text)
noteToOrg Int
num [Block]
note = do
Doc Text
contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
note
let marker :: [Char]
marker = [Char]
"[fn:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] "
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
marker) ([Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
marker) Doc Text
contents
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) -> [Char] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Doc Text
forall {a}. HasChars a => Char -> Doc a
escChar (Text -> [Char]
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
| 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"
blockToOrg :: PandocMonad m
=> Block
-> 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
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
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"#+RESULTS:" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
([Char] -> Doc Text -> Doc Text
forall a. IsString a => [Char] -> Doc a -> Doc a
prefixed [Char]
": " (Doc Text -> Doc Text)
-> ([Text] -> Doc Text) -> [Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ([Text] -> [Doc Text]) -> [Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Doc Text) -> [Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t)
blockToOrg (Div attr :: (Text, [Text], [(Text, Text)])
attr@(Text
ident,[Text]
_,[(Text, Text)]
_) [Block]
bs) = do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"refs" Bool -> Bool -> Bool
&& Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts
then Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
else (Text, [Text], [(Text, Text)]) -> [Block] -> Org m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
(Text, [Text], [(Text, Text)]) -> [Block] -> Org m (Doc Text)
divToOrg (Text, [Text], [(Text, Text)])
attr [Block]
bs
blockToOrg (Plain [Inline]
inlines) = [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
inlines
blockToOrg (Para [Inline]
inlines) = do
Doc Text
contents <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
inlines
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToOrg (LineBlock [[Inline]]
lns) = do
let splitStanza :: [a] -> [[a]]
splitStanza [] = []
splitStanza [a]
xs = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty) [a]
xs of
([a]
l, []) -> [[a]
l]
([a]
l, a
_:[a]
r) -> [a]
l [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
splitStanza [a]
r
let joinWithLinefeeds :: [Doc Text] -> Doc Text
joinWithLinefeeds = Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
forall a. Doc a
cr
let joinWithBlankLines :: [Doc a] -> Doc a
joinWithBlankLines = [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ([Doc a] -> Doc a) -> ([Doc a] -> [Doc a]) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse Doc a
forall a. Doc a
blankline
let prettifyStanza :: [[Inline]] -> StateT WriterState m (Doc Text)
prettifyStanza [[Inline]]
ls = [Doc Text] -> Doc Text
joinWithLinefeeds ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline] -> StateT WriterState m (Doc Text))
-> [[Inline]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [[Inline]]
ls
Doc Text
contents <- [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
joinWithBlankLines ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> Org m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Inline]] -> Org m (Doc Text))
-> [[[Inline]]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [[Inline]] -> Org m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
[[Inline]] -> StateT WriterState m (Doc Text)
prettifyStanza ([[Inline]] -> [[[Inline]]]
forall {a}. (Eq a, Monoid a) => [a] -> [[a]]
splitStanza [[Inline]]
lns)
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_verse" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_verse" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
blockToOrg (RawBlock Format
"html" Text
str) =
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_html" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_html" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToOrg b :: Block
b@(RawBlock Format
f Text
str)
| Format -> Bool
isRawFormat Format
f = Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
| Bool
otherwise = do
LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToOrg Block
HorizontalRule = Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"--------------" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToOrg (Header Int
level (Text, [Text], [(Text, Text)])
attr [Inline]
inlines) = do
let tagName :: Inline -> Maybe [Text]
tagName Inline
inline = case Inline
inline of
Span (Text
_, [Text]
_, [(Text, Text)]
kv) [Inline]
_ -> (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Text -> [Text]) -> Maybe Text -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"tag-name" [(Text, Text)]
kv
Inline
_ -> Maybe [Text]
forall a. Maybe a
Nothing
let ([Inline]
htext, [Inline]
tagsInlines) = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Maybe [Text] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Text] -> Bool)
-> (Inline -> Maybe [Text]) -> Inline -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Maybe [Text]
tagName) [Inline]
inlines
Doc Text
contents <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg ([Inline] -> Org m (Doc Text)) -> [Inline] -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
Space) [Inline]
htext
Int
columns <- WriterOptions -> Int
writerColumns (WriterOptions -> Int)
-> StateT WriterState m WriterOptions -> StateT WriterState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let headerDoc :: Doc Text
headerDoc = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat
[ [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc Text) -> [Char] -> Doc Text
forall a b. (a -> b) -> a -> b
$ if Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
999 then [Char]
" " else Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
level Char
'*'
, Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "
, Doc Text
contents
]
let tags :: Text
tags = case (Inline -> Maybe [Text]) -> [Inline] -> Maybe [Text]
forall c. Monoid c => (Inline -> c) -> [Inline] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Maybe [Text]
tagName [Inline]
tagsInlines of
Maybe [Text]
Nothing -> Text
""
Just [Text]
ts -> Char -> Text -> Text
T.cons Char
':' (Text -> [Text] -> Text
T.intercalate Text
":" [Text]
ts) Text -> Char -> Text
`T.snoc` Char
':'
let tagsDoc :: Doc Text
tagsDoc = if Text -> Bool
T.null Text
tags
then Doc Text
forall a. Doc a
empty
else (Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
tags) (Doc Text -> Doc Text) -> (Int -> Doc Text) -> Int -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc Text) -> (Int -> [Char]) -> Int -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> [Char]
forall a. Int -> a -> [a]
`replicate` Char
' ') (Int -> [Char]) -> (Int -> Int) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Doc Text) -> Int -> Doc Text
forall a b. (a -> b) -> a -> b
$
Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
headerDoc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
forall a. HasChars a => a -> Int
realLength Text
tags
let drawerStr :: Doc Text
drawerStr = if (Text, [Text], [(Text, Text)])
attr (Text, [Text], [(Text, Text)])
-> (Text, [Text], [(Text, Text)]) -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, [Text], [(Text, Text)])
nullAttr
then Doc Text
forall a. Doc a
empty
else Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (Text, [Text], [(Text, Text)]) -> Doc Text
propertiesDrawer (Text, [Text], [(Text, Text)])
attr
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text
headerDoc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
tagsDoc) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
drawerStr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
blockToOrg (CodeBlock (Text
ident,[Text]
classes,[(Text, Text)]
kvs) Text
str) = do
let name :: Doc Text
name = if Text -> Bool
T.null Text
ident
then Doc Text
forall a. Doc a
empty
else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
"#+name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ident
let startnum :: Text
startnum = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
x -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
trimr Text
x) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"startFrom" [(Text, Text)]
kvs
let numberlines :: Text
numberlines = if Text
"numberLines" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
then if Text
"continuedSourceBlock" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
then Text
" +n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
startnum
else Text
" -n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
startnum
else Text
""
let lang :: Maybe Text
lang = case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"example",Text
"code"]) [Text]
classes of
[] -> Maybe Text
forall a. Maybe a
Nothing
Text
l:[Text]
_ -> if Text
"code" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
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")
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
Doc Text
contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
blocks
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_quote" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_quote" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToOrg (Table (Text, [Text], [(Text, Text)])
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
caption', [Alignment]
_, [Double]
_, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
Doc Text
caption'' <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
caption'
let caption :: Doc Text
caption = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption'
then Doc Text
forall a. Doc a
empty
else Doc Text
"#+caption: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
caption''
[Doc Text]
headers' <- ([Block] -> Org m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [[Block]]
headers
[[Doc Text]]
rawRows <- ([[Block]] -> StateT WriterState m [Doc Text])
-> [[[Block]]] -> StateT WriterState m [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([Block] -> Org m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg) [[[Block]]]
rows
let numChars :: [Doc Text] -> Int
numChars = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Doc Text] -> [Int]) -> [Doc Text] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Int) -> [Doc Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset
let widthsInChars :: [Int]
widthsInChars =
([Doc Text] -> Int) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Int
numChars ([[Doc Text]] -> [Int]) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Doc Text]] -> [[Doc Text]]
forall a. [[a]] -> [[a]]
transpose ([Doc Text]
headers' [Doc Text] -> [[Doc Text]] -> [[Doc Text]]
forall a. a -> [a] -> [a]
: [[Doc Text]]
rawRows)
let hpipeBlocks :: [Doc a] -> Doc a
hpipeBlocks [Doc a]
blocks = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat [Doc a
beg, Doc a
middle, Doc a
end]
where sep' :: Doc a
sep' = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
" | "
beg :: Doc a
beg = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
"| "
end :: Doc a
end = a -> Doc a
forall a. HasChars a => a -> Doc a
vfill a
" |"
middle :: Doc a
middle = [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse Doc a
sep' [Doc a]
blocks
let makeRow :: [Doc Text] -> Doc Text
makeRow = [Doc Text] -> Doc Text
forall {a}. HasChars a => [Doc a] -> Doc a
hpipeBlocks ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Doc Text -> Doc Text) -> [Int] -> [Doc Text] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock [Int]
widthsInChars
let head' :: Doc Text
head' = [Doc Text] -> Doc Text
makeRow [Doc Text]
headers'
[Doc Text]
rows' <- ([[Block]] -> Org m (Doc Text))
-> [[[Block]]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\[[Block]]
row -> do [Doc Text]
cols <- ([Block] -> Org m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [[Block]]
row
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
makeRow [Doc Text]
cols) [[[Block]]]
rows
let border :: Char -> Doc a
border Char
ch = Char -> Doc a
forall {a}. HasChars a => Char -> Doc a
char Char
'|' Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Char -> Doc a
forall {a}. HasChars a => Char -> Doc a
char Char
ch Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
([Doc a] -> Doc a
forall a. [Doc a] -> Doc a
hcat ([Doc a] -> Doc a) -> ([Doc a] -> [Doc a]) -> [Doc a] -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse (Char -> Doc a
forall {a}. HasChars a => Char -> Doc a
char Char
ch Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Char -> Doc a
forall {a}. HasChars a => Char -> Doc a
char Char
'+' Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Char -> Doc a
forall {a}. HasChars a => Char -> Doc a
char Char
ch) ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$
(Int -> Doc a) -> [Int] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> [Char] -> Doc a
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc a) -> [Char] -> Doc a
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
l Char
ch) [Int]
widthsInChars) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<>
Char -> Doc a
forall {a}. HasChars a => Char -> Doc a
char Char
ch Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Char -> Doc a
forall {a}. HasChars a => Char -> Doc a
char Char
'|'
let body :: Doc Text
body = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows'
let head'' :: Doc Text
head'' = if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
then Doc Text
forall a. Doc a
empty
else Doc Text
head' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Char -> Doc Text
forall {a}. HasChars a => Char -> Doc a
border Char
'-'
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
head'' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToOrg (BulletList [[Block]]
items) = do
[Doc Text]
contents <- ([Block] -> Org m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
bulletListItemToOrg [[Block]]
items
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if [[Block]] -> Bool
isTightList [[Block]]
items then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
forall a. Doc a
blankline
blockToOrg (OrderedList (Int
start, ListNumberStyle
_, ListNumberDelim
delim) [[Block]]
items) = do
let delim' :: ListNumberDelim
delim' = case ListNumberDelim
delim of
ListNumberDelim
TwoParens -> ListNumberDelim
OneParen
ListNumberDelim
x -> ListNumberDelim
x
let markers :: [Text]
markers = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
items) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Int, ListNumberStyle, ListNumberDelim) -> [Text]
orderedListMarkers
(Int
start, ListNumberStyle
Decimal, ListNumberDelim
delim')
counters :: [Maybe Int]
counters = (case Int
start of Int
1 -> Maybe Int
forall a. Maybe a
Nothing; Int
n -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Maybe Int -> [Maybe Int] -> [Maybe Int]
forall a. a -> [a] -> [a]
: Maybe Int -> [Maybe Int]
forall a. a -> [a]
repeat Maybe Int
forall a. Maybe a
Nothing
[Doc Text]
contents <- ([Block] -> ([Block] -> Org m (Doc Text)) -> Org m (Doc Text))
-> [[Block]]
-> [[Block] -> Org m (Doc Text)]
-> StateT WriterState m [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\[Block]
x [Block] -> Org m (Doc Text)
f -> [Block] -> Org m (Doc Text)
f [Block]
x) [[Block]]
items ([[Block] -> Org m (Doc Text)] -> StateT WriterState m [Doc Text])
-> [[Block] -> Org m (Doc Text)] -> StateT WriterState m [Doc Text]
forall a b. (a -> b) -> a -> b
$
(Text -> Maybe Int -> [Block] -> Org m (Doc Text))
-> [Text] -> [Maybe Int] -> [[Block] -> Org m (Doc Text)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> Maybe Int -> [Block] -> Org m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Maybe Int -> [Block] -> Org m (Doc Text)
orderedListItemToOrg [Text]
markers [Maybe Int]
counters
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (if [[Block]] -> Bool
isTightList [[Block]]
items then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep) [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
forall a. Doc a
blankline
blockToOrg (DefinitionList [([Inline], [[Block]])]
items) = do
[Doc Text]
contents <- (([Inline], [[Block]]) -> Org m (Doc Text))
-> [([Inline], [[Block]])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Inline], [[Block]]) -> Org m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> Org m (Doc Text)
definitionListItemToOrg [([Inline], [[Block]])]
items
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToOrg (Figure (Text
ident, [Text]
_, [(Text, Text)]
_) Caption
caption [Block]
body) = do
Doc Text
capt <- case Caption
caption of
Caption Maybe [Inline]
_ [] -> Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Doc a
empty
Caption Maybe [Inline]
_ [Block]
cpt -> (Doc Text
"#+caption: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text) -> Org m (Doc Text) -> Org m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg ([Block] -> [Inline]
blocksToInlines [Block]
cpt)
Doc Text
contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
body
let anchor :: Doc Text
anchor = if Text -> Bool
T.null Text
ident
then Doc Text
forall a. Doc a
empty
else Doc Text
"<<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">>"
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
anchor Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline)
bulletListItemToOrg :: PandocMonad m => [Block] -> Org m (Doc Text)
bulletListItemToOrg :: forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
bulletListItemToOrg [Block]
items = do
Extensions
exts <- (WriterState -> Extensions) -> StateT WriterState m Extensions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> Extensions) -> StateT WriterState m Extensions)
-> (WriterState -> Extensions) -> StateT WriterState m Extensions
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Extensions
writerExtensions (WriterOptions -> Extensions)
-> (WriterState -> WriterOptions) -> WriterState -> Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
Doc Text
contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg (Extensions -> [Block] -> [Block]
taskListItemToOrg Extensions
exts [Block]
items)
let contents' :: Doc Text
contents' = (case [Block]
items of
Plain{}:[Block]
_ -> Doc Text
forall a. Monoid a => a
mempty
Para{}:[Block]
_ -> Doc Text
forall a. Monoid a => a
mempty
[Block]
_ -> Doc Text
forall a. Doc a
cr) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
contents
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"- " Doc Text
contents' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| [Block] -> Bool
endsWithPlain [Block]
items
then Doc Text
forall a. Doc a
cr
else Doc Text
forall a. Doc a
blankline
orderedListItemToOrg :: PandocMonad m
=> Text
-> Maybe Int
-> [Block]
-> Org m (Doc Text)
orderedListItemToOrg :: forall (m :: * -> *).
PandocMonad m =>
Text -> Maybe Int -> [Block] -> Org m (Doc Text)
orderedListItemToOrg Text
marker Maybe Int
counter [Block]
items = do
Extensions
exts <- (WriterState -> Extensions) -> StateT WriterState m Extensions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((WriterState -> Extensions) -> StateT WriterState m Extensions)
-> (WriterState -> Extensions) -> StateT WriterState m Extensions
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Extensions
writerExtensions (WriterOptions -> Extensions)
-> (WriterState -> WriterOptions) -> WriterState -> Extensions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions
Doc Text
contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg (Extensions -> [Block] -> [Block]
taskListItemToOrg Extensions
exts [Block]
items)
let contents' :: Doc Text
contents' = (case [Block]
items of
Plain{}:[Block]
_ -> Doc Text
forall a. Monoid a => a
mempty
Para{}:[Block]
_ -> Doc Text
forall a. Monoid a => a
mempty
[Block]
_ -> Doc Text
forall a. Doc a
cr) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
contents
let cookie :: Doc Text
cookie = Doc Text -> (Int -> Doc Text) -> Maybe Int -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Doc a
empty
(\Int
n -> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[@" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
n) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"]")
Maybe Int
counter
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang (Text -> Int
T.length Text
marker Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
(Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
marker Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
cookie Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space) Doc Text
contents' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
items Bool -> Bool -> Bool
|| [Block] -> Bool
endsWithPlain [Block]
items
then Doc Text
forall a. Doc a
cr
else Doc Text
forall a. Doc a
blankline
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
definitionListItemToOrg :: PandocMonad m
=> ([Inline], [[Block]]) -> Org m (Doc Text)
definitionListItemToOrg :: forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> Org m (Doc Text)
definitionListItemToOrg ([Inline]
label, [[Block]]
defs) = do
Doc Text
label' <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
label
Doc Text
contents <- [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> Org m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> Org m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [[Block]]
defs
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
2 Doc Text
"- " (Doc Text
label' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" :: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
if [[Block]] -> Bool
isTightList [[Block]]
defs
then Doc Text
forall a. Doc a
cr
else Doc Text
forall a. Doc a
blankline
propertiesDrawer :: Attr -> Doc Text
propertiesDrawer :: (Text, [Text], [(Text, Text)]) -> Doc Text
propertiesDrawer (Text
ident, [Text]
classes, [(Text, Text)]
kv) =
let
drawerStart :: Doc Text
drawerStart = [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
":PROPERTIES:"
drawerEnd :: Doc Text
drawerEnd = [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
":END:"
kv' :: [(Text, Text)]
kv' = if [Text]
classes [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
forall a. Monoid a => a
mempty then [(Text, Text)]
kv else (Text
"CLASS", [Text] -> Text
T.unwords [Text]
classes)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kv
kv'' :: [(Text, Text)]
kv'' = if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall a. Monoid a => a
mempty then [(Text, Text)]
kv' else (Text
"CUSTOM_ID", Text
ident)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kv'
properties :: Doc Text
properties = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Doc Text) -> [(Text, Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Doc Text
kvToOrgProperty [(Text, Text)]
kv''
in
Doc Text
drawerStart Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
properties Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
drawerEnd
where
kvToOrgProperty :: (Text, Text) -> Doc Text
kvToOrgProperty :: (Text, Text) -> Doc Text
kvToOrgProperty (Text
key, Text
value) =
[Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
key Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
": " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
value Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
data DivBlockType
= GreaterBlock Text Attr
| Drawer Text Attr
| UnwrappedWithAnchor Text
deriving (Int -> DivBlockType -> [Char] -> [Char]
[DivBlockType] -> [Char] -> [Char]
DivBlockType -> [Char]
(Int -> DivBlockType -> [Char] -> [Char])
-> (DivBlockType -> [Char])
-> ([DivBlockType] -> [Char] -> [Char])
-> Show DivBlockType
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> DivBlockType -> [Char] -> [Char]
showsPrec :: Int -> DivBlockType -> [Char] -> [Char]
$cshow :: DivBlockType -> [Char]
show :: DivBlockType -> [Char]
$cshowList :: [DivBlockType] -> [Char] -> [Char]
showList :: [DivBlockType] -> [Char] -> [Char]
Show)
divBlockType :: Attr-> DivBlockType
divBlockType :: (Text, [Text], [(Text, Text)]) -> DivBlockType
divBlockType (Text
ident, [Text]
classes, [(Text, Text)]
kvs)
| ([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)
| (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)
| 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
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
Doc Text
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
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
forall a. Doc a
blankline
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (Text, [Text], [(Text, Text)]) -> Doc Text
attrHtml (Text, [Text], [(Text, Text)])
attr'
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
blockName
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp Doc Text
contents
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
blockName Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
Drawer Text
drawerName (Text
_,[Text]
_,[(Text, Text)]
kvs) -> do
Doc Text
contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
bs
let keys :: Doc Text
keys = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Doc Text) -> [(Text, Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) ->
Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
k Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":"
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
v) [(Text, Text)]
kvs
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text)) -> Doc Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
drawerName Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
cr
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
keys Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
":END:" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
UnwrappedWithAnchor Text
ident -> do
Doc Text
contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
bs
let contents' :: Doc Text
contents' = if Text -> Bool
T.null Text
ident
then Doc Text
contents
else Doc Text
"<<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">>" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
Doc Text -> Org m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline)
attrHtml :: Attr -> Doc Text
attrHtml :: (Text, [Text], [(Text, Text)]) -> Doc Text
attrHtml (Text
"" , [] , []) = Doc Text
forall a. Monoid a => a
mempty
attrHtml (Text
ident, [Text]
classes, [(Text, Text)]
kvs) =
let
name :: Doc Text
name = if Text -> Bool
T.null Text
ident then Doc Text
forall a. Monoid a => a
mempty else Doc Text
"#+name: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
keyword :: Doc Text
keyword = Doc Text
"#+attr_html"
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
blockListToOrg :: PandocMonad m
=> [Block]
-> 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
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
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
shouldFix (Str Text
"-") = Bool
True
shouldFix (Str Text
x)
| 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
inlineToOrg :: PandocMonad m => Inline -> Org m (Doc Text)
inlineToOrg :: forall (m :: * -> *). PandocMonad m => Inline -> Org m (Doc Text)
inlineToOrg (Span (Text
uid, [], []) []) =
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"<<" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
uid Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">>"
inlineToOrg (Span (Text, [Text], [(Text, Text)])
_ [Inline]
lst) =
[Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Emph [Inline]
lst) = do
Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"/" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"/"
inlineToOrg (Underline [Inline]
lst) = do
Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"_" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"_"
inlineToOrg (Strong [Inline]
lst) = do
Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"*" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"*"
inlineToOrg (Strikeout [Inline]
lst) = do
Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"+" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"+"
inlineToOrg (Superscript [Inline]
lst) = do
Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"^{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"}"
inlineToOrg (Subscript [Inline]
lst) = do
Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"_{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"}"
inlineToOrg (SmallCaps [Inline]
lst) = [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Quoted QuoteType
SingleQuote [Inline]
lst) = do
Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"'" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"'"
inlineToOrg (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"\"" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
inlineToOrg (Cite [Citation]
cs [Inline]
lst) = do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
if Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_citations WriterOptions
opts
then do
let renderCiteItem :: Citation -> StateT WriterState m (Doc Text)
renderCiteItem Citation
c = do
Doc Text
citePref <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg (Citation -> [Inline]
citationPrefix Citation
c)
let (Maybe LocatorInfo
locinfo, [Inline]
suffix) = LocatorMap -> [Inline] -> (Maybe LocatorInfo, [Inline])
parseLocator LocatorMap
locmap (Citation -> [Inline]
citationSuffix Citation
c)
Doc Text
citeSuff <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
suffix
let locator :: Doc Text
locator = case Maybe LocatorInfo
locinfo of
Just LocatorInfo
info -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\160" Text
" " (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"{" Text
"" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"}" Text
"" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ LocatorInfo -> Text
locatorRaw LocatorInfo
info
Maybe LocatorInfo
Nothing -> Doc Text
forall a. Monoid a => a
mempty
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep [ Doc Text
citePref
, (Doc Text
"@" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Citation -> Text
citationId Citation
c))
, Doc Text
locator
, Doc Text
citeSuff ]
Doc Text
citeItems <- [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse Doc Text
"; " ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text]
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Citation -> StateT WriterState m (Doc Text))
-> [Citation] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Citation -> StateT WriterState m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Citation -> StateT WriterState m (Doc Text)
renderCiteItem [Citation]
cs
let sty :: Doc Text
sty = case [Citation]
cs of
(Citation
d:[Citation]
_)
| Citation -> CitationMode
citationMode Citation
d CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
AuthorInText
-> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"/t"
[Citation
d]
| Citation -> CitationMode
citationMode Citation
d CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CitationMode
SuppressAuthor
-> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"/na"
[Citation]
_ -> Doc Text
forall a. Monoid a => a
mempty
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[cite" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
sty Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
":" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
citeItems Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
else [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Code (Text, [Text], [(Text, Text)])
_ Text
str) = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"=" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"="
inlineToOrg (Str Text
str) = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> 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 ([Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text [Char]
"\\\\" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr)
inlineToOrg Inline
Space = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToOrg Inline
SoftBreak = do
WrapOption
wrapText <- (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions)
case WrapOption
wrapText of
WrapOption
WrapPreserve -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
WrapOption
WrapAuto -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
WrapOption
WrapNone -> Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToOrg (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text
src, Text
_)) =
case [Inline]
txt of
[Str Text
x] | Text -> Text
escapeURI Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src ->
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
orgPath Text
x) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
[Inline]
_ -> do Doc Text
contents <- [Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
txt
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
orgPath Text
src) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"][" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
inlineToOrg (Image (Text, [Text], [(Text, Text)])
_ [Inline]
_ (Text
source, Text
_)) =
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
orgPath Text
source) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]]"
inlineToOrg (Note [Block]
contents) = do
[[Block]]
notes <- (WriterState -> [[Block]]) -> StateT WriterState m [[Block]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> [[Block]]
stNotes
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st { stNotes = contents:notes }
let ref :: Text
ref = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
notes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[fn:" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ref Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
orgPath :: Text -> Text
orgPath :: Text -> Text
orgPath Text
src = case Text -> Maybe (Char, Text)
T.uncons Text
src of
Maybe (Char, Text)
Nothing -> Text
""
Just (Char
'#', Text
_) -> Text
src
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)
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
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") ]