{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.Man
   Copyright   : Copyright (C) 2018-2019 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 Prelude
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 Text.Pandoc.Class (PandocMonad(..), report)
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.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, initialPos)
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 opts :: ReaderOptions
opts txt :: Text
txt = do
  RoffTokens
tokenz <- SourcePos -> Text -> m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
SourcePos -> Text -> m RoffTokens
lexRoff (String -> SourcePos
initialPos "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 parser :: ParserT [RoffToken] ManState m a
parser state :: ManState
state input :: [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 "\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 "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 _ blocks :: [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
$ \st :: ManState
st -> ManState
st { tableCellsPlain :: Bool
tableCellsPlain = Bool
True }
  let isTbl :: RoffToken -> Bool
isTbl (Tbl{}) = Bool
True
      isTbl _          = Bool
False
  Tbl _opts :: [TableOption]
_opts rows :: [TableRow]
rows pos :: 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
    ((as :: [CellFormat]
as,_):_) -> 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 (headerRow' :: TableRow
headerRow', bodyRows' :: [TableRow]
bodyRows') =
            case [TableRow]
rows of
              (h :: TableRow
h:x :: TableRow
x:bs :: [TableRow]
bs)
               | TableRow -> Bool
isHrule TableRow
x -> (TableRow
h, [TableRow]
bs)
              _ -> (([],[]), [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 :: [Double]
widths = if Bool
isPlainTable
                      then Double -> [Double]
forall a. a -> [a]
repeat 0.0
                      else Double -> [Double]
forall a. a -> [a]
repeat ((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))
                                   :: Double)
      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
$ Inlines
-> [(Alignment, Double)] -> [Blocks] -> [[Blocks]] -> Blocks
B.table Inlines
forall a. Monoid a => a
mempty ([Alignment] -> [Double] -> [(Alignment, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
alignments [Double]
widths)
                  [Blocks]
headerRow [[Blocks]]
bodyRows) 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 ts :: 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 _  -> 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 _  -> String -> ParsecT s ManState m Blocks
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "Could not parse table cell"
          Right x :: 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
$ \s :: 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 x :: 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 ([cellfmt :: CellFormat
cellfmt], _) = CellFormat -> Char
columnType CellFormat
cellfmt Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['_','-','=']
  isHrule (_, [RoffTokens ss :: 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 -> [c :: Char
c])]] -> Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['_','-','=']
      _                     -> Bool
False
  isHrule _ = Bool
False

  fallback :: SourcePos -> m Blocks
fallback pos :: 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 "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 "TABLE")

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


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 "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 "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 "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 predic :: 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 t :: 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 _pos :: SourcePos
_pos _x :: p
_x (ControlLine _ _ pos' :: SourcePos
pos':_) = SourcePos
pos'
    nextPos pos :: SourcePos
pos _x :: p
_x _xs :: [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
+ 1) 1) ""

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 _) = Bool
True
  isTextLine _ = 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 EmptyLine = Bool
True
  isEmptyLine _ = Bool
False

mmacro :: PandocMonad m => T.Text -> ManParser m RoffToken
mmacro :: Text -> ManParser m RoffToken
mmacro mk :: 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 mk' :: Text
mk' _ _) | Text
mk Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
mk' = Bool
True
                            | Bool
otherwise = Bool
False
  isControlLine _ = 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 _ = Bool
False

--
-- RoffToken -> Block functions
--

parseTitle :: PandocMonad m => ManParser m Blocks
parseTitle :: ManParser m Blocks
parseTitle = do
  (ControlLine _ args :: [Arg]
args _) <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro "TH"
  let adjustMeta :: Meta -> Meta
adjustMeta =
       case [Arg]
args of
         (x :: Arg
x:y :: Arg
y:z :: Arg
z:_) -> Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta "title" (Arg -> Inlines
linePartsToInlines Arg
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 "section" (Arg -> Inlines
linePartsToInlines Arg
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 "date" (Arg -> Inlines
linePartsToInlines Arg
z)
         [x :: Arg
x,y :: Arg
y]     -> Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta "title" (Arg -> Inlines
linePartsToInlines Arg
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 "section" (Arg -> Inlines
linePartsToInlines Arg
y)
         [x :: Arg
x]       -> Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta "title" (Arg -> Inlines
linePartsToInlines Arg
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
$ \st :: 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 :: Arg -> Inlines
linePartsToInlines = Bool -> Arg -> Inlines
go Bool
False

  where
  go :: Bool -> [LinePart] -> Inlines
  go :: Bool -> Arg -> Inlines
go _ [] = Inlines
forall a. Monoid a => a
mempty
  go mono :: Bool
mono (MacroArg _:xs :: Arg
xs) = Bool -> Arg -> Inlines
go Bool
mono Arg
xs -- shouldn't happen
  go mono :: Bool
mono (RoffStr s :: Text
s : RoffStr t :: Text
t : xs :: Arg
xs) = Bool -> Arg -> Inlines
go Bool
mono (Text -> LinePart
RoffStr (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)LinePart -> Arg -> Arg
forall a. a -> [a] -> [a]
:Arg
xs)
  go mono :: Bool
mono (RoffStr s :: Text
s : xs :: Arg
xs)
    | Bool
mono      = Text -> Inlines
code Text
s Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bool -> Arg -> Inlines
go Bool
mono Arg
xs
    | Bool
otherwise = Text -> Inlines
text Text
s Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bool -> Arg -> Inlines
go Bool
mono Arg
xs
  go mono :: Bool
mono (Font fs :: FontSpec
fs: xs :: Arg
xs) =
    if Int
litals Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
       then Inlines -> Inlines
emph (Bool -> Arg -> Inlines
go Bool
mono (FontSpec -> LinePart
Font FontSpec
fs{ fontItalic :: Bool
fontItalic = Bool
False } LinePart -> Arg -> Arg
forall a. a -> [a] -> [a]
:
                   (LinePart -> LinePart) -> Arg -> Arg
forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\s :: FontSpec
s -> FontSpec
s{ fontItalic :: Bool
fontItalic = Bool
False }))
                   Arg
itals)) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
            Bool -> Arg -> Inlines
go Bool
mono Arg
italsrest
       else if Int
lbolds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Int
lbolds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lmonos
            then Inlines -> Inlines
strong (Bool -> Arg -> Inlines
go Bool
mono (FontSpec -> LinePart
Font FontSpec
fs{ fontBold :: Bool
fontBold = Bool
False } LinePart -> Arg -> Arg
forall a. a -> [a] -> [a]
:
                   (LinePart -> LinePart) -> Arg -> Arg
forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\s :: FontSpec
s -> FontSpec
s{ fontBold :: Bool
fontBold = Bool
False }))
                   Arg
bolds)) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                 Bool -> Arg -> Inlines
go Bool
mono Arg
boldsrest
            else if Int
lmonos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                 then Bool -> Arg -> Inlines
go Bool
True (FontSpec -> LinePart
Font FontSpec
fs{ fontMonospace :: Bool
fontMonospace = Bool
False } LinePart -> Arg -> Arg
forall a. a -> [a] -> [a]
:
                    (LinePart -> LinePart) -> Arg -> Arg
forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\s :: FontSpec
s -> FontSpec
s { fontMonospace :: Bool
fontMonospace = Bool
False }))
                    Arg
monos) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bool -> Arg -> Inlines
go Bool
mono Arg
monosrest
                 else Bool -> Arg -> Inlines
go Bool
mono Arg
xs
    where
      adjustFontSpec :: (FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec f :: FontSpec -> FontSpec
f (Font fspec :: FontSpec
fspec) = FontSpec -> LinePart
Font (FontSpec -> FontSpec
f FontSpec
fspec)
      adjustFontSpec _ x :: LinePart
x            = LinePart
x
      withFont :: (FontSpec -> Bool) -> LinePart -> Bool
withFont f :: FontSpec -> Bool
f (Font fspec :: FontSpec
fspec) = FontSpec -> Bool
f FontSpec
fspec
      withFont _ _            = Bool
False
      litals :: Int
litals = Arg -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Arg
itals
      lbolds :: Int
lbolds = Arg -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Arg
bolds
      lmonos :: Int
lmonos = Arg -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Arg
monos
      (itals :: Arg
itals, italsrest :: Arg
italsrest) =
        if FontSpec -> Bool
fontItalic FontSpec
fs
           then (LinePart -> Bool) -> Arg -> (Arg, Arg)
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)) Arg
xs
           else ([], Arg
xs)
      (bolds :: Arg
bolds, boldsrest :: Arg
boldsrest) =
        if FontSpec -> Bool
fontBold FontSpec
fs
           then (LinePart -> Bool) -> Arg -> (Arg, Arg)
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)) Arg
xs
           else ([], Arg
xs)
      (monos :: Arg
monos, monosrest :: Arg
monosrest) =
        if FontSpec -> Bool
