{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{- |
   Module      : Text.Pandoc.Readers.Roff
   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

Tokenizer for roff formats (man, ms).
-}
module Text.Pandoc.Readers.Roff
  ( FontSpec(..)
  , defaultFontSpec
  , LinePart(..)
  , Arg
  , TableOption
  , CellFormat(..)
  , TableRow
  , RoffToken(..)
  , RoffTokens(..)
  , linePartsToText
  , lexRoff
  )
where

import Safe (lastDef)
import Control.Monad (void, mzero, mplus, guard)
import Control.Monad.Except (throwError)
import Text.Pandoc.Class.PandocMonad
       (getResourcePath, readFileFromDirs, PandocMonad(..), report)
import Data.Char (isLower, toLower, toUpper, chr, isAscii, isAlphaNum)
import Data.Default (Default)
import qualified Data.Map as M
import Data.List (intercalate)
import qualified Data.Text as T
import Text.Pandoc.Logging (LogMessage(..))
import Text.Pandoc.Options
import Text.Pandoc.Parsing
import Text.Pandoc.Shared (safeRead)
import Text.Parsec hiding (tokenPrim)
import Text.Pandoc.RoffChar (characterCodes, combiningAccents)
import qualified Data.Sequence as Seq
import qualified Data.Foldable as Foldable
import qualified Data.Text.Normalize as Normalize

-- import Debug.Trace (traceShowId)

--
-- Data Types
--
data FontSpec = FontSpec{ FontSpec -> Bool
fontBold      :: Bool
                        , FontSpec -> Bool
fontItalic    :: Bool
                        , FontSpec -> Bool
fontMonospace :: Bool
                        } deriving (Int -> FontSpec -> ShowS
[FontSpec] -> ShowS
FontSpec -> String
(Int -> FontSpec -> ShowS)
-> (FontSpec -> String) -> ([FontSpec] -> ShowS) -> Show FontSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontSpec] -> ShowS
$cshowList :: [FontSpec] -> ShowS
show :: FontSpec -> String
$cshow :: FontSpec -> String
showsPrec :: Int -> FontSpec -> ShowS
$cshowsPrec :: Int -> FontSpec -> ShowS
Show, FontSpec -> FontSpec -> Bool
(FontSpec -> FontSpec -> Bool)
-> (FontSpec -> FontSpec -> Bool) -> Eq FontSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontSpec -> FontSpec -> Bool
$c/= :: FontSpec -> FontSpec -> Bool
== :: FontSpec -> FontSpec -> Bool
$c== :: FontSpec -> FontSpec -> Bool
Eq, Eq FontSpec
Eq FontSpec
-> (FontSpec -> FontSpec -> Ordering)
-> (FontSpec -> FontSpec -> Bool)
-> (FontSpec -> FontSpec -> Bool)
-> (FontSpec -> FontSpec -> Bool)
-> (FontSpec -> FontSpec -> Bool)
-> (FontSpec -> FontSpec -> FontSpec)
-> (FontSpec -> FontSpec -> FontSpec)
-> Ord FontSpec
FontSpec -> FontSpec -> Bool
FontSpec -> FontSpec -> Ordering
FontSpec -> FontSpec -> FontSpec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontSpec -> FontSpec -> FontSpec
$cmin :: FontSpec -> FontSpec -> FontSpec
max :: FontSpec -> FontSpec -> FontSpec
$cmax :: FontSpec -> FontSpec -> FontSpec
>= :: FontSpec -> FontSpec -> Bool
$c>= :: FontSpec -> FontSpec -> Bool
> :: FontSpec -> FontSpec -> Bool
$c> :: FontSpec -> FontSpec -> Bool
<= :: FontSpec -> FontSpec -> Bool
$c<= :: FontSpec -> FontSpec -> Bool
< :: FontSpec -> FontSpec -> Bool
$c< :: FontSpec -> FontSpec -> Bool
compare :: FontSpec -> FontSpec -> Ordering
$ccompare :: FontSpec -> FontSpec -> Ordering
$cp1Ord :: Eq FontSpec
Ord)

defaultFontSpec :: FontSpec
defaultFontSpec :: FontSpec
defaultFontSpec = Bool -> Bool -> Bool -> FontSpec
FontSpec Bool
False Bool
False Bool
False

data LinePart = RoffStr T.Text
              | Font FontSpec
              | MacroArg Int
              deriving Int -> LinePart -> ShowS
[LinePart] -> ShowS
LinePart -> String
(Int -> LinePart -> ShowS)
-> (LinePart -> String) -> ([LinePart] -> ShowS) -> Show LinePart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinePart] -> ShowS
$cshowList :: [LinePart] -> ShowS
show :: LinePart -> String
$cshow :: LinePart -> String
showsPrec :: Int -> LinePart -> ShowS
$cshowsPrec :: Int -> LinePart -> ShowS
Show

type Arg = [LinePart]

type TableOption = (T.Text, T.Text)

data CellFormat =
  CellFormat
  { CellFormat -> Char
columnType     :: Char
  , CellFormat -> Bool
pipePrefix     :: Bool
  , CellFormat -> Bool
pipeSuffix     :: Bool
  , CellFormat -> [Text]
columnSuffixes :: [T.Text]
  } deriving (Int -> CellFormat -> ShowS
[CellFormat] -> ShowS
CellFormat -> String
(Int -> CellFormat -> ShowS)
-> (CellFormat -> String)
-> ([CellFormat] -> ShowS)
-> Show CellFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellFormat] -> ShowS
$cshowList :: [CellFormat] -> ShowS
show :: CellFormat -> String
$cshow :: CellFormat -> String
showsPrec :: Int -> CellFormat -> ShowS
$cshowsPrec :: Int -> CellFormat -> ShowS
Show, CellFormat -> CellFormat -> Bool
(CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> Bool) -> Eq CellFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellFormat -> CellFormat -> Bool
$c/= :: CellFormat -> CellFormat -> Bool
== :: CellFormat -> CellFormat -> Bool
$c== :: CellFormat -> CellFormat -> Bool
Eq, Eq CellFormat
Eq CellFormat
-> (CellFormat -> CellFormat -> Ordering)
-> (CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> CellFormat)
-> (CellFormat -> CellFormat -> CellFormat)
-> Ord CellFormat
CellFormat -> CellFormat -> Bool
CellFormat -> CellFormat -> Ordering
CellFormat -> CellFormat -> CellFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CellFormat -> CellFormat -> CellFormat
$cmin :: CellFormat -> CellFormat -> CellFormat
max :: CellFormat -> CellFormat -> CellFormat
$cmax :: CellFormat -> CellFormat -> CellFormat
>= :: CellFormat -> CellFormat -> Bool
$c>= :: CellFormat -> CellFormat -> Bool
> :: CellFormat -> CellFormat -> Bool
$c> :: CellFormat -> CellFormat -> Bool
<= :: CellFormat -> CellFormat -> Bool
$c<= :: CellFormat -> CellFormat -> Bool
< :: CellFormat -> CellFormat -> Bool
$c< :: CellFormat -> CellFormat -> Bool
compare :: CellFormat -> CellFormat -> Ordering
$ccompare :: CellFormat -> CellFormat -> Ordering
$cp1Ord :: Eq CellFormat
Ord)

type TableRow = ([CellFormat], [RoffTokens])

data RoffToken = TextLine [LinePart]
               | EmptyLine
               | ControlLine T.Text [Arg] SourcePos
               | Tbl [TableOption] [TableRow] SourcePos
               deriving Int -> RoffToken -> ShowS
[RoffToken] -> ShowS
RoffToken -> String
(Int -> RoffToken -> ShowS)
-> (RoffToken -> String)
-> ([RoffToken] -> ShowS)
-> Show RoffToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoffToken] -> ShowS
$cshowList :: [RoffToken] -> ShowS
show :: RoffToken -> String
$cshow :: RoffToken -> String
showsPrec :: Int -> RoffToken -> ShowS
$cshowsPrec :: Int -> RoffToken -> ShowS
Show

newtype RoffTokens = RoffTokens { RoffTokens -> Seq RoffToken
unRoffTokens :: Seq.Seq RoffToken }
        deriving (Int -> RoffTokens -> ShowS
[RoffTokens] -> ShowS
RoffTokens -> String
(Int -> RoffTokens -> ShowS)
-> (RoffTokens -> String)
-> ([RoffTokens] -> ShowS)
-> Show RoffTokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoffTokens] -> ShowS
$cshowList :: [RoffTokens] -> ShowS
show :: RoffTokens -> String
$cshow :: RoffTokens -> String
showsPrec :: Int -> RoffTokens -> ShowS
$cshowsPrec :: Int -> RoffTokens -> ShowS
Show, b -> RoffTokens -> RoffTokens
NonEmpty RoffTokens -> RoffTokens
RoffTokens -> RoffTokens -> RoffTokens
(RoffTokens -> RoffTokens -> RoffTokens)
-> (NonEmpty RoffTokens -> RoffTokens)
-> (forall b. Integral b => b -> RoffTokens -> RoffTokens)
-> Semigroup RoffTokens
forall b. Integral b => b -> RoffTokens -> RoffTokens
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> RoffTokens -> RoffTokens
$cstimes :: forall b. Integral b => b -> RoffTokens -> RoffTokens
sconcat :: NonEmpty RoffTokens -> RoffTokens
$csconcat :: NonEmpty RoffTokens -> RoffTokens
<> :: RoffTokens -> RoffTokens -> RoffTokens
$c<> :: RoffTokens -> RoffTokens -> RoffTokens
Semigroup, Semigroup RoffTokens
RoffTokens
Semigroup RoffTokens
-> RoffTokens
-> (RoffTokens -> RoffTokens -> RoffTokens)
-> ([RoffTokens] -> RoffTokens)
-> Monoid RoffTokens
[RoffTokens] -> RoffTokens
RoffTokens -> RoffTokens -> RoffTokens
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [RoffTokens] -> RoffTokens
$cmconcat :: [RoffTokens] -> RoffTokens
mappend :: RoffTokens -> RoffTokens -> RoffTokens
$cmappend :: RoffTokens -> RoffTokens -> RoffTokens
mempty :: RoffTokens
$cmempty :: RoffTokens
$cp1Monoid :: Semigroup RoffTokens
Monoid)

