{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Writers.Texinfo
   Copyright   : Copyright (C) 2008-2019 John MacFarlane
                               2012 Peter Wang
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' format into Texinfo.
-}
module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where
import Prelude
import Control.Monad.Except (throwError)
import Control.Monad.State.Strict
import Data.Char (chr, ord)
import Data.List (maximumBy, transpose)
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (unEscapeString)
import System.FilePath
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)

data WriterState =
  WriterState { WriterState -> Bool
stStrikeout   :: Bool  -- document contains strikeout
              , WriterState -> Bool
stEscapeComma :: Bool -- in a context where we need @comma
              , WriterState -> Set Text
stIdentifiers :: Set.Set Text -- header ids used already
              , WriterState -> WriterOptions
stOptions     :: WriterOptions -- writer options
              }

{- TODO:
 - internal cross references a la HTML
 - generated .texi files don't work when run through texi2dvi
 -}

type TI m = StateT WriterState m

-- | Convert Pandoc to Texinfo.
writeTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTexinfo :: WriterOptions -> Pandoc -> m Text
writeTexinfo options :: WriterOptions
options document :: Pandoc
document =
  StateT WriterState m Text -> WriterState -> m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions -> Pandoc -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> TI m Text
pandocToTexinfo WriterOptions
options (Pandoc -> StateT WriterState m Text)
-> Pandoc -> StateT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Pandoc -> Pandoc
wrapTop Pandoc
document)
  WriterState :: Bool -> Bool -> Set Text -> WriterOptions -> WriterState
WriterState { stStrikeout :: Bool
stStrikeout = Bool
False, stEscapeComma :: Bool
stEscapeComma = Bool
False,
                stIdentifiers :: Set Text
stIdentifiers = Set Text
forall a. Set a
Set.empty, stOptions :: WriterOptions
stOptions = WriterOptions
options}

-- | Add a "Top" node around the document, needed by Texinfo.
wrapTop :: Pandoc -> Pandoc
wrapTop :: Pandoc -> Pandoc
wrapTop (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) =
  Meta -> [Block] -> Pandoc
Pandoc Meta
meta (Int -> Attr -> [Inline] -> Block
Header 0 Attr
nullAttr (Meta -> [Inline]
docTitle Meta
meta) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
blocks)

pandocToTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> TI m Text
pandocToTexinfo :: WriterOptions -> Pandoc -> TI m Text
pandocToTexinfo options :: WriterOptions
options (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) = do
  let titlePage :: Bool
titlePage = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ([Inline] -> Bool) -> [[Inline]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
                      ([[Inline]] -> Bool) -> [[Inline]] -> Bool
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta [Inline] -> [[Inline]] -> [[Inline]]
forall a. a -> [a] -> [a]
: Meta -> [Inline]
docDate Meta
meta [Inline] -> [[Inline]] -> [[Inline]]
forall a. a -> [a] -> [a]
: Meta -> [[Inline]]
docAuthors Meta
meta
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
options WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
options
                    else Maybe Int
forall a. Maybe a
Nothing
  Context Text
metadata <- WriterOptions
-> ([Block] -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> Meta
-> StateT WriterState m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
options
              ([Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo)
              ((Doc Text -> Doc Text)
-> StateT WriterState m (Doc Text)
-> StateT WriterState m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (StateT WriterState m (Doc Text)
 -> StateT WriterState m (Doc Text))
-> ([Inline] -> StateT WriterState m (Doc Text))
-> [Inline]
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Inline] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo)
              Meta
meta
  Doc Text
body <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
blocks
  WriterState
st <- StateT WriterState m WriterState
forall s (m :: * -> *). MonadState s m => m s
get
  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 "body" Doc Text
body
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
options)
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "titlepage" Bool
titlePage
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField "strikeout" (WriterState -> Bool
stStrikeout WriterState
st) Context Text
metadata
  Text -> TI m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TI m Text) -> Text -> TI m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
options of
       Nothing  -> Doc Text
body
       Just tpl :: Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

