{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.Man
   Copyright   : Copyright (C) 2018-2020 Yan Pashkovsky and John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : Yan Pashkovsky <yanp.bugz@gmail.com>
   Stability   : WIP
   Portability : portable

Conversion of man to 'Pandoc' document.
-}
module Text.Pandoc.Readers.Man (readMan) where

import Data.Char (toLower)
import Data.Default (Default)
import Control.Monad (liftM, mzero, guard, void)
import Control.Monad.Trans (lift)
import Control.Monad.Except (throwError)
import Data.Maybe (catMaybes, isJust)
import Data.List (intersperse, intercalate)
import qualified Data.Text as T
import Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad(..), report)
import Text.Pandoc.Error (PandocError (PandocParsecError))
import Text.Pandoc.Logging (LogMessage(..))
import Text.Pandoc.Options
import Text.Pandoc.Parsing
import Text.Pandoc.Walk (query)
import Text.Pandoc.Shared (crFilter, mapLeft)
import Text.Pandoc.Readers.Roff  -- TODO explicit imports
import Text.Parsec hiding (tokenPrim)
import qualified Text.Parsec as Parsec
import Text.Parsec.Pos (updatePosString)
import qualified Data.Foldable as Foldable

data ManState = ManState { ManState -> ReaderOptions
readerOptions   :: ReaderOptions
                         , ManState -> Meta
metadata        :: Meta
                         , ManState -> Bool
tableCellsPlain :: Bool
                         } deriving Int -> ManState -> ShowS
[ManState] -> ShowS
ManState -> String
(Int -> ManState -> ShowS)
-> (ManState -> String) -> ([ManState] -> ShowS) -> Show ManState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ManState] -> ShowS
$cshowList :: [ManState] -> ShowS
show :: ManState -> String
$cshow :: ManState -> String
showsPrec :: Int -> ManState -> ShowS
$cshowsPrec :: Int -> ManState -> ShowS
Show

instance Default ManState where
  def :: ManState
def = ManState :: ReaderOptions -> Meta -> Bool -> ManState
ManState { readerOptions :: ReaderOptions
readerOptions   = ReaderOptions
forall a. Default a => a
def
                 , metadata :: Meta
metadata        = Meta
nullMeta
                 , tableCellsPlain :: Bool
tableCellsPlain = Bool
True }

type ManParser m = ParserT [RoffToken] ManState m


-- | Read man (troff) from an input string and return a Pandoc document.
readMan :: PandocMonad m => ReaderOptions -> T.Text -> m Pandoc
readMan :: ReaderOptions -> Text -> m Pandoc
readMan ReaderOptions
opts Text
txt = do
  RoffTokens
tokenz <- SourcePos -> Text -> m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
SourcePos -> Text -> m RoffTokens
lexRoff (String -> SourcePos
initialPos String
"input") (Text -> Text
crFilter Text
txt)
  let state :: ManState
state = ManState
forall a. Default a => a
def {readerOptions :: ReaderOptions
readerOptions = ReaderOptions
opts} :: ManState
  Either PandocError Pandoc
eitherdoc <- ParserT [RoffToken] ManState m Pandoc
-> ManState -> [RoffToken] -> m (Either PandocError Pandoc)
forall (m :: * -> *) a.
PandocMonad m =>
ParserT [RoffToken] ManState m a
-> ManState -> [RoffToken] -> m (Either PandocError a)
readWithMTokens ParserT [RoffToken] ManState m Pandoc
forall (m :: * -> *). PandocMonad m => ManParser m Pandoc
parseMan ManState
state
     (Seq RoffToken -> [RoffToken]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq RoffToken -> [RoffToken])
-> (RoffTokens -> Seq RoffToken) -> RoffTokens -> [RoffToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoffTokens -> Seq RoffToken
unRoffTokens (RoffTokens -> [RoffToken]) -> RoffTokens -> [RoffToken]
forall a b. (a -> b) -> a -> b
$ RoffTokens
tokenz)
  (PandocError -> m Pandoc)
-> (Pandoc -> m Pandoc) -> Either PandocError Pandoc -> m Pandoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PandocError -> m Pandoc
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Either PandocError Pandoc
eitherdoc

readWithMTokens :: PandocMonad m
        => ParserT [RoffToken] ManState m a  -- ^ parser
        -> ManState                         -- ^ initial state
        -> [RoffToken]                       -- ^ input
        -> m (Either PandocError a)
readWithMTokens :: ParserT [RoffToken] ManState m a
-> ManState -> [RoffToken] -> m (Either PandocError a)
readWithMTokens ParserT [RoffToken] ManState m a
parser ManState
state [RoffToken]
input =
  let leftF :: ParseError -> PandocError
leftF = Text -> ParseError -> PandocError
PandocParsecError (Text -> ParseError -> PandocError)
-> ([String] -> Text) -> [String] -> ParseError -> PandocError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> ([String] -> String) -> [String] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> ParseError -> PandocError)
-> [String] -> ParseError -> PandocError
forall a b. (a -> b) -> a -> b
$ RoffToken -> String
forall a. Show a => a -> String
show (RoffToken -> String) -> [RoffToken] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RoffToken]
input
  in (ParseError -> PandocError)
-> Either ParseError a -> Either PandocError a
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft ParseError -> PandocError
leftF (Either ParseError a -> Either PandocError a)
-> m (Either ParseError a) -> m (Either PandocError a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ParserT [RoffToken] ManState m a
-> ManState -> String -> [RoffToken] -> m (Either ParseError a)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT ParserT [RoffToken] ManState m a
parser ManState
state String
"source" [RoffToken]
input

parseMan :: PandocMonad m => ManParser m Pandoc
parseMan :: ManParser m Pandoc
parseMan = do
  [Blocks]
bs <- ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlock ParsecT [RoffToken] ManState m [Blocks]
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m [Blocks]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  Meta
meta <- ManState -> Meta
metadata (ManState -> Meta)
-> ParsecT [RoffToken] ManState m ManState
-> ParsecT [RoffToken] ManState m Meta
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m ManState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let (Pandoc Meta
_ [Block]
blocks) = Blocks -> Pandoc
doc (Blocks -> Pandoc) -> Blocks -> Pandoc
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat [Blocks]
bs
  Pandoc -> ManParser m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> ManParser m Pandoc) -> Pandoc -> ManParser m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks

parseBlock :: PandocMonad m => ManParser m Blocks
parseBlock :: ManParser m Blocks
parseBlock = [ManParser m Blocks] -> ManParser m Blocks
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseList
                    , ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseDefinitionList
                    , ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseHeader
                    , ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseTable
                    , ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseTitle
                    , ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseCodeBlock
                    , ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlockQuote
                    , ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseNewParagraph
                    , ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parsePara
                    , ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
skipUnknownMacro
                    ]

parseTable :: PandocMonad m => ManParser m Blocks
parseTable :: ManParser m Blocks
parseTable = do
  (ManState -> ManState) -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((ManState -> ManState) -> ParsecT [RoffToken] ManState m ())
-> (ManState -> ManState) -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ \ManState
st -> ManState
st { tableCellsPlain :: Bool
tableCellsPlain = Bool
True }
  let isTbl :: RoffToken -> Bool
isTbl Tbl{} = Bool
True
      isTbl RoffToken
_     = Bool
False
  Tbl [TableOption]
_opts [TableRow]
rows SourcePos
pos <- (RoffToken -> Bool) -> ParserT [RoffToken] ManState m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isTbl
  case [TableRow]
rows of
    (([CellFormat]
as,[RoffTokens]
_):[TableRow]
_) -> ManParser m Blocks -> ManParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
      let as' :: [Maybe Alignment]
as' = (CellFormat -> Maybe Alignment)
-> [CellFormat] -> [Maybe Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Maybe Alignment
columnTypeToAlignment (Char -> Maybe Alignment)
-> (CellFormat -> Char) -> CellFormat -> Maybe Alignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellFormat -> Char
columnType) [CellFormat]
as
      Bool -> ParsecT [RoffToken] ManState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [RoffToken] ManState m ())
-> Bool -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ (Maybe Alignment -> Bool) -> [Maybe Alignment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe Alignment -> Bool
forall a. Maybe a -> Bool
isJust [Maybe Alignment]
as'
      let alignments :: [Alignment]
alignments = [Maybe Alignment] -> [Alignment]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Alignment]
as'
      let (TableRow
headerRow', [TableRow]
bodyRows') =
            case [TableRow]
rows of
              (TableRow
h:TableRow
x:[TableRow]
bs)
               | TableRow -> Bool
isHrule TableRow
x -> (TableRow
h, [TableRow]
bs)
              [TableRow]
_ -> (([],[]), [TableRow]
rows)
      [Blocks]
headerRow <- (RoffTokens -> ManParser m Blocks)
-> [RoffTokens] -> ParsecT [RoffToken] ManState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RoffTokens -> ManParser m Blocks
forall (m :: * -> *) s.
PandocMonad m =>
RoffTokens -> ParsecT s ManState m Blocks
parseTableCell ([RoffTokens] -> ParsecT [RoffToken] ManState m [Blocks])
-> [RoffTokens] -> ParsecT [RoffToken] ManState m [Blocks]
forall a b. (a -> b) -> a -> b
$ TableRow -> [RoffTokens]
forall a b. (a, b) -> b
snd TableRow
headerRow'
      [[Blocks]]
bodyRows <- (TableRow -> ParsecT [RoffToken] ManState m [Blocks])
-> [TableRow] -> ParsecT [RoffToken] ManState m [[Blocks]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((RoffTokens -> ManParser m Blocks)
-> [RoffTokens] -> ParsecT [RoffToken] ManState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RoffTokens -> ManParser m Blocks
forall (m :: * -> *) s.
PandocMonad m =>
RoffTokens -> ParsecT s ManState m Blocks
parseTableCell ([RoffTokens] -> ParsecT [RoffToken] ManState m [Blocks])
-> (TableRow -> [RoffTokens])
-> TableRow
-> ParsecT [RoffToken] ManState m [Blocks]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableRow -> [RoffTokens]
forall a b. (a, b) -> b
snd) [TableRow]
bodyRows'
      Bool
isPlainTable <- ManState -> Bool
tableCellsPlain (ManState -> Bool)
-> ParsecT [RoffToken] ManState m ManState
-> ParsecT [RoffToken] ManState m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m ManState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      let widths :: [ColWidth]
widths = if Bool
isPlainTable
                      then ColWidth -> [ColWidth]
forall a. a -> [a]
repeat ColWidth
ColWidthDefault
                      else ColWidth -> [ColWidth]
forall a. a -> [a]
repeat (ColWidth -> [ColWidth]) -> ColWidth -> [ColWidth]
forall a b. (a -> b) -> a -> b
$ Double -> ColWidth
ColWidth (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
alignments))
      Blocks -> ManParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ManParser m Blocks) -> Blocks -> ManParser m Blocks
forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
B.table Caption
B.emptyCaption ([Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
alignments [ColWidth]
widths)
                  (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr ([Row] -> TableHead) -> [Row] -> TableHead
forall a b. (a -> b) -> a -> b
$ [Blocks] -> [Row]
toHeaderRow [Blocks]
headerRow)
                  [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> Row) -> [[Blocks]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Row
toRow [[Blocks]]
bodyRows]
                  (Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])) ManParser m Blocks -> ManParser m Blocks -> ManParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> SourcePos -> ManParser m Blocks
forall (m :: * -> *). PandocMonad m => SourcePos -> m Blocks
fallback SourcePos
pos
    [] -> SourcePos -> ManParser m Blocks
forall (m :: * -> *). PandocMonad m => SourcePos -> m Blocks
fallback SourcePos
pos

 where

  parseTableCell :: RoffTokens -> ParsecT s ManState m Blocks
parseTableCell RoffTokens
ts = do
    ManState
st <- ParsecT s ManState m ManState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let ts' :: [RoffToken]
ts' = Seq RoffToken -> [RoffToken]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq RoffToken -> [RoffToken]) -> Seq RoffToken -> [RoffToken]
forall a b. (a -> b) -> a -> b
$ RoffTokens -> Seq RoffToken
unRoffTokens RoffTokens
ts
    let plaintcell :: ParsecT [RoffToken] ManState m Blocks
plaintcell = ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [RoffToken] ManState m Blocks
 -> ParsecT [RoffToken] ManState m Blocks)
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall a b. (a -> b) -> a -> b
$ do
          ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
          Inlines -> Blocks
plain (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines (Inlines -> Blocks)
-> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInlines ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m Inlines
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
    let blockstcell :: ParsecT [RoffToken] ManState m Blocks
blockstcell = ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [RoffToken] ManState m Blocks
 -> ParsecT [RoffToken] ManState m Blocks)
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall a b. (a -> b) -> a -> b
$ do
          ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
          [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [RoffToken] ManState m [Blocks]
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlock ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
    Either PandocError Blocks
res <- if [RoffToken] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RoffToken]
ts'
              then Either PandocError Blocks
-> ParsecT s ManState m (Either PandocError Blocks)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PandocError Blocks
 -> ParsecT s ManState m (Either PandocError Blocks))
-> Either PandocError Blocks
-> ParsecT s ManState m (Either PandocError Blocks)
forall a b. (a -> b) -> a -> b
$ Blocks -> Either PandocError Blocks
forall a b. b -> Either a b
Right Blocks
forall a. Monoid a => a
mempty
              else m (Either PandocError Blocks)
-> ParsecT s ManState m (Either PandocError Blocks)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either PandocError Blocks)
 -> ParsecT s ManState m (Either PandocError Blocks))
-> m (Either PandocError Blocks)
-> ParsecT s ManState m (Either PandocError Blocks)
forall a b. (a -> b) -> a -> b
$ ParsecT [RoffToken] ManState m Blocks
-> ManState -> [RoffToken] -> m (Either PandocError Blocks)
forall (m :: * -> *) a.
PandocMonad m =>
ParserT [RoffToken] ManState m a
-> ManState -> [RoffToken] -> m (Either PandocError a)
readWithMTokens ParsecT [RoffToken] ManState m Blocks
plaintcell ManState
st [RoffToken]
ts'
    case Either PandocError Blocks
res of
      Left PandocError
_  -> do
        Either PandocError Blocks
res' <- m (Either PandocError Blocks)
-> ParsecT s ManState m (Either PandocError Blocks)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either PandocError Blocks)
 -> ParsecT s ManState m (Either PandocError Blocks))
-> m (Either PandocError Blocks)
-> ParsecT s ManState m (Either PandocError Blocks)
forall a b. (a -> b) -> a -> b
$ ParsecT [RoffToken] ManState m Blocks
-> ManState -> [RoffToken] -> m (Either PandocError Blocks)
forall (m :: * -> *) a.
PandocMonad m =>
ParserT [RoffToken] ManState m a
-> ManState -> [RoffToken] -> m (Either PandocError a)
readWithMTokens ParsecT [RoffToken] ManState m Blocks
blockstcell ManState
st [RoffToken]
ts'
        case Either PandocError Blocks
res' of
          Left PandocError
_  -> String -> ParsecT s ManState m Blocks
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"Could not parse table cell"
          Right Blocks
x -> do
            (ManState -> ManState) -> ParsecT s ManState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((ManState -> ManState) -> ParsecT s ManState m ())
-> (ManState -> ManState) -> ParsecT s ManState m ()
forall a b. (a -> b) -> a -> b
$ \ManState
s -> ManState
s{ tableCellsPlain :: Bool
tableCellsPlain = Bool
False }
            Blocks -> ParsecT s ManState m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
x
      Right Blocks
x -> Blocks -> ParsecT s ManState m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
x

  isHrule :: TableRow -> Bool
  isHrule :: TableRow -> Bool
isHrule ([CellFormat
cellfmt], [RoffTokens]
_) = CellFormat -> Char
columnType CellFormat
cellfmt Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'_',Char
'-',Char
'=']
  isHrule ([CellFormat]
_, [RoffTokens Seq RoffToken
ss]) =
    case Seq RoffToken -> [RoffToken]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq RoffToken
ss of
      [TextLine [RoffStr (Text -> String
T.unpack -> [Char
c])]] -> Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'_',Char
'-',Char
'=']
      [RoffToken]
_                     -> Bool
False
  isHrule TableRow
_ = Bool
False

  fallback :: SourcePos -> m Blocks
fallback SourcePos
pos = do
    LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
"TABLE" SourcePos
pos
    Blocks -> m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Text -> Inlines
B.text Text
"TABLE")

  columnTypeToAlignment :: Char -> Maybe Alignment
  columnTypeToAlignment :: Char -> Maybe Alignment
columnTypeToAlignment Char
c =
    case Char -> Char
toLower Char
c of
      Char
'a' -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
AlignLeft
      Char
'c' -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
AlignCenter
      Char
'l' -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
AlignLeft
      Char
'n' -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
AlignRight
      Char
'r' -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
AlignRight
      Char
_   -> Maybe Alignment
forall a. Maybe a
Nothing

  toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Blocks] -> [Cell]) -> [Blocks] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
simpleCell
  toHeaderRow :: [Blocks] -> [Row]
toHeaderRow [Blocks]
l = [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]

parseNewParagraph :: PandocMonad m => ManParser m Blocks
parseNewParagraph :: ManParser m Blocks
parseNewParagraph = do
  Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"P" ManParser m RoffToken
-> ManParser m RoffToken -> ManParser m RoffToken
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"PP" ManParser m RoffToken
-> ManParser m RoffToken -> ManParser m RoffToken
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"LP" ManParser m RoffToken
-> ManParser m RoffToken -> ManParser m RoffToken
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
  Blocks -> ManParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty

--
-- Parser: [RoffToken] -> Pandoc
--

msatisfy :: Monad m => (RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
msatisfy :: (RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
predic = (RoffToken -> String)
-> (SourcePos -> RoffToken -> [RoffToken] -> SourcePos)
-> (RoffToken -> Maybe RoffToken)
-> ParserT [RoffToken] st m RoffToken
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim RoffToken -> String
forall a. Show a => a -> String
show SourcePos -> RoffToken -> [RoffToken] -> SourcePos
forall p. SourcePos -> p -> [RoffToken] -> SourcePos
nextPos RoffToken -> Maybe RoffToken
testTok
  where
    testTok :: RoffToken -> Maybe RoffToken
testTok RoffToken
t     = if RoffToken -> Bool
predic RoffToken
t then RoffToken -> Maybe RoffToken
forall a. a -> Maybe a
Just RoffToken
t else Maybe RoffToken
forall a. Maybe a
Nothing
    nextPos :: SourcePos -> p -> [RoffToken] -> SourcePos
nextPos SourcePos
_pos p
_x (ControlLine Text
_ [[LinePart]]
_ SourcePos
pos':[RoffToken]
_) = SourcePos
pos'
    nextPos SourcePos
pos p
_x [RoffToken]
_xs  = SourcePos -> String -> SourcePos
updatePosString
                             (SourcePos -> Int -> SourcePos
setSourceColumn
                               (SourcePos -> Int -> SourcePos
setSourceLine SourcePos
pos (Int -> SourcePos) -> Int -> SourcePos
forall a b. (a -> b) -> a -> b
$ SourcePos -> Int
sourceLine SourcePos
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
1) String
""

mtoken :: PandocMonad m => ManParser m RoffToken
mtoken :: ManParser m RoffToken
mtoken = (RoffToken -> Bool) -> ManParser m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
msatisfy (Bool -> RoffToken -> Bool
forall a b. a -> b -> a
const Bool
True)

mline :: PandocMonad m => ManParser m RoffToken
mline :: ManParser m RoffToken
mline = (RoffToken -> Bool) -> ManParser m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isTextLine where
  isTextLine :: RoffToken -> Bool
isTextLine (TextLine [LinePart]
_) = Bool
True
  isTextLine RoffToken
_ = Bool
False

memptyLine :: PandocMonad m => ManParser m RoffToken
memptyLine :: ManParser m RoffToken
memptyLine = (RoffToken -> Bool) -> ManParser m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isEmptyLine where
  isEmptyLine :: RoffToken -> Bool
isEmptyLine RoffToken
EmptyLine = Bool
True
  isEmptyLine RoffToken
_ = Bool
False

mmacro :: PandocMonad m => T.Text -> ManParser m RoffToken
mmacro :: Text -> ManParser m RoffToken
mmacro Text
mk = (RoffToken -> Bool) -> ManParser m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isControlLine where
  isControlLine :: RoffToken -> Bool
isControlLine (ControlLine Text
mk' [[LinePart]]
_ SourcePos
_) | Text
mk Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
mk' = Bool
True
                            | Bool
otherwise = Bool
False
  isControlLine RoffToken
_ = Bool
False

mmacroAny :: PandocMonad m => ManParser m RoffToken
mmacroAny :: ManParser m RoffToken
mmacroAny = (RoffToken -> Bool) -> ManParser m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isControlLine where
  isControlLine :: RoffToken -> Bool
isControlLine ControlLine{} = Bool
True
  isControlLine RoffToken
_ = Bool
False

--
-- RoffToken -> Block functions
--

parseTitle :: PandocMonad m => ManParser m Blocks
parseTitle :: ManParser m Blocks
parseTitle = do
  (ControlLine Text
_ [[LinePart]]
args SourcePos
_) <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"TH"
  let adjustMeta :: Meta -> Meta
adjustMeta =
       case [[LinePart]]
args of
         ([LinePart]
x:[LinePart]
y:[LinePart]
z:[[LinePart]]
_) -> Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x) (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"section" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
y) (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"date" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
z)
         [[LinePart]
x,[LinePart]
y]     -> Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x) (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"section" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
y)
         [[LinePart]
x]       -> Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x)
         []        -> Meta -> Meta
forall a. a -> a
id
  (ManState -> ManState) -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((ManState -> ManState) -> ParsecT [RoffToken] ManState m ())
-> (ManState -> ManState) -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ \ManState
st -> ManState
st{ metadata :: Meta
metadata = Meta -> Meta
adjustMeta (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ ManState -> Meta
metadata ManState
st }
  Blocks -> ManParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty

linePartsToInlines :: [LinePart] -> Inlines
linePartsToInlines :: [LinePart] -> Inlines
linePartsToInlines = Bool -> [LinePart] -> Inlines
go Bool
False

  where
  go :: Bool -> [LinePart] -> Inlines
  go :: Bool -> [LinePart] -> Inlines
go Bool
_ [] = Inlines
forall a. Monoid a => a
mempty
  go Bool
mono (MacroArg Int
_:[LinePart]
xs) = Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
xs -- shouldn't happen
  go Bool
mono (RoffStr Text
s : RoffStr Text
t : [LinePart]
xs) = Bool -> [LinePart] -> Inlines
go Bool
mono (Text -> LinePart
RoffStr (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)LinePart -> [LinePart] -> [LinePart]
forall a. a -> [a] -> [a]
:[LinePart]
xs)
  go Bool
mono (RoffStr Text
s : [LinePart]
xs)
    | Bool
mono      = Text -> Inlines
code Text
s Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
xs
    | Bool
otherwise = Text -> Inlines
text Text
s Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
xs
  go Bool
mono (Font FontSpec
fs: [LinePart]
xs)
    | Int
litals Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
litals Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lbolds Bool -> Bool -> Bool
&& Int
litals Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lmonos
       = Inlines -> Inlines
emph (Bool -> [LinePart] -> Inlines
go Bool
mono (FontSpec -> LinePart
Font FontSpec
fs{ fontItalic :: Bool
fontItalic = Bool
False } LinePart -> [LinePart] -> [LinePart]
forall a. a -> [a] -> [a]
:
                   (LinePart -> LinePart) -> [LinePart] -> [LinePart]
forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\FontSpec
s -> FontSpec
s{ fontItalic :: Bool
fontItalic = Bool
False }))
                   [LinePart]
itals)) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
            Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
italsrest
    | Int
lbolds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
lbolds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lmonos
       = Inlines -> Inlines
strong (Bool -> [LinePart] -> Inlines
go Bool
mono (FontSpec -> LinePart
Font FontSpec
fs{ fontBold :: Bool
fontBold = Bool
False } LinePart -> [LinePart] -> [LinePart]
forall a. a -> [a] -> [a]
:
              (LinePart -> LinePart) -> [LinePart] -> [LinePart]
forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\FontSpec
s -> FontSpec
s{ fontBold :: Bool
fontBold = Bool
False }))
              [LinePart]
bolds)) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
            Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
boldsrest
    | Int
lmonos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
       = Bool -> [LinePart] -> Inlines
go Bool
True (FontSpec -> LinePart
Font FontSpec
fs{ fontMonospace :: Bool
fontMonospace = Bool
False } LinePart -> [LinePart] -> [LinePart]
forall a. a -> [a] -> [a]
:
          (LinePart -> LinePart) -> [LinePart] -> [LinePart]
forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\FontSpec
s -> FontSpec
s { fontMonospace :: Bool
fontMonospace = Bool
False }))
          [LinePart]
monos) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
monosrest
    | Bool
otherwise = Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
xs
    where
      adjustFontSpec :: (FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec FontSpec -> FontSpec
f (Font FontSpec
fspec) = FontSpec -> LinePart
Font (FontSpec -> FontSpec
f FontSpec
fspec)
      adjustFontSpec FontSpec -> FontSpec
_ LinePart
x            = LinePart
x
      withFont :: (FontSpec -> Bool) -> LinePart -> Bool
withFont FontSpec -> Bool
f (Font FontSpec
fspec) = FontSpec -> Bool
f FontSpec
fspec
      withFont FontSpec -> Bool
_ LinePart
_            = Bool
False
      litals :: Int
litals = [LinePart] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LinePart]
itals
      lbolds :: Int
lbolds = [LinePart] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LinePart]
bolds
      lmonos :: Int
lmonos = [LinePart] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LinePart]
monos
      ([LinePart]
itals, [LinePart]
italsrest) =
        if FontSpec -> Bool
fontItalic FontSpec
fs
           then (LinePart -> Bool) -> [LinePart] -> ([LinePart], [LinePart])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((FontSpec -> Bool) -> LinePart -> Bool
withFont (Bool -> Bool
not (Bool -> Bool) -> (FontSpec -> Bool) -> FontSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSpec -> Bool
fontItalic)) [LinePart]
xs
           else ([], [LinePart]
xs)
      ([LinePart]
bolds, [LinePart]
boldsrest) =
        if FontSpec -> Bool
fontBold FontSpec
fs
           then (LinePart -> Bool) -> [LinePart] -> ([LinePart], [LinePart])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((FontSpec -> Bool) -> LinePart -> Bool
withFont (Bool -> Bool
not (Bool -> Bool) -> (FontSpec -> Bool) -> FontSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSpec -> Bool
fontBold)) [LinePart]
xs
           else ([], [LinePart]
xs)
      ([LinePart]
monos, [LinePart]
monosrest) =
        if FontSpec -> Bool
fontMonospace FontSpec
fs
           then (LinePart -> Bool) -> [LinePart] -> ([LinePart], [LinePart])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((FontSpec -> Bool) -> LinePart -> Bool
withFont (Bool -> Bool
not (Bool -> Bool) -> (FontSpec -> Bool) -> FontSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSpec -> Bool
fontMonospace)) [LinePart]
xs
           else ([], [LinePart]
xs)

parsePara :: PandocMonad m => ManParser m Blocks
parsePara :: ManParser m Blocks
parsePara = Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines (Inlines -> Blocks)
-> ParsecT [RoffToken] ManState m Inlines -> ManParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInlines

parseInlines :: PandocMonad m => ManParser m Inlines
parseInlines :: ManParser m Inlines
parseInlines = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space ([Inlines] -> Inlines)
-> ParsecT [RoffToken] ManState m [Inlines] -> ManParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ManParser m Inlines -> ParsecT [RoffToken] ManState m [Inlines]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ManParser m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInline

parseInline :: PandocMonad m => ManParser m Inlines
parseInline :: ManParser m Inlines
parseInline = ManParser m Inlines -> ManParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ManParser m Inlines -> ManParser m Inlines)
-> ManParser m Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
  RoffToken
tok <- ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mtoken
  case RoffToken
tok of
    TextLine [LinePart]
lparts -> Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ [LinePart] -> Inlines
linePartsToInlines [LinePart]
lparts
    ControlLine Text
mname [[LinePart]]
args SourcePos
pos -> Text -> [[LinePart]] -> SourcePos -> ManParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> [[LinePart]] -> SourcePos -> ManParser m Inlines
handleInlineMacro Text
mname [[LinePart]]
args SourcePos
pos
    RoffToken
_ -> ManParser m Inlines
forall (m :: * -> *) a. MonadPlus m => m a
mzero

handleInlineMacro :: PandocMonad m
                  => T.Text -> [Arg] -> SourcePos -> ManParser m Inlines
handleInlineMacro :: Text -> [[LinePart]] -> SourcePos -> ManParser m Inlines
handleInlineMacro Text
mname [[LinePart]]
args SourcePos
_pos =
  case Text
mname of
    Text
"UR" -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseLink [[LinePart]]
args
    Text
"MT" -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseEmailLink [[LinePart]]
args
    Text
"B"  -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseBold [[LinePart]]
args
    Text
"I"  -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseItalic [[LinePart]]
args
    Text
"br" -> Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
linebreak
    Text
"BI" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
strong, Inlines -> Inlines
emph] [[LinePart]]
args
    Text
"IB" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
emph, Inlines -> Inlines
strong] [[LinePart]]
args
    Text
"IR" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
emph, Inlines -> Inlines
forall a. a -> a
id] [[LinePart]]
args
    Text
"RI" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
forall a. a -> a
id, Inlines -> Inlines
emph] [[LinePart]]
args
    Text
"BR" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
strong, Inlines -> Inlines
forall a. a -> a
id] [[LinePart]]
args
    Text
"RB" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
forall a. a -> a
id, Inlines -> Inlines
strong] [[LinePart]]
args
    Text
"SY" -> Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
strong (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space
                   ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ ([LinePart] -> Inlines) -> [[LinePart]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [LinePart] -> Inlines
linePartsToInlines [[LinePart]]
args
    Text
"YS" -> Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
    Text
"OP" -> case [[LinePart]]
args of
              ([LinePart]
x:[[LinePart]]
ys) -> Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"[" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                         [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat (Inlines -> Inlines
strong ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x) Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:
                           ([LinePart] -> Inlines) -> [[LinePart]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map ((Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> ([LinePart] -> Inlines) -> [LinePart] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LinePart] -> Inlines
linePartsToInlines) [[LinePart]]
ys)
                         Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"]"
              []     -> Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
    Text
_ -> ManParser m Inlines
forall (m :: * -> *) a. MonadPlus m => m a
mzero

parseBold :: PandocMonad m => [Arg] -> ManParser m Inlines
parseBold :: [[LinePart]] -> ManParser m Inlines
parseBold [] = do
  TextLine [LinePart]
lparts <- ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mline
  Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
strong (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [LinePart] -> Inlines
linePartsToInlines [LinePart]
lparts
parseBold [[LinePart]]
args = Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$
  Inlines -> Inlines
strong (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ ([LinePart] -> Inlines) -> [[LinePart]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [LinePart] -> Inlines
linePartsToInlines [[LinePart]]
args

parseItalic :: PandocMonad m => [Arg] -> ManParser m Inlines
parseItalic :: [[LinePart]] -> ManParser m Inlines
parseItalic [] = do
  TextLine [LinePart]
lparts <- ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mline
  Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
emph (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [LinePart] -> Inlines
linePartsToInlines [LinePart]
lparts
parseItalic [[LinePart]]
args = Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$
  Inlines -> Inlines
emph (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ ([LinePart] -> Inlines) -> [[LinePart]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [LinePart] -> Inlines
linePartsToInlines [[LinePart]]
args

parseAlternatingFonts :: [Inlines -> Inlines]
                      -> [Arg]
                      -> ManParser m Inlines
parseAlternatingFonts :: [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines]
constructors [[LinePart]]
args = Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$
  ((Inlines -> Inlines) -> [LinePart] -> Inlines)
-> [Inlines -> Inlines] -> [[LinePart]] -> [Inlines]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Inlines -> Inlines
f [LinePart]
arg -> Inlines -> Inlines
f ([LinePart] -> Inlines
linePartsToInlines [LinePart]
arg)) ([Inlines -> Inlines] -> [Inlines -> Inlines]
forall a. [a] -> [a]
cycle [Inlines -> Inlines]
constructors) [[LinePart]]
args

lineInl :: PandocMonad m => ManParser m Inlines
lineInl :: ManParser m Inlines
lineInl = do
  (TextLine [LinePart]
fragments) <- ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mline
  Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ [LinePart] -> Inlines
linePartsToInlines [LinePart]
fragments

bareIP :: PandocMonad m => ManParser m RoffToken
bareIP :: ManParser m RoffToken
bareIP = (RoffToken -> Bool) -> ManParser m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isBareIP where
  isBareIP :: RoffToken -> Bool
isBareIP (ControlLine Text
"IP" [] SourcePos
_) = Bool
True
  isBareIP RoffToken
_                  = Bool
False

endmacro :: PandocMonad m => T.Text -> ManParser m ()
endmacro :: Text -> ManParser m ()
endmacro Text
name = ParsecT [RoffToken] ManState m RoffToken -> ManParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
name)
             ManParser m () -> ManParser m () -> ManParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ManParser m () -> ManParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [RoffToken] ManState m RoffToken -> ManParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [RoffToken] ManState m RoffToken
forall st. ParserT [RoffToken] st m RoffToken
newBlockMacro)
             ManParser m () -> ManParser m () -> ManParser m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ManParser m () -> ManParser m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ManParser m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  where
    newBlockMacro :: ParserT [RoffToken] st m RoffToken
newBlockMacro = (RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParserT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isNewBlockMacro
    isNewBlockMacro :: RoffToken -> Bool
isNewBlockMacro (ControlLine Text
"SH" [[LinePart]]
_ SourcePos
_) = Bool
True
    isNewBlockMacro (ControlLine Text
"SS" [[LinePart]]
_ SourcePos
_) = Bool
True
    isNewBlockMacro RoffToken
_ = Bool
False

parseCodeBlock :: PandocMonad m => ManParser m Blocks
parseCodeBlock :: ManParser m Blocks
parseCodeBlock = ManParser m Blocks -> ManParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ManParser m Blocks -> ManParser m Blocks)
-> ManParser m Blocks -> ManParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
bareIP
  ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Text -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"in") -- some people indent their code
  [Maybe Text]
toks <- (Text -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"nf" ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m [Maybe Text]
-> ParsecT [RoffToken] ManState m [Maybe Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [RoffToken] ManState m (Maybe Text)
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m [Maybe Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [RoffToken] ManState m (Maybe Text)
codeline (Text -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
"fi"))
      ParsecT [RoffToken] ManState m [Maybe Text]
-> ParsecT [RoffToken] ManState m [Maybe Text]
-> ParsecT [RoffToken] ManState m [Maybe Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"EX" ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m [Maybe Text]
-> ParsecT [RoffToken] ManState m [Maybe Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [RoffToken] ManState m (Maybe Text)
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m [Maybe Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [RoffToken] ManState m (Maybe Text)
codeline (Text -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
"EE"))
  ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Text -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"in")
  Blocks -> ManParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ManParser m Blocks) -> Blocks -> ManParser m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Blocks
codeBlock (Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text]
toks)

  where

  codeline :: ParsecT [RoffToken] ManState m (Maybe Text)
codeline = do
    RoffToken
tok <- ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mtoken
    case RoffToken
tok of
      ControlLine Text
"PP" [[LinePart]]
_ SourcePos
_ -> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text))
-> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"" -- .PP sometimes used for blank line
      ControlLine Text
mname [[LinePart]]
args SourcePos
pos ->
        (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Inlines -> Text) -> Inlines -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Text) -> Inlines -> Text
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
getText (Inlines -> Maybe Text)
-> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> [[LinePart]]
-> SourcePos
-> ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> [[LinePart]] -> SourcePos -> ManParser m Inlines
handleInlineMacro Text
mname [[LinePart]]
args SourcePos
pos) ParsecT [RoffToken] ManState m (Maybe Text)
-> ParsecT [RoffToken] ManState m (Maybe Text)
-> ParsecT [RoffToken] ManState m (Maybe Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          do LogMessage -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [RoffToken] ManState m ())
-> LogMessage -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mname) SourcePos
pos
             Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
      Tbl [TableOption]
_ [TableRow]
_ SourcePos
pos     -> do
        LogMessage -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [RoffToken] ManState m ())
-> LogMessage -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
"TABLE" SourcePos
pos
        Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text))
-> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"TABLE"
      RoffToken
EmptyLine -> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text))
-> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
      TextLine [LinePart]
ss
        | Bool -> Bool
not ([LinePart] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LinePart]
ss)
        , (LinePart -> Bool) -> [LinePart] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LinePart -> Bool
isFontToken [LinePart]
ss -> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        | Bool
otherwise -> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text))
-> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [LinePart] -> Text
linePartsToText [LinePart]
ss

  isFontToken :: LinePart -> Bool
isFontToken Font{}     = Bool
True
  isFontToken LinePart
_            = Bool
False

  getText :: Inline -> T.Text
  getText :: Inline -> Text
getText (Str Text
s)    = Text
s
  getText Inline
Space      = Text
" "
  getText (Code Attr
_ Text
s) = Text
s
  getText Inline
SoftBreak  = Text
"\n"
  getText Inline
LineBreak  = Text
"\n"
  getText Inline
_          = Text
""

parseHeader :: PandocMonad m => ManParser m Blocks
parseHeader :: ManParser m Blocks
parseHeader = do
  ControlLine Text
name [[LinePart]]
args SourcePos
_ <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"SH" ManParser m RoffToken
-> ManParser m RoffToken -> ManParser m RoffToken
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"SS"
  Inlines
contents <- if [[LinePart]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[LinePart]]
args
                 then Inlines
-> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
forall a. Monoid a => a
mempty ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
lineInl
                 else Inlines -> ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT [RoffToken] ManState m Inlines)
-> Inlines -> ParsecT [RoffToken] ManState m Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space
                             ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ ([LinePart] -> Inlines) -> [[LinePart]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [LinePart] -> Inlines
linePartsToInlines [[LinePart]]
args
  let lvl :: Int
lvl = if Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"SH" then Int
1 else Int
2
  Blocks -> ManParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ManParser m Blocks) -> Blocks -> ManParser m Blocks
forall a b. (a -> b) -> a -> b
$ Int -> Inlines -> Blocks
header Int
lvl Inlines
contents

parseBlockQuote :: PandocMonad m => ManParser m Blocks
parseBlockQuote :: ManParser m Blocks
parseBlockQuote = Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> ManParser m Blocks -> ManParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
continuation

data ListType = Ordered ListAttributes
              | Bullet
              | Definition T.Text

listTypeMatches :: Maybe ListType -> ListType -> Bool
listTypeMatches :: Maybe ListType -> ListType -> Bool
listTypeMatches Maybe ListType
Nothing ListType
_            = Bool
True
listTypeMatches (Just ListType
Bullet) ListType
Bullet = Bool
True
listTypeMatches (Just (Ordered (Int
_,ListNumberStyle
x,ListNumberDelim
y))) (Ordered (Int
_,ListNumberStyle
x',ListNumberDelim
y'))
                                     = ListNumberStyle
x ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
x' Bool -> Bool -> Bool
&& ListNumberDelim
y ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
y'
listTypeMatches (Just (Definition Text
_)) (Definition Text
_) = Bool
True
listTypeMatches (Just ListType
_) ListType
_           = Bool
False

listItem :: PandocMonad m => Maybe ListType -> ManParser m (ListType, Blocks)
listItem :: Maybe ListType -> ManParser m (ListType, Blocks)
listItem Maybe ListType
mbListType = ManParser m (ListType, Blocks) -> ManParser m (ListType, Blocks)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ManParser m (ListType, Blocks) -> ManParser m (ListType, Blocks))
-> ManParser m (ListType, Blocks) -> ManParser m (ListType, Blocks)
forall a b. (a -> b) -> a -> b
$ do
  (ControlLine Text
_ [[LinePart]]
args SourcePos
_) <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"IP"
  case [[LinePart]]
args of
    ([LinePart]
arg1 : [[LinePart]]
_)  -> do
      let cs :: Text
cs = [LinePart] -> Text
linePartsToText [LinePart]
arg1
      let cs' :: Text
cs' = if Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
cs Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')') Text
cs) then Text
cs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." else Text
cs
      let lt :: ListType
lt = case Parsec Text ParserState (Int, ListNumberStyle, ListNumberDelim)
-> ParserState
-> String
-> Text
-> Either ParseError (Int, ListNumberStyle, ListNumberDelim)
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
Parsec.runParser Parsec Text ParserState (Int, ListNumberStyle, ListNumberDelim)
forall s (m :: * -> *).
Stream s m Char =>
ParserT s ParserState m (Int, ListNumberStyle, ListNumberDelim)
anyOrderedListMarker ParserState
defaultParserState
                     String
"list marker" Text
cs' of
                  Right (Int
start, ListNumberStyle
listtype, ListNumberDelim
listdelim)
                    | Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
cs' -> (Int, ListNumberStyle, ListNumberDelim) -> ListType
Ordered (Int
start, ListNumberStyle
listtype, ListNumberDelim
listdelim)
                    | Bool
otherwise -> (Int, ListNumberStyle, ListNumberDelim) -> ListType
Ordered (Int
start, ListNumberStyle
listtype, ListNumberDelim
DefaultDelim)
                  Left ParseError
_
                    | Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\183" Bool -> Bool -> Bool
|| Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"-" Bool -> Bool -> Bool
|| Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*" Bool -> Bool -> Bool
|| Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"+"
                                   -> ListType
Bullet
                    | Bool
otherwise    -> Text -> ListType
Definition Text
cs
      Bool -> ParsecT [RoffToken] ManState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [RoffToken] ManState m ())
-> Bool -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ Maybe ListType -> ListType -> Bool
listTypeMatches Maybe ListType
mbListType ListType
lt
      ManParser m RoffToken -> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
      Inlines
inls <- Inlines
-> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
forall a. Monoid a => a
mempty ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInlines
      ManParser m RoffToken -> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
      Blocks
continuations <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [RoffToken] ManState m [Blocks]
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
continuation
      (ListType, Blocks) -> ManParser m (ListType, Blocks)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListType
lt, Inlines -> Blocks
para Inlines
inls Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
continuations)
    []          -> ManParser m (ListType, Blocks)
forall (m :: * -> *) a. MonadPlus m => m a
mzero

parseList :: PandocMonad m => ManParser m Blocks
parseList :: ManParser m Blocks
parseList = ManParser m Blocks -> ManParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ManParser m Blocks -> ManParser m Blocks)
-> ManParser m Blocks -> ManParser m Blocks
forall a b. (a -> b) -> a -> b
$ do
  x :: (ListType, Blocks)
x@(ListType
lt, Blocks
_) <- Maybe ListType -> ManParser m (ListType, Blocks)
forall (m :: * -> *).
PandocMonad m =>
Maybe ListType -> ManParser m (ListType, Blocks)
listItem Maybe ListType
forall a. Maybe a
Nothing
  [(ListType, Blocks)]
xs <- ManParser m (ListType, Blocks)
-> ParsecT [RoffToken] ManState m [(ListType, Blocks)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Maybe ListType -> ManParser m (ListType, Blocks)
forall (m :: * -> *).
PandocMonad m =>
Maybe ListType -> ManParser m (ListType, Blocks)
listItem (ListType -> Maybe ListType
forall a. a -> Maybe a
Just ListType
lt))
  let toDefItem :: (ListType, a) -> (Inlines, [a])
toDefItem (Definition Text
t, a
bs) = (Text -> Inlines
B.text Text
t, [a
bs])
      toDefItem (ListType, a)
_ = (Inlines, [a])
forall a. Monoid a => a
mempty
  Blocks -> ManParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> ManParser m Blocks) -> Blocks -> ManParser m Blocks
forall a b. (a -> b) -> a -> b
$ case ListType
lt of
             ListType
Bullet        -> [Blocks] -> Blocks
bulletList ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ ((ListType, Blocks) -> Blocks) -> [(ListType, Blocks)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (ListType, Blocks) -> Blocks
forall a b. (a, b) -> b
snd ((ListType, Blocks)
x(ListType, Blocks) -> [(ListType, Blocks)] -> [(ListType, Blocks)]
forall a. a -> [a] -> [a]
:[(ListType, Blocks)]
xs)
             Ordered (Int, ListNumberStyle, ListNumberDelim)
lattr -> (Int, ListNumberStyle, ListNumberDelim) -> [Blocks] -> Blocks
orderedListWith (Int, ListNumberStyle, ListNumberDelim)
lattr ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ ((ListType, Blocks) -> Blocks) -> [(ListType, Blocks)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (ListType, Blocks) -> Blocks
forall a b. (a, b) -> b
snd ((ListType, Blocks)
x(ListType, Blocks) -> [(ListType, Blocks)] -> [(ListType, Blocks)]
forall a. a -> [a] -> [a]
:[(ListType, Blocks)]
xs)
             Definition Text
_  -> [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> [(Inlines, [Blocks])] -> Blocks
forall a b. (a -> b) -> a -> b
$ ((ListType, Blocks) -> (Inlines, [Blocks]))
-> [(ListType, Blocks)] -> [(Inlines, [Blocks])]
forall a b. (a -> b) -> [a] -> [b]
map (ListType, Blocks) -> (Inlines, [Blocks])
forall a. (ListType, a) -> (Inlines, [a])
toDefItem ((ListType, Blocks)
x(ListType, Blocks) -> [(ListType, Blocks)] -> [(ListType, Blocks)]
forall a. a -> [a] -> [a]
:[(ListType, Blocks)]
xs)

continuation :: PandocMonad m => ManParser m Blocks
continuation :: ManParser m Blocks
continuation =
      [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [RoffToken] ManState m [Blocks] -> ManParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"RS" ManParser m RoffToken
-> ParsecT [RoffToken] ManState m [Blocks]
-> ParsecT [RoffToken] ManState m [Blocks]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ManParser m Blocks
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m [Blocks]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlock (Text -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
"RE"))
  ManParser m Blocks -> ManParser m Blocks -> ManParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [RoffToken] ManState m [Blocks] -> ManParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ManParser m Blocks -> ParsecT [RoffToken] ManState m [Blocks]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (  ManParser m Blocks -> ManParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
bareIP ManParser m RoffToken -> ManParser m Blocks -> ManParser m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parsePara)
                       ManParser m Blocks -> ManParser m Blocks -> ManParser m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ManParser m Blocks -> ManParser m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
bareIP ManParser m RoffToken -> ManParser m Blocks -> ManParser m Blocks
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ManParser m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseCodeBlock)
                        )

definitionListItem :: PandocMonad m
                   => ManParser m (Inlines, [Blocks])
definitionListItem :: ManParser m (Inlines, [Blocks])
definitionListItem = ManParser m (Inlines, [Blocks]) -> ManParser m (Inlines, [Blocks])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ManParser m (Inlines, [Blocks])
 -> ManParser m (Inlines, [Blocks]))
-> ManParser m (Inlines, [Blocks])
-> ManParser m (Inlines, [Blocks])
forall a b. (a -> b) -> a -> b
$ do
  Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"TP"  -- args specify indent level, can ignore
  ManParser m RoffToken -> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
  Inlines
term <- ManParser m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInline
  ManParser m RoffToken -> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
  [Inlines]
moreterms <- ManParser m Inlines -> ParsecT [RoffToken] ManState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ManParser m Inlines -> ParsecT [RoffToken] ManState m [Inlines])
-> ManParser m Inlines -> ParsecT [RoffToken] ManState m [Inlines]
forall a b. (a -> b) -> a -> b
$ ManParser m Inlines -> ManParser m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ManParser m Inlines -> ManParser m Inlines)
-> ManParser m Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ do
                 Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"TQ"
                 ManParser m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInline
  ManParser m RoffToken -> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
  Inlines
inls <- Inlines -> ManParser m Inlines -> ManParser m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
forall a. Monoid a => a
mempty ManParser m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInlines
  ManParser m RoffToken -> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
  Blocks
continuations <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [RoffToken] ManState m [Blocks]
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
continuation
  (Inlines, [Blocks]) -> ManParser m (Inlines, [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return ( [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat (Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.linebreak (Inlines
termInlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:[Inlines]
moreterms))
         , [Inlines -> Blocks
para Inlines
inls Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
continuations])

parseDefinitionList :: PandocMonad m => ManParser m Blocks
parseDefinitionList :: ManParser m Blocks
parseDefinitionList = [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> ParsecT [RoffToken] ManState m [(Inlines, [Blocks])]
-> ManParser m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m (Inlines, [Blocks])
-> ParsecT [RoffToken] ManState m [(Inlines, [Blocks])]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [RoffToken] ManState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
ManParser m (Inlines, [Blocks])
definitionListItem

parseLink :: PandocMonad m => [Arg] -> ManParser m Inlines
parseLink :: [[LinePart]] -> ManParser m Inlines
parseLink [[LinePart]]
args = do
  Inlines
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT [RoffToken] ManState m [Inlines] -> ManParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ManParser m Inlines -> ParsecT [RoffToken] ManState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ManParser m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
lineInl
  ControlLine Text
_ [[LinePart]]
endargs SourcePos
_ <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"UE"
  let url :: Text
url = case [[LinePart]]
args of
              [] -> Text
""
              ([LinePart]
x:[[LinePart]]
_) -> [LinePart] -> Text
linePartsToText [LinePart]
x
  Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link Text
url Text
"" Inlines
contents Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
    case [[LinePart]]
endargs of
      []    -> Inlines
forall a. Monoid a => a
mempty
      ([LinePart]
x:[[LinePart]]
_) -> [LinePart] -> Inlines
linePartsToInlines [LinePart]
x

parseEmailLink :: PandocMonad m => [Arg] -> ManParser m Inlines
parseEmailLink :: [[LinePart]] -> ManParser m Inlines
parseEmailLink [[LinePart]]
args = do
  Inlines
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT [RoffToken] ManState m [Inlines] -> ManParser m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ManParser m Inlines -> ParsecT [RoffToken] ManState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ManParser m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
lineInl
  ControlLine Text
_ [[LinePart]]
endargs SourcePos
_ <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"ME"
  let url :: Text
url = case [[LinePart]]
args of
              [] -> Text
""
              ([LinePart]
x:[[LinePart]]
_) -> Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [LinePart] -> Text
linePartsToText [LinePart]
x
  Inlines -> ManParser m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link Text
url Text
"" Inlines
contents Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
    case [[LinePart]]
endargs of
      []    -> Inlines
forall a. Monoid a => a
mempty
      ([LinePart]
x:[[LinePart]]
_) -> [LinePart] -> Inlines
linePartsToInlines [LinePart]
x

skipUnknownMacro :: PandocMonad m => ManParser m Blocks
skipUnknownMacro :: ManParser m Blocks
skipUnknownMacro = do
  RoffToken
tok <- ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mmacroAny
  case RoffToken
tok of
    ControlLine Text
mkind [[LinePart]]
_ SourcePos
pos -> do
      LogMessage -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [RoffToken] ManState m ())
-> LogMessage -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mkind) SourcePos
pos
      Blocks -> ManParser m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
    RoffToken
_                 -> String -> ManParser m Blocks
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"the impossible happened"