singleTok :: RoffToken -> RoffTokens
singleTok :: RoffToken -> RoffTokens
singleTok RoffToken
t = Seq RoffToken -> RoffTokens
RoffTokens (RoffToken -> Seq RoffToken
forall a. a -> Seq a
Seq.singleton RoffToken
t)

data RoffMode = NormalMode
              | CopyMode
              deriving Int -> RoffMode -> ShowS
[RoffMode] -> ShowS
RoffMode -> String
(Int -> RoffMode -> ShowS)
-> (RoffMode -> String) -> ([RoffMode] -> ShowS) -> Show RoffMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoffMode] -> ShowS
$cshowList :: [RoffMode] -> ShowS
show :: RoffMode -> String
$cshow :: RoffMode -> String
showsPrec :: Int -> RoffMode -> ShowS
$cshowsPrec :: Int -> RoffMode -> ShowS
Show

data RoffState = RoffState { RoffState -> Map Text RoffTokens
customMacros     :: M.Map T.Text RoffTokens
                           , RoffState -> FontSpec
prevFont         :: FontSpec
                           , RoffState -> FontSpec
currentFont      :: FontSpec
                           , RoffState -> Char
tableTabChar     :: Char
                           , RoffState -> RoffMode
roffMode         :: RoffMode
                           , RoffState -> Maybe Bool
lastExpression   :: Maybe Bool
                           , RoffState -> Bool
afterConditional :: Bool
                           } deriving Int -> RoffState -> ShowS
[RoffState] -> ShowS
RoffState -> String
(Int -> RoffState -> ShowS)
-> (RoffState -> String)
-> ([RoffState] -> ShowS)
-> Show RoffState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoffState] -> ShowS
$cshowList :: [RoffState] -> ShowS
show :: RoffState -> String
$cshow :: RoffState -> String
showsPrec :: Int -> RoffState -> ShowS
$cshowsPrec :: Int -> RoffState -> ShowS
Show

instance Default RoffState where
  def :: RoffState
def = RoffState :: Map Text RoffTokens
-> FontSpec
-> FontSpec
-> Char
-> RoffMode
-> Maybe Bool
-> Bool
-> RoffState
RoffState { customMacros :: Map Text RoffTokens
customMacros = [(Text, RoffTokens)] -> Map Text RoffTokens
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                       ([(Text, RoffTokens)] -> Map Text RoffTokens)
-> [(Text, RoffTokens)] -> Map Text RoffTokens
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> (Text, RoffTokens))
-> [(Text, Text)] -> [(Text, RoffTokens)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
n, Text
s) ->
                                (Text
n, RoffToken -> RoffTokens
singleTok
                                  ([LinePart] -> RoffToken
TextLine [Text -> LinePart
RoffStr Text
s])))
                       [ (Text
"Tm", Text
"\x2122")
                       , (Text
"lq", Text
"\x201C")
                       , (Text
"rq", Text
"\x201D")
                       , (Text
"R",  Text
"\x00AE") ]
                  , prevFont :: FontSpec
prevFont = FontSpec
defaultFontSpec
                  , currentFont :: FontSpec
currentFont = FontSpec
defaultFontSpec
                  , tableTabChar :: Char
tableTabChar = Char
'\t'
                  , roffMode :: RoffMode
roffMode = RoffMode
NormalMode
                  , lastExpression :: Maybe Bool
lastExpression = Maybe Bool
forall a. Maybe a
Nothing
                  , afterConditional :: Bool
afterConditional = Bool
False
                  }

type RoffLexer m = ParserT T.Text RoffState m

--
-- Lexer: T.Text -> RoffToken
--

eofline :: Stream s m Char => ParsecT s u m ()
eofline :: ParsecT s u m ()
eofline = ParsecT s u m Char -> ParsecT s u m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> () () -> ParsecT s u m String -> ParsecT s u m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\}")

spacetab :: Stream s m Char => ParsecT s u m Char
spacetab :: ParsecT s u m Char
spacetab = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\t'

characterCodeMap :: M.Map T.Text Char
characterCodeMap :: Map Text Char
characterCodeMap =
  [(Text, Char)] -> Map Text Char
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Char)] -> Map Text Char)
-> [(Text, Char)] -> Map Text Char
forall a b. (a -> b) -> a -> b
$ ((Char, Text) -> (Text, Char)) -> [(Char, Text)] -> [(Text, Char)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
x,Text
y) -> (Text
y,Char
x)) [(Char, Text)]
characterCodes

combiningAccentsMap :: M.Map T.Text Char
combiningAccentsMap :: Map Text Char
combiningAccentsMap =
  [(Text, Char)] -> Map Text Char
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Char)] -> Map Text Char)
-> [(Text, Char)] -> Map Text Char
forall a b. (a -> b) -> a -> b
$ ((Char, Text) -> (Text, Char)) -> [(Char, Text)] -> [(Text, Char)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
x,Text
y) -> (Text
y,Char
x)) [(Char, Text)]
combiningAccents

escape :: PandocMonad m => RoffLexer m [LinePart]
escape :: RoffLexer m [LinePart]
escape = RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RoffLexer m [LinePart] -> RoffLexer m [LinePart])
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall a b. (a -> b) -> a -> b
$ do
  RoffLexer m ()
forall (m :: * -> *). PandocMonad m => RoffLexer m ()
backslash
  RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
escapeGlyph RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
escapeNormal

escapeGlyph :: PandocMonad m => RoffLexer m [LinePart]
escapeGlyph :: RoffLexer m [LinePart]
escapeGlyph = do
  Char
c <- ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (String -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'[',Char
'('])
  RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg RoffLexer m Text
-> (Text -> RoffLexer m [LinePart]) -> RoffLexer m [LinePart]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Text -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> Text -> RoffLexer m [LinePart]
resolveGlyph Char
c

resolveGlyph :: PandocMonad m => Char -> T.Text -> RoffLexer m [LinePart]
resolveGlyph :: Char -> Text -> RoffLexer m [LinePart]
resolveGlyph Char
delimChar Text
glyph = do
  let cs :: Text
cs = Text -> Text -> Text -> Text
T.replace Text
"_u" Text
" u" Text
glyph -- unicode glyphs separated by _
  (case Text -> [Text]
T.words Text
cs of
      []  -> RoffLexer m [LinePart]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      [Text
s] -> case Text -> Map Text Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
s Map Text Char
characterCodeMap Maybe Char -> Maybe Char -> Maybe Char
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Maybe Char
readUnicodeChar Text
s of
               Maybe Char
Nothing -> RoffLexer m [LinePart]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
               Just Char
c  -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr (Text -> LinePart) -> Text -> LinePart
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c]
      (Text
s:[Text]
ss) -> do
        Char
basechar <- case Text -> Map Text Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
s Map Text Char
characterCodeMap Maybe Char -> Maybe Char -> Maybe Char
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                         Text -> Maybe Char
readUnicodeChar Text
s of
                      Maybe Char
Nothing ->
                        case Text -> String
T.unpack Text
s of
                          [Char
ch] | Char -> Bool
isAscii Char
ch Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
ch ->
                                 Char -> ParsecT Text RoffState m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
ch
                          String
_ -> ParsecT Text RoffState m Char
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                      Just Char
c  -> Char -> ParsecT Text RoffState m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
        let addAccents :: [Text] -> Text -> m Text
addAccents [] Text
xs = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ NormalizationMode -> Text -> Text
Normalize.normalize NormalizationMode
Normalize.NFC (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                                        Text -> Text
T.reverse Text
xs
            addAccents (Text
a:[Text]
as) Text
xs =
              case Text -> Map Text Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
a Map Text Char
combiningAccentsMap Maybe Char -> Maybe Char -> Maybe Char
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Maybe Char
readUnicodeChar Text
a of
                Just Char
x  -> [Text] -> Text -> m Text
addAccents [Text]
as (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
x Text
xs
                Maybe Char
Nothing -> m Text
forall (m :: * -> *) a. MonadPlus m => m a
mzero
        [Text] -> Text -> ParsecT Text RoffState m Text
forall (m :: * -> *). MonadPlus m => [Text] -> Text -> m Text
addAccents [Text]
ss (Char -> Text
T.singleton Char
basechar) ParsecT Text RoffState m Text
-> (Text -> RoffLexer m [LinePart]) -> RoffLexer m [LinePart]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
xs -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
xs])
      RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> case Char
delimChar of
            Char