-- | Escape things as needed for Texinfo.
stringToTexinfo :: Text -> Text
stringToTexinfo :: Text -> Text
stringToTexinfo = [(Char, Text)] -> Text -> Text
escapeStringUsing [(Char, Text)]
texinfoEscapes
  where texinfoEscapes :: [(Char, Text)]
texinfoEscapes = [ ('{', "@{")
                         , ('}', "@}")
                         , ('@', "@@")
                         , ('\160', "@ ")
                         , ('\x2014', "---")
                         , ('\x2013', "--")
                         , ('\x2026', "@dots{}")
                         , ('\x2019', "'")
                         ]

escapeCommas :: PandocMonad m => TI m (Doc Text) -> TI m (Doc Text)
escapeCommas :: TI m (Doc Text) -> TI m (Doc Text)
escapeCommas parser :: TI m (Doc Text)
parser = do
  Bool
oldEscapeComma <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stEscapeComma
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stEscapeComma :: Bool
stEscapeComma = Bool
True }
  Doc Text
res <- TI m (Doc Text)
parser
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stEscapeComma :: Bool
stEscapeComma = Bool
oldEscapeComma }
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
res

-- | Puts contents into Texinfo command.
inCmd :: Text -> Doc Text -> Doc Text
inCmd :: Text -> Doc Text -> Doc Text
inCmd cmd :: Text
cmd contents :: Doc Text
contents = Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char '@' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
cmd Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents

-- | Convert Pandoc block element to Texinfo.
blockToTexinfo :: PandocMonad m
               => Block     -- ^ Block to convert
               -> TI m (Doc Text)

blockToTexinfo :: Block -> TI m (Doc Text)
blockToTexinfo Null = Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty

blockToTexinfo (Div _ bs :: [Block]
bs) = [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
bs

blockToTexinfo (Plain lst :: [Inline]
lst) =
  [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst

-- title beginning with fig: indicates that the image is a figure
blockToTexinfo (Para [Image attr :: Attr
attr txt :: [Inline]
txt (src :: Text
src,tgt :: Text
tgt)])
  | Just tit :: Text
tit <- Text -> Text -> Maybe Text
T.stripPrefix "fig:" Text
tgt = do
      Doc Text
capt <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
              then Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
              else (\c :: Doc Text
c -> String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@caption" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
c) (Doc Text -> Doc Text) -> TI m (Doc Text) -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
                     [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
txt
      Doc Text
img  <- Inline -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> TI m (Doc Text)
inlineToTexinfo (Attr -> [Inline] -> Target -> Inline
Image Attr
attr [Inline]
txt (Text
src,Text
tit))
      Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@float" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
img Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end float"

blockToTexinfo (Para lst :: [Inline]
lst) =
  [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst    -- this is handled differently from Plain in blockListToTexinfo

blockToTexinfo (LineBlock lns :: [[Inline]]
lns) =
  Block -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> TI m (Doc Text)
blockToTexinfo (Block -> TI m (Doc Text)) -> Block -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns

blockToTexinfo (BlockQuote lst :: [Block]
lst) = do
  Doc Text
contents <- [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@quotation" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end quotation"

blockToTexinfo (CodeBlock _ str :: Text
str) =
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI 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
$$
         String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@verbatim" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
         Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
         String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end verbatim" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

blockToTexinfo b :: Block
b@(RawBlock f :: Format
f str :: Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "texinfo" = Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "tex" =
                      Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@tex" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end tex"
  | Bool
otherwise      = do
      LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty

blockToTexinfo (BulletList lst :: [[Block]]
lst) = do
  [Doc Text]
items <- ([Block] -> TI m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
listItemToTexinfo [[Block]]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@itemize" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end itemize" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

blockToTexinfo (OrderedList (start :: Int
start, numstyle :: ListNumberStyle
numstyle, _) lst :: [[Block]]
lst) = do
  [Doc Text]
items <- ([Block] -> TI m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
listItemToTexinfo [[Block]]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@enumerate " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
exemplar Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end enumerate" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
  where
    exemplar :: Doc Text
exemplar = case ListNumberStyle
numstyle of
                DefaultStyle -> Doc Text
decimal
                Decimal      -> Doc Text
decimal
                Example      -> Doc Text
decimal
                UpperRoman   -> Doc Text
decimal   -- Roman numerals not supported
                LowerRoman   -> Doc Text
decimal
                UpperAlpha   -> Doc Text
upperAlpha
                LowerAlpha   -> Doc Text
lowerAlpha
    decimal :: Doc Text
decimal = if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
                 then Doc Text
forall a. Doc a
empty
                 else String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
start)
    upperAlpha :: Doc Text
upperAlpha = String -> Doc Text
forall a. HasChars a => String -> Doc a
text [Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord 'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]
    lowerAlpha :: Doc Text
lowerAlpha = String -> Doc Text
forall a. HasChars a => String -> Doc a
text [Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord 'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]

blockToTexinfo (DefinitionList lst :: [([Inline], [[Block]])]
lst) = do
  [Doc Text]
items <- (([Inline], [[Block]]) -> TI m (Doc Text))
-> [([Inline], [[Block]])] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Inline], [[Block]]) -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> TI m (Doc Text)
defListItemToTexinfo [([Inline], [[Block]])]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@table @asis" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end table" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

blockToTexinfo HorizontalRule =
    -- XXX can't get the equivalent from LaTeX.hs to work
    Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@iftex" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
             String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@bigskip@hrule@bigskip" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
             String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end iftex" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
             String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@ifnottex" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
             String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate 72 '-') Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
             String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end ifnottex"

blockToTexinfo (Header 0 _ lst :: [Inline]
lst) = do
  Doc Text
txt <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
lst
            then Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "Top"
            else [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@node Top" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@top " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
txt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline

blockToTexinfo (Header level :: Int
level (ident :: Text
ident,_,_) lst :: [Inline]
lst)
  | Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 Bool -> Bool -> Bool
|| Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 4 = Block -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> TI m (Doc Text)
blockToTexinfo ([Inline] -> Block
Para [Inline]
lst)
  | Bool
otherwise = do
    Doc Text
node <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListForNode [Inline]
lst
    Doc Text
txt <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
    Set Text
idsUsed <- (WriterState -> Set Text) -> StateT WriterState m (Set Text)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Set Text
stIdentifiers
    WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
    let id' :: Text
id' = if Text -> Bool
T.null Text
ident
                 then Extensions -> [Inline] -> Set Text -> Text
uniqueIdent (WriterOptions -> Extensions
writerExtensions WriterOptions
opts) [Inline]
lst Set Text
idsUsed
                 else Text
ident
    (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stIdentifiers :: Set Text
stIdentifiers = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
id' Set Text
idsUsed }
    Text
sec <- Int -> TI m Text
forall (m :: * -> *). PandocMonad m => Int -> TI m Text
seccmd Int
level
    Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if (Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) Bool -> Bool -> Bool
&& (Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 4)
                then Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@node " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
node Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                     Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
sec Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
txt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                     String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@anchor" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (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 -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id')
                else Doc Text
txt
    where
      seccmd :: PandocMonad m => Int -> TI m Text
      seccmd :: Int -> TI m Text
seccmd 1 = Text -> TI m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "@chapter "
      seccmd 2 = Text -> TI m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "@section "
      seccmd 3 = Text -> TI m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "@subsection "
      seccmd 4 = Text -> TI m Text
forall (m :: * -> *) a. Monad m => a -> m a
return "@subsubsection "
      seccmd _ = PandocError -> TI m Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> TI m Text) -> PandocError -> TI m Text
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError "illegal seccmd level"

blockToTexinfo (Table caption :: [Inline]
caption aligns :: [Alignment]
aligns widths :: [Double]
widths heads :: [[Block]]
heads rows :: [[[Block]]]
rows) = do
  Doc Text
headers <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
heads
                then Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                else [Alignment] -> [[Block]] -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Alignment] -> [[Block]] -> TI m (Doc Text)
tableHeadToTexinfo [Alignment]
aligns [[Block]]
heads
  Doc Text
captionText <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
caption
  [Doc Text]
rowsText <- ([[Block]] -> TI m (Doc Text))
-> [[[Block]]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Alignment] -> [[Block]] -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Alignment] -> [[Block]] -> TI m (Doc Text)
tableRowToTexinfo [Alignment]
aligns) [[[Block]]]
rows
  String
colDescriptors <-
    if (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
== 0) [Double]
widths
       then do -- use longest entry instead of column widths
            [[String]]
cols <- ([[Block]] -> StateT WriterState m [String])
-> [[[Block]]] -> StateT WriterState m [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Block] -> StateT WriterState m String)
-> [[Block]] -> StateT WriterState m [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Doc Text] -> String)
-> StateT WriterState m [Doc Text] -> StateT WriterState m String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Text -> String
T.unpack (Text -> String) -> ([Doc Text] -> Text) -> [Doc Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat) (StateT WriterState m [Doc Text] -> StateT WriterState m String)
-> ([Block] -> StateT WriterState m [Doc Text])
-> [Block]
-> StateT WriterState m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> TI m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> TI m (Doc Text)
blockToTexinfo)) ([[[Block]]] -> StateT WriterState m [[String]])
-> [[[Block]]] -> StateT WriterState m [[String]]
forall a b. (a -> b) -> a -> b
$
                        [[[Block]]] -> [[[Block]]]