fontMonospace FontSpec
fs
           then (LinePart -> Bool) -> Arg -> (Arg, Arg)
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)) Arg
xs
           else ([], Arg
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 lparts :: Arg
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
$ Arg -> Inlines
linePartsToInlines Arg
lparts
    ControlLine mname :: Text
mname args :: [Arg]
args pos :: SourcePos
pos -> Text -> [Arg] -> SourcePos -> ManParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> [Arg] -> SourcePos -> ManParser m Inlines
handleInlineMacro Text
mname [Arg]
args SourcePos
pos
    _ -> ManParser m Inlines
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

parseBold :: PandocMonad m => [Arg] -> ManParser m Inlines
parseBold :: [Arg] -> ManParser m Inlines
parseBold [] = do
  TextLine lparts :: Arg
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
$ Arg -> Inlines
linePartsToInlines Arg
lparts
parseBold args :: [Arg]
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
$ (Arg -> Inlines) -> [Arg] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> Inlines
linePartsToInlines [Arg]
args

parseItalic :: PandocMonad m => [Arg] -> ManParser m Inlines
parseItalic :: [Arg] -> ManParser m Inlines
parseItalic [] = do
  TextLine lparts :: Arg
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
$ Arg -> Inlines
linePartsToInlines Arg
lparts
parseItalic args :: [Arg]
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
$ (Arg -> Inlines) -> [Arg] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> Inlines
linePartsToInlines [Arg]
args

parseAlternatingFonts :: [Inlines -> Inlines]
                      -> [Arg]
                      -> ManParser m Inlines
parseAlternatingFonts :: [Inlines -> Inlines] -> [Arg] -> ManParser m Inlines
parseAlternatingFonts constructors :: [Inlines -> Inlines]
constructors args :: [Arg]
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) -> Arg -> Inlines)
-> [Inlines -> Inlines] -> [Arg] -> [Inlines]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\f :: Inlines -> Inlines
f arg :: Arg
arg -> Inlines -> Inlines
f (Arg -> Inlines
linePartsToInlines Arg
arg)) ([Inlines -> Inlines] -> [Inlines -> Inlines]
forall a. [a] -> [a]
cycle [Inlines -> Inlines]
constructors) [Arg]
args

lineInl :: PandocMonad m => ManParser m Inlines
lineInl :: ManParser m Inlines
lineInl = do
  (TextLine fragments :: Arg
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
$ Arg -> Inlines
linePartsToInlines Arg
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 "IP" [] _) = Bool
True
  isBareIP _                  = Bool
False

endmacro :: PandocMonad m => T.Text -> ManParser m ()
endmacro :: Text -> ManParser m ()
endmacro name :: 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 "SH" _ _) = Bool
True
    isNewBlockMacro (ControlLine "SS" _ _) = Bool
True
    isNewBlockMacro _ = 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 "in") -- some people indent their code
  [Maybe Text]
toks <- (Text -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro "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 "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 "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 "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 "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 "\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 "PP" _ _ -> 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 "" -- .PP sometimes used for blank line
      ControlLine mname :: Text
mname args :: [Arg]
args pos :: SourcePos
pos -> do
        (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
-> [Arg] -> SourcePos -> ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> [Arg] -> SourcePos -> ManParser m Inlines
handleInlineMacro Text
mname [Arg]
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
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 _ _ pos :: 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 "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 "TABLE"
      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 ""
      TextLine ss :: Arg
ss
        | Bool -> Bool
not (Arg -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Arg
ss)
        , (LinePart -> Bool) -> Arg -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LinePart -> Bool
isFontToken Arg
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
$ Arg -> Text
linePartsToText Arg
ss

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

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

parseHeader :: PandocMonad m => ManParser m Blocks
parseHeader :: ManParser m Blocks
parseHeader = do
  ControlLine name :: Text
name args :: [Arg]
args _ <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro "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 "SS"
  Inlines
contents <- if [Arg] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Arg]
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
$ (Arg -> Inlines) -> [Arg] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> Inlines
linePartsToInlines [Arg]
args
  let lvl :: Int
lvl = if Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "SH" then 1 else 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

listTypeMatches :: Maybe ListType -> ListType -> Bool
listTypeMatches :: Maybe ListType -> ListType -> Bool
listTypeMatches Nothing _            = Bool
True
listTypeMatches (Just Bullet) Bullet = Bool
True
listTypeMatches (Just (Ordered (_,x :: ListNumberStyle
x,y :: ListNumberDelim
y))) (Ordered (_,x' :: ListNumberStyle
x',y' :: 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 _) _           = Bool
False

listItem :: PandocMonad m => Maybe ListType -> ManParser m (ListType, Blocks)
listItem :: Maybe ListType -> ManParser m (ListType, Blocks)
listItem mbListType :: 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 _ args :: [Arg]
args _) <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro "IP"
  case [Arg]
args of
    (arg1 :: Arg
arg1 : _)  -> do
      let cs :: Text
cs = Arg -> Text
linePartsToText Arg
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
== '.') Text
cs Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ')') Text
cs) then Text
cs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." else Text
cs
      let lt :: ListType
lt = case Parsec Text ParserState ListAttributes
-> ParserState
-> String
-> Text
-> Either ParseError ListAttributes
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
Parsec.runParser Parsec Text ParserState ListAttributes
forall s (m :: * -> *).
Stream s m Char =>
ParserT s ParserState m ListAttributes
anyOrderedListMarker ParserState
defaultParserState
                     "list marker" Text
cs' of
                  Right (start :: Int
start, listtype :: ListNumberStyle
listtype, listdelim :: ListNumberDelim
listdelim)
                    | Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
cs' -> ListAttributes -> ListType
Ordered (Int
start, ListNumberStyle
listtype, ListNumberDelim
listdelim)
                    | Bool
otherwise -> ListAttributes -> ListType
Ordered (Int
start, ListNumberStyle
listtype, ListNumberDelim
DefaultDelim)
                  Left _        -> ListType
Bullet
      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
      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
      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
  (lt :: ListType
lt, x :: Blocks
x) <- Maybe ListType -> ManParser m (ListType, Blocks)
forall (m :: * -> *).
PandocMonad m =>
Maybe ListType -> ManParser m (ListType, Blocks)
listItem Maybe ListType
forall a. Maybe a
Nothing
  [Blocks]
xs <- ((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)] -> [Blocks])
-> ParsecT [RoffToken] ManState m [(ListType, Blocks)]
-> ParsecT [RoffToken] ManState m [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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))
  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
             Bullet        -> [Blocks] -> Blocks
bulletList (Blocks
xBlocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[Blocks]
xs)
             Ordered lattr :: ListAttributes
lattr -> ListAttributes -> [Blocks] -> Blocks
orderedListWith ListAttributes
lattr (Blocks
xBlocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:[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 "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 "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 "TP"  -- args specify indent level, can ignore
  Inlines
term <- ManParser m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInline
  [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 "TQ"
                 ManParser m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInline
  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
  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 :: [Arg] -> ManParser m Inlines
parseLink args :: [Arg]
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 _ endargs :: [Arg]
endargs _ <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro "UE"
  let url :: Text
url = case [Arg]
args of
              [] -> ""
              (x :: Arg
x:_) -> Arg -> Text
linePartsToText Arg
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 "" Inlines
contents Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
    case [Arg]
endargs of
      []    -> Inlines
forall a. Monoid a => a
mempty
      (x :: Arg
x:_) -> Arg -> Inlines
linePartsToInlines Arg
x

parseEmailLink :: PandocMonad m => [Arg] -> ManParser m Inlines
parseEmailLink :: [Arg] -> ManParser m Inlines
parseEmailLink args :: [Arg]
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 _ endargs :: [Arg]
endargs _ <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro "ME"
  let url :: Text
url = case [Arg]
args of
              [] -> ""
              (x :: Arg
x:_) -> "mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Arg -> Text
linePartsToText Arg
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 "" Inlines
contents Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
    case [Arg]
endargs of
      []    -> Inlines
forall a. Monoid a => a
mempty
      (x :: Arg
x:_) -> Arg -> Inlines
linePartsToInlines Arg
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 mkind :: Text
mkind _ pos :: 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
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
    _                 -> String -> ManParser m Blocks
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail "the impossible happened"