{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Writers.ZimWiki ( writeZimWiki ) where
import Control.Monad (zipWithM)
import Control.Monad.State.Strict (StateT, evalStateT, gets, modify)
import Data.Default (Default (..))
import Data.List (transpose)
import Data.List.NonEmpty (nonEmpty)
import qualified Data.Map as Map
import Text.DocLayout (render, literal)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options (WrapOption (..),
WriterOptions (writerTableOfContents, writerTemplate,
writerWrapText))
import Text.Pandoc.Shared (figureDiv, linesToPara, removeFormatting, trimr)
import Text.Pandoc.URI (escapeURI, isURI)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)
data WriterState = WriterState {
WriterState -> Text
stIndent :: Text,
WriterState -> Bool
stInTable :: Bool,
WriterState -> Bool
stInLink :: Bool
}
instance Default WriterState where
def :: WriterState
def = WriterState { stIndent :: Text
stIndent = Text
"", stInTable :: Bool
stInTable = Bool
False, stInLink :: Bool
stInLink = Bool
False }
type ZW = StateT WriterState
writeZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeZimWiki WriterOptions
opts Pandoc
document = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> ZW m Text
pandocToZimWiki WriterOptions
opts Pandoc
document) forall a. Default a => a
def
pandocToZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> ZW m Text
pandocToZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> ZW m Text
pandocToZimWiki WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
Context Text
metadata <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki WriterOptions
opts)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts)
Meta
meta
Text
main <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki WriterOptions
opts [Block]
blocks
let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Text
main
forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts) Context Text
metadata
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Just Template Text
tpl -> forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
Maybe (Template Text)
Nothing -> Text
main
escapeText :: Text -> Text
escapeText :: Text -> Text
escapeText = Text -> Text -> Text -> Text
T.replace Text
"__" Text
"''__''" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text -> Text -> Text
T.replace Text
"**" Text
"''**''" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text -> Text -> Text
T.replace Text
"~~" Text
"''~~''" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text -> Text -> Text
T.replace Text
"//" Text
"''//''"
blockToZimWiki :: PandocMonad m => WriterOptions -> Block -> ZW m Text
blockToZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> ZW m Text
blockToZimWiki WriterOptions
opts (Div Attr
_attrs [Block]
bs) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki WriterOptions
opts [Block]
bs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
contents forall a. Semigroup a => a -> a -> a
<> Text
"\n"
blockToZimWiki WriterOptions
opts (Plain [Inline]
inlines) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
inlines
blockToZimWiki WriterOptions
opts (Para [Inline]
inlines) = do
Text
indent <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Text
stIndent
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
inlines
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
contents forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
indent then Text
"\n" else Text
""
blockToZimWiki WriterOptions
opts (LineBlock [[Inline]]
lns) =
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> ZW m Text
blockToZimWiki WriterOptions
opts forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToZimWiki WriterOptions
opts b :: Block
b@(RawBlock Format
f Text
str)
| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"zimwiki" = forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> ZW m Text
indentFromHTML WriterOptions
opts Text
str
| Bool
otherwise = do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
blockToZimWiki WriterOptions
_ Block
HorizontalRule = forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n----\n"
blockToZimWiki WriterOptions
opts (Header Int
level Attr
_ [Inline]
inlines) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
inlines
let eqs :: Text
eqs = Int -> Text -> Text
T.replicate ( Int
7 forall a. Num a => a -> a -> a
- Int
level ) Text
"="
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
eqs forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
contents forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
eqs forall a. Semigroup a => a -> a -> a
<> Text
"\n"
blockToZimWiki WriterOptions
_ (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
_) Text
str) = do
let langal :: [(Text, Text)]
langal = [(Text
"javascript", Text
"js"), (Text
"bash", Text
"sh"), (Text
"winbatch", Text
"dosbatch")]
let langmap :: Map Text Text
langmap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
langal
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [Text]
classes of
[] -> Text
"'''\n" forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanupCode Text
str forall a. Semigroup a => a -> a -> a
<> Text
"\n'''\n"
(Text
x:[Text]
_) -> Text
"{{{code: lang=\"" forall a. Semigroup a => a -> a -> a
<>
forall a. a -> Maybe a -> a
fromMaybe Text
x (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
x Map Text Text
langmap) forall a. Semigroup a => a -> a -> a
<> Text
"\" linenumbers=\"True\"\n" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"\n}}}\n"
blockToZimWiki WriterOptions
opts (BlockQuote [Block]
blocks) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki WriterOptions
opts [Block]
blocks
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text
"> " forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
contents
blockToZimWiki WriterOptions
opts (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
capt, [Alignment]
aligns, [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
Text
captionDoc <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
capt
then forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
else do
Text
c <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
capt
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"" forall a. Semigroup a => a -> a -> a
<> Text
c forall a. Semigroup a => a -> a -> a
<> Text
"\n"
[Text]
headers' <- if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
then forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Alignment -> [Block] -> ZW m Text
tableItemToZimWiki WriterOptions
opts) [Alignment]
aligns (forall a. [a] -> a
head [[[Block]]]
rows)
else forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Walkable Inline a => a -> [Inline]
removeFormatting)[[Block]]
headers
[[Text]]
rows' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Alignment -> [Block] -> ZW m Text
tableItemToZimWiki WriterOptions
opts) [Alignment]
aligns) [[[Block]]]
rows
let widths :: [Int]
widths = forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
T.length) forall a b. (a -> b) -> a -> b
$
forall a. [[a]] -> [[a]]
transpose ([Text]
headers'forall a. a -> [a] -> [a]
:[[Text]]
rows')
let padTo :: (Int, Alignment) -> Text -> Text
padTo (Int
width, Alignment
al) Text
s =
case Int
width forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
s of
Int
x | Int
x forall a. Ord a => a -> a -> Bool
> Int
0 ->
if Alignment
al forall a. Eq a => a -> a -> Bool
== Alignment
AlignLeft Bool -> Bool -> Bool
|| Alignment
al forall a. Eq a => a -> a -> Bool
== Alignment
AlignDefault
then Text
s forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
x Text
" "
else if Alignment
al forall a. Eq a => a -> a -> Bool
== Alignment
AlignRight
then Int -> Text -> Text
T.replicate Int
x Text
" " forall a. Semigroup a => a -> a -> a
<> Text
s
else Int -> Text -> Text
T.replicate (Int
x forall a. Integral a => a -> a -> a
`div` Int
2) Text
" " forall a. Semigroup a => a -> a -> a
<>
Text
s forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
x forall a. Num a => a -> a -> a
- Int
x forall a. Integral a => a -> a -> a
`div` Int
2) Text
" "
| Bool
otherwise -> Text
s
let borderCell :: (Int, Alignment) -> p -> Text
borderCell (Int
width, Alignment
al) p
_
| Alignment
al forall a. Eq a => a -> a -> Bool
== Alignment
AlignLeft = Text
":"forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
widthforall a. Num a => a -> a -> a
-Int
1) Text
"-"
| Alignment
al forall a. Eq a => a -> a -> Bool
== Alignment
AlignDefault = Int -> Text -> Text
T.replicate Int
width Text
"-"
| Alignment
al forall a. Eq a => a -> a -> Bool
== Alignment
AlignRight = Int -> Text -> Text
T.replicate (Int
widthforall a. Num a => a -> a -> a
-Int
1) Text
"-" forall a. Semigroup a => a -> a -> a
<> Text
":"
| Bool
otherwise = Text
":" forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
widthforall a. Num a => a -> a -> a
-Int
2) Text
"-" forall a. Semigroup a => a -> a -> a
<> Text
":"
let underheader :: Text
underheader = Text
"|" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"|" (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {p}. (Int, Alignment) -> p -> Text
borderCell (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
widths [Alignment]
aligns) [Text]
headers') forall a. Semigroup a => a -> a -> a
<> Text
"|"
let renderRow :: [Text] -> Text
renderRow [Text]
cells = Text
"|" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"|" (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, Alignment) -> Text -> Text
padTo (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
widths [Alignment]
aligns) [Text]
cells) forall a. Semigroup a => a -> a -> a
<> Text
"|"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
captionDoc forall a. Semigroup a => a -> a -> a
<>
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
headers' then Text
"" else [Text] -> Text
renderRow [Text]
headers' forall a. Semigroup a => a -> a -> a
<> Text
"\n") forall a. Semigroup a => a -> a -> a
<> Text
underheader forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<>
[Text] -> Text
T.unlines (forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
renderRow [[Text]]
rows')
blockToZimWiki WriterOptions
opts (BulletList [[Block]]
items) = do
[Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
listItemToZimWiki WriterOptions
opts) [[Block]]
items
Text
indent <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Text
stIndent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
vcat [Text]
contents forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
indent then Text
"\n" else Text
""
blockToZimWiki WriterOptions
opts (OrderedList ListAttributes
_ [[Block]]
items) = do
[Text]
contents <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> ZW m Text
orderedListItemToZimWiki WriterOptions
opts) [Int
1..] [[Block]]
items
Text
indent <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Text
stIndent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
vcat [Text]
contents forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
indent then Text
"\n" else Text
""
blockToZimWiki WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
items) = do
[Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> ZW m Text
definitionListItemToZimWiki WriterOptions
opts) [([Inline], [[Block]])]
items
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
vcat [Text]
contents
blockToZimWiki WriterOptions
opts (Figure Attr
attr Caption
capt [Block]
body) = do
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> ZW m Text
blockToZimWiki WriterOptions
opts (Attr -> Caption -> [Block] -> Block
figureDiv Attr
attr Caption
capt [Block]
body)
definitionListItemToZimWiki :: PandocMonad m
=> WriterOptions
-> ([Inline],[[Block]])
-> ZW m Text
definitionListItemToZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> ([Inline], [[Block]]) -> ZW m Text
definitionListItemToZimWiki WriterOptions
opts ([Inline]
label, [[Block]]
items) = do
Text
labelText <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
label
[Text]
contents <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki WriterOptions
opts) [[Block]]
items
Text
indent <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Text
stIndent
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
indent forall a. Semigroup a => a -> a -> a
<> Text
"* **" forall a. Semigroup a => a -> a -> a
<> Text
labelText forall a. Semigroup a => a -> a -> a
<> Text
"** " forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text]
contents
indentFromHTML :: PandocMonad m => WriterOptions -> Text -> ZW m Text
indentFromHTML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> ZW m Text
indentFromHTML WriterOptions
_ Text
str = do
Text
indent <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Text
stIndent
if Text
"<li>" Text -> Text -> Bool
`T.isInfixOf` Text
str
then forall (m :: * -> *) a. Monad m => a -> m a
return Text
indent
else if Text
"</li>" Text -> Text -> Bool
`T.isInfixOf` Text
str
then forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n"
else if Text
"<li value=" Text -> Text -> Bool
`T.isInfixOf` Text
str
then forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
else if Text
"<ol>" Text -> Text -> Bool
`T.isInfixOf` Text
str
then do
let olcount :: Int
olcount=Text -> Text -> Int
countSubStrs Text
"<ol>" Text
str
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stIndent :: Text
stIndent = WriterState -> Text
stIndent WriterState
s forall a. Semigroup a => a -> a -> a
<>
Int -> Text -> Text
T.replicate Int
olcount Text
"\t" }
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
else if Text
"</ol>" Text -> Text -> Bool
`T.isInfixOf` Text
str
then do
let olcount :: Int
olcount=Text -> Text -> Int
countSubStrs Text
"/<ol>" Text
str
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stIndent :: Text
stIndent = Int -> Text -> Text
T.drop Int
olcount (WriterState -> Text
stIndent WriterState
s) }
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
else forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
countSubStrs :: Text -> Text -> Int
countSubStrs :: Text -> Text -> Int
countSubStrs Text
sub Text
str = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Text -> Text -> [(Text, Text)]
T.breakOnAll Text
sub Text
str
cleanupCode :: Text -> Text
cleanupCode :: Text -> Text
cleanupCode = Text -> Text -> Text -> Text
T.replace Text
"<nowiki>" Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"</nowiki>" Text
""
vcat :: [Text] -> Text
vcat :: [Text] -> Text
vcat = Text -> [Text] -> Text
T.intercalate Text
"\n"
listItemToZimWiki :: PandocMonad m => WriterOptions -> [Block] -> ZW m Text
listItemToZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
listItemToZimWiki WriterOptions
opts [Block]
items = do
Text
indent <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Text
stIndent
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stIndent :: Text
stIndent = Text
indent forall a. Semigroup a => a -> a -> a
<> Text
"\t" }
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki WriterOptions
opts [Block]
items
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stIndent :: Text
stIndent = Text
indent }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
indent forall a. Semigroup a => a -> a -> a
<> Text
"* " forall a. Semigroup a => a -> a -> a
<> Text
contents
orderedListItemToZimWiki :: PandocMonad m
=> WriterOptions -> Int -> [Block] -> ZW m Text
orderedListItemToZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Int -> [Block] -> ZW m Text
orderedListItemToZimWiki WriterOptions
opts Int
itemnum [Block]
items = do
Text
indent <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Text
stIndent
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stIndent :: Text
stIndent = Text
indent forall a. Semigroup a => a -> a -> a
<> Text
"\t" }
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki WriterOptions
opts [Block]
items
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s{ stIndent :: Text
stIndent = Text
indent }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
indent forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
itemnum) forall a. Semigroup a => a -> a -> a
<> Text
". " forall a. Semigroup a => a -> a -> a
<> Text
contents
tableItemToZimWiki :: PandocMonad m
=> WriterOptions -> Alignment -> [Block] -> ZW m Text
tableItemToZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Alignment -> [Block] -> ZW m Text
tableItemToZimWiki WriterOptions
opts Alignment
align' [Block]
item = do
let mkcell :: a -> a
mkcell a
x = (if Alignment
align' forall a. Eq a => a -> a -> Bool
== Alignment
AlignRight Bool -> Bool -> Bool
|| Alignment
align' forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter
then a
" "
else a
"") forall a. Semigroup a => a -> a -> a
<> a
x forall a. Semigroup a => a -> a -> a
<>
(if Alignment
align' forall a. Eq a => a -> a -> Bool
== Alignment
AlignLeft Bool -> Bool -> Bool
|| Alignment
align' forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter
then a
" "
else a
"")
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stInTable :: Bool
stInTable = Bool
True }
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki WriterOptions
opts [Block]
item
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stInTable :: Bool
stInTable = Bool
False }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {a}. (Semigroup a, IsString a) => a -> a
mkcell Text
contents
blockListToZimWiki :: PandocMonad m
=> WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki WriterOptions
opts [Block]
blocks = [Text] -> Text
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> ZW m Text
blockToZimWiki WriterOptions
opts) [Block]
blocks
inlineListToZimWiki :: PandocMonad m
=> WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst = [Text] -> Text
T.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> ZW m Text
inlineToZimWiki WriterOptions
opts) [Inline]
lst
inlineToZimWiki :: PandocMonad m
=> WriterOptions -> Inline -> ZW m Text
inlineToZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> ZW m Text
inlineToZimWiki WriterOptions
opts (Emph [Inline]
lst) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"//" forall a. Semigroup a => a -> a -> a
<> Text
contents forall a. Semigroup a => a -> a -> a
<> Text
"//"
inlineToZimWiki WriterOptions
opts (Underline [Inline]
lst) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"__" forall a. Semigroup a => a -> a -> a
<> Text
contents forall a. Semigroup a => a -> a -> a
<> Text
"__"
inlineToZimWiki WriterOptions
opts (Strong [Inline]
lst) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"**" forall a. Semigroup a => a -> a -> a
<> Text
contents forall a. Semigroup a => a -> a -> a
<> Text
"**"
inlineToZimWiki WriterOptions
opts (Strikeout [Inline]
lst) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"~~" forall a. Semigroup a => a -> a -> a
<> Text
contents forall a. Semigroup a => a -> a -> a
<> Text
"~~"
inlineToZimWiki WriterOptions
opts (Superscript [Inline]
lst) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"^{" forall a. Semigroup a => a -> a -> a
<> Text
contents forall a. Semigroup a => a -> a -> a
<> Text
"}"
inlineToZimWiki WriterOptions
opts (Subscript [Inline]
lst) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"_{" forall a. Semigroup a => a -> a -> a
<> Text
contents forall a. Semigroup a => a -> a -> a
<> Text
"}"
inlineToZimWiki WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"\8216" forall a. Semigroup a => a -> a -> a
<> Text
contents forall a. Semigroup a => a -> a -> a
<> Text
"\8217"
inlineToZimWiki WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"\8220" forall a. Semigroup a => a -> a -> a
<> Text
contents forall a. Semigroup a => a -> a -> a
<> Text
"\8221"
inlineToZimWiki WriterOptions
opts (Span Attr
_attrs [Inline]
ils) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
ils
inlineToZimWiki WriterOptions
opts (SmallCaps [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst
inlineToZimWiki WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
lst
inlineToZimWiki WriterOptions
_ (Code Attr
_ Text
str) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"''" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"''"
inlineToZimWiki WriterOptions
_ (Str Text
str) = do
Bool
inTable <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInTable
Bool
inLink <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInLink
if Bool
inTable
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace Text
"|" Text
"\\|" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeText forall a b. (a -> b) -> a -> b
$ Text
str
else
if Bool
inLink
then forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeText Text
str
inlineToZimWiki WriterOptions
_ (Math MathType
mathType Text
str) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
delim forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
delim
where delim :: Text
delim = case MathType
mathType of
MathType
DisplayMath -> Text
"$$"
MathType
InlineMath -> Text
"$"
inlineToZimWiki WriterOptions
opts il :: Inline
il@(RawInline Format
f Text
str)
| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"zimwiki" = forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
| Format
f forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Text -> ZW m Text
indentFromHTML WriterOptions
opts Text
str
| Bool
otherwise = do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
inlineToZimWiki WriterOptions
_ Inline
LineBreak = do
Bool
inTable <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInTable
if Bool
inTable
then forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\n"
else forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n"
inlineToZimWiki WriterOptions
opts Inline
SoftBreak =
case WriterOptions -> WrapOption
writerWrapText WriterOptions
opts of
WrapOption
WrapNone -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
WrapOption
WrapAuto -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
WrapOption
WrapPreserve -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n"
inlineToZimWiki WriterOptions
_ Inline
Space = forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToZimWiki WriterOptions
opts (Link Attr
_ [Inline]
txt (Text
src, Text
_)) = do
Bool
inTable <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInTable
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stInLink :: Bool
stInLink = Bool
True }
Text
label <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> [Inline]
removeFormatting [Inline]
txt
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stInLink :: Bool
stInLink = Bool
False }
let label' :: Text
label'= if Bool
inTable
then Text
""
else Text
"|"forall a. Semigroup a => a -> a -> a
<>Text
label
case [Inline]
txt of
[Str Text
s] | Text
"mailto:" Text -> Text -> Bool
`T.isPrefixOf` Text
src -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"<" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
">"
| Text -> Text
escapeURI Text
s forall a. Eq a => a -> a -> Bool
== Text
src -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
src
[Inline]
_ -> if Text -> Bool
isURI Text
src
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"[[" forall a. Semigroup a => a -> a -> a
<> Text
src forall a. Semigroup a => a -> a -> a
<> Text
label' forall a. Semigroup a => a -> a -> a
<> Text
"]]"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"[[" forall a. Semigroup a => a -> a -> a
<> Text
src' forall a. Semigroup a => a -> a -> a
<> Text
label' forall a. Semigroup a => a -> a -> a
<> Text
"]]"
where
src' :: Text
src' = forall a. a -> Maybe a -> a
fromMaybe Text
src forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"/" Text
src
inlineToZimWiki WriterOptions
opts (Image Attr
attr [Inline]
alt (Text
source, Text
tit)) = do
Text
alt' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> ZW m Text
inlineListToZimWiki WriterOptions
opts [Inline]
alt
Bool
inTable <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInTable
let txt :: Text
txt = case (Text
tit, [Inline]
alt, Bool
inTable) of
(Text
"",[], Bool
_) -> Text
""
(Text
"", [Inline]
_, Bool
False ) -> Text
"|" forall a. Semigroup a => a -> a -> a
<> Text
alt'
(Text
_ , [Inline]
_, Bool
False ) -> Text
"|" forall a. Semigroup a => a -> a -> a
<> Text
tit
(Text
_ , [Inline]
_, Bool
True ) -> Text
""
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"{{" forall a. Semigroup a => a -> a -> a
<> Text
source forall a. Semigroup a => a -> a -> a
<> WriterOptions -> Attr -> Text
imageDims WriterOptions
opts Attr
attr forall a. Semigroup a => a -> a -> a
<> Text
txt forall a. Semigroup a => a -> a -> a
<> Text
"}}"
inlineToZimWiki WriterOptions
opts (Note [Block]
contents) = do
Text
contents' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> ZW m Text
blockListToZimWiki WriterOptions
opts [Block]
contents
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
" **{Note:** " forall a. Semigroup a => a -> a -> a
<> Text -> Text
trimr Text
contents' forall a. Semigroup a => a -> a -> a
<> Text
"**}**"
imageDims :: WriterOptions -> Attr -> Text
imageDims :: WriterOptions -> Attr -> Text
imageDims WriterOptions
opts Attr
attr = forall {a}. (Semigroup a, IsString a) => Maybe a -> Maybe a -> a
go (Maybe Dimension -> Maybe Text
toPx forall a b. (a -> b) -> a -> b
$ Direction -> Attr -> Maybe Dimension
dimension Direction
Width Attr
attr) (Maybe Dimension -> Maybe Text
toPx forall a b. (a -> b) -> a -> b
$ Direction -> Attr -> Maybe Dimension
dimension Direction
Height Attr
attr)
where
toPx :: Maybe Dimension -> Maybe Text
toPx = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WriterOptions -> Dimension -> Text
showInPixel WriterOptions
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Dimension -> Maybe Dimension
checkPct
checkPct :: Maybe Dimension -> Maybe Dimension
checkPct (Just (Percent Double
_)) = forall a. Maybe a
Nothing
checkPct Maybe Dimension
maybeDim = Maybe Dimension
maybeDim
go :: Maybe a -> Maybe a -> a
go (Just a
w) Maybe a
Nothing = a
"?" forall a. Semigroup a => a -> a -> a
<> a
w
go (Just a
w) (Just a
h) = a
"?" forall a. Semigroup a => a -> a -> a
<> a
w forall a. Semigroup a => a -> a -> a
<> a
"x" forall a. Semigroup a => a -> a -> a
<> a
h
go Maybe a
Nothing (Just a
h) = a
"?0x" forall a. Semigroup a => a -> a -> a
<> a
h
go Maybe a
Nothing Maybe a
Nothing = a
""