'['  -> Text -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m [LinePart]
escUnknown (Text
"\\[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
glyph Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")
            Char
'('  -> Text -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m [LinePart]
escUnknown (Text
"\\(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
glyph)
            Char
'\'' -> Text -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m [LinePart]
escUnknown (Text
"\\C'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
glyph Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")
            Char
_    -> String -> RoffLexer m [LinePart]
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"resolveGlyph: unknown glyph delimiter"

readUnicodeChar :: T.Text -> Maybe Char
readUnicodeChar :: Text -> Maybe Char
readUnicodeChar Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Just (Char
'u', Text
cs) | Text -> Int
T.length Text
cs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
3 -> Int -> Char
chr (Int -> Char) -> Maybe Int -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text
"0x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cs)
  Maybe (Char, Text)
_ -> Maybe Char
forall a. Maybe a
Nothing

escapeNormal :: PandocMonad m => RoffLexer m [LinePart]
escapeNormal :: RoffLexer m [LinePart]
escapeNormal = do
  Char
c <- String -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"{}"
  ParsecT Text RoffState m () -> ParsecT Text RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Text RoffState m ()
forall (m :: * -> *). PandocMonad m => RoffLexer m ()
expandString
  case Char
c of
    Char
' ' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
" "]
    Char
'"' -> [LinePart]
forall a. Monoid a => a
mempty [LinePart] -> ParsecT Text RoffState m () -> RoffLexer m [LinePart]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ((Char -> Bool) -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n')) -- line comment
    Char
'#' -> [LinePart]
forall a. Monoid a => a
mempty [LinePart]
-> ParsecT Text RoffState m String -> RoffLexer m [LinePart]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text RoffState m Char
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m String
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 Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
    Char
'%' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty  -- optional hyphenation
    Char
'&' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty  -- nonprintable zero-width
    Char
')' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty  -- nonprintable zero-width
    Char
'*' -> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
escString
    Char
',' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty  -- to fix spacing after roman
    Char
'-' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"-"]
    Char
'.' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"."]
    Char
'/' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty  -- to fix spacing before roman
    Char
'0' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\x2007"] -- digit-width space
    Char
':' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty  -- zero-width break
    Char
'A' -> RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg RoffLexer m Text
-> (Text -> RoffLexer m [LinePart]) -> RoffLexer m [LinePart]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m [LinePart]
checkDefined
    Char
'B' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'B' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'C' -> RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg RoffLexer m Text
-> (Text -> RoffLexer m [LinePart]) -> RoffLexer m [LinePart]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Text -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> Text -> RoffLexer m [LinePart]
resolveGlyph Char
'\''
    Char
'D' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'D' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'E' -> do
      RoffMode
mode <- RoffState -> RoffMode
roffMode (RoffState -> RoffMode)
-> ParsecT Text RoffState m RoffState
-> ParsecT Text RoffState m RoffMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      case RoffMode
mode of
        RoffMode
CopyMode   -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty
        RoffMode
NormalMode -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\\"]
    Char
'H' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'H' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'L' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'L' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'M' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'M' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg, Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ((Char -> Bool) -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n'))]
    Char
'N' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'N' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'O' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'O' [Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 (String -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'0',Char
'1'])]
    Char
'R' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'R' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'S' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'S' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'V' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'V' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg, Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum]
    Char
'X' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'X' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'Y' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'Y' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg, Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ((Char -> Bool) -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n'))]
    Char
'Z' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'Z' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'\'' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"'"]
    Char
'\n' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty  -- line continuation
    Char
'^' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\x200A"] -- 1/12 em space
    Char
'_' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"_"]
    Char
'`' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"`"]
    Char
'a' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty  -- "non-interpreted leader character"
    Char
'b' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'b' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'c' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty  -- interrupt text processing
    Char
'd' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'd' [] -- forward down 1/2em
    Char
'e' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\\"]
    Char
'f' -> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
escFont
    Char
'g' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'g' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg, Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ((Char -> Bool) -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n'))]
    Char
'h' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'h' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'k' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'k' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg, Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ((Char -> Bool) -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n'))]
    Char
'l' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'l' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'm' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'm' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg, Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ((Char -> Bool) -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n'))]
    Char
'n' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'm' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg, Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ((Char -> Bool) -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n'))]
    Char
'o' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'o' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'p' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'p' []
    Char
'r' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'r' []
    Char
's' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
's' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg, RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
signedNumber]
    Char
't' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\t"]
    Char
'u' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'u' []
    Char
'v' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'v' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'w' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'w' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'x' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'x' [RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
quoteArg]
    Char
'z' -> Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
'z' [Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar]
    Char
'|' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\x2006"] --1/6 em space
    Char
'~' -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\160"] -- nonbreaking space
    Char
'\\' -> do
      RoffMode
mode <- RoffState -> RoffMode
roffMode (RoffState -> RoffMode)
-> ParsecT Text RoffState m RoffState
-> ParsecT Text RoffState m RoffMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      case RoffMode
mode of
        RoffMode
CopyMode   -> Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
        RoffMode
NormalMode -> Char -> ParsecT Text RoffState m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\'
      [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\\"]
    Char
_   -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr (Text -> LinePart) -> Text -> LinePart
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c]
    -- man 7 groff: "If  a  backslash  is followed by a character that
    -- does not constitute a defined escape sequence, the backslash
    -- is  silently  ignored  and  the character maps to itself."

escIgnore :: PandocMonad m
          => Char
          -> [RoffLexer m T.Text]
          -> RoffLexer m [LinePart]
escIgnore :: Char -> [RoffLexer m Text] -> RoffLexer m [LinePart]
escIgnore Char
c [RoffLexer m Text]
argparsers = do
  SourcePos
pos <- ParsecT Text RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Text
arg <- (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text)
-> ParsecT Text RoffState m (Text, Text) -> RoffLexer m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RoffLexer m Text -> ParsecT Text RoffState m (Text, Text)
forall (m :: * -> *) st a.
Monad m =>
ParsecT Text st m a -> ParsecT Text st m (a, Text)
withRaw ([RoffLexer m Text] -> RoffLexer m Text
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [RoffLexer m Text]
argparsers) RoffLexer m Text -> RoffLexer m Text -> RoffLexer m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> RoffLexer m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
  LogMessage -> ParsecT Text RoffState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT Text RoffState m ())
-> LogMessage -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
T.cons Char
c Text
arg) SourcePos
pos
  [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty

escUnknown :: PandocMonad m => T.Text -> RoffLexer m [LinePart]
escUnknown :: Text -> RoffLexer m [LinePart]
escUnknown Text
s = do
  SourcePos
pos <- ParsecT Text RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  LogMessage -> ParsecT Text RoffState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT Text RoffState m ())
-> LogMessage -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
s SourcePos
pos
  [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\xFFFD"]

signedNumber :: PandocMonad m => RoffLexer m T.Text
signedNumber :: RoffLexer m Text
signedNumber = RoffLexer m Text -> RoffLexer m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RoffLexer m Text -> RoffLexer m Text)
-> RoffLexer m Text -> RoffLexer m Text
forall a b. (a -> b) -> a -> b
$ do
  Text
sign <- Text -> RoffLexer m Text -> RoffLexer m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (Text
"-" Text -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' RoffLexer m Text -> RoffLexer m Text -> RoffLexer m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text
"" Text -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+')
  Text
ds <- ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  Text -> RoffLexer m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
sign Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ds)

-- Parses: [..] or (..
escapeArg :: PandocMonad m => RoffLexer m T.Text
escapeArg :: RoffLexer m Text
escapeArg = [RoffLexer m Text] -> RoffLexer m Text
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
    [ Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ParsecT Text RoffState m Char
-> ParsecT Text RoffState m () -> ParsecT Text RoffState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text RoffState m () -> ParsecT Text RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Text RoffState m ()
forall (m :: * -> *). PandocMonad m => RoffLexer m ()
expandString ParsecT Text RoffState m () -> RoffLexer m Text -> RoffLexer m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                  ParsecT Text RoffState m Char
-> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar (String -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'\n',Char
']']) (Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']')
    , Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT Text RoffState m Char
-> ParsecT Text RoffState m () -> ParsecT Text RoffState m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text RoffState m () -> ParsecT Text RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Text RoffState m ()
forall (m :: * -> *). PandocMonad m => RoffLexer m ()
expandString ParsecT Text RoffState m () -> RoffLexer m Text -> RoffLexer m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                  Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
2 ((Char -> Bool) -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n'))
    ]

expandString :: PandocMonad m => RoffLexer m ()
expandString :: RoffLexer m ()
expandString = RoffLexer m () -> RoffLexer m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RoffLexer m () -> RoffLexer m ())
-> RoffLexer m () -> RoffLexer m ()
forall a b. (a -> b) -> a -> b
$ do
  SourcePos
pos <- ParsecT Text RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
  Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'
  Text
cs <- RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg RoffLexer m Text -> RoffLexer m Text -> RoffLexer m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
  Text
s <- [LinePart] -> Text
linePartsToText ([LinePart] -> Text)
-> ParsecT Text RoffState m [LinePart] -> RoffLexer m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> SourcePos -> ParsecT Text RoffState m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Text -> SourcePos -> RoffLexer m [LinePart]
resolveText Text
cs SourcePos
pos
  RoffLexer m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput RoffLexer m Text -> (Text -> RoffLexer m ()) -> RoffLexer m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> RoffLexer m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (Text -> RoffLexer m ())
-> (Text -> Text) -> Text -> RoffLexer m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  () -> RoffLexer m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Parses: '..'
quoteArg :: PandocMonad m => RoffLexer m T.Text
quoteArg :: RoffLexer m Text
quoteArg = Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT Text RoffState m Char
-> RoffLexer m Text -> RoffLexer m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text RoffState m Char
-> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar (String -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'\n',Char
'\'']) (Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'')

escFont :: PandocMonad m => RoffLexer m [LinePart]
escFont :: RoffLexer m [LinePart]
escFont = do
  Text
font <- RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg RoffLexer m Text -> RoffLexer m Text -> RoffLexer m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
  FontSpec
font' <- if Text -> Bool
T.null Text
font Bool -> Bool -> Bool
|| Text
font Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"P"
              then RoffState -> FontSpec
prevFont (RoffState -> FontSpec)
-> ParsecT Text RoffState m RoffState
-> ParsecT Text RoffState m FontSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
              else FontSpec -> ParsecT Text RoffState m FontSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (FontSpec -> ParsecT Text RoffState m FontSpec)
-> FontSpec -> ParsecT Text RoffState m FontSpec
forall a b. (a -> b) -> a -> b
$ (Char -> FontSpec -> FontSpec) -> FontSpec -> String -> FontSpec
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> FontSpec -> FontSpec
processFontLetter FontSpec
defaultFontSpec (String -> FontSpec) -> String -> FontSpec
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
font
  (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((RoffState -> RoffState) -> ParsecT Text RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st -> RoffState
st{ prevFont :: FontSpec
prevFont = RoffState -> FontSpec
currentFont RoffState
st
                         , currentFont :: FontSpec
currentFont = FontSpec
font' }
  [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [FontSpec -> LinePart
Font FontSpec
font']
  where
    processFontLetter :: Char -> FontSpec -> FontSpec
processFontLetter Char
c FontSpec
fs
              | Char -> Bool
isLower Char
c    = Char -> FontSpec -> FontSpec
processFontLetter (Char -> Char
toUpper Char
c) FontSpec
fs
    processFontLetter Char
'B' FontSpec
fs = FontSpec
fs{ fontBold :: Bool
fontBold = Bool
True }
    processFontLetter Char
'I' FontSpec
fs = FontSpec
fs{ fontItalic :: Bool
fontItalic = Bool
True }
    processFontLetter Char
'C' FontSpec
fs = FontSpec
fs{ fontMonospace :: Bool
fontMonospace = Bool
True }
    processFontLetter Char
_   FontSpec
fs = FontSpec
fs -- do nothing

-- separate function from lexMacro since real man files sometimes do not
-- follow the rules
lexComment :: PandocMonad m => RoffLexer m RoffTokens
lexComment :: RoffLexer m RoffTokens
lexComment = do
  ParsecT Text RoffState m String -> ParsecT Text RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text RoffState m String
 -> ParsecT Text RoffState m String)
-> ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text RoffState m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".\\\""
  ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT Text RoffState m Char -> ParsecT Text RoffState m ())
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n"
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
eofline
  RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty

lexMacro :: PandocMonad m => RoffLexer m RoffTokens
lexMacro :: RoffLexer m RoffTokens
lexMacro = do
  SourcePos
pos <- ParsecT Text RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  RoffState
st <- ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool -> ParsecT Text RoffState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text RoffState m ())
-> Bool -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ SourcePos -> Int
sourceColumn SourcePos
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| RoffState -> Bool
afterConditional RoffState
st
  Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT Text RoffState m Char
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
  ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
  Text
macroName <- ParsecT Text RoffState m Char -> ParserT Text RoffState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
manyChar ((Char -> Bool) -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAlphaNum)
  case Text
macroName of
    Text
"nop" -> RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty
    Text
"ie"  -> Text -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m RoffTokens
lexConditional Text
"ie"
    Text
"if"  -> Text -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m RoffTokens
lexConditional Text
"if"
    Text
"el"  -> Text -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m RoffTokens
lexConditional Text
"el"
    Text
"while" -> Text -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m RoffTokens
lexConditional Text
"while"
               -- this doesn't get the semantics right but
               -- avoids parse errors

    Text
_ -> do
       [[LinePart]]
args <- RoffLexer m [[LinePart]]
forall (m :: * -> *). PandocMonad m => RoffLexer m [[LinePart]]
lexArgs
       case Text
macroName of
         Text
""     -> RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty
         Text
"TS"   -> SourcePos -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
SourcePos -> RoffLexer m RoffTokens
lexTable SourcePos
pos
         Text
"de"   -> [[LinePart]] -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexMacroDef [[LinePart]]
args
         Text
"de1"  -> [[LinePart]] -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexMacroDef [[LinePart]]
args
         Text
"ds"   -> [[LinePart]] -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexStringDef [[LinePart]]
args
         Text
"ds1"  -> [[LinePart]] -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexStringDef [[LinePart]]
args
         Text
"sp"   -> RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffTokens -> RoffLexer m RoffTokens)
-> RoffTokens -> RoffLexer m RoffTokens
forall a b. (a -> b) -> a -> b
$ RoffToken -> RoffTokens
singleTok RoffToken
EmptyLine
         Text
"so"   -> [[LinePart]] -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexIncludeFile [[LinePart]]
args
         Text
_      -> Text -> [[LinePart]] -> SourcePos -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> [[LinePart]] -> SourcePos -> RoffLexer m RoffTokens
resolveMacro Text
macroName [[LinePart]]
args SourcePos
pos

lexTable :: PandocMonad m => SourcePos -> RoffLexer m RoffTokens
lexTable :: SourcePos -> RoffLexer m RoffTokens
lexTable SourcePos
pos = do
  RoffLexer m RoffTokens -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexComment
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  [(Text, Text)]
opts <- ParsecT Text RoffState m [(Text, Text)]
-> ParsecT Text RoffState m [(Text, Text)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text RoffState m [(Text, Text)]
forall (m :: * -> *). PandocMonad m => RoffLexer m [(Text, Text)]
tableOptions ParsecT Text RoffState m [(Text, Text)]
-> ParsecT Text RoffState m [(Text, Text)]
-> ParsecT Text RoffState m [(Text, Text)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [] [(Text, Text)]
-> ParsecT Text RoffState m ()
-> ParsecT Text RoffState m [(Text, Text)]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';')
  case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"tab" [(Text, Text)]
opts of
    Just (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
c, Text
_)) -> (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((RoffState -> RoffState) -> ParsecT Text RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st -> RoffState
st{ tableTabChar :: Char
tableTabChar = Char
c }
    Maybe Text
_                              -> (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((RoffState -> RoffState) -> ParsecT Text RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st -> RoffState
st{ tableTabChar :: Char
tableTabChar = Char
'\t' }
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  RoffLexer m RoffTokens -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexComment
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  [TableRow]
rows <- RoffLexer m [TableRow]
forall (m :: * -> *). PandocMonad m => RoffLexer m [TableRow]
lexTableRows
  [[TableRow]]
morerows <- RoffLexer m [TableRow] -> ParsecT Text RoffState m [[TableRow]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (RoffLexer m [TableRow] -> ParsecT Text RoffState m [[TableRow]])
-> RoffLexer m [TableRow] -> ParsecT Text RoffState m [[TableRow]]
forall a b. (a -> b) -> a -> b
$ RoffLexer m [TableRow] -> RoffLexer m [TableRow]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RoffLexer m [TableRow] -> RoffLexer m [TableRow])
-> RoffLexer m [TableRow] -> RoffLexer m [TableRow]
forall a b. (a -> b) -> a -> b
$ do
    String -> ParsecT Text RoffState m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".T&"
    ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
    ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
    RoffLexer m [TableRow]
forall (m :: * -> *). PandocMonad m => RoffLexer m [TableRow]
lexTableRows
  String -> ParsecT Text RoffState m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".TE"
  ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
eofline
  RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffTokens -> RoffLexer m RoffTokens)
-> RoffTokens -> RoffLexer m RoffTokens
forall a b. (a -> b) -> a -> b
$ RoffToken -> RoffTokens
singleTok (RoffToken -> RoffTokens) -> RoffToken -> RoffTokens
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> [TableRow] -> SourcePos -> RoffToken
Tbl [(Text, Text)]
opts ([TableRow]
rows [TableRow] -> [TableRow] -> [TableRow]
forall a. Semigroup a => a -> a -> a
<> [[TableRow]] -> [TableRow]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TableRow]]
morerows) SourcePos
pos

lexTableRows :: PandocMonad m => RoffLexer m [TableRow]
lexTableRows :: RoffLexer m [TableRow]
lexTableRows = do
  [[CellFormat]]
aligns <- RoffLexer m [[CellFormat]]
forall (m :: * -> *). PandocMonad m => RoffLexer m [[CellFormat]]
tableFormatSpec
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  ParsecT Text RoffState m RoffTokens -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT Text RoffState m RoffTokens
 -> ParsecT Text RoffState m ())
-> ParsecT Text RoffState m RoffTokens
-> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text RoffState m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexComment
          ParsecT Text RoffState m RoffTokens
-> ParsecT Text RoffState m RoffTokens
-> ParsecT Text RoffState m RoffTokens
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text RoffState m RoffTokens
-> ParsecT Text RoffState m RoffTokens
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RoffTokens
forall a. Monoid a => a
mempty RoffTokens
-> ParsecT Text RoffState m Char
-> ParsecT Text RoffState m RoffTokens
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> ParsecT Text RoffState m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".sp" ParsecT Text RoffState m String
-> ParsecT Text RoffState m () -> ParsecT Text RoffState m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spaceChar ParsecT Text RoffState m ()
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline))
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  [[RoffTokens]]
rows <- ParsecT Text RoffState m [RoffTokens]
-> ParsecT Text RoffState m [[RoffTokens]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text RoffState m String -> ParsecT Text RoffState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT Text RoffState m String -> ParsecT Text RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text RoffState m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".TE") ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text RoffState m String -> ParsecT Text RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text RoffState m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
".T&")) ParsecT Text RoffState m ()
-> ParsecT Text RoffState m [RoffTokens]
-> ParsecT Text RoffState m [RoffTokens]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  ParsecT Text RoffState m [RoffTokens]
forall (m :: * -> *). PandocMonad m => RoffLexer m [RoffTokens]
tableRow)
  [TableRow] -> RoffLexer m [TableRow]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TableRow] -> RoffLexer m [TableRow])
-> [TableRow] -> RoffLexer m [TableRow]
forall a b. (a -> b) -> a -> b
$ [[CellFormat]] -> [[RoffTokens]] -> [TableRow]
forall a b. [a] -> [b] -> [(a, b)]
zip [[CellFormat]]
aligns [[RoffTokens]]
rows

tableCell :: PandocMonad m => RoffLexer m RoffTokens
tableCell :: RoffLexer m RoffTokens
tableCell = do
  SourcePos
pos <- ParsecT Text RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  (ParsecT Text RoffState m String
forall u. ParsecT Text u m String
enclosedCell ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text RoffState m String
simpleCell) ParsecT Text RoffState m String
-> (String -> RoffLexer m RoffTokens) -> RoffLexer m RoffTokens
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SourcePos -> Text -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
SourcePos -> Text -> m RoffTokens
lexRoff SourcePos
pos (Text -> RoffLexer m RoffTokens)
-> (String -> Text) -> String -> RoffLexer m RoffTokens
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  where
  enclosedCell :: ParsecT Text u m String
enclosedCell = do
    ParsecT Text u m String -> ParsecT Text u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"T{")
    ParsecT Text u m Char
-> ParsecT Text u m String -> ParsecT Text u m String
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 Text u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT Text u m String -> ParsecT Text u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"T}"))
  simpleCell :: ParsecT Text RoffState m String
simpleCell = do
    Char
tabChar <- RoffState -> Char
tableTabChar (RoffState -> Char)
-> ParsecT Text RoffState m RoffState
-> ParsecT Text RoffState m Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    ParsecT Text RoffState m Char -> ParsecT Text RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
tabChar ParsecT Text RoffState m Char
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline) ParsecT Text RoffState m ()
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)

tableRow :: PandocMonad m => RoffLexer m [RoffTokens]
tableRow :: RoffLexer m [RoffTokens]
tableRow = do
  Char
tabChar <- RoffState -> Char
tableTabChar (RoffState -> Char)
-> ParsecT Text RoffState m RoffState
-> ParsecT Text RoffState m Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  RoffTokens
c <- RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
tableCell
  [RoffTokens]
cs <- RoffLexer m RoffTokens -> RoffLexer m [RoffTokens]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (RoffLexer m RoffTokens -> RoffLexer m [RoffTokens])
-> RoffLexer m RoffTokens -> RoffLexer m [RoffTokens]
forall a b. (a -> b) -> a -> b
$ RoffLexer m RoffTokens -> RoffLexer m RoffTokens
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
tabChar ParsecT Text RoffState m Char
-> RoffLexer m RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
tableCell)
  ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
eofline
  RoffLexer m RoffTokens -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexComment
  [RoffTokens] -> RoffLexer m [RoffTokens]
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffTokens
cRoffTokens -> [RoffTokens] -> [RoffTokens]
forall a. a -> [a] -> [a]
:[RoffTokens]
cs)

tableOptions :: PandocMonad m => RoffLexer m [TableOption]
tableOptions :: RoffLexer m [(Text, Text)]
tableOptions = ParsecT Text RoffState m (Text, Text) -> RoffLexer m [(Text, Text)]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text RoffState m (Text, Text)
forall (m :: * -> *). PandocMonad m => RoffLexer m (Text, Text)
tableOption RoffLexer m [(Text, Text)]
-> ParsecT Text RoffState m () -> RoffLexer m [(Text, Text)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces RoffLexer m [(Text, Text)]
-> ParsecT Text RoffState m Char -> RoffLexer m [(Text, Text)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'

tableOption :: PandocMonad m => RoffLexer m TableOption
tableOption :: RoffLexer m (Text, Text)
tableOption = do
  Text
k <- ParserT Text RoffState m Char -> ParserT Text RoffState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ParserT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
  Text
v <- Text
-> ParserT Text RoffState m Text -> ParserT Text RoffState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (ParserT Text RoffState m Text -> ParserT Text RoffState m Text)
-> ParserT Text RoffState m Text -> ParserT Text RoffState m Text
forall a b. (a -> b) -> a -> b
$ ParserT Text RoffState m Text -> ParserT Text RoffState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Text RoffState m Text -> ParserT Text RoffState m Text)
-> ParserT Text RoffState m Text -> ParserT Text RoffState m Text
forall a b. (a -> b) -> a -> b
$ do
         ParserT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParserT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
         Char -> ParserT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
         ParserT Text RoffState m Char
-> ParserT Text RoffState m Char -> ParserT Text RoffState m Text
forall s (m :: * -> *) t st a.
Stream s m t =>
ParserT s st m Char -> ParserT s st m a -> ParserT s st m Text
manyTillChar ParserT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Char -> ParserT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')')
  ParserT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParserT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
  ParsecT Text RoffState m () -> ParsecT Text RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParserT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' ParserT Text RoffState m Char
-> ParsecT Text RoffState m () -> ParsecT Text RoffState m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParserT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab)
  (Text, Text) -> RoffLexer m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k,Text
v)

tableFormatSpec :: PandocMonad m => RoffLexer m [[CellFormat]]
tableFormatSpec :: RoffLexer m [[CellFormat]]
tableFormatSpec = do
  [CellFormat]
first <- RoffLexer m [CellFormat]
forall (m :: * -> *). PandocMonad m => RoffLexer m [CellFormat]
tableFormatSpecLine
  [[CellFormat]]
rest <- RoffLexer m [CellFormat] -> RoffLexer m [[CellFormat]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (RoffLexer m [CellFormat] -> RoffLexer m [[CellFormat]])
-> RoffLexer m [CellFormat] -> RoffLexer m [[CellFormat]]
forall a b. (a -> b) -> a -> b
$ RoffLexer m [CellFormat] -> RoffLexer m [CellFormat]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RoffLexer m [CellFormat] -> RoffLexer m [CellFormat])
-> RoffLexer m [CellFormat] -> RoffLexer m [CellFormat]
forall a b. (a -> b) -> a -> b
$ (ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT Text RoffState m Char
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',') ParsecT Text RoffState m Char
-> RoffLexer m [CellFormat] -> RoffLexer m [CellFormat]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RoffLexer m [CellFormat]
forall (m :: * -> *). PandocMonad m => RoffLexer m [CellFormat]
tableFormatSpecLine
  let speclines :: [[CellFormat]]
speclines = [CellFormat]
first[CellFormat] -> [[CellFormat]] -> [[CellFormat]]
forall a. a -> [a] -> [a]
:[[CellFormat]]
rest
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  [[CellFormat]] -> RoffLexer m [[CellFormat]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[CellFormat]] -> RoffLexer m [[CellFormat]])
-> [[CellFormat]] -> RoffLexer m [[CellFormat]]
forall a b. (a -> b) -> a -> b
$ [[CellFormat]]
speclines [[CellFormat]] -> [[CellFormat]] -> [[CellFormat]]
forall a. Semigroup a => a -> a -> a
<> [CellFormat] -> [[CellFormat]]
forall a. a -> [a]
repeat ([CellFormat] -> [[CellFormat]] -> [CellFormat]
forall a. a -> [a] -> a
lastDef [] [[CellFormat]]
speclines) -- last line is default

tableFormatSpecLine :: PandocMonad m => RoffLexer m [CellFormat]
tableFormatSpecLine :: RoffLexer m [CellFormat]
tableFormatSpecLine =
  ParsecT Text RoffState m CellFormat -> RoffLexer m [CellFormat]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text RoffState m CellFormat -> RoffLexer m [CellFormat])
-> ParsecT Text RoffState m CellFormat -> RoffLexer m [CellFormat]
forall a b. (a -> b) -> a -> b
$ ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab ParsecT Text RoffState m ()
-> ParsecT Text RoffState m CellFormat
-> ParsecT Text RoffState m CellFormat
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text RoffState m CellFormat
forall (m :: * -> *). PandocMonad m => RoffLexer m CellFormat
tableColFormat ParsecT Text RoffState m CellFormat
-> ParsecT Text RoffState m ()
-> ParsecT Text RoffState m CellFormat
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab

tableColFormat :: PandocMonad m => RoffLexer m CellFormat
tableColFormat :: RoffLexer m CellFormat
tableColFormat = do
    Bool
pipePrefix' <- Bool
-> ParsecT Text RoffState m Bool -> ParsecT Text RoffState m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False
                   (ParsecT Text RoffState m Bool -> ParsecT Text RoffState m Bool)
-> ParsecT Text RoffState m Bool -> ParsecT Text RoffState m Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool
-> ParsecT Text RoffState m String -> ParsecT Text RoffState m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text RoffState m String -> ParsecT Text RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text RoffState m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"|" ParsecT Text RoffState m String
-> ParsecT Text RoffState m () -> ParsecT Text RoffState m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab)
    Char
c <- String -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'a',Char
'A',Char
'c',Char
'C',Char
'l',Char
'L',Char
'n',Char
'N',Char
'r',Char
'R',Char
's',Char
'S',Char
'^',Char
'_',Char
'-',
                Char
'=',Char
'|']
    [Text]
suffixes <- ParsecT Text RoffState m Text -> ParsecT Text RoffState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text RoffState m Text -> ParsecT Text RoffState m [Text])
-> ParsecT Text RoffState m Text -> ParsecT Text RoffState m [Text]
forall a b. (a -> b) -> a -> b
$ ParsecT Text RoffState m Text -> ParsecT Text RoffState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab ParsecT Text RoffState m ()
-> ParsecT Text RoffState m Text -> ParsecT Text RoffState m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) ParsecT Text RoffState m Text
-> ParsecT Text RoffState m Text -> ParsecT Text RoffState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      (do Char
x <- String -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'b',Char
'B',Char
'd',Char
'D',Char
'e',Char
'E',Char
'f',Char
'F',Char
'i',Char
'I',Char
'm',Char
'M',
                  Char
'p',Char
'P',Char
't',Char
'T',Char
'u',Char
'U',Char
'v',Char
'V',Char
'w',Char
'W',Char
'x',Char
'X', Char
'z',Char
'Z']
          String
num <- case Char -> Char
toLower Char
x of
                   Char
'w' -> ParsecT Text RoffState m Char -> ParsecT Text RoffState m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                           (do Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
                               String
xs <- ParsecT Text RoffState m Char
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m String
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 Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')')
                               String -> ParsecT Text RoffState m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
