{-# 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 (mzero, guard, void)
import Control.Monad.Trans (lift)
import Control.Monad.Except (throwError)
import Data.Maybe (catMaybes, isJust)
import Data.List (intersperse)
import qualified Data.Text as T
import Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad(..), report)
import Text.Pandoc.Logging (LogMessage(..))
import Text.Pandoc.Options
import Text.Pandoc.Parsing
import Text.Pandoc.Walk (query)
import Text.Pandoc.Readers.Roff  -- TODO explicit imports
import qualified Text.Pandoc.Parsing as P
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
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 :: ReaderOptions
readerOptions   = forall a. Default a => a
def
                 , metadata :: Meta
metadata        = Meta
nullMeta
                 , tableCellsPlain :: Bool
tableCellsPlain = Bool
True }

type ManParser m = P.ParsecT [RoffToken] ManState m


-- | Read man (troff) from an input string and return a Pandoc document.
readMan :: (PandocMonad m, ToSources a)
        => ReaderOptions
        -> a
        -> m Pandoc
readMan :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMan ReaderOptions
opts a
s = do
  let Sources [(SourcePos, Text)]
inps = forall a. ToSources a => a -> Sources
toSources a
s
  RoffTokens
tokenz <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
PandocMonad m =>
SourcePos -> Text -> m RoffTokens
lexRoff) [(SourcePos, Text)]
inps
  let state :: ManState
state = forall a. Default a => a
def {readerOptions :: ReaderOptions
readerOptions = ReaderOptions
opts} :: ManState
  Either ParseError Pandoc
eitherdoc <- forall (m :: * -> *) a.
PandocMonad m =>
ParsecT [RoffToken] ManState m a
-> ManState -> [RoffToken] -> m (Either ParseError a)
readWithMTokens forall (m :: * -> *). PandocMonad m => ManParser m Pandoc
parseMan ManState
state
     (forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoffTokens -> Seq RoffToken
unRoffTokens forall a b. (a -> b) -> a -> b
$ RoffTokens
tokenz)
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sources -> ParseError -> PandocError
fromParsecError ([(SourcePos, Text)] -> Sources
Sources [(SourcePos, Text)]
inps)) forall (m :: * -> *) a. Monad m => a -> m a
return Either ParseError Pandoc
eitherdoc


readWithMTokens :: PandocMonad m
        => ParsecT [RoffToken] ManState m a  -- ^ parser
        -> ManState                         -- ^ initial state
        -> [RoffToken]                       -- ^ input
        -> m (Either ParseError a)
readWithMTokens :: forall (m :: * -> *) a.
PandocMonad m =>
ParsecT [RoffToken] ManState m a
-> ManState -> [RoffToken] -> m (Either ParseError a)
readWithMTokens ParsecT [RoffToken] ManState m a
parser ManState
state [RoffToken]
input =
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT ParsecT [RoffToken] ManState m a
parser ManState
state String
"source" [RoffToken]
input


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

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

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

 where

  parseTableCell :: RoffTokens -> ParsecT s ManState m Blocks
parseTableCell RoffTokens
ts = do
    ManState
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    let ts' :: [RoffToken]
ts' = forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList forall a b. (a -> b) -> a -> b
$ RoffTokens -> Seq RoffToken
unRoffTokens RoffTokens
ts
    let plaintcell :: ParsecT [RoffToken] ManState m Blocks
plaintcell = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
          forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
          Inlines -> Blocks
plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInlines forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
    let blockstcell :: ParsecT [RoffToken] ManState m Blocks
blockstcell = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
          forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
          forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlock forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
    Either ParseError Blocks
res <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RoffToken]
ts'
              then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty
              else forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PandocMonad m =>
ParsecT [RoffToken] ManState m a
-> ManState -> [RoffToken] -> m (Either ParseError a)
readWithMTokens ParsecT [RoffToken] ManState m Blocks
plaintcell ManState
st [RoffToken]
ts'
    case Either ParseError Blocks
res of
      Left ParseError
_  -> do
        Either ParseError Blocks
res' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PandocMonad m =>
ParsecT [RoffToken] ManState m a
-> ManState -> [RoffToken] -> m (Either ParseError a)
readWithMTokens ParsecT [RoffToken] ManState m Blocks
blockstcell ManState
st [RoffToken]
ts'
        case Either ParseError Blocks
res' of
          Left ParseError
_  -> forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"Could not parse table cell"
          Right Blocks
x -> do
            forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ManState
s -> ManState
s{ tableCellsPlain :: Bool
tableCellsPlain = Bool
False }
            forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
x
      Right Blocks
x -> 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'_',Char
'-',Char
'=']
  isHrule ([CellFormat]
_, [RoffTokens Seq RoffToken
ss]) =
    case forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq RoffToken
ss of
      [TextLine [RoffStr (Text -> String
T.unpack -> [Char
c])]] -> Char
c 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
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
"TABLE" SourcePos
pos
    forall (m :: * -> *) a. Monad m => a -> m a
return 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' -> forall a. a -> Maybe a
Just Alignment
AlignLeft
      Char
'c' -> forall a. a -> Maybe a
Just Alignment
AlignCenter
      Char
'l' -> forall a. a -> Maybe a
Just Alignment
AlignLeft
      Char
'n' -> forall a. a -> Maybe a
Just Alignment
AlignRight
      Char
'r' -> forall a. a -> Maybe a
Just Alignment
AlignRight
      Char
_   -> forall a. Maybe a
Nothing

  toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]

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

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

msatisfy :: Monad m
         => (RoffToken -> Bool) -> P.ParsecT [RoffToken] st m RoffToken
msatisfy :: forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
predic = forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
P.tokenPrim forall a. Show a => a -> String
show 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 forall a. a -> Maybe a
Just RoffToken
t else 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
P.updatePosString
                             (SourcePos -> Int -> SourcePos
P.setSourceColumn
                               (SourcePos -> Int -> SourcePos
P.setSourceLine SourcePos
pos forall a b. (a -> b) -> a -> b
$
                                 SourcePos -> Int
P.sourceLine SourcePos
pos forall a. Num a => a -> a -> a
+ Int
1) Int
1) String
""

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

mline :: PandocMonad m => ManParser m RoffToken
mline :: forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mline = forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [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 :: forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine = forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [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 :: forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
mk = forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isControlLine where
  isControlLine :: RoffToken -> Bool
isControlLine (ControlLine Text
mk' [[LinePart]]
_ SourcePos
_) | Text
mk 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 :: forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mmacroAny = forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [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 :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseTitle = do
  (ControlLine Text
_ [[LinePart]]
args SourcePos
_) <- 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]]
_) -> forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"section" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"date" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
z)
         [[LinePart]
x,[LinePart]
y]     -> forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"section" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
y)
         [[LinePart]
x]       -> forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"title" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x)
         []        -> forall a. a -> a
id
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \ManState
st -> ManState
st{ metadata :: Meta
metadata = Meta -> Meta
adjustMeta forall a b. (a -> b) -> a -> b
$ ManState -> Meta
metadata ManState
st }
  forall (m :: * -> *) a. Monad m => a -> m a
return 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
_ [] = 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 forall a. Semigroup a => a -> a -> a
<> Text
t)forall a. a -> [a] -> [a]
:[LinePart]
xs)
  go Bool
mono (RoffStr Text
s : [LinePart]
xs)
    | Bool
mono      = Text -> Inlines
code Text
s forall a. Semigroup a => a -> a -> a
<> Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
xs
    | Bool
otherwise = Text -> Inlines
text Text
s 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 forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
litals forall a. Ord a => a -> a -> Bool
>= Int
lbolds Bool -> Bool -> Bool
&& Int
litals 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 } forall a. a -> [a] -> [a]
:
                   forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\FontSpec
s -> FontSpec
s{ fontItalic :: Bool
fontItalic = Bool
False }))
                   [LinePart]
itals)) forall a. Semigroup a => a -> a -> a
<>
            Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
italsrest
    | Int
lbolds forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
lbolds 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 } forall a. a -> [a] -> [a]
:
              forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\FontSpec
s -> FontSpec
s{ fontBold :: Bool
fontBold = Bool
False }))
              [LinePart]
bolds)) forall a. Semigroup a => a -> a -> a
<>
            Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
boldsrest
    | Int
lmonos 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 } forall a. a -> [a] -> [a]
:
          forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\FontSpec
s -> FontSpec
s { fontMonospace :: Bool
fontMonospace = Bool
False }))
          [LinePart]
monos) 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [LinePart]
itals
      lbolds :: Int
lbolds = forall (t :: * -> *) a. Foldable t => t a -> Int
length [LinePart]
bolds
      lmonos :: Int
lmonos = forall (t :: * -> *) a. Foldable t => t a -> Int
length [LinePart]
monos
      ([LinePart]
itals, [LinePart]
italsrest) =
        if FontSpec -> Bool
fontItalic FontSpec
fs
           then forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((FontSpec -> Bool) -> LinePart -> Bool
withFont (Bool -> Bool
not 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 forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((FontSpec -> Bool) -> LinePart -> Bool
withFont (Bool -> Bool
not 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 forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((FontSpec -> Bool) -> LinePart -> Bool
withFont (Bool -> Bool
not 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 :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parsePara = Inlines -> Blocks
para forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInlines

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

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

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

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

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

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

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

bareIP :: PandocMonad m => ManParser m RoffToken
bareIP :: forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
bareIP = forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [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 :: forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
name = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
name)
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall {st}. ParsecT [RoffToken] st m RoffToken
newBlockMacro)
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  where
    newBlockMacro :: ParsecT [RoffToken] st m RoffToken
newBlockMacro = forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [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 :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseCodeBlock = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
bareIP
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"in") -- some people indent their code
  [Maybe Text]
toks <- (forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"nf" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 (forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
"fi"))
      forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"EX" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 (forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
"EE"))
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"in")
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Blocks
codeBlock (Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe Text]
toks)

  where

  codeline :: ParsecT [RoffToken] ManState m (Maybe Text)
codeline = do
    RoffToken
tok <- forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mtoken
    case RoffToken
tok of
      ControlLine Text
"PP" [[LinePart]]
_ SourcePos
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"" -- .PP sometimes used for blank line
      ControlLine Text
mname [[LinePart]]
args SourcePos
pos ->
        (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
getText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Text -> [[LinePart]] -> SourcePos -> ManParser m Inlines
handleInlineMacro Text
mname [[LinePart]]
args SourcePos
pos) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          do forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"." forall a. Semigroup a => a -> a -> a
<> Text
mname) SourcePos
pos
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Tbl [TableOption]
_ [TableRow]
_ SourcePos
pos     -> do
        forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
"TABLE" SourcePos
pos
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
"TABLE"
      RoffToken
EmptyLine -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
""
      TextLine [LinePart]
ss
        | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LinePart]
ss)
        , forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LinePart -> Bool
isFontToken [LinePart]
ss -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just 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 :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseHeader = do
  ControlLine Text
name [[LinePart]]
args SourcePos
_ <- forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"SH" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"SS"
  Inlines
contents <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[LinePart]]
args
                 then forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Monoid a => a
mempty forall (m :: * -> *). PandocMonad m => ManParser m Inlines
lineInl
                 else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Inlines
B.space
                             forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [LinePart] -> Inlines
linePartsToInlines [[LinePart]]
args
  let lvl :: Int
lvl = if Text
name forall a. Eq a => a -> a -> Bool
== Text
"SH" then Int
1 else Int
2
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Inlines -> Blocks
header Int
lvl Inlines
contents

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

parseList :: PandocMonad m => ManParser m Blocks
parseList :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseList = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  x :: (ListType, Blocks)
x@(ListType
lt, Blocks
_) <- forall (m :: * -> *).
PandocMonad m =>
Maybe ListType -> ManParser m (ListType, Blocks)
listItem forall a. Maybe a
Nothing
  [(ListType, Blocks)]
xs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall (m :: * -> *).
PandocMonad m =>
Maybe ListType -> ManParser m (ListType, Blocks)
listItem (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)
_ = forall a. Monoid a => a
mempty
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case ListType
lt of
             ListType
Bullet        -> [Blocks] -> Blocks
bulletList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd ((ListType, Blocks)
xforall a. a -> [a] -> [a]
:[(ListType, Blocks)]
xs)
             Ordered (Int, ListNumberStyle, ListNumberDelim)
lattr -> (Int, ListNumberStyle, ListNumberDelim) -> [Blocks] -> Blocks
orderedListWith (Int, ListNumberStyle, ListNumberDelim)
lattr forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd ((ListType, Blocks)
xforall a. a -> [a] -> [a]
:[(ListType, Blocks)]
xs)
             Definition Text
_  -> [(Inlines, [Blocks])] -> Blocks
definitionList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (ListType, a) -> (Inlines, [a])
toDefItem ((ListType, Blocks)
xforall a. a -> [a] -> [a]
:[(ListType, Blocks)]
xs)

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

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

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

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

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

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