{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}

module Text.Pandoc.Writers.Vimdoc (writeVimdoc) where

import Control.Applicative (optional, (<|>))
import Control.Monad (forM)
import Control.Monad.Reader (MonadReader (..), ReaderT (..), asks)
import Control.Monad.State (MonadState (..), StateT, evalStateT, gets, modify)
import Data.Default (Default (..))
import Data.List (intercalate, intersperse, transpose)
import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Text.DocLayout hiding (char, link, text)
import Text.Pandoc.Class.PandocMonad ( report, PandocMonad )
import Text.Pandoc.Definition
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Logging (LogMessage (..))
import Text.Pandoc.Options (WrapOption (..), WriterOptions (..))
import Text.Pandoc.Parsing.General (many1Till, many1TillChar, readWith)
import Text.Pandoc.Shared (capitalize, onlySimpleTableCells, orderedListMarkers, isTightList, makeSections, removeFormatting, tshow)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.URI (escapeURI, isURI)
import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)
import Text.Parsec (anyChar, char, eof, string, try)
import Text.Read (readMaybe)
import Text.Pandoc.Chunks (toTOCTree, SecInfo (..))
import Data.Tree (Tree(..))
import Data.Functor ((<&>))
import Data.Sequence (Seq, (|>), (<|))
import qualified Data.Sequence as Seq
import Data.Foldable (toList)

data WriterState = WriterState
  { WriterState -> Int
indentLevel :: Int -- How much to indent the block. Inlines shouldn't
                       -- be concerned with indent level (I guess?)
  , WriterState -> Int
shiftWidth :: Int -- spaces per indentation level
  , WriterState -> WriterOptions
writerOptions :: WriterOptions
  , WriterState -> Maybe Text
vimdocPrefix :: Maybe Text
  }

instance Default WriterState where
  def :: WriterState
def =
    WriterState
      { indentLevel :: Int
indentLevel = Int
0
      , shiftWidth :: Int
shiftWidth = Int
4
      , writerOptions :: WriterOptions
writerOptions = WriterOptions
forall a. Default a => a
def
      , vimdocPrefix :: Maybe Text
vimdocPrefix = Maybe Text
forall a. Maybe a
Nothing
      }

indent :: (Monad m) => Int -> (VW m a) -> (VW m a)
indent :: forall (m :: * -> *) a. Monad m => Int -> VW m a -> VW m a
indent Int
n = (WriterState -> WriterState)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall a.
(WriterState -> WriterState)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterState
s -> WriterState
s{indentLevel = indentLevel s + n})

type VW m = StateT (Seq (Doc Text)) (ReaderT WriterState m)

runRR :: (Monad m) => Seq (Doc Text) -> WriterState -> VW m a -> m a
runRR :: forall (m :: * -> *) a.
Monad m =>
Seq (Doc Text) -> WriterState -> VW m a -> m a
runRR Seq (Doc Text)
footnotes WriterState
opts VW m a
action = ReaderT WriterState m a -> WriterState -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (VW m a -> Seq (Doc Text) -> ReaderT WriterState m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT VW m a
action Seq (Doc Text)
footnotes) WriterState
opts

docShiftWidth :: Meta -> Maybe Int
docShiftWidth :: Meta -> Maybe Int
docShiftWidth Meta
meta = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"shiftwidth" Meta
meta of
  Just (MetaInlines [Str Text
sw]) -> [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
sw)
  Just (MetaString Text
sw) -> [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
sw)
  Maybe MetaValue
_ -> Maybe Int
forall a. Maybe a
Nothing

docVimdocPrefix :: Meta -> Maybe Text
docVimdocPrefix :: Meta -> Maybe Text
docVimdocPrefix Meta
meta = case Text -> Meta -> Maybe MetaValue
lookupMeta Text
"vimdoc-prefix" Meta
meta of
  Just (MetaInlines [Str Text
pref]) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pref
  Just (MetaString Text
pref) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pref
  Maybe MetaValue
_ -> Maybe Text
forall a. Maybe a
Nothing

{- | Build a vim modeline
>>> makeModeLine def
"vim:tw=72:sw=4:ts=4:ft=help:norl:et:"
-}
makeModeLine :: WriterState -> Text
makeModeLine :: WriterState -> Text
makeModeLine WriterState
ws =
  [Char] -> Text
T.pack ([Char] -> Text) -> ([[Char]] -> [Char]) -> [[Char]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
":" ([[Char]] -> Text) -> [[Char]] -> Text
forall a b. (a -> b) -> a -> b
$
    [ [Char]
"vim"
    , [Char]
"tw=" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
tw
    , [Char]
"sw=" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sw
    , [Char]
"ts=" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
sw
    , [Char]
"ft=help"
    , [Char]
"norl" -- left-to-right text
    , [Char]
"et:" -- expandtab and finishing ":"
    ]
 where
  tw :: Int
tw = WriterOptions -> Int
writerColumns (WriterOptions -> Int)
-> (WriterState -> WriterOptions) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
writerOptions (WriterState -> Int) -> WriterState -> Int
forall a b. (a -> b) -> a -> b
$ WriterState
ws
  sw :: Int
sw = WriterState -> Int
shiftWidth WriterState
ws

-- | Build a single formatted TOC line
tocEntryToLine :: (PandocMonad m) => SecInfo -> VW m Text
tocEntryToLine :: forall (m :: * -> *). PandocMonad m => SecInfo -> VW m Text
tocEntryToLine SecInfo
secinfo = do
  Text
rightRef <- Text -> VW m Text
forall (m :: * -> *). Monad m => Text -> VW m Text
mkVimdocRef (SecInfo -> Text
secId SecInfo
secinfo)
  let numberStr :: Text
numberStr = case SecInfo -> Maybe Text
secNumber SecInfo
secinfo of
        Maybe Text
Nothing -> Text
""
        Just Text
x | Char
'.' Char -> Text -> Bool
`T.elem` Text
x -> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
        Just Text
x -> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". "
  Doc Text
title <- [Inline] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc ([Inline] -> VW m (Doc Text)) -> [Inline] -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
forall a. Walkable Inline a => a -> [Inline]
removeFormatting (SecInfo -> [Inline]
secTitle SecInfo
secinfo)
  let titlePlain :: Text
titlePlain = Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text
title Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" ")

  -- length sub 2 because vertical bars are concealed
  let rightRefLen :: Int
rightRefLen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Text -> Int
T.length Text
rightRef Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
  let numberLen :: Int
numberLen = Text -> Int
T.length Text
numberStr
  let leftLen :: Int
leftLen = Int
numberLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
titlePlain
  let padForRight :: Int
padForRight = Int
1
  Int
textWidth <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> Int
writerColumns (WriterOptions -> Int)
-> (WriterState -> WriterOptions) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
writerOptions)
  Int
il <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Int
indentLevel

  -- positive when we lack space (i.e. content is too long)
  let lack :: Int
lack = (Int
il Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leftLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
padForRight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightRefLen) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
textWidth

  -- when lacking, truncate title reserving 3+ chars for ellipsis
  let finalTitle :: Text
finalTitle =
        if Int
lack Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
          then
            let trunc :: Text
trunc = Int -> Text -> Text
T.dropEnd (Int
lack Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Text
titlePlain
                stripped :: Text
stripped = Text -> Text
T.stripEnd Text
trunc
                ellipsis :: Text
ellipsis =
                  Int -> Text -> Text
T.replicate (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
trunc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
stripped) Text
"."
             in Text
stripped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ellipsis
          else Text
titlePlain

  -- Negative lack means we have an excess of space, so we fill it with dots
  let dots :: Text
dots = Int -> Text -> Text
T.replicate (Int -> Int
forall a. Num a => a -> a
negate Int
lack) Text
"."

  Text -> VW m Text
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> VW m Text) -> ([Text] -> Text) -> [Text] -> VW m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> VW m Text) -> [Text] -> VW m Text
forall a b. (a -> b) -> a -> b
$ [Text
numberStr, Text
finalTitle, Text
dots, Text
" ", Text
rightRef]

vimdocTOC :: (PandocMonad m) => WriterState -> [Block] -> VW m (Doc Text)
vimdocTOC :: forall (m :: * -> *).
PandocMonad m =>
WriterState -> [Block] -> VW m (Doc Text)
vimdocTOC (WriterState{writerOptions :: WriterState -> WriterOptions
writerOptions = WriterOptions
opts}) [Block]
blocks = do
  let (Node SecInfo
_ [Tree SecInfo]
subtrees) =
        [Block] -> Tree SecInfo
toTOCTree ([Block] -> Tree SecInfo) -> [Block] -> Tree SecInfo
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Int -> [Block] -> [Block]
makeSections (WriterOptions -> Bool
writerNumberSections WriterOptions
opts) Maybe Int
forall a. Maybe a
Nothing [Block]
blocks
  let tocDepth :: Int
tocDepth = WriterOptions -> Int
writerTOCDepth WriterOptions
opts
  let isBelowTocDepth :: Tree SecInfo -> Bool
isBelowTocDepth (Node SecInfo
sec [Tree SecInfo]
_) = SecInfo -> Int
secLevel SecInfo
sec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
tocDepth

  let makeItem :: (PandocMonad m) => Tree SecInfo -> VW m (Doc Text)
      makeItem :: forall (m :: * -> *).
PandocMonad m =>
Tree SecInfo -> VW m (Doc Text)
makeItem (Node SecInfo
secinfo [Tree SecInfo]
xs) = do
        Text
line <- SecInfo -> VW m Text
forall (m :: * -> *). PandocMonad m => SecInfo -> VW m Text
tocEntryToLine SecInfo
secinfo
        -- When unnumbered, indent constantly by two,
        -- otherwise indent by (length of marker + 1)
        let markerLen :: Int
markerLen = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 Text -> Int
T.length (SecInfo -> Maybe Text
secNumber SecInfo
secinfo)
        [Doc Text]
childItems <-
          Int -> VW m [Doc Text] -> VW m [Doc Text]
forall (m :: * -> *) a. Monad m => Int -> VW m a -> VW m a
indent Int
markerLen (VW m [Doc Text] -> VW m [Doc Text])
-> VW m [Doc Text] -> VW m [Doc Text]
forall a b. (a -> b) -> a -> b
$
            (Tree SecInfo -> VW m (Doc Text))
-> [Tree SecInfo] -> VW m [Doc Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Tree SecInfo -> VW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tree SecInfo -> VW m (Doc Text)
makeItem ((Tree SecInfo -> Bool) -> [Tree SecInfo] -> [Tree SecInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter Tree SecInfo -> Bool
isBelowTocDepth [Tree SecInfo]
xs)
        Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
line 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
markerLen ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
childItems))

  [Doc Text]
items <- (Tree SecInfo -> VW m (Doc Text))
-> [Tree SecInfo]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Tree SecInfo -> VW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Tree SecInfo -> VW m (Doc Text)
makeItem ((Tree SecInfo -> Bool) -> [Tree SecInfo] -> [Tree SecInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter Tree SecInfo -> Bool
isBelowTocDepth [Tree SecInfo]
subtrees)
  Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items

writeVimdoc :: (PandocMonad m) => WriterOptions -> Pandoc -> m Text
writeVimdoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeVimdoc WriterOptions
opts document :: Pandoc
document@(Pandoc Meta
meta [Block]
_) =
  let
    sw :: Int
sw = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (WriterState -> Int
shiftWidth WriterState
forall a. Default a => a
def) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Meta -> Maybe Int
docShiftWidth Meta
meta
    vp :: Maybe Text
vp = Meta -> Maybe Text
docVimdocPrefix Meta
meta
    footnotes :: Seq a
footnotes = Seq a
forall a. Seq a
Seq.empty
    initialEnv :: WriterState
initialEnv = WriterState
forall a. Default a => a
def{shiftWidth = sw, writerOptions = opts, vimdocPrefix = vp}
   in
    Seq (Doc Text) -> WriterState -> VW m Text -> m Text
forall (m :: * -> *) a.
Monad m =>
Seq (Doc Text) -> WriterState -> VW m a -> m a
runRR Seq (Doc Text)
forall a. Seq a
footnotes WriterState
initialEnv (VW m Text -> m Text) -> VW m Text -> m Text
forall a b. (a -> b) -> a -> b
$ Pandoc -> VW m Text
forall (m :: * -> *). PandocMonad m => Pandoc -> VW m Text
pandocToVimdoc Pandoc
document

pandocToVimdoc :: (PandocMonad m) => Pandoc -> VW m Text
pandocToVimdoc :: forall (m :: * -> *). PandocMonad m => Pandoc -> VW m Text
pandocToVimdoc (Pandoc Meta
meta [Block]
body) = do
  WriterState
st <- StateT (Seq (Doc Text)) (ReaderT WriterState m) WriterState
forall r (m :: * -> *). MonadReader r m => m r
ask
  let opts :: WriterOptions
opts = WriterState -> WriterOptions
writerOptions WriterState
st

  Context Text
metadata <- WriterOptions
-> ([Block]
    -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> ([Inline]
    -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Meta
-> StateT (Seq (Doc Text)) (ReaderT 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 (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc Meta
meta
  Doc Text
main <- do
    Doc Text
body' <- [Block]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [Block]
body
    Seq (Doc Text)
footnotes <- StateT (Seq (Doc Text)) (ReaderT WriterState m) (Seq (Doc Text))
forall s (m :: * -> *). MonadState s m => m s
get
    Doc Text
rule <- Block -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> VW m (Doc Text)
blockToVimdoc Block
HorizontalRule
    let footnotes' :: Doc Text
footnotes' = if Seq (Doc Text) -> Bool
forall a. Seq a -> Bool
Seq.null Seq (Doc Text)
footnotes
          then Doc Text
forall a. Doc a
Empty
          else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep (Seq (Doc Text) -> [Doc Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Doc Text) -> [Doc Text]) -> Seq (Doc Text) -> [Doc Text]
forall a b. (a -> b) -> a -> b
$ Doc Text
rule Doc Text -> Seq (Doc Text) -> Seq (Doc Text)
forall a. a -> Seq a -> Seq a
<| Seq (Doc Text)
footnotes)
    Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
body' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
footnotes'

  Doc Text
title <- [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc ([Inline]
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta
  [Doc Text]
authors <- ([Inline]
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> [[Inline]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc ([[Inline]]
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> [[Inline]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
  let authors' :: Doc Text
authors' = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
intersperse (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] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap [Doc Text]
authors)
  let tw :: Int
tw = WriterOptions -> Int
writerColumns (WriterOptions -> Int)
-> (WriterState -> WriterOptions) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
writerOptions (WriterState -> Int) -> WriterState -> Int
forall a b. (a -> b) -> a -> b
$ WriterState
st

  let combinedTitle :: Text
combinedTitle =
        Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tw) (Doc Text -> Text) -> (Doc Text -> Doc Text) -> Doc Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
cblock Int
tw (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
            (Doc Text
title 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
<> (if Doc Text -> Bool
forall a. Doc a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Doc Text
authors' then Doc Text
"" else Doc Text
"by" 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
<> Doc Text
authors')

  -- This is placed here because I couldn't find a way to right-align text
  -- inside template to the width specified by a variable
  let toc_reminder :: Text
toc_reminder =
        Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> (Doc Text -> Doc Text) -> Doc Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
rblock Int
tw (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
          (Doc Text
"Type |gO| to see the table of contents." :: Doc Text)

  Text
toc <- Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tw) (Doc Text -> Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
-> VW m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterState
-> [Block]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterState -> [Block] -> VW m (Doc Text)
vimdocTOC WriterState
st [Block]
body

  let modeline :: Text
modeline = WriterState -> Text
makeModeLine WriterState
st
  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 -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (if WriterOptions -> Bool
writerTableOfContents WriterOptions
opts then Text
toc else Text
"")
          (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"modeline" Text
modeline
          (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"combined-title" Text
combinedTitle
          (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc-reminder" Text
toc_reminder
          (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
metadata

  Text -> VW m Text
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> VW m Text) -> Text -> VW m Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
      Just Template Text
tpl -> Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tw) (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ 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
      Maybe (Template Text)
Nothing -> Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
tw) Doc Text
main

blockListToVimdoc :: (PandocMonad m) => [Block] -> VW m (Doc Text)
blockListToVimdoc :: forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [Block]
blocks = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> [Block]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> VW m (Doc Text)
blockToVimdoc [Block]
blocks

blockToVimdoc :: (PandocMonad m) => Block -> VW m (Doc Text)

blockToVimdoc :: forall (m :: * -> *). PandocMonad m => Block -> VW m (Doc Text)
blockToVimdoc (Plain [Inline]
inlines) = [Inline] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines

blockToVimdoc (Para [Inline]
inlines) = do
  Doc Text
contents <- [Inline] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines
  Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW 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

blockToVimdoc (LineBlock [[Inline]]
inliness) = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
-> VW m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline] -> VW m (Doc Text))
-> [[Inline]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Inline] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [[Inline]]
inliness

blockToVimdoc (CodeBlock (Text
_, [Text]
cls, [(Text, Text)]
_) Text
code) = do
  Int
sw <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Int
shiftWidth
  let lang :: Text
lang = case [Text]
cls of
        (Text
lang' : [Text]
_) -> Text
lang'
        [Text]
_ -> Text
""
  -- NOTE: No blankline after the codeblock because closing `<` is concealed
  Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text))
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> VW m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> VW m (Doc Text)) -> [Doc Text] -> VW 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
lang
    , Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
sw (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code)
    , Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush Doc Text
"<"
    ]

blockToVimdoc block :: Block
block@(RawBlock Format
format Text
raw) = case Format
format of
  Format
"vimdoc" -> Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
raw
  Format
_ -> Doc Text
"" Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
-> VW m (Doc Text)
forall a b.
a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
block)

blockToVimdoc (BlockQuote [Block]
blocks) = do
  Doc Text
content <- [Block] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [Block]
blocks
  Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 Doc Text
content Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

blockToVimdoc (OrderedList ListAttributes
listAttr [[Block]]
items) = do
  let itemSpacer :: Doc a
itemSpacer = if [[Block]] -> Bool
isTightList [[Block]]
items then Doc a
forall a. Doc a
empty else Doc a
forall a. Doc a
blankline
  let itemsWithMarkers :: [(Text, [Block])]
itemsWithMarkers = [Text] -> [[Block]] -> [(Text, [Block])]
forall a b. [a] -> [b] -> [(a, b)]
zip (ListAttributes -> [Text]
orderedListMarkers ListAttributes
listAttr) [[Block]]
items
  [Doc Text]
items' <- [(Text, [Block])]
-> ((Text, [Block]) -> VW m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, [Block])]
itemsWithMarkers (((Text, [Block]) -> VW m (Doc Text))
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> ((Text, [Block]) -> VW m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ \(Text
marker, [Block]
blocks) -> do
    let markerLen :: Int
markerLen = Text -> Int
T.length Text
marker

    Doc Text
item' <- Int -> VW m (Doc Text) -> VW m (Doc Text)
forall (m :: * -> *) a. Monad m => Int -> VW m a -> VW m a
indent (Int
markerLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (VW m (Doc Text) -> VW m (Doc Text))
-> VW m (Doc Text) -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Block] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [Block]
blocks
    Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ 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 -> 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
markerLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Doc Text
item' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
itemSpacer
  Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

blockToVimdoc (BulletList [[Block]]
items) = do
  let itemSpacer :: Doc a
itemSpacer = if [[Block]] -> Bool
isTightList [[Block]]
items then Doc a
forall a. Doc a
empty else Doc a
forall a. Doc a
blankline
  [Doc Text]
items' <- [[Block]]
-> ([Block] -> VW m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Block]]
items (([Block] -> VW m (Doc Text))
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> ([Block] -> VW m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ \[Block]
blocks -> do
    let marker :: Doc Text
marker = Doc Text
"-"
    Doc Text
item <- Int -> VW m (Doc Text) -> VW m (Doc Text)
forall (m :: * -> *) a. Monad m => Int -> VW m a -> VW m a
indent Int
2 (VW m (Doc Text) -> VW m (Doc Text))
-> VW m (Doc Text) -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Block] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [Block]
blocks
    Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
marker 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
<> Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 Doc Text
item Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
itemSpacer
  Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

blockToVimdoc (DefinitionList [([Inline], [[Block]])]
items) = do
  Int
sw <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Int
shiftWidth
  let sepAll :: [Doc a] -> Doc a
sepAll = if (([Inline], [[Block]]) -> Bool) -> [([Inline], [[Block]])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([[Block]] -> Bool
isTightList ([[Block]] -> Bool)
-> (([Inline], [[Block]]) -> [[Block]])
-> ([Inline], [[Block]])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline], [[Block]]) -> [[Block]]
forall a b. (a, b) -> b
snd) [([Inline], [[Block]])]
items then [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
vcat else [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
vsep
  [Doc Text]
items' <- [([Inline], [[Block]])]
-> (([Inline], [[Block]]) -> VW m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [([Inline], [[Block]])]
items ((([Inline], [[Block]]) -> VW m (Doc Text))
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> (([Inline], [[Block]]) -> VW m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ \([Inline]
term, [[Block]]
definitions) -> do
    let sepCur :: [Doc a] -> Doc a
sepCur = if [[Block]] -> Bool
isTightList [[Block]]
definitions then [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
vcat else [Doc a] -> Doc a
forall a. [Doc a] -> Doc a
vsep
    Doc Text
labeledTerm <- [Inline] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
mkVimdocDefinitionTerm [Inline]
term
    [Doc Text]
definitions' <- Int
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (m :: * -> *) a. Monad m => Int -> VW m a -> VW m a
indent Int
sw (StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ ([Block] -> VW m (Doc Text))
-> [[Block]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [Block] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [[Block]]
definitions
    Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
labeledTerm 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
<> Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
sw ([Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
sepCur [Doc Text]
definitions')
  Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
sepAll [Doc Text]
items' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

blockToVimdoc (Header Int
level (Text
ref, [Text]
_, [(Text, Text)]
_) [Inline]
inlines) = do
  Int
tw <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> Int
writerColumns (WriterOptions -> Int)
-> (WriterState -> WriterOptions) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
writerOptions)
  let rule :: Text
rule = case Int
level of
        Int
1 -> Int -> Text -> Text
T.replicate Int
tw Text
"="
        Int
2 -> Int -> Text -> Text
T.replicate Int
tw Text
"-"
        Int
_ -> Text
""
  Text
title <- (Doc Text -> Text)
-> VW m (Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall a b.
(a -> b)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing) (VW m (Doc Text)
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text)
-> ([Inline] -> VW m (Doc Text))
-> [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc ([Inline] -> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text)
-> [Inline] -> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall a b. (a -> b) -> a -> b
$ case Int
level of
    Int
3 -> [Inline] -> [Inline]
forall a. Walkable Inline a => a -> a
capitalize [Inline]
inlines
    Int
_ -> [Inline]
inlines

  Text
label <- Text -> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall (m :: * -> *). Monad m => Text -> VW m Text
mkVimdocTag Text
ref
  -- One manual space that ensures that even if spaceLeft is 0, title and ref
  -- don't touch each other
  let label' :: Text
label' = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label
  -- (+ 2) due to stars concealment
  let spaceLeft :: Int
spaceLeft = Int
tw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
title Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2

  Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat
      [ Doc Text
forall a. Doc a
blankline
      , Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
rule
      , Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyRight Int
spaceLeft Char
' ' Text
label'
      , Doc Text
forall a. Doc a
blankline
      ]

blockToVimdoc Block
HorizontalRule = do
  Int
tw <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> Int
writerColumns (WriterOptions -> Int)
-> (WriterState -> WriterOptions) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
writerOptions)
  Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text -> Text
T.replicate (Int
tw Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Text
" *") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

-- Based on blockToMarkdown' from Text.Pandoc.Writers.Markdown
blockToVimdoc t :: Block
t@(Table (Text
_, [Text]
_, [(Text, Text)]
_) Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
  let isColRowSpans :: Cell -> Bool
isColRowSpans (Cell (Text, [Text], [(Text, Text)])
_ Alignment
_ RowSpan
rs ColSpan
cs [Block]
_) = RowSpan
rs RowSpan -> RowSpan -> Bool
forall a. Ord a => a -> a -> Bool
> RowSpan
1 Bool -> Bool -> Bool
|| ColSpan
cs ColSpan -> ColSpan -> Bool
forall a. Ord a => a -> a -> Bool
> ColSpan
1
  let rowHasColRowSpans :: Row -> Bool
rowHasColRowSpans (Row (Text, [Text], [(Text, Text)])
_ [Cell]
cs) = (Cell -> Bool) -> [Cell] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Cell -> Bool
isColRowSpans [Cell]
cs
  let tbodyHasColRowSpans :: TableBody -> Bool
tbodyHasColRowSpans (TableBody (Text, [Text], [(Text, Text)])
_ RowHeadColumns
_ [Row]
rhs [Row]
rs) =
        (Row -> Bool) -> [Row] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Row -> Bool
rowHasColRowSpans [Row]
rhs Bool -> Bool -> Bool
|| (Row -> Bool) -> [Row] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Row -> Bool
rowHasColRowSpans [Row]
rs
  let theadHasColRowSpans :: TableHead -> Bool
theadHasColRowSpans (TableHead (Text, [Text], [(Text, Text)])
_ [Row]
rs) = (Row -> Bool) -> [Row] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Row -> Bool
rowHasColRowSpans [Row]
rs
  let tfootHasColRowSpans :: TableFoot -> Bool
tfootHasColRowSpans (TableFoot (Text, [Text], [(Text, Text)])
_ [Row]
rs) = (Row -> Bool) -> [Row] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Row -> Bool
rowHasColRowSpans [Row]
rs
  let hasColRowSpans :: Bool
hasColRowSpans =
        TableHead -> Bool
theadHasColRowSpans TableHead
thead
          Bool -> Bool -> Bool
|| (TableBody -> Bool) -> [TableBody] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TableBody -> Bool
tbodyHasColRowSpans [TableBody]
tbody
          Bool -> Bool -> Bool
|| TableFoot -> Bool
tfootHasColRowSpans TableFoot
tfoot
  let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[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
  let numcols :: Int
numcols =
        NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (NonEmpty Int -> Int) -> NonEmpty Int -> Int
forall a b. (a -> b) -> a -> b
$
          [Alignment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([[Block]] -> Int) -> [[[Block]]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [[Block]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Block]]
headers [[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
: [[[Block]]]
rows)
  Doc Text
caption' <- [Inline] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
caption
  let caption'' :: Doc Text
caption''
        | [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption = Doc Text
forall a. Doc a
blankline
        | Bool
otherwise = Doc Text
forall a. Doc a
blankline 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
  let hasSimpleCells :: Bool
hasSimpleCells = [[[Block]]] -> Bool
onlySimpleTableCells ([[[Block]]] -> Bool) -> [[[Block]]] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Block]]
headers [[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
: [[[Block]]]
rows
  let isSimple :: Bool
isSimple = Bool
hasSimpleCells Bool -> Bool -> Bool
&& (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasColRowSpans
  let isPlainBlock :: Block -> Bool
isPlainBlock (Plain [Inline]
_) = Bool
True
      isPlainBlock Block
_ = Bool
False
  let hasBlocks :: Bool
hasBlocks = Bool -> Bool
not (([[Block]] -> Bool) -> [[[Block]]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
isPlainBlock)) ([[[Block]]] -> Bool) -> [[[Block]]] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Block]]
headers [[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
: [[[Block]]]
rows)
  let padRow :: [Doc a] -> [Doc a]
padRow [Doc a]
r = [Doc a]
r [Doc a] -> [Doc a] -> [Doc a]
forall a. [a] -> [a] -> [a]
++ Int -> Doc a -> [Doc a]
forall a. Int -> a -> [a]
replicate Int
x Doc a
forall a. Doc a
empty
       where
        x :: Int
x = Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Doc a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc a]
r
  let aligns' :: [Alignment]
aligns' = [Alignment]
aligns [Alignment] -> [Alignment] -> [Alignment]
forall a. [a] -> [a] -> [a]
++ Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
x Alignment
AlignDefault
       where
        x :: Int
x = Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Alignment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns
  let widths' :: [Double]
widths' = [Double]
widths [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
x Double
0.0
       where
        x :: Int
x = Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths
  Int
sw <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Int
shiftWidth
  [Doc Text]
rawHeaders <- [Doc Text] -> [Doc Text]
forall {a}. [Doc a] -> [Doc a]
padRow ([Doc Text] -> [Doc Text])
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> VW m (Doc Text))
-> [[Block]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [[Block]]
headers
  [[Doc Text]]
rawRows <- ([[Block]]
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> [[[Block]]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [[Doc Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([Doc Text] -> [Doc Text])
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall a b.
(a -> b)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> [Doc Text]
forall {a}. [Doc a] -> [Doc a]
padRow (StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> ([[Block]]
    -> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> [[Block]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> VW m (Doc Text))
-> [[Block]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc) [[[Block]]]
rows
  let hasHeader :: Bool
hasHeader = ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
  if
    | Bool
isSimple -> do
        -- Simple table
        Doc Text
tbl <-
          Int -> VW m (Doc Text) -> VW m (Doc Text)
forall (m :: * -> *) a. Monad m => Int -> VW m a -> VW m a
indent Int
sw (VW m (Doc Text) -> VW m (Doc Text))
-> VW m (Doc Text) -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
            Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> VW m (Doc Text)
forall (m :: * -> *).
Monad m =>
Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> VW m (Doc Text)
vimdocTable Bool
False Bool
hasHeader [Alignment]
aligns' [Double]
widths' [Doc Text]
rawHeaders [[Doc Text]]
rawRows
        Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
sw (Doc Text
tbl 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
    | Bool -> Bool
not (Bool
hasBlocks Bool -> Bool -> Bool
|| Bool
hasColRowSpans) -> do
        -- Multiline table
        Doc Text
tbl <-
          Int -> VW m (Doc Text) -> VW m (Doc Text)
forall (m :: * -> *) a. Monad m => Int -> VW m a -> VW m a
indent Int
sw (VW m (Doc Text) -> VW m (Doc Text))
-> VW m (Doc Text) -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
            Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> VW m (Doc Text)
forall (m :: * -> *).
Monad m =>
Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> VW m (Doc Text)
vimdocTable Bool
True Bool
hasHeader [Alignment]
aligns' [Double]
widths' [Doc Text]
rawHeaders [[Doc Text]]
rawRows
        Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
sw (Doc Text
tbl 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
    | Bool
otherwise -> (Doc Text
"[TABLE]" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption'') Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
-> VW m (Doc Text)
forall a b.
a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
t)

blockToVimdoc (Figure (Text, [Text], [(Text, Text)])
_ Caption
_ [Block]
blocks) = [Block] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [Block]
blocks

blockToVimdoc (Div (Text, [Text], [(Text, Text)])
_ [Block]
blocks) = [Block] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [Block]
blocks

{- | Create a vimdoc tag. Tag is prefixed with "$vimdocPrefix-" if vimdocPrefix
is a Just value.
>>> runReader (mkVimdocTag "abc") def
"*abc*"
>>> runReader (mkVimdocTag "abc") (def{vimdocPrefix = Just "myCoolProject"})
"*myCoolProject-abc*"
-}
mkVimdocTag :: (Monad m) => Text -> VW m Text
mkVimdocTag :: forall (m :: * -> *). Monad m => Text -> VW m Text
mkVimdocTag Text
tag = do
  (WriterState -> Maybe Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Maybe Text
vimdocPrefix StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text)
-> (Maybe Text -> Text) -> VW m Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Maybe Text
_ | Text -> Bool
T.null Text
tag -> Text
""
    Maybe Text
Nothing -> Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
    Just Text
pref' -> Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pref' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"

{- | Create a hotlink for a tag, ie. a followable vimdoc link. Tag is prefixed
 - with "$vimdocPrefix-" if vimdocPrefix is a Just value
>>> runReader (mkVimdocRef "abc") def
"|abc|"
>>> runReader (mkVimdocRef "abc") (def{vimdocPrefix = Just "myCoolProject"})
"|myCoolProject-abc|"
-}
mkVimdocRef :: (Monad m) => Text -> VW m Text
mkVimdocRef :: forall (m :: * -> *). Monad m => Text -> VW m Text
mkVimdocRef Text
ref =
  (WriterState -> Maybe Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Maybe Text
vimdocPrefix StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text)
-> (Maybe Text -> Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Maybe Text
_ | Text -> Bool
T.null Text
ref -> Text
""
    Maybe Text
Nothing -> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|"
    Just Text
pref' -> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pref' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|"

mkVimdocDefinitionTerm ::
  (PandocMonad m) =>
  [Inline] ->
  VW m (Doc Text)
mkVimdocDefinitionTerm :: forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
mkVimdocDefinitionTerm [Inline]
inlines = do
  Int
il <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Int
indentLevel
  Int
tw <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> Int
writerColumns (WriterOptions -> Int)
-> (WriterState -> WriterOptions) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
writerOptions)
  Maybe Text
label <- case [Inline]
inlines of
    -- NOTE: commands in vim are unique, so they get no prefix
    [Code (Text
ref, [Text]
_, [(Text, Text)]
_) Text
code]
      | Text -> Text -> Bool
T.isPrefixOf Text
":" Text
code ->
          Maybe Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text))
-> (Text -> Maybe Text)
-> Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text))
-> Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
    [Code (Text
ref, [Text]
_, [(Text, Text)]
_) Text
_] | Bool -> Bool
not (Text -> Bool
T.null Text
ref) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall (m :: * -> *). Monad m => Text -> VW m Text
mkVimdocTag Text
ref
    [Span (Text
ref, [Text]
_, [(Text, Text)]
_) [Inline]
_] | Bool -> Bool
not (Text -> Bool
T.null Text
ref) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall (m :: * -> *). Monad m => Text -> VW m Text
mkVimdocTag Text
ref
    [Inline]
_ -> Maybe Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Maybe Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

  Doc Text
term <- case [Inline]
inlines of
    [Code (Text, [Text], [(Text, Text)])
_ Text
code] | Text -> Text -> Bool
T.isPrefixOf Text
":" Text
code -> Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code
    [Inline]
_ -> [Inline] -> VW m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines
  let termLen :: Int
termLen = Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset Doc Text
term
  let labelLen :: Int
labelLen = Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Text -> Int
T.length Maybe Text
label

  if Int
il Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
termLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
labelLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
tw
    then
      Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text))
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> VW m (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] -> VW m (Doc Text)) -> [Doc Text] -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
        [ case Maybe Text
label of
            Maybe Text
Nothing -> Doc Text
forall a. Doc a
empty
            -- (+2) due to stars concealment
            Just Text
l -> Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
rblock (Int
tw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
l) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
        , Doc Text
term
        ]
    else
      Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> VW m (Doc Text))
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> VW m (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] -> VW m (Doc Text)) -> [Doc Text] -> VW m (Doc Text)
forall a b. (a -> b) -> a -> b
$
        [ -- Since we calculated that label fits on the same line as
          -- term and since label actually must exceed textwidth to align
          -- properly, we disable wrapping.
          -- vvvvvvvv
          Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap Doc Text
term
        , case Maybe Text
label of
            Maybe Text
Nothing -> Doc Text
forall a. Doc a
empty
            -- (+2) due to stars concealment
            Just Text
l -> Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
rblock (Int
tw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
termLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
il Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
l)
        ]

-- | Write a vimdoc table
vimdocTable ::
  (Monad m) =>
  -- | whether this is a multiline table
  Bool ->
  -- | whether the table has a header
  Bool ->
  -- | column alignments
  [Alignment] ->
  -- | column widths
  [Double] ->
  -- | table header cells
  [Doc Text] ->
  -- | table body rows
  [[Doc Text]] ->
  VW m (Doc Text)
vimdocTable :: forall (m :: * -> *).
Monad m =>
Bool
-> Bool
-> [Alignment]
-> [Double]
-> [Doc Text]
-> [[Doc Text]]
-> VW m (Doc Text)
vimdocTable Bool
multiline Bool
headless [Alignment]
aligns [Double]
widths [Doc Text]
rawHeaders [[Doc Text]]
rawRows = do
  let isSimple :: Bool
isSimple = (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths
  let alignHeader :: Alignment -> Int -> Doc a -> Doc a
alignHeader Alignment
alignment = case Alignment
alignment of
        Alignment
AlignLeft -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
lblock
        Alignment
AlignCenter -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
cblock
        Alignment
AlignRight -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
rblock
        Alignment
AlignDefault -> Int -> Doc a -> Doc a
forall a. HasChars a => Int -> Doc a -> Doc a
lblock
  -- Number of characters per column necessary to output every cell
  -- without requiring a line break.
  -- The @+2@ is needed for specifying the alignment.
  let numChars :: [Doc Text] -> Int
numChars = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Doc Text] -> [Int]) -> [Doc Text] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Int) -> [Doc Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Int
forall a. (IsString a, HasChars a) => Doc a -> Int
offset
  -- Number of characters per column necessary to output every cell
  -- without requiring a line break *inside a word*.
  -- The @+2@ is needed for specifying the alignment.
  let minNumChars :: [Doc Text] -> Int
minNumChars = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Int) -> ([Doc Text] -> Int) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int)
-> ([Doc Text] -> Maybe (NonEmpty Int)) -> [Doc Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> ([Doc Text] -> [Int]) -> [Doc Text] -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Int) -> [Doc Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc Text -> Int
forall a. HasChars a => Doc a -> Int
minOffset
  let columns :: [[Doc Text]]
columns = [[Doc Text]] -> [[Doc Text]]
forall a. [[a]] -> [[a]]
transpose ([Doc Text]
rawHeaders [Doc Text] -> [[Doc Text]] -> [[Doc Text]]
forall a. a -> [a] -> [a]
: [[Doc Text]]
rawRows)

  Int
il <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Int
indentLevel

  -- x = (2 * length columns)         -- spaces for specifying the alignment
  -- y = (length columns - 1)         -- spaces between the columns
  -- x + y = (3 * length columns - 1) -- total needed correction
  Int
tw <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> Int
writerColumns (WriterOptions -> Int)
-> (WriterState -> WriterOptions) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
writerOptions)
  let tw' :: Int
tw' = Int
tw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
il Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [[Doc Text]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Doc Text]]
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  WrapOption
wrap <- (WriterState -> WrapOption)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) WrapOption
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
writerOptions)

  -- minimal column width without wrapping a single word
  let relWidth :: a -> [Doc Text] -> Int
relWidth a
w [Doc Text]
col =
        Int -> Int -> Int
forall a. Ord a => a -> a -> a
max
          (a -> Int
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
tw' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a -> a -> a
forall a. Num a => a -> a -> a
* a
w)
          ( if WrapOption
wrap WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
              then [Doc Text] -> Int
minNumChars [Doc Text]
col
              else [Doc Text] -> Int
numChars [Doc Text]
col
          )
  let widthsInChars :: [Int]
widthsInChars
        | Bool
isSimple = ([Doc Text] -> Int) -> [[Doc Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Int
numChars [[Doc Text]]
columns
        | Bool
otherwise = (Double -> [Doc Text] -> Int) -> [Double] -> [[Doc Text]] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> [Doc Text] -> Int
forall {a}. RealFrac a => a -> [Doc Text] -> Int
relWidth [Double]
widths [[Doc Text]]
columns
  let makeRow :: [Doc Text] -> Doc Text
makeRow =
        [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat
          ([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 (Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
lblock Int
1 (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
" "))
          ([Doc Text] -> [Doc Text])
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alignment -> Int -> Doc Text -> Doc Text)
-> [Alignment] -> [Int] -> [Doc Text] -> [Doc Text]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Alignment -> Int -> Doc Text -> Doc Text
forall {a}. HasChars a => Alignment -> Int -> Doc a -> Doc a
alignHeader [Alignment]
aligns [Int]
widthsInChars
  let rows' :: [Doc Text]
rows' = ([Doc Text] -> Doc Text) -> [[Doc Text]] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map [Doc Text] -> Doc Text
makeRow [[Doc Text]]
rawRows
  -- TODO: reduce tw in case head is not empty
  let head' :: Doc Text
head' = [Doc Text] -> Doc Text
makeRow [Doc Text]
rawHeaders Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
" ~"
  let head'' :: Doc Text
head'' =
        if Bool
headless
          then Doc Text
forall a. Doc a
empty
          else Doc Text
head'
  let body :: Doc Text
body =
        if Bool
multiline
          then
            [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep [Doc Text]
rows'
              Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ if [Doc Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc Text]
rows' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
                then Doc Text
forall a. Doc a
blankline
                else Doc Text
forall a. Doc a
empty
          else [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows'
  Doc Text -> VW m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> VW m (Doc Text)) -> Doc Text -> VW 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
head''
      Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (if Bool
multiline then Doc Text
forall a. Doc a
blankline else Doc Text
forall a. Doc a
empty)
      Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body

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

inlineListToVimdoc :: (PandocMonad m) => [Inline] -> VW m (Doc Text)
inlineListToVimdoc :: forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Inline
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> VW m (Doc Text)
inlineToVimdoc [Inline]
inlines

inlineToVimdoc :: (PandocMonad m) => Inline -> VW m (Doc Text)

inlineToVimdoc :: forall (m :: * -> *). PandocMonad m => Inline -> VW m (Doc Text)
inlineToVimdoc (Str Text
str) = Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> (Text -> Doc Text)
-> Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState 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
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text
replaceSpecialStrings Text
str

-- Neither `:h help-writing`, nor neovim's grammar.js for vimdoc and
-- highlights.scm say anything about styling text, so we strip all the
-- formatting
inlineToVimdoc (Emph [Inline]
inlines) = [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines
inlineToVimdoc (Underline [Inline]
inlines) = [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines
inlineToVimdoc (Strong [Inline]
inlines) = [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines
inlineToVimdoc (Strikeout [Inline]
inlines) = [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines
inlineToVimdoc (Superscript [Inline]
inlines) = [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines
inlineToVimdoc (Subscript [Inline]
inlines) = [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines
inlineToVimdoc (SmallCaps [Inline]
inlines) = [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines

inlineToVimdoc (Quoted QuoteType
typ [Inline]
inlines) =
  let quote :: Doc Text
quote = case QuoteType
typ of QuoteType
SingleQuote -> Doc Text
"'"; QuoteType
DoubleQuote -> Doc Text
"\""
   in [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
-> (Doc Text
    -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b.
StateT (Seq (Doc Text)) (ReaderT WriterState m) a
-> (a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) b)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Doc Text
text -> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
quote Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
text Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
quote)

inlineToVimdoc (Cite [Citation]
_citations [Inline]
inlines) = [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines

inlineToVimdoc (Code (Text
_, [Text]
cls, [(Text, Text)]
_) Text
code) = do
  let hasNoLang :: Bool
hasNoLang = [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls
  Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> (Text -> Doc Text)
-> Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState 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
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ case Text -> [Text]
T.words Text
code of
    [Text
":help", Text
ref] | Bool
hasNoLang -> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|"
    [Text
":h", Text
ref]    | Bool
hasNoLang -> Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|"
    [Text]
_                          -> Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

inlineToVimdoc Inline
Space = Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Doc a
space
inlineToVimdoc Inline
SoftBreak =
  (WriterState -> WrapOption)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) WrapOption
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
writerOptions) StateT (Seq (Doc Text)) (ReaderT WriterState m) WrapOption
-> (WrapOption
    -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b.
StateT (Seq (Doc Text)) (ReaderT WriterState m) a
-> (a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) b)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    WrapOption
WrapAuto -> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Doc a
space
    WrapOption
WrapNone -> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
" "
    WrapOption
WrapPreserve -> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
"\n"

inlineToVimdoc Inline
LineBreak = Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
"\n"

inlineToVimdoc (Math MathType
_ Text
math) = Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> (Text -> Doc Text)
-> Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState 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
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text
"`$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
math Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$`"

inlineToVimdoc inline :: Inline
inline@(RawInline (Format Text
format) Text
text) = case Text
format of
  Text
"vimdoc" -> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
text
  Text
_ -> Doc Text
"" Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b.
a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Inline -> LogMessage
InlineNotRendered Inline
inline)

inlineToVimdoc (Link (Text, [Text], [(Text, Text)])
_ [Inline]
txt (Text
src, Text
_)) = do
  let srcSuffix :: Text
srcSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
src (Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src)
  Text
linkText <- Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
txt

  let isAutolink :: Bool
isAutolink = case [Inline]
txt of
        [Str Text
x] | Text -> Text
escapeURI Text
x Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
src, Text
srcSuffix] -> Bool
True
        [Inline]
_ -> Bool
False

  Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ case Text -> Either PandocError Text
refdocLinkToLink Text
src of
    Right Text
link | Bool
isAutolink -> 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
link Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"|"
    Right Text
link ->
      Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
T.stripEnd Text
linkText) 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
<> 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
link Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"|"
    Left PandocError
_ | Text -> Bool
isURI Text
src, Bool
isAutolink -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
srcSuffix
    Left PandocError
_ -> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
T.stripEnd Text
linkText) 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
srcSuffix

inlineToVimdoc (Image {}) = Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
""

inlineToVimdoc (Note [Block]
blocks) = do
  Int
newN <- (Seq (Doc Text) -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Seq (Doc Text) -> Int) -> Seq (Doc Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Doc Text) -> Int
forall a. Seq a -> Int
Seq.length)
  Doc Text
contents <- [Block]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> VW m (Doc Text)
blockListToVimdoc [Block]
blocks
  Text
tag <- Text -> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall (m :: * -> *). Monad m => Text -> VW m Text
mkVimdocTag (Text
"footnote" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
newN)
  Int
tw <- (WriterState -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WriterOptions -> Int
writerColumns (WriterOptions -> Int)
-> (WriterState -> WriterOptions) -> WriterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
writerOptions)

  -- (+2) due to concealment of stars
  --                     vvvvvvvv
  let taggedContents :: Doc Text
taggedContents = Int -> Doc Text -> Doc Text
forall a. HasChars a => Int -> Doc a -> Doc a
rblock (Int
tw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
tag) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
  (Seq (Doc Text) -> Seq (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Seq (Doc Text) -> Doc Text -> Seq (Doc Text)
forall a. Seq a -> a -> Seq a
|> Doc Text
taggedContents)

  Text
ref <- Text -> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall (m :: * -> *). Monad m => Text -> VW m Text
mkVimdocRef (Text
"footnote" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
newN)
  Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ 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
ref

inlineToVimdoc (Span (Text, [Text], [(Text, Text)])
_ [Inline]
inlines) = [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> VW m (Doc Text)
inlineListToVimdoc [Inline]
inlines


refdocLinkToLink :: Text -> Either PandocError Text
refdocLinkToLink :: Text -> Either PandocError Text
refdocLinkToLink Text
x = (\Parsec Sources (Maybe Any) Text
parser -> Parsec Sources (Maybe Any) Text
-> Maybe Any -> Text -> Either PandocError Text
forall t st a.
ToSources t =>
Parsec Sources st a -> st -> t -> Either PandocError a
readWith Parsec Sources (Maybe Any) Text
parser Maybe Any
forall a. Maybe a
Nothing Text
x) (Parsec Sources (Maybe Any) Text -> Either PandocError Text)
-> Parsec Sources (Maybe Any) Text -> Either PandocError Text
forall a b. (a -> b) -> a -> b
$ do
  [Char] -> ParsecT Sources (Maybe Any) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"http" ParsecT Sources (Maybe Any) Identity [Char]
-> ParsecT Sources (Maybe Any) Identity (Maybe Char)
-> ParsecT Sources (Maybe Any) Identity (Maybe Char)
forall a b.
ParsecT Sources (Maybe Any) Identity a
-> ParsecT Sources (Maybe Any) Identity b
-> ParsecT Sources (Maybe Any) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources (Maybe Any) Identity Char
-> ParsecT Sources (Maybe Any) Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> ParsecT Sources (Maybe Any) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
's') ParsecT Sources (Maybe Any) Identity (Maybe Char)
-> ParsecT Sources (Maybe Any) Identity [Char]
-> ParsecT Sources (Maybe Any) Identity [Char]
forall a b.
ParsecT Sources (Maybe Any) Identity a
-> ParsecT Sources (Maybe Any) Identity b
-> ParsecT Sources (Maybe Any) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Sources (Maybe Any) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"://"

  let vimhelpP :: ParsecT Sources u Identity Text
vimhelpP = do
        ParsecT Sources u Identity [Char]
-> ParsecT Sources u Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Sources u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"vimhelp.org/") ParsecT Sources u Identity [Char]
-> ParsecT Sources u Identity [Char]
-> ParsecT Sources u Identity [Char]
forall a.
ParsecT Sources u Identity a
-> ParsecT Sources u Identity a -> ParsecT Sources u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> ParsecT Sources u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"neo.vimhelp.org/"

        ParsecT Sources u Identity Text -> ParsecT Sources u Identity Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources u Identity Char
-> ParsecT Sources u Identity Char
-> ParsecT Sources u Identity [Char]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParsecT s st m a -> ParsecT s st m end -> ParsecT s st m [a]
many1Till ParsecT Sources u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Char -> ParsecT Sources u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#') ParsecT Sources u Identity [Char]
-> ParsecT Sources u Identity Text
-> ParsecT Sources u Identity Text
forall a b.
ParsecT Sources u Identity a
-> ParsecT Sources u Identity b -> ParsecT Sources u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources u Identity Char
-> ParsecT Sources u Identity () -> ParsecT Sources u Identity Text
forall end s (m :: * -> *) t st.
(Show end, Stream s m t) =>
ParsecT s st m Char -> ParsecT s st m end -> ParsecT s st m Text
many1TillChar ParsecT Sources u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT Sources u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
          ParsecT Sources u Identity Text
-> ParsecT Sources u Identity Text
-> ParsecT Sources u Identity Text
forall a.
ParsecT Sources u Identity a
-> ParsecT Sources u Identity a -> ParsecT Sources u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Sources u Identity Char
-> ParsecT Sources u Identity () -> ParsecT Sources u Identity Text
forall end s (m :: * -> *) t st.
(Show end, Stream s m t) =>
ParsecT s st m Char -> ParsecT s st m end -> ParsecT s st m Text
many1TillChar ParsecT Sources u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT Sources u Identity () -> ParsecT Sources u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources u Identity () -> ParsecT Sources u Identity ())
-> ParsecT Sources u Identity () -> ParsecT Sources u Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Sources u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
".html" ParsecT Sources u Identity [Char]
-> ParsecT Sources u Identity () -> ParsecT Sources u Identity ()
forall a b.
ParsecT Sources u Identity a
-> ParsecT Sources u Identity b -> ParsecT Sources u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)

  let neovimP :: ParsecT Sources u Identity Text
neovimP = do
        [Char] -> ParsecT Sources u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"neovim.io/doc/user/"
        ParsecT Sources u Identity Text -> ParsecT Sources u Identity Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources u Identity Char
-> ParsecT Sources u Identity Char
-> ParsecT Sources u Identity [Char]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParsecT s st m a -> ParsecT s st m end -> ParsecT s st m [a]
many1Till ParsecT Sources u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Char -> ParsecT Sources u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#') ParsecT Sources u Identity [Char]
-> ParsecT Sources u Identity Text
-> ParsecT Sources u Identity Text
forall a b.
ParsecT Sources u Identity a
-> ParsecT Sources u Identity b -> ParsecT Sources u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources u Identity Char
-> ParsecT Sources u Identity () -> ParsecT Sources u Identity Text
forall end s (m :: * -> *) t st.
(Show end, Stream s m t) =>
ParsecT s st m Char -> ParsecT s st m end -> ParsecT s st m Text
many1TillChar ParsecT Sources u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT Sources u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
          ParsecT Sources u Identity Text
-> ParsecT Sources u Identity Text
-> ParsecT Sources u Identity Text
forall a.
ParsecT Sources u Identity a
-> ParsecT Sources u Identity a -> ParsecT Sources u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do Text
base <- ParsecT Sources u Identity Char
-> ParsecT Sources u Identity () -> ParsecT Sources u Identity Text
forall end s (m :: * -> *) t st.
(Show end, Stream s m t) =>
ParsecT s st m Char -> ParsecT s st m end -> ParsecT s st m Text
many1TillChar ParsecT Sources u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT Sources u Identity () -> ParsecT Sources u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources u Identity () -> ParsecT Sources u Identity ())
-> ParsecT Sources u Identity () -> ParsecT Sources u Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Sources u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
".html" ParsecT Sources u Identity [Char]
-> ParsecT Sources u Identity () -> ParsecT Sources u Identity ()
forall a b.
ParsecT Sources u Identity a
-> ParsecT Sources u Identity b -> ParsecT Sources u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
                 Text -> ParsecT Sources u Identity Text
forall a. a -> ParsecT Sources u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ParsecT Sources u Identity Text)
-> Text -> ParsecT Sources u Identity Text
forall a b. (a -> b) -> a -> b
$ Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".txt"

  Parsec Sources (Maybe Any) Text -> Parsec Sources (Maybe Any) Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Sources (Maybe Any) Text
forall {u}. ParsecT Sources u Identity Text
vimhelpP Parsec Sources (Maybe Any) Text
-> Parsec Sources (Maybe Any) Text
-> Parsec Sources (Maybe Any) Text
forall a.
ParsecT Sources (Maybe Any) Identity a
-> ParsecT Sources (Maybe Any) Identity a
-> ParsecT Sources (Maybe Any) Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Sources (Maybe Any) Text
forall {u}. ParsecT Sources u Identity Text
neovimP