xs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")) ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                           String -> ParsecT Text RoffState m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                   Char
'f' -> Int
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT Text RoffState m String
-> ParsecT Text RoffState m () -> ParsecT Text RoffState m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
                   Char
'm' -> Int
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT Text RoffState m String
-> ParsecT Text RoffState m () -> ParsecT Text RoffState m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
                   Char
_   -> String -> ParsecT Text RoffState m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
          Text -> ParsecT Text RoffState m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Text RoffState m Text)
-> Text -> ParsecT Text RoffState m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
num)
    Bool
pipeSuffix' <- Bool
-> ParsecT Text RoffState m Bool -> ParsecT Text RoffState m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (ParsecT Text RoffState m Bool -> ParsecT Text RoffState m Bool)
-> ParsecT Text RoffState m Bool -> ParsecT Text RoffState m Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool
-> ParsecT Text RoffState m String -> ParsecT Text RoffState m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Text RoffState m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"|"
    CellFormat -> RoffLexer m CellFormat
forall (m :: * -> *) a. Monad m => a -> m a
return (CellFormat -> RoffLexer m CellFormat)
-> CellFormat -> RoffLexer m CellFormat
forall a b. (a -> b) -> a -> b
$ CellFormat :: Char -> Bool -> Bool -> [Text] -> CellFormat
CellFormat
             { columnType :: Char
columnType     = Char
c
             , pipePrefix :: Bool
pipePrefix     = Bool
pipePrefix'
             , pipeSuffix :: Bool
pipeSuffix     = Bool
pipeSuffix'
             , columnSuffixes :: [Text]
columnSuffixes = [Text]
suffixes }

-- We don't fully handle the conditional.  But we do
-- include everything under '.ie n', which occurs commonly
-- in man pages.
lexConditional :: PandocMonad m => T.Text -> RoffLexer m RoffTokens
lexConditional :: Text -> RoffLexer m RoffTokens
lexConditional Text
mname = do
  SourcePos
pos <- ParsecT Text RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
  Maybe Bool
mbtest <- if Text
mname Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"el"
               then (Bool -> Bool) -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Maybe Bool -> Maybe Bool)
-> (RoffState -> Maybe Bool) -> RoffState -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoffState -> Maybe Bool
lastExpression (RoffState -> Maybe Bool)
-> ParsecT Text RoffState m RoffState
-> ParsecT Text RoffState m (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
               else ParsecT Text RoffState m (Maybe Bool)
forall (m :: * -> *). PandocMonad m => RoffLexer m (Maybe Bool)
expression
  ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
  RoffState
st <- ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState -- save state, so we can reset it
  RoffTokens
ifPart <- do
      ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT Text RoffState m Char -> ParsecT Text RoffState m ())
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char)
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT Text RoffState m Char
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
      RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexGroup
       RoffLexer m RoffTokens
-> RoffLexer m RoffTokens -> RoffLexer m RoffTokens
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((RoffState -> RoffState) -> ParsecT Text RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
s -> RoffState
s{ afterConditional :: Bool
afterConditional = Bool
True }
              RoffTokens
t <- RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
manToken
              (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((RoffState -> RoffState) -> ParsecT Text RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
s -> RoffState
s{ afterConditional :: Bool
afterConditional = Bool
False }
              RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
t
  case Maybe Bool
mbtest of
    Maybe Bool
Nothing    -> do
      RoffState -> ParsecT Text RoffState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState RoffState
st  -- reset state, so we don't record macros in skipped section
      LogMessage -> ParsecT Text RoffState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT Text RoffState m ())
-> LogMessage -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Char -> Text -> Text
T.cons Char
'.' Text
mname) SourcePos
pos
      RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty
    Just Bool
True  -> RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
ifPart
    Just Bool
False -> do
      RoffState -> ParsecT Text RoffState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState RoffState
st
      RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty

expression :: PandocMonad m => RoffLexer m (Maybe Bool)
expression :: RoffLexer m (Maybe Bool)
expression = do
  Text
raw <- Char
-> Char
-> ParserT Text RoffState m Char
-> ParserT Text RoffState m Text
forall s (m :: * -> *) st.
Stream s m Char =>
Char -> Char -> ParserT s st m Char -> ParserT s st m Text
charsInBalanced Char
'(' Char
')' ((Char -> Bool) -> ParserT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'))
      ParserT Text RoffState m Text
-> ParserT Text RoffState m Text -> ParserT Text RoffState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParserT Text RoffState m Char -> ParserT Text RoffState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char ParserT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
nonspaceChar
  Maybe Bool -> RoffLexer m (Maybe Bool)
forall (m :: * -> *) s.
Monad m =>
Maybe Bool -> ParsecT s RoffState m (Maybe Bool)
returnValue (Maybe Bool -> RoffLexer m (Maybe Bool))
-> Maybe Bool -> RoffLexer m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
    case Text
raw of
      Text
"1"  -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
      Text
"n"  -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True  -- nroff mode
      Text
"t"  -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False -- troff mode
      Text
_    -> Maybe Bool
forall a. Maybe a
Nothing
  where
    returnValue :: Maybe Bool -> ParsecT s RoffState m (Maybe Bool)
returnValue Maybe Bool
v = do
      (RoffState -> RoffState) -> ParsecT s RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((RoffState -> RoffState) -> ParsecT s RoffState m ())
-> (RoffState -> RoffState) -> ParsecT s RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st -> RoffState
st{ lastExpression :: Maybe Bool
lastExpression = Maybe Bool
v }
      Maybe Bool -> ParsecT s RoffState m (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
v

lexGroup :: PandocMonad m => RoffLexer m RoffTokens
lexGroup :: RoffLexer m RoffTokens
lexGroup = do
  ParsecT Text RoffState m String
forall u. ParsecT Text u m String
groupstart
  [RoffTokens] -> RoffTokens
forall a. Monoid a => [a] -> a
mconcat ([RoffTokens] -> RoffTokens)
-> ParsecT Text RoffState m [RoffTokens] -> RoffLexer m RoffTokens
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RoffLexer m RoffTokens
-> ParsecT Text RoffState m String
-> ParsecT Text RoffState m [RoffTokens]
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 RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
manToken ParsecT Text RoffState m String
forall u. ParsecT Text u m String
groupend
  where
    groupstart :: ParsecT Text u m String
groupstart = ParsecT Text u m String -> ParsecT Text u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text u m String -> ParsecT Text u m String)
-> ParsecT Text u m String -> ParsecT Text u m String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\{" ParsecT Text u m String
-> ParsecT Text u m () -> ParsecT Text u m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text u m String -> ParsecT Text u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT Text u m String -> ParsecT Text u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Text u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\n"))
    groupend :: ParsecT Text u m String
groupend   = ParsecT Text u m String -> ParsecT Text u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text u m String -> ParsecT Text u m String)
-> ParsecT Text u m String -> ParsecT Text u m String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\}"

lexIncludeFile :: PandocMonad m => [Arg] -> RoffLexer m RoffTokens
lexIncludeFile :: [[LinePart]] -> RoffLexer m RoffTokens
lexIncludeFile [[LinePart]]
args = do
  SourcePos
pos <- ParsecT Text RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  case [[LinePart]]
args of
    ([LinePart]
f:[[LinePart]]
_) -> do
      let fp :: Text
fp = [LinePart] -> Text
linePartsToText [LinePart]
f
      [String]
dirs <- ParsecT Text RoffState m [String]
forall (m :: * -> *). PandocMonad m => m [String]
getResourcePath
      Maybe Text
result <- [String] -> String -> ParsecT Text RoffState m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
[String] -> String -> m (Maybe Text)
readFileFromDirs [String]
dirs (String -> ParsecT Text RoffState m (Maybe Text))
-> String -> ParsecT Text RoffState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
fp
      case Maybe Text
result of
        Maybe Text
Nothing  -> LogMessage -> ParsecT Text RoffState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT Text RoffState m ())
-> LogMessage -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
CouldNotLoadIncludeFile Text
fp SourcePos
pos
        Just Text
s   -> ParsecT Text RoffState m Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput ParsecT Text RoffState m Text
-> (Text -> ParsecT Text RoffState m ())
-> ParsecT Text RoffState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParsecT Text RoffState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (Text -> ParsecT Text RoffState m ())
-> (Text -> Text) -> Text -> ParsecT Text RoffState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
      RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty
    []    -> RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty

resolveMacro :: PandocMonad m
             => T.Text -> [Arg] -> SourcePos -> RoffLexer m RoffTokens
resolveMacro :: Text -> [[LinePart]] -> SourcePos -> RoffLexer m RoffTokens
resolveMacro Text
macroName [[LinePart]]
args SourcePos
pos = do
  Map Text RoffTokens
macros <- RoffState -> Map Text RoffTokens
customMacros (RoffState -> Map Text RoffTokens)
-> ParsecT Text RoffState m RoffState
-> ParsecT Text RoffState m (Map Text RoffTokens)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case Text -> Map Text RoffTokens -> Maybe RoffTokens
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
macroName Map Text RoffTokens
macros of
    Maybe RoffTokens
Nothing -> RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffTokens -> RoffLexer m RoffTokens)
-> RoffTokens -> RoffLexer m RoffTokens
forall a b. (a -> b) -> a -> b
$ RoffToken -> RoffTokens
singleTok (RoffToken -> RoffTokens) -> RoffToken -> RoffTokens
forall a b. (a -> b) -> a -> b
$ Text -> [[LinePart]] -> SourcePos -> RoffToken
ControlLine Text
macroName [[LinePart]]
args SourcePos
pos
    Just RoffTokens
ts -> do
      let fillLP :: LinePart -> [LinePart] -> [LinePart]
fillLP (MacroArg Int
i)    [LinePart]
zs =
            case Int -> [[LinePart]] -> [[LinePart]]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [[LinePart]]
args of
              []     -> [LinePart]
zs
              ([LinePart]
ys:[[LinePart]]
_) -> [LinePart]
ys [LinePart] -> [LinePart] -> [LinePart]
forall a. Semigroup a => a -> a -> a
<> [LinePart]
zs
          fillLP LinePart
z [LinePart]
zs = LinePart
z LinePart -> [LinePart] -> [LinePart]
forall a. a -> [a] -> [a]
: [LinePart]
zs
      let fillMacroArg :: RoffToken -> RoffToken
fillMacroArg (TextLine [LinePart]
lineparts) =
            [LinePart] -> RoffToken
TextLine ((LinePart -> [LinePart] -> [LinePart])
-> [LinePart] -> [LinePart] -> [LinePart]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LinePart -> [LinePart] -> [LinePart]
fillLP [] [LinePart]
lineparts)
          fillMacroArg RoffToken
x = RoffToken
x
      RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffTokens -> RoffLexer m RoffTokens)
-> RoffTokens -> RoffLexer m RoffTokens
forall a b. (a -> b) -> a -> b
$ Seq RoffToken -> RoffTokens
RoffTokens (Seq RoffToken -> RoffTokens)
-> (RoffTokens -> Seq RoffToken) -> RoffTokens -> RoffTokens
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RoffToken -> RoffToken) -> Seq RoffToken -> Seq RoffToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RoffToken -> RoffToken
fillMacroArg (Seq RoffToken -> Seq RoffToken)
-> (RoffTokens -> Seq RoffToken) -> RoffTokens -> Seq RoffToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoffTokens -> Seq RoffToken
unRoffTokens (RoffTokens -> RoffTokens) -> RoffTokens -> RoffTokens
forall a b. (a -> b) -> a -> b
$ RoffTokens
ts

lexStringDef :: PandocMonad m => [Arg] -> RoffLexer m RoffTokens
lexStringDef :: [[LinePart]] -> RoffLexer m RoffTokens
lexStringDef [[LinePart]]
args = do -- string definition
   case [[LinePart]]
args of
     []     -> String -> ParsecT Text RoffState m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"No argument to .ds"
     ([LinePart]
x:[[LinePart]]
ys) -> do
       let ts :: RoffTokens
ts = RoffToken -> RoffTokens
singleTok (RoffToken -> RoffTokens) -> RoffToken -> RoffTokens
forall a b. (a -> b) -> a -> b
$ [LinePart] -> RoffToken
TextLine ([LinePart] -> [[LinePart]] -> [LinePart]
forall a. [a] -> [[a]] -> [a]
intercalate [Text -> LinePart
RoffStr Text
" " ] [[LinePart]]
ys)
       let stringName :: Text
stringName = [LinePart] -> Text
linePartsToText [LinePart]
x
       (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((RoffState -> RoffState) -> ParsecT Text RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st ->
         RoffState
st{ customMacros :: Map Text RoffTokens
customMacros = Text -> RoffTokens -> Map Text RoffTokens -> Map Text RoffTokens
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
stringName RoffTokens
ts (RoffState -> Map Text RoffTokens
customMacros RoffState
st) }
   RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty

lexMacroDef :: PandocMonad m => [Arg] -> RoffLexer m RoffTokens
lexMacroDef :: [[LinePart]] -> RoffLexer m RoffTokens
lexMacroDef [[LinePart]]
args = do -- macro definition
   (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((RoffState -> RoffState) -> ParsecT Text RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st -> RoffState
st{ roffMode :: RoffMode
roffMode = RoffMode
CopyMode }
   (Text
macroName, Text
stopMacro) <-
     case [[LinePart]]
args of
       ([LinePart]
x : [LinePart]
y : [[LinePart]]
_) -> (Text, Text) -> ParsecT Text RoffState m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([LinePart] -> Text
linePartsToText [LinePart]
x, [LinePart] -> Text
linePartsToText [LinePart]
y)
                      -- optional second arg
       ([LinePart]
x:[[LinePart]]
_)       -> (Text, Text) -> ParsecT Text RoffState m (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([LinePart] -> Text
linePartsToText [LinePart]
x, Text
".")
       []          -> String -> ParsecT Text RoffState m (Text, Text)
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"No argument to .de"
   let stop :: ParsecT Text RoffState m ()
stop = ParsecT Text RoffState m () -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text RoffState m () -> ParsecT Text RoffState m ())
-> ParsecT Text RoffState m () -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ do
         Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT Text RoffState m Char
-> ParsecT Text RoffState m Char -> ParsecT Text RoffState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
         ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
         Text -> ParsecT Text RoffState m Text
forall s (m :: * -> *) u.
Stream s m Char =>
Text -> ParsecT s u m Text
textStr Text
stopMacro
         [[LinePart]]
_ <- RoffLexer m [[LinePart]]
forall (m :: * -> *). PandocMonad m => RoffLexer m [[LinePart]]
lexArgs
         () -> ParsecT Text RoffState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   RoffTokens
ts <- [RoffTokens] -> RoffTokens
forall a. Monoid a => [a] -> a
mconcat ([RoffTokens] -> RoffTokens)
-> ParsecT Text RoffState m [RoffTokens] -> RoffLexer m RoffTokens
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RoffLexer m RoffTokens
-> ParsecT Text RoffState m ()
-> ParsecT Text RoffState m [RoffTokens]
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 RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
manToken ParsecT Text RoffState m ()
stop
   (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ((RoffState -> RoffState) -> ParsecT Text RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st ->
     RoffState
st{ customMacros :: Map Text RoffTokens
customMacros = Text -> RoffTokens -> Map Text RoffTokens -> Map Text RoffTokens
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
macroName RoffTokens
ts (RoffState -> Map Text RoffTokens
customMacros RoffState
st)
       , roffMode :: RoffMode
roffMode = RoffMode
NormalMode }
   RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty

lexArgs :: PandocMonad m => RoffLexer m [Arg]
lexArgs :: RoffLexer m [[LinePart]]
lexArgs = do
  [[LinePart]]
args <- ParsecT Text RoffState m [LinePart] -> RoffLexer m [[LinePart]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text RoffState m [LinePart] -> RoffLexer m [[LinePart]])
-> ParsecT Text RoffState m [LinePart] -> RoffLexer m [[LinePart]]
forall a b. (a -> b) -> a -> b
$ ParsecT Text RoffState m [LinePart]
-> ParsecT Text RoffState m [LinePart]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text RoffState m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
oneArg
  ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
eofline
  [[LinePart]] -> RoffLexer m [[LinePart]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[LinePart]]
args

  where

  oneArg :: PandocMonad m => RoffLexer m [LinePart]
  oneArg :: RoffLexer m [LinePart]
oneArg = do
    ParsecT Text RoffState m String -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT Text RoffState m String -> ParsecT Text RoffState m ())
-> ParsecT Text RoffState m String -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text RoffState m String -> ParsecT Text RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text RoffState m String
 -> ParsecT Text RoffState m String)
-> ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text RoffState m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\n"  -- continuation line
    RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
quotedArg RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
plainArg
    -- try, because there are some erroneous files, e.g. linux/bpf.2

  plainArg :: PandocMonad m => RoffLexer m [LinePart]
  plainArg :: RoffLexer m [LinePart]
plainArg = do
    ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
    [[LinePart]] -> [LinePart]
forall a. Monoid a => [a] -> a
mconcat ([[LinePart]] -> [LinePart])
-> ParsecT Text RoffState m [[LinePart]] -> RoffLexer m [LinePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RoffLexer m [LinePart] -> ParsecT Text RoffState m [[LinePart]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
macroArg RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
escape RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
regularText RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall u. ParsecT Text u m [LinePart]
unescapedQuote)
    where
      unescapedQuote :: ParsecT Text u m [LinePart]
unescapedQuote = Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"' ParsecT Text u m Char
-> ParsecT Text u m [LinePart] -> ParsecT Text u m [LinePart]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [LinePart] -> ParsecT Text u m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\""]

  quotedArg :: PandocMonad m => RoffLexer m [LinePart]
  quotedArg :: RoffLexer m [LinePart]
quotedArg = do
    ParsecT Text RoffState m Char -> ParsecT Text RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
    Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
    [LinePart]
xs <- [[LinePart]] -> [LinePart]
forall a. Monoid a => [a] -> a
mconcat ([[LinePart]] -> [LinePart])
-> ParsecT Text RoffState m [[LinePart]] -> RoffLexer m [LinePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           RoffLexer m [LinePart] -> ParsecT Text RoffState m [[LinePart]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
macroArg RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
escape RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
regularText
                 RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
spaceTabChar RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall u. ParsecT Text u m [LinePart]
escapedQuote)
    Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
    [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
xs
    where
      escapedQuote :: ParsecT Text u m [LinePart]
escapedQuote = ParsecT Text u m [LinePart] -> ParsecT Text u m [LinePart]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text u m [LinePart] -> ParsecT Text u m [LinePart])
-> ParsecT Text u m [LinePart] -> ParsecT Text u m [LinePart]
forall a b. (a -> b) -> a -> b
$ do
        Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
        Char -> ParsecT Text u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
        [LinePart] -> ParsecT Text u m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\""]

checkDefined :: PandocMonad m => T.Text -> RoffLexer m [LinePart]
checkDefined :: Text -> RoffLexer m [LinePart]
checkDefined Text
name = do
  Map Text RoffTokens
macros <- RoffState -> Map Text RoffTokens
customMacros (RoffState -> Map Text RoffTokens)
-> ParsecT Text RoffState m RoffState
-> ParsecT Text RoffState m (Map Text RoffTokens)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case Text -> Map Text RoffTokens -> Maybe RoffTokens
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
name Map Text RoffTokens
macros of
    Just RoffTokens
_  -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"1"]
    Maybe RoffTokens
Nothing -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"0"]

escString :: PandocMonad m => RoffLexer m [LinePart]
escString :: RoffLexer m [LinePart]
escString = RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RoffLexer m [LinePart] -> RoffLexer m [LinePart])
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall a b. (a -> b) -> a -> b
$ do
  SourcePos
pos <- ParsecT Text RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  (do Text
cs <- RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg RoffLexer m Text -> RoffLexer m Text -> RoffLexer m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
      Text -> SourcePos -> RoffLexer m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Text -> SourcePos -> RoffLexer m [LinePart]
resolveText Text
cs SourcePos
pos)
    RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [LinePart]
forall a. Monoid a => a
mempty [LinePart]
-> ParsecT Text RoffState m Char -> RoffLexer m [LinePart]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'S'

-- strings and macros share namespace
resolveText :: PandocMonad m
              => T.Text -> SourcePos -> RoffLexer m [LinePart]
resolveText :: Text -> SourcePos -> RoffLexer m [LinePart]
resolveText Text
stringname SourcePos
pos = do
  RoffTokens Seq RoffToken
ts <- Text -> [[LinePart]] -> SourcePos -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> [[LinePart]] -> SourcePos -> RoffLexer m RoffTokens
resolveMacro Text
stringname [] SourcePos
pos
  case Seq RoffToken -> [RoffToken]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq RoffToken
ts of
    [TextLine [LinePart]
xs] -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
xs
    [RoffToken]
_          -> do
      LogMessage -> ParsecT Text RoffState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT Text RoffState m ())
-> LogMessage -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"unknown string " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stringname) SourcePos
pos
      [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty

lexLine :: PandocMonad m => RoffLexer m RoffTokens
lexLine :: RoffLexer m RoffTokens
lexLine = do
  RoffMode
mode <- RoffState -> RoffMode
roffMode (RoffState -> RoffMode)
-> ParsecT Text RoffState m RoffState
-> ParsecT Text RoffState m RoffMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case RoffMode
mode of
    RoffMode
CopyMode   -> ParsecT Text RoffState m String -> ParsecT Text RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT Text RoffState m String -> ParsecT Text RoffState m ())
-> ParsecT Text RoffState m String -> ParsecT Text RoffState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text RoffState m String -> ParsecT Text RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text RoffState m String
 -> ParsecT Text RoffState m String)
-> ParsecT Text RoffState m String
-> ParsecT Text RoffState m String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text RoffState m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\&"
    RoffMode
NormalMode -> () -> ParsecT Text RoffState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  [LinePart]
lnparts <- [[LinePart]] -> [LinePart]
forall a. Monoid a => [a] -> a
mconcat ([[LinePart]] -> [LinePart])
-> ParsecT Text RoffState m [[LinePart]]
-> ParsecT Text RoffState m [LinePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m [LinePart]
-> ParsecT Text RoffState m [[LinePart]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text RoffState m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
linePart
  ParsecT Text RoffState m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
eofline
  [LinePart] -> RoffLexer m RoffTokens
forall (m :: * -> *). Monad m => [LinePart] -> m RoffTokens
go [LinePart]
lnparts
  where  -- return empty line if we only have empty strings;
         -- this can happen if the line just contains \f[C], for example.
    go :: [LinePart] -> m RoffTokens
go [] = RoffTokens -> m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty
    go (RoffStr Text
"" : [LinePart]
xs) = [LinePart] -> m RoffTokens
go [LinePart]
xs
    go [LinePart]
xs = RoffTokens -> m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffTokens -> m RoffTokens) -> RoffTokens -> m RoffTokens
forall a b. (a -> b) -> a -> b
$ RoffToken -> RoffTokens
singleTok (RoffToken -> RoffTokens) -> RoffToken -> RoffTokens
forall a b. (a -> b) -> a -> b
$ [LinePart] -> RoffToken
TextLine [LinePart]
xs

linePart :: PandocMonad m => RoffLexer m [LinePart]
linePart :: RoffLexer m [LinePart]
linePart = RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
macroArg RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
escape RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
           RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
regularText RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
quoteChar RoffLexer m [LinePart]
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
spaceTabChar

backslash :: PandocMonad m => RoffLexer m ()
backslash :: RoffLexer m ()
backslash = do
  Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
  RoffMode
mode <- RoffState -> RoffMode
roffMode (RoffState -> RoffMode)
-> ParsecT Text RoffState m RoffState
-> ParsecT Text RoffState m RoffMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case RoffMode
mode of
    -- experimentally, it seems you don't always need to double
    -- the backslash in macro defs.  It's essential with \\$1,
    -- but not with \\f[I].  So we make the second one optional.
    RoffMode
CopyMode   -> ParsecT Text RoffState m Char -> RoffLexer m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT Text RoffState m Char -> RoffLexer m ())
-> ParsecT Text RoffState m Char -> RoffLexer m ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
    RoffMode
NormalMode -> () -> RoffLexer m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

macroArg :: PandocMonad m => RoffLexer m [LinePart]
macroArg :: RoffLexer m [LinePart]
macroArg = RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (RoffLexer m [LinePart] -> RoffLexer m [LinePart])
-> RoffLexer m [LinePart] -> RoffLexer m [LinePart]
forall a b. (a -> b) -> a -> b
$ do
  SourcePos
pos <- ParsecT Text RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  RoffLexer m ()
forall (m :: * -> *). PandocMonad m => RoffLexer m ()
backslash
  Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$'
  Text
x <- RoffLexer m Text
forall (m :: * -> *). PandocMonad m => RoffLexer m Text
escapeArg RoffLexer m Text -> RoffLexer m Text -> RoffLexer m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT Text RoffState m Char -> RoffLexer m Text
forall s (m :: * -> *) st.
(Stream s m Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  case Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
x of
    Just Int
i  -> [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> LinePart
MacroArg Int
i]
    Maybe Int
Nothing -> do
      LogMessage -> RoffLexer m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> RoffLexer m ()) -> LogMessage -> RoffLexer m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"illegal macro argument " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) SourcePos
pos
      [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return []

regularText :: PandocMonad m => RoffLexer m [LinePart]
regularText :: RoffLexer m [LinePart]
regularText = do
  Text
s <- ParserT Text RoffState m Char -> ParserT Text RoffState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParserT s st m Char -> ParserT s st m Text
many1Char (ParserT Text RoffState m Char -> ParserT Text RoffState m Text)
-> ParserT Text RoffState m Char -> ParserT Text RoffState m Text
forall a b. (a -> b) -> a -> b
$ String -> ParserT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n\r\t \\\""
  [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
s]

quoteChar :: PandocMonad m => RoffLexer m [LinePart]
quoteChar :: RoffLexer m [LinePart]
quoteChar = do
  Char -> ParsecT Text RoffState m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
  [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\""]

spaceTabChar :: PandocMonad m => RoffLexer m [LinePart]
spaceTabChar :: RoffLexer m [LinePart]
spaceTabChar = do
  Char
c <- ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
spacetab
  [LinePart] -> RoffLexer m [LinePart]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr (Text -> LinePart) -> Text -> LinePart
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c]

lexEmptyLine :: PandocMonad m => RoffLexer m RoffTokens
lexEmptyLine :: RoffLexer m RoffTokens
lexEmptyLine = ParsecT Text RoffState m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT Text RoffState m Char
-> RoffLexer m RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RoffTokens -> RoffLexer m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffToken -> RoffTokens
singleTok RoffToken
EmptyLine)

manToken :: PandocMonad m => RoffLexer m RoffTokens
manToken :: RoffLexer m RoffTokens
manToken = RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexComment RoffLexer m RoffTokens
-> RoffLexer m RoffTokens -> RoffLexer m RoffTokens
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexMacro RoffLexer m RoffTokens
-> RoffLexer m RoffTokens -> RoffLexer m RoffTokens
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexLine RoffLexer m RoffTokens
-> RoffLexer m RoffTokens -> RoffLexer m RoffTokens
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexEmptyLine

linePartsToText :: [LinePart] -> T.Text
linePartsToText :: [LinePart] -> Text
linePartsToText = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([LinePart] -> [Text]) -> [LinePart] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LinePart -> Text) -> [LinePart] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map LinePart -> Text
go
  where
  go :: LinePart -> Text
go (RoffStr Text
s) = Text
s
  go LinePart
_ = Text
forall a. Monoid a => a
mempty

-- | Tokenize a string as a sequence of roff tokens.
lexRoff :: PandocMonad m => SourcePos -> T.Text -> m RoffTokens
lexRoff :: SourcePos -> Text -> m RoffTokens
lexRoff SourcePos
pos Text
txt = do
  Either PandocError RoffTokens
eithertokens <- ParserT Text RoffState m RoffTokens
-> RoffState -> Text -> m (Either PandocError RoffTokens)
forall s (m :: * -> *) st a.
(Stream s m Char, ToText s) =>
ParserT s st m a -> st -> s -> m (Either PandocError a)
readWithM (do SourcePos -> ParsecT Text RoffState m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
                                [RoffTokens] -> RoffTokens
forall a. Monoid a => [a] -> a
mconcat ([RoffTokens] -> RoffTokens)
-> ParsecT Text RoffState m [RoffTokens]
-> ParserT Text RoffState m RoffTokens
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT Text RoffState m RoffTokens
-> ParsecT Text RoffState m [RoffTokens]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParserT Text RoffState m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
manToken) RoffState
forall a. Default a => a
def Text
txt
  case Either PandocError RoffTokens
eithertokens of
    Left PandocError
e       -> PandocError -> m RoffTokens
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
    Right RoffTokens
tokenz -> RoffTokens -> m RoffTokens
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
tokenz