{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
module Text.Pandoc.Writers.Org (writeOrg) where
import Control.Monad.State.Strict
import Data.Char (isAlphaNum, isDigit)
import Data.List (intersect, intersperse, partition, transpose)
import Data.List.NonEmpty (nonEmpty)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
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 :: WriterOptions -> Pandoc -> m Text
writeOrg WriterOptions
opts Pandoc
document = do
let st :: WriterState
st = WriterState :: [[Block]] -> Bool -> WriterOptions -> WriterState
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 :: 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 (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 (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 (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 :: [[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] -> Org m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> [Block] -> Org 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] -> Org 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 :: 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 (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 (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 -> Text
escapeString :: Text -> Text
escapeString Text
t
| (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x2013' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\x2026') Text
t = Text
t
| Bool
otherwise = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escChar Text
t
where
escChar :: Char -> Text
escChar Char
'\x2013' = Text
"--"
escChar Char
'\x2014' = Text
"---"
escChar Char
'\x2019' = Text
"'"
escChar Char
'\x2026' = Text
"..."
escChar Char
c = Char -> Text
T.singleton Char
c
isRawFormat :: Format -> Bool
isRawFormat :: Format -> Bool
isRawFormat Format
f =
Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"tex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"org"
blockToOrg :: PandocMonad m
=> Block
-> Org m (Doc Text)
blockToOrg :: Block -> Org m (Doc Text)
blockToOrg Block
Null = Doc Text -> Org m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToOrg (Div Attr
attr [Block]
bs) = Attr -> [Block] -> Org m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Block] -> Org m (Doc Text)
divToOrg Attr
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 (SimpleFigure Attr
attr [Inline]
txt (Text
src, Text
tit)) = do
Doc Text
capt <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
then Doc Text -> Org m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> Doc Text) -> Org m (Doc Text) -> Org m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
txt
Doc Text
img <- Inline -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> Org m (Doc Text)
inlineToOrg (Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
txt (Text
src,Text
tit))
Doc Text -> Org m (Doc Text)
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
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
img Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
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 (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)
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)
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 (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 (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 (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 (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 (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 Attr
attr [Inline]
inlines) = do
Doc Text
contents <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
inlines
let headerStr :: Doc Text
headerStr = [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
'*'
let drawerStr :: Doc Text
drawerStr = if Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
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
<> Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Attr -> Doc Text
propertiesDrawer Attr
attr)
Doc Text -> Org m (Doc Text)
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
headerStr 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
drawerStr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
blockToOrg (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
kvs) Text
str) = do
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
then if Text
"continuedSourceBlock" Text -> [Text] -> 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 at :: [Text]
at = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
pandocLangToOrg [Text]
classes [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Text]
orgLangIdentifiers
let (Text
beg, [Char]
end) = case [Text]
at of
[] -> (Text
"#+begin_example" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
numberlines, [Char]
"#+end_example")
(Text
x:[Text]
_) -> (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, [Char]
"#+end_src")
Doc Text -> Org m (Doc Text)
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
beg Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [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
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 (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
$$
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_quote" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
blockToOrg (Table Attr
_ 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 (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)
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)
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)
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 (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)
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)
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 (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 (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 (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)
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 (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
$$
(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 (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')
let maxMarkerLength :: Int
maxMarkerLength = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length [Text]
markers
let markers' :: [Text]
markers' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
m -> let s :: Int
s = Int
maxMarkerLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
m
in Text
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
s Text
" ") [Text]
markers
[Doc Text]
contents <- (Text -> [Block] -> Org m (Doc Text))
-> [Text] -> [[Block]] -> StateT WriterState m [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Text -> [Block] -> Org m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Block] -> Org m (Doc Text)
orderedListItemToOrg [Text]
markers' [[Block]]
items
Doc Text -> Org m (Doc Text)
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
$$
(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)
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 (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
bulletListItemToOrg :: PandocMonad m => [Block] -> Org m (Doc Text)
bulletListItemToOrg :: [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)
Doc Text -> Org m (Doc Text)
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
endsWithPlain [Block]
items
then Doc Text
forall a. Doc a
cr
else Doc Text
forall a. Doc a
blankline
orderedListItemToOrg :: PandocMonad m
=> Text
-> [Block]
-> Org m (Doc Text)
orderedListItemToOrg :: Text -> [Block] -> Org m (Doc Text)
orderedListItemToOrg Text
marker [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)
Doc Text -> Org m (Doc Text)
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
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
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 :: ([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)
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 (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 :: Attr -> 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
divBlockType :: Attr-> DivBlockType
divBlockType :: Attr -> 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 -> Attr -> 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 -> Attr -> 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 -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"center", Text
"quote"]) (Text -> Bool) -> (Text -> Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
divToOrg :: PandocMonad m
=> Attr -> [Block] -> Org m (Doc Text)
divToOrg :: Attr -> [Block] -> Org m (Doc Text)
divToOrg Attr
attr [Block]
bs = do
Doc Text
contents <- [Block] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> Org m (Doc Text)
blockListToOrg [Block]
bs
case Attr -> DivBlockType
divBlockType Attr
attr of
GreaterBlock Text
blockName Attr
attr' ->
Doc Text -> Org m (Doc Text)
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
$$ Attr -> Doc Text
attrHtml Attr
attr'
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+begin_" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
blockName
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"#+end_" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
blockName Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline
Drawer Text
drawerName (Text
_,[Text]
_,[(Text, Text)]
kvs) -> do
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 (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
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 (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 :: Attr -> Doc Text
attrHtml (Text
"" , [] , []) = Doc Text
forall a. Monoid a => a
mempty
attrHtml (Text
ident, [Text]
classes, [(Text, Text)]
kvs) =
let
name :: Doc Text
name = if Text -> Bool
T.null Text
ident then Doc Text
forall a. Monoid a => a
mempty else Doc Text
"#+name: " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
ident Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
keyword :: Doc Text
keyword = Doc Text
"#+attr_html"
classKv :: (Text, Text)
classKv = (Text
"class", [Text] -> Text
T.unwords [Text]
classes)
kvStrings :: [Text]
kvStrings = ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) -> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v) ((Text, Text)
classKv(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs)
in Doc Text
name Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
keyword Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
": " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Text
T.unwords [Text]
kvStrings) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
blockListToOrg :: PandocMonad m
=> [Block]
-> Org m (Doc Text)
blockListToOrg :: [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] -> 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)
mapM Block -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> Org m (Doc Text)
blockToOrg [Block]
blocks
inlineListToOrg :: PandocMonad m
=> [Inline]
-> Org m (Doc Text)
inlineListToOrg :: [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] -> 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)
mapM Inline -> Org 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 :: Inline -> Org m (Doc Text)
inlineToOrg (Span (Text
uid, [], []) []) =
Doc Text -> Org m (Doc Text)
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
uid Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
">>"
inlineToOrg (Span Attr
_ [Inline]
lst) =
[Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Emph [Inline]
lst) = do
Doc Text
contents <- [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> Org m (Doc Text)
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
<> 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] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> Org m (Doc Text)
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
<> 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] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> Org m (Doc Text)
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
<> 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] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> Org m (Doc Text)
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
<> 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] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> Org m (Doc Text)
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
<> 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] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> Org m (Doc Text)
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
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"}"
inlineToOrg (SmallCaps [Inline]
lst) = [Inline] -> Org 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] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> Org m (Doc Text)
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
<> 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] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
Doc Text -> Org m (Doc Text)
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
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\""
inlineToOrg (Cite [Citation]
_ [Inline]
lst) = [Inline] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
lst
inlineToOrg (Code Attr
_ Text
str) = Doc Text -> Org m (Doc Text)
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
str Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"="
inlineToOrg (Str Text
str) = Doc Text -> Org m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> Org m (Doc Text))
-> (Text -> Doc Text) -> Text -> Org m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Org m (Doc Text)) -> Text -> Org m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeString Text
str
inlineToOrg (Math MathType
t Text
str) = do
(WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stHasMath :: Bool
stHasMath = Bool
True }
Doc Text -> Org m (Doc Text)
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 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 (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 -> Org m (Doc Text)
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
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 -> Org m (Doc Text)
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
$ Inline -> LogMessage
InlineNotRendered Inline
il
Doc Text -> Org m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToOrg Inline
LineBreak = Doc Text -> Org m (Doc Text)
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 -> Org m (Doc Text)
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 -> Org m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
WrapOption
WrapAuto -> Doc Text -> Org m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
WrapOption
WrapNone -> Doc Text -> Org m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToOrg (Link Attr
_ [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 -> Org m (Doc Text)
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 -> 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] -> Org m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> Org m (Doc Text)
inlineListToOrg [Inline]
txt
Doc Text -> Org m (Doc Text)
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 -> 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 Attr
_ [Inline]
_ (Text
source, Text
_)) =
Doc Text -> Org m (Doc Text)
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 -> 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 :: [[Block]]
stNotes = [Block]
contents[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
notes }
let ref :: Text
ref = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
notes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Doc Text -> Org m (Doc Text)
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
"[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
c Char -> Text -> Bool
`elemText` 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
orgLangIdentifiers :: [Text]
orgLangIdentifiers :: [Text]
orgLangIdentifiers =
[ Text
"asymptote"
, Text
"lisp"
, Text
"awk"
, Text
"lua"
, Text
"C"
, Text
"matlab"
, Text
"C++"
, Text
"mscgen"
, Text
"clojure"
, Text
"ocaml"
, Text
"css"
, Text
"octave"
, Text
"D"
, Text
"org"
, Text
"ditaa"
, Text
"oz"
, Text
"calc"
, Text
"perl"
, Text
"emacs-lisp"
, Text
"plantuml"
, Text
"eshell"
, Text
"processing"
, Text
"fortran"
, Text
"python"
, Text
"gnuplot"
, Text
"R"
, Text
"screen"
, Text
"ruby"
, Text
"dot"
, Text
"sass"
, Text
"haskell"
, Text
"scheme"
, Text
"java"
, Text
"sed"
, Text
"js"
, Text
"sh"
, Text
"latex"
, Text
"sql"
, Text
"ledger"
, Text
"sqlite"
, Text
"lilypond"
, Text
"vala" ]