forall a. [[a]] -> [[a]]
transpose ([[[Block]]] -> [[[Block]]]) -> [[[Block]]] -> [[[Block]]]
forall a b. (a -> b) -> a -> b
$ [[Block]]
heads [[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
: [[[Block]]]
rows
            String -> StateT WriterState m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT WriterState m String)
-> String -> StateT WriterState m String
forall a b. (a -> b) -> a -> b
$ ([String] -> String) -> [[String]] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((\x :: String
x -> "{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
xString -> String -> String
forall a. [a] -> [a] -> [a]
++"} ") (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (String -> String -> Ordering) -> [String] -> String
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((String -> Int) -> String -> String -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)) [[String]]
cols
       else String -> StateT WriterState m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> StateT WriterState m String)
-> String -> StateT WriterState m String
forall a b. (a -> b) -> a -> b
$ "@columnfractions " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Double -> String) -> [Double] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Double -> String
forall r. PrintfType r => String -> r
printf "%.2f ") [Double]
widths
  let tableBody :: Doc Text
tableBody = String -> Doc Text
forall a. HasChars a => String -> Doc a
text ("@multitable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
colDescriptors) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                  Doc Text
headers Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                  [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rowsText Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                  String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end multitable"
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
captionText
              then Doc Text
tableBody Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
              else String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@float" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                   Doc Text
tableBody Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                   Text -> Doc Text -> Doc Text
inCmd "caption" Doc Text
captionText Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                   String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end float"

tableHeadToTexinfo :: PandocMonad m
                   => [Alignment]
                   -> [[Block]]
                   -> TI m (Doc Text)
tableHeadToTexinfo :: [Alignment] -> [[Block]] -> TI m (Doc Text)
tableHeadToTexinfo = Text -> [Alignment] -> [[Block]] -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Alignment] -> [[Block]] -> TI m (Doc Text)
tableAnyRowToTexinfo "@headitem "

tableRowToTexinfo :: PandocMonad m
                  => [Alignment]
                  -> [[Block]]
                  -> TI m (Doc Text)
tableRowToTexinfo :: [Alignment] -> [[Block]] -> TI m (Doc Text)
tableRowToTexinfo = Text -> [Alignment] -> [[Block]] -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> [Alignment] -> [[Block]] -> TI m (Doc Text)
tableAnyRowToTexinfo "@item "

tableAnyRowToTexinfo :: PandocMonad m
                     => Text
                     -> [Alignment]
                     -> [[Block]]
                     -> TI m (Doc Text)
tableAnyRowToTexinfo :: Text -> [Alignment] -> [[Block]] -> TI m (Doc Text)
tableAnyRowToTexinfo itemtype :: Text
itemtype aligns :: [Alignment]
aligns cols :: [[Block]]
cols =
  (Alignment -> [Block] -> TI m (Doc Text))
-> [Alignment] -> [[Block]] -> StateT WriterState m [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Alignment -> [Block] -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Alignment -> [Block] -> TI m (Doc Text)
alignedBlock [Alignment]
aligns [[Block]]
cols StateT WriterState m [Doc Text]
-> ([Doc Text] -> TI m (Doc Text)) -> TI m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text))
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> TI 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
itemtype Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$) (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)
-> Doc Text -> [Doc Text] -> Doc Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\row :: Doc Text
row item :: Doc Text
item -> Doc Text
row Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
  (if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
row then Doc Text
forall a. Doc a
empty else String -> Doc Text
forall a. HasChars a => String -> Doc a
text " @tab ") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
item) Doc Text
forall a. Doc a
empty

alignedBlock :: PandocMonad m
             => Alignment
             -> [Block]
             -> TI m (Doc Text)
-- XXX @flushleft and @flushright text won't get word wrapped.  Since word
-- wrapping is more important than alignment, we ignore the alignment.
alignedBlock :: Alignment -> [Block] -> TI m (Doc Text)
alignedBlock _ = [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo
{-
alignedBlock AlignLeft col = do
  b <- blockListToTexinfo col
  return $ text "@flushleft" $$ b $$ text "@end flushleft"
alignedBlock AlignRight col = do
  b <- blockListToTexinfo col
  return $ text "@flushright" $$ b $$ text "@end flushright"
alignedBlock _ col = blockListToTexinfo col
-}

-- | Convert Pandoc block elements to Texinfo.
blockListToTexinfo :: PandocMonad m
                   => [Block]
                   -> TI m (Doc Text)
blockListToTexinfo :: [Block] -> TI m (Doc Text)
blockListToTexinfo [] = Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockListToTexinfo (x :: Block
x:xs :: [Block]
xs) = do
  Doc Text
x' <- Block -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> TI m (Doc Text)
blockToTexinfo Block
x
  case Block
x of
    Header level :: Int
level _ _ -> do
      -- We need need to insert a menu for this node.
      let (before :: [Block]
before, after :: [Block]
after) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isHeaderBlock [Block]
xs
      Doc Text
before' <- [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
before
      let menu :: [Block]
menu = if Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 4
                    then Int -> [Block] -> [Block]
collectNodes (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [Block]
after
                    else []
      [Doc Text]
lines' <- (Block -> TI m (Doc Text))
-> [Block] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> TI m (Doc Text)
makeMenuLine [Block]
menu
      let menu' :: Doc Text
menu' = if [Doc Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
lines'
                    then Doc Text
forall a. Doc a
empty
                    else Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                         String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@menu" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                         [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
lines' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                         String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end menu"
      Doc Text
after' <- [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
after
      Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
x' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
before' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
menu' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
after'
    Para _ -> do
      Doc Text
xs' <- [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
xs
      case [Block]
xs of
           (CodeBlock _ _:_) -> Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
x' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
xs'
           _                 -> Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
x' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ Doc Text
xs'
    _ -> do
      Doc Text
xs' <- [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
xs
      Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
x' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
xs'

collectNodes :: Int -> [Block] -> [Block]
collectNodes :: Int -> [Block] -> [Block]
collectNodes _ [] = []
collectNodes level :: Int
level (x :: Block
x:xs :: [Block]
xs) =
  case Block
x of
    (Header hl :: Int
hl _ _) | Int
hl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
level -> []
                    | Int
hl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
level -> Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: Int -> [Block] -> [Block]
collectNodes Int
level [Block]
xs
                    | Bool
otherwise -> Int -> [Block] -> [Block]
collectNodes Int
level [Block]
xs
    _ ->
      Int -> [Block] -> [Block]
collectNodes Int
level [Block]
xs

makeMenuLine :: PandocMonad m
             => Block
             -> TI m (Doc Text)
makeMenuLine :: Block -> TI m (Doc Text)
makeMenuLine (Header _ _ lst :: [Inline]
lst) = do
  Doc Text
txt <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListForNode [Inline]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "* " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
txt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text "::"
makeMenuLine _ = PandocError -> TI m (Doc Text)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> TI m (Doc Text)) -> PandocError -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError "makeMenuLine called with non-Header block"

listItemToTexinfo :: PandocMonad m
                  => [Block]
                  -> TI m (Doc Text)
listItemToTexinfo :: [Block] -> TI m (Doc Text)
listItemToTexinfo lst :: [Block]
lst = do
  Doc Text
contents <- [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
lst
  let spacer :: Doc a
spacer = case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
lst of
                    (Para{}:_) -> Doc a
forall a. Doc a
blankline
                    _          -> Doc a
forall a. Doc a
empty
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@item" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
spacer

defListItemToTexinfo :: PandocMonad m
                     => ([Inline], [[Block]])
                     -> TI m (Doc Text)
defListItemToTexinfo :: ([Inline], [[Block]]) -> TI m (Doc Text)
defListItemToTexinfo (term :: [Inline]
term, defs :: [[Block]]
defs) = do
    Doc Text
term' <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
term
    let defToTexinfo :: [Block] -> StateT WriterState m (Doc Text)
defToTexinfo bs :: [Block]
bs = do Doc Text
d <- [Block] -> StateT WriterState m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
bs
                             case [Block] -> [Block]
forall a. [a] -> [a]
reverse [Block]
bs of
                                  (Para{}:_) -> Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
d Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
                                  _          -> Doc Text -> StateT WriterState m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
d
    [Doc Text]
defs' <- ([Block] -> TI m (Doc Text))
-> [[Block]] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
defToTexinfo [[Block]]
defs
    Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@item " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
term' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$+$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
defs'

-- | Convert list of inline elements to Texinfo.
inlineListToTexinfo :: PandocMonad m
                    => [Inline]  -- ^ Inlines to convert
                    -> TI m (Doc Text)
inlineListToTexinfo :: [Inline] -> TI m (Doc Text)
inlineListToTexinfo lst :: [Inline]
lst = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT WriterState m [Doc Text] -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> TI m (Doc Text))
-> [Inline] -> StateT WriterState m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Inline -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> TI m (Doc Text)
inlineToTexinfo [Inline]
lst

-- | Convert list of inline elements to Texinfo acceptable for a node name.
inlineListForNode :: PandocMonad m
                  => [Inline]  -- ^ Inlines to convert
                  -> TI m (Doc Text)
inlineListForNode :: [Inline] -> TI m (Doc Text)
inlineListForNode = Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text))
-> ([Inline] -> Doc Text) -> [Inline] -> TI 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 -> Doc Text) -> ([Inline] -> Text) -> [Inline] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stringToTexinfo (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
disallowedInNode) (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify

-- periods, commas, colons, and parentheses are disallowed in node names
disallowedInNode :: Char -> Bool
disallowedInNode :: Char -> Bool
disallowedInNode c :: Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (".,:()" :: String)

-- | Convert inline element to Texinfo
inlineToTexinfo :: PandocMonad m
                => Inline    -- ^ Inline to convert
                -> TI m (Doc Text)

inlineToTexinfo :: Inline -> TI m (Doc Text)
inlineToTexinfo (Span _ lst :: [Inline]
lst) =
  [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst

inlineToTexinfo (Emph lst :: [Inline]
lst) =
  Text -> Doc Text -> Doc Text
inCmd "emph" (Doc Text -> Doc Text) -> TI m (Doc Text) -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst

inlineToTexinfo (Strong lst :: [Inline]
lst) =
  Text -> Doc Text -> Doc Text
inCmd "strong" (Doc Text -> Doc Text) -> TI m (Doc Text) -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst

inlineToTexinfo (Strikeout lst :: [Inline]
lst) = do
  (WriterState -> WriterState) -> StateT WriterState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> StateT WriterState m ())
-> (WriterState -> WriterState) -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ \st :: WriterState
st -> WriterState
st{ stStrikeout :: Bool
stStrikeout = Bool
True }
  Doc Text
contents <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@textstrikeout{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text "}"

inlineToTexinfo (Superscript lst :: [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@sup{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char '}'

inlineToTexinfo (Subscript lst :: [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@sub{" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char '}'

inlineToTexinfo (SmallCaps lst :: [Inline]
lst) =
  Text -> Doc Text -> Doc Text
inCmd "sc" (Doc Text -> Doc Text) -> TI m (Doc Text) -> TI m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst

inlineToTexinfo (Code _ str :: Text
str) =
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ "@code{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
stringToTexinfo Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}"

inlineToTexinfo (Quoted SingleQuote lst :: [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char '`' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char '\''

inlineToTexinfo (Quoted DoubleQuote lst :: [Inline]
lst) = do
  Doc Text
contents <- [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "``" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text "''"

inlineToTexinfo (Cite _ lst :: [Inline]
lst) =
  [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
lst
inlineToTexinfo (Str str :: Text
str) = Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
stringToTexinfo Text
str)
inlineToTexinfo (Math _ str :: Text
str) = Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
inCmd "math" (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
str
inlineToTexinfo il :: Inline
il@(RawInline f :: Format
f str :: Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "latex" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "tex" =
                      Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@tex" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@end tex"
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "texinfo" =  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
  | Bool
otherwise      =  do
      LogMessage -> StateT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT WriterState m ())
-> LogMessage -> StateT WriterState m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToTexinfo LineBreak = Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@*" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
inlineToTexinfo SoftBreak = do
  WrapOption
wrapText <- (WriterState -> WrapOption) -> StateT WriterState m WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions)
  case WrapOption
wrapText of
      WrapAuto     -> Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
      WrapNone     -> Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
      WrapPreserve -> Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
inlineToTexinfo Space = Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space

inlineToTexinfo (Link _ txt :: [Inline]
txt (src :: Text
src, _))
  | Just ('#', _) <- Text -> Maybe (Char, Text)
T.uncons Text
src = do
      Doc Text
contents <- TI m (Doc Text) -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
TI m (Doc Text) -> TI m (Doc Text)
escapeCommas (TI m (Doc Text) -> TI m (Doc Text))
-> TI m (Doc Text) -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
txt
      Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@ref" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
        Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
stringToTexinfo Text
src) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text "," Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents)
  | Bool
otherwise = case [Inline]
txt of
      [Str x :: Text
x] | Text -> Text
escapeURI Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src ->  -- autolink
                  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ "@url{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}"
      _ -> do
        Doc Text
contents <- TI m (Doc Text) -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
TI m (Doc Text) -> TI m (Doc Text)
escapeCommas (TI m (Doc Text) -> TI m (Doc Text))
-> TI m (Doc Text) -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
txt
        let src1 :: Text
src1 = Text -> Text
stringToTexinfo Text
src
        Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ("@uref{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ",") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                 Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char '}'

inlineToTexinfo (Image attr :: Attr
attr alternate :: [Inline]
alternate (source :: Text
source, _)) = do
  Doc Text
content <- TI m (Doc Text) -> TI m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
TI m (Doc Text) -> TI m (Doc Text)
escapeCommas (TI m (Doc Text) -> TI m (Doc Text))
-> TI m (Doc Text) -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> TI m (Doc Text)
inlineListToTexinfo [Inline]
alternate
  WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  let showDim :: Direction -> Text
showDim dim :: Direction
dim = case Direction -> Attr -> Maybe Dimension
dimension Direction
dim Attr
attr of
                      (Just (Pixel a :: Integer
a))   -> WriterOptions -> Dimension -> Text
showInInch WriterOptions
opts (Integer -> Dimension
Pixel Integer
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "in"
                      (Just (Percent _)) -> ""
                      (Just d :: Dimension
d)           -> Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
d
                      Nothing            -> ""
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ("@image{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Direction -> Text
showDim Direction
Width Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Direction -> Text
showDim Direction
Height Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ",")
           Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
content Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
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
ext Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}")
  where
    ext :: Text
ext     = Int -> Text -> Text
T.drop 1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension String
source'
    base :: Text
base    = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
source'
    source' :: String
source' = if Text -> Bool
isURI Text
source
              then Text -> String
T.unpack Text
source
              else String -> String
unEscapeString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
source

inlineToTexinfo (Note contents :: [Block]
contents) = do
  Doc Text
contents' <- [Block] -> TI m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> TI m (Doc Text)
blockListToTexinfo [Block]
contents
  Doc Text -> TI m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> TI m (Doc Text)) -> Doc Text -> TI m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "@footnote" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents'