{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{- |
   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, guard)
import Control.Monad.Except (throwError)
import Text.Pandoc.Class.PandocMonad
       (getResourcePath, readFileFromDirs, PandocMonad(..), report)
import Data.Char (isLower, toLower, toUpper, 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.Pandoc.Readers.Roff.Escape
import qualified Data.Sequence as Seq
import qualified Data.Foldable as Foldable

-- 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
$cshowsPrec :: Int -> FontSpec -> ShowS
showsPrec :: Int -> FontSpec -> ShowS
$cshow :: FontSpec -> String
show :: FontSpec -> String
$cshowList :: [FontSpec] -> ShowS
showList :: [FontSpec] -> ShowS
Show, FontSpec -> FontSpec -> Bool
(FontSpec -> FontSpec -> Bool)
-> (FontSpec -> FontSpec -> Bool) -> Eq FontSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontSpec -> FontSpec -> Bool
== :: FontSpec -> FontSpec -> Bool
$c/= :: FontSpec -> FontSpec -> Bool
/= :: 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
$ccompare :: FontSpec -> FontSpec -> Ordering
compare :: FontSpec -> FontSpec -> Ordering
$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
>= :: FontSpec -> FontSpec -> Bool
$cmax :: FontSpec -> FontSpec -> FontSpec
max :: FontSpec -> FontSpec -> FontSpec
$cmin :: FontSpec -> FontSpec -> FontSpec
min :: FontSpec -> FontSpec -> 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
$cshowsPrec :: Int -> LinePart -> ShowS
showsPrec :: Int -> LinePart -> ShowS
$cshow :: LinePart -> String
show :: LinePart -> String
$cshowList :: [LinePart] -> ShowS
showList :: [LinePart] -> ShowS
Show

instance RoffLikeLexer RoffTokens where
  -- The token stream is a list of 'LinePart's
  type Token RoffTokens = [LinePart]
  type State RoffTokens = RoffState
  emit :: Text -> Token RoffTokens
emit Text
t = [Text -> LinePart
RoffStr Text
t]
  expandString :: forall (m :: * -> *). PandocMonad m => Lexer m RoffTokens ()
expandString = ParsecT Sources (State RoffTokens) m ()
-> ParsecT Sources (State RoffTokens) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources (State RoffTokens) m ()
 -> ParsecT Sources (State RoffTokens) m ())
-> ParsecT Sources (State RoffTokens) m ()
-> ParsecT Sources (State RoffTokens) m ()
forall a b. (a -> b) -> a -> b
$ do
    SourcePos
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
    Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\'
    Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'*'
    Text
cs <- Lexer m RoffTokens Text
ParsecT Sources RoffState m Text
forall (m :: * -> *) x.
(PandocMonad m, RoffLikeLexer x) =>
Lexer m x Text
escapeArg ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
    Text
s <- [LinePart] -> Text
linePartsToText ([LinePart] -> Text)
-> ParsecT Sources RoffState m [LinePart]
-> ParsecT Sources RoffState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> SourcePos -> ParsecT Sources RoffState m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Text -> SourcePos -> RoffLexer m [LinePart]
resolveText Text
cs SourcePos
pos
    Text -> ParsecT Sources RoffState m ()
forall (m :: * -> *) u. Monad m => Text -> ParsecT Sources u m ()
addToInput Text
s
  escString :: forall (m :: * -> *).
PandocMonad m =>
Lexer m RoffTokens (Token RoffTokens)
escString = ParsecT Sources (State RoffTokens) m (Token RoffTokens)
-> ParsecT Sources (State RoffTokens) m (Token RoffTokens)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources (State RoffTokens) m (Token RoffTokens)
 -> ParsecT Sources (State RoffTokens) m (Token RoffTokens))
-> ParsecT Sources (State RoffTokens) m (Token RoffTokens)
-> ParsecT Sources (State RoffTokens) m (Token RoffTokens)
forall a b. (a -> b) -> a -> b
$ do
    SourcePos
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
    (do Text
cs <- Lexer m RoffTokens Text
ParsecT Sources RoffState m Text
forall (m :: * -> *) x.
(PandocMonad m, RoffLikeLexer x) =>
Lexer m x Text
escapeArg ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar
        Text -> SourcePos -> ParsecT Sources RoffState m [LinePart]
forall (m :: * -> *).
PandocMonad m =>
Text -> SourcePos -> RoffLexer m [LinePart]
resolveText Text
cs SourcePos
pos)
      ParsecT Sources RoffState m [LinePart]
-> ParsecT Sources RoffState m [LinePart]
-> ParsecT Sources RoffState 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 Sources RoffState m Char
-> ParsecT Sources RoffState m [LinePart]
forall a b.
a -> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'S'
  backslash :: forall (m :: * -> *). PandocMonad m => Lexer m RoffTokens ()
backslash = do
    Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\'
    RoffMode
mode <- RoffState -> RoffMode
roffMode (RoffState -> RoffMode)
-> ParsecT Sources RoffState m RoffState
-> ParsecT Sources RoffState m RoffMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources 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 Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT Sources RoffState m Char
 -> ParsecT Sources RoffState m ())
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\'
      RoffMode
NormalMode -> () -> ParsecT Sources RoffState m ()
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  checkDefined :: forall (m :: * -> *).
PandocMonad m =>
Text -> Lexer m RoffTokens (Token RoffTokens)
checkDefined Text
name = do
    Map Text RoffTokens
macros <- RoffState -> Map Text RoffTokens
customMacros (RoffState -> Map Text RoffTokens)
-> ParsecT Sources RoffState m RoffState
-> ParsecT Sources RoffState m (Map Text RoffTokens)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources 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] -> ParsecT Sources RoffState m [LinePart]
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"1"]
      Maybe RoffTokens
Nothing -> [LinePart] -> ParsecT Sources RoffState m [LinePart]
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"0"]
  -- \E is ignored in copy mode
  escE :: forall (m :: * -> *).
PandocMonad m =>
Lexer m RoffTokens (Token RoffTokens)
escE = do
      RoffMode
mode <- RoffState -> RoffMode
roffMode (RoffState -> RoffMode)
-> ParsecT Sources RoffState m RoffState
-> ParsecT Sources RoffState m RoffMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      case RoffMode
mode of
        RoffMode
CopyMode   -> [LinePart] -> ParsecT Sources RoffState m [LinePart]
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty
        RoffMode
NormalMode -> [LinePart] -> ParsecT Sources RoffState m [LinePart]
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\\"]
  escFont :: forall (m :: * -> *).
PandocMonad m =>
Lexer m RoffTokens (Token RoffTokens)
escFont = do
    Text
font <- Lexer m RoffTokens Text
ParsecT Sources RoffState m Text
forall (m :: * -> *) x.
(PandocMonad m, RoffLikeLexer x) =>
Lexer m x Text
escapeArg ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 Sources RoffState m RoffState
-> ParsecT Sources RoffState m FontSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                else FontSpec -> ParsecT Sources RoffState m FontSpec
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FontSpec -> ParsecT Sources RoffState m FontSpec)
-> FontSpec -> ParsecT Sources RoffState m FontSpec
forall a b. (a -> b) -> a -> b
$ (Char -> FontSpec -> FontSpec) -> FontSpec -> String -> FontSpec
forall a b. (a -> b -> b) -> b -> [a] -> b
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 Sources RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RoffState -> RoffState) -> ParsecT Sources RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st -> RoffState
st{ prevFont = currentFont st
                           , currentFont = font' }
    [LinePart] -> ParsecT Sources RoffState m [LinePart]
forall a. a -> ParsecT Sources RoffState m a
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 = True }
      processFontLetter Char
'I' FontSpec
fs = FontSpec
fs{ fontItalic = True }
      processFontLetter Char
'C' FontSpec
fs = FontSpec
fs{ fontMonospace = True }
      processFontLetter Char
_   FontSpec
fs = FontSpec
fs -- do nothing

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
$cshowsPrec :: Int -> CellFormat -> ShowS
showsPrec :: Int -> CellFormat -> ShowS
$cshow :: CellFormat -> String
show :: CellFormat -> String
$cshowList :: [CellFormat] -> ShowS
showList :: [CellFormat] -> ShowS
Show, CellFormat -> CellFormat -> Bool
(CellFormat -> CellFormat -> Bool)
-> (CellFormat -> CellFormat -> Bool) -> Eq CellFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellFormat -> CellFormat -> Bool
== :: CellFormat -> CellFormat -> Bool
$c/= :: CellFormat -> CellFormat -> Bool
/= :: 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
$ccompare :: CellFormat -> CellFormat -> Ordering
compare :: CellFormat -> CellFormat -> Ordering
$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
>= :: CellFormat -> CellFormat -> Bool
$cmax :: CellFormat -> CellFormat -> CellFormat
max :: CellFormat -> CellFormat -> CellFormat
$cmin :: CellFormat -> CellFormat -> CellFormat
min :: CellFormat -> CellFormat -> 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
$cshowsPrec :: Int -> RoffToken -> ShowS
showsPrec :: Int -> RoffToken -> ShowS
$cshow :: RoffToken -> String
show :: RoffToken -> String
$cshowList :: [RoffToken] -> ShowS
showList :: [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
$cshowsPrec :: Int -> RoffTokens -> ShowS
showsPrec :: Int -> RoffTokens -> ShowS
$cshow :: RoffTokens -> String
show :: RoffTokens -> String
$cshowList :: [RoffTokens] -> ShowS
showList :: [RoffTokens] -> ShowS
Show, 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
$c<> :: RoffTokens -> RoffTokens -> RoffTokens
<> :: RoffTokens -> RoffTokens -> RoffTokens
$csconcat :: NonEmpty RoffTokens -> RoffTokens
sconcat :: NonEmpty RoffTokens -> RoffTokens
$cstimes :: forall b. Integral b => b -> RoffTokens -> RoffTokens
stimes :: forall b. Integral b => b -> 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
$cmempty :: RoffTokens
mempty :: RoffTokens
$cmappend :: RoffTokens -> RoffTokens -> RoffTokens
mappend :: RoffTokens -> RoffTokens -> RoffTokens
$cmconcat :: [RoffTokens] -> RoffTokens
mconcat :: [RoffTokens] -> 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
$cshowsPrec :: Int -> RoffMode -> ShowS
showsPrec :: Int -> RoffMode -> ShowS
$cshow :: RoffMode -> String
show :: RoffMode -> String
$cshowList :: [RoffMode] -> ShowS
showList :: [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
$cshowsPrec :: Int -> RoffState -> ShowS
showsPrec :: Int -> RoffState -> ShowS
$cshow :: RoffState -> String
show :: RoffState -> String
$cshowList :: [RoffState] -> ShowS
showList :: [RoffState] -> ShowS
Show

instance Default RoffState where
  def :: RoffState
def = 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
$ (TableOption -> (Text, RoffTokens))
-> [TableOption] -> [(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 = ParsecT Sources RoffState m

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

eofline :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s u m ()
eofline :: forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 a b. a -> ParsecT s u m b -> ParsecT s u m a
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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"\\}")

spacetab :: (Stream s m Char, UpdateSourcePos s Char) => ParsecT s u m Char
spacetab :: forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab = Char -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\t'

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

lexMacro :: PandocMonad m => RoffLexer m RoffTokens
lexMacro :: forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexMacro = do
  SourcePos
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  RoffState
st <- ParsecT Sources RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool -> ParsecT Sources RoffState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources RoffState m ())
-> Bool -> ParsecT Sources 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
-> ParsecT Sources 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\''
  ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
  Text
macroName <- ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
manyChar ((Char -> Bool) -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAlphaNum)
  case Text
macroName of
    Text
"nop" -> RoffTokens -> RoffLexer m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
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 a. a -> ParsecT Sources RoffState m a
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 a. a -> ParsecT Sources RoffState m a
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 :: forall (m :: * -> *).
PandocMonad m =>
SourcePos -> RoffLexer m RoffTokens
lexTable SourcePos
pos = do
  RoffLexer m RoffTokens -> ParsecT Sources 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 Sources RoffState m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  [TableOption]
opts <- ParsecT Sources RoffState m [TableOption]
-> ParsecT Sources RoffState m [TableOption]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Sources RoffState m [TableOption]
forall (m :: * -> *). PandocMonad m => RoffLexer m [TableOption]
tableOptions ParsecT Sources RoffState m [TableOption]
-> ParsecT Sources RoffState m [TableOption]
-> ParsecT Sources RoffState m [TableOption]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [] [TableOption]
-> ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m [TableOption]
forall a b.
a -> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
';')
  case Text -> [TableOption] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"tab" [TableOption]
opts of
    Just (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
c, Text
_)) -> (RoffState -> RoffState) -> ParsecT Sources RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RoffState -> RoffState) -> ParsecT Sources RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st -> RoffState
st{ tableTabChar = c }
    Maybe Text
_                              -> (RoffState -> RoffState) -> ParsecT Sources RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RoffState -> RoffState) -> ParsecT Sources RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st -> RoffState
st{ tableTabChar = '\t' }
  ParsecT Sources RoffState m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  RoffLexer m RoffTokens -> ParsecT Sources 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 Sources RoffState m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 Sources RoffState m [[TableRow]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (RoffLexer m [TableRow]
 -> ParsecT Sources RoffState m [[TableRow]])
-> RoffLexer m [TableRow]
-> ParsecT Sources 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 Sources RoffState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
".T&"
    ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
    ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
    RoffLexer m [TableRow]
forall (m :: * -> *). PandocMonad m => RoffLexer m [TableRow]
lexTableRows
  String -> ParsecT Sources RoffState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
".TE"
  ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
  ParsecT Sources RoffState m ()
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
eofline
  RoffTokens -> RoffLexer m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
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
$ [TableOption] -> [TableRow] -> SourcePos -> RoffToken
Tbl [TableOption]
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 :: forall (m :: * -> *). PandocMonad m => RoffLexer m [TableRow]
lexTableRows = do
  [[CellFormat]]
aligns <- RoffLexer m [[CellFormat]]
forall (m :: * -> *). PandocMonad m => RoffLexer m [[CellFormat]]
tableFormatSpec
  ParsecT Sources RoffState m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  ParsecT Sources RoffState m RoffTokens
-> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT Sources RoffState m RoffTokens
 -> ParsecT Sources RoffState m ())
-> ParsecT Sources RoffState m RoffTokens
-> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexComment
          ParsecT Sources RoffState m RoffTokens
-> ParsecT Sources RoffState m RoffTokens
-> ParsecT Sources RoffState m RoffTokens
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources RoffState m RoffTokens
-> ParsecT Sources 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 Sources RoffState m Char
-> ParsecT Sources RoffState m RoffTokens
forall a b.
a -> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> ParsecT Sources RoffState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
".sp" ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m () -> ParsecT Sources RoffState m ()
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spaceChar ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline))
  ParsecT Sources RoffState m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  [[RoffTokens]]
rows <- ParsecT Sources RoffState m [RoffTokens]
-> ParsecT Sources RoffState m [[RoffTokens]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Sources RoffState m String
-> ParsecT Sources 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 Sources RoffState m String
-> ParsecT Sources RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Sources RoffState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
".TE") ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Sources RoffState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
".T&")) ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m [RoffTokens]
-> ParsecT Sources RoffState m [RoffTokens]
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  ParsecT Sources RoffState m [RoffTokens]
forall (m :: * -> *). PandocMonad m => RoffLexer m [RoffTokens]
tableRow)
  [TableRow] -> RoffLexer m [TableRow]
forall a. a -> ParsecT Sources RoffState m a
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 :: forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
tableCell = do
  SourcePos
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  (ParsecT Sources RoffState m String
forall {u}. ParsecT Sources u m String
enclosedCell ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources RoffState m String
simpleCell) ParsecT Sources RoffState m String
-> (String -> RoffLexer m RoffTokens) -> RoffLexer m RoffTokens
forall a b.
ParsecT Sources RoffState m a
-> (a -> ParsecT Sources RoffState m b)
-> ParsecT Sources RoffState m b
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 Sources u m String
enclosedCell = do
    ParsecT Sources u m String -> ParsecT Sources u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Sources u m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"T{")
    ParsecT Sources u m Char
-> ParsecT Sources u m String -> ParsecT Sources 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 Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (ParsecT Sources u m String -> ParsecT Sources u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Sources u m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"T}"))
  simpleCell :: ParsecT Sources RoffState m String
simpleCell = do
    Char
tabChar <- RoffState -> Char
tableTabChar (RoffState -> Char)
-> ParsecT Sources RoffState m RoffState
-> ParsecT Sources RoffState m Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Sources RoffState m Char -> ParsecT Sources 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
tabChar ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline) ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar)

tableRow :: PandocMonad m => RoffLexer m [RoffTokens]
tableRow :: forall (m :: * -> *). PandocMonad m => RoffLexer m [RoffTokens]
tableRow = do
  Char
tabChar <- RoffState -> Char
tableTabChar (RoffState -> Char)
-> ParsecT Sources RoffState m RoffState
-> ParsecT Sources RoffState m Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
tabChar ParsecT Sources RoffState m Char
-> RoffLexer m RoffTokens -> RoffLexer m RoffTokens
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
tableCell)
  ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
  ParsecT Sources RoffState m ()
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
eofline
  RoffLexer m RoffTokens -> ParsecT Sources 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 a. a -> ParsecT Sources RoffState m a
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 :: forall (m :: * -> *). PandocMonad m => RoffLexer m [TableOption]
tableOptions = ParsecT Sources RoffState m TableOption
-> ParsecT Sources RoffState m [TableOption]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources RoffState m TableOption
forall (m :: * -> *). PandocMonad m => RoffLexer m TableOption
tableOption ParsecT Sources RoffState m [TableOption]
-> ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m [TableOption]
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources RoffState m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces ParsecT Sources RoffState m [TableOption]
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m [TableOption]
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
';'

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

tableFormatSpec :: PandocMonad m => RoffLexer m [[CellFormat]]
tableFormatSpec :: forall (m :: * -> *). PandocMonad m => 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
-> ParsecT Sources 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
',') ParsecT Sources RoffState m Char
-> RoffLexer m [CellFormat] -> RoffLexer m [CellFormat]
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m b
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 Sources RoffState m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'.'
  [[CellFormat]] -> RoffLexer m [[CellFormat]]
forall a. a -> ParsecT Sources RoffState m a
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 :: forall (m :: * -> *). PandocMonad m => RoffLexer m [CellFormat]
tableFormatSpecLine =
  ParsecT Sources RoffState m CellFormat
-> ParsecT Sources RoffState m [CellFormat]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Sources RoffState m CellFormat
 -> ParsecT Sources RoffState m [CellFormat])
-> ParsecT Sources RoffState m CellFormat
-> ParsecT Sources RoffState m [CellFormat]
forall a b. (a -> b) -> a -> b
$ ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m CellFormat
-> ParsecT Sources RoffState m CellFormat
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Sources RoffState m CellFormat
forall (m :: * -> *). PandocMonad m => RoffLexer m CellFormat
tableColFormat ParsecT Sources RoffState m CellFormat
-> ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m CellFormat
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab

tableColFormat :: PandocMonad m => RoffLexer m CellFormat
tableColFormat :: forall (m :: * -> *). PandocMonad m => RoffLexer m CellFormat
tableColFormat = do
    Bool
pipePrefix' <- Bool
-> ParsecT Sources RoffState m Bool
-> ParsecT Sources 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 Sources RoffState m Bool
 -> ParsecT Sources RoffState m Bool)
-> ParsecT Sources RoffState m Bool
-> ParsecT Sources RoffState m Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool
-> ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m Bool
forall a b.
a -> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT Sources RoffState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"|" ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m String
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources RoffState m Char -> ParsecT Sources 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 Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab)
    Char
c <- String -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 Sources RoffState m Text
-> ParsecT Sources RoffState m [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Sources RoffState m Text
 -> ParsecT Sources RoffState m [Text])
-> ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m [Text]
forall a b. (a -> b) -> a -> b
$ ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit) ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
-> ParsecT Sources 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 Sources RoffState m Char
-> ParsecT Sources RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
-> ParsecT Sources 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'('
                               String
xs <- ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
-> ParsecT Sources 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
')')
                               String -> ParsecT Sources RoffState m String
forall a. a -> ParsecT Sources RoffState m a
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 Sources RoffState m String
-> ParsecT Sources RoffState m String
-> ParsecT Sources 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 Sources RoffState m String
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                   Char
'f' -> Int
-> ParsecT Sources RoffState m Char
-> ParsecT Sources 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m String
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
                   Char
'm' -> Int
-> ParsecT Sources RoffState m Char
-> ParsecT Sources 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 Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
alphaNum ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m ()
-> ParsecT Sources RoffState m String
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
                   Char
_   -> String -> ParsecT Sources RoffState m String
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
          Text -> ParsecT Sources RoffState m Text
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Sources RoffState m Text)
-> Text -> ParsecT Sources 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 Sources RoffState m Bool
-> ParsecT Sources 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 Sources RoffState m Bool
 -> ParsecT Sources RoffState m Bool)
-> ParsecT Sources RoffState m Bool
-> ParsecT Sources RoffState m Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool
-> ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m Bool
forall a b.
a -> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT Sources RoffState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"|"
    CellFormat -> RoffLexer m CellFormat
forall a. a -> ParsecT Sources RoffState m a
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
             { 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 :: forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m RoffTokens
lexConditional Text
mname = do
  SourcePos
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s 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 a b. (a -> b) -> Maybe a -> Maybe b
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 Sources RoffState m RoffState
-> RoffLexer m (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
               else RoffLexer m (Maybe Bool)
forall (m :: * -> *). PandocMonad m => RoffLexer m (Maybe Bool)
expression
  ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
  RoffState
st <- ParsecT Sources 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 Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT Sources RoffState m Char
 -> ParsecT Sources RoffState m ())
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources RoffState m Char
 -> ParsecT Sources RoffState m Char)
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Char
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 Sources RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RoffState -> RoffState) -> ParsecT Sources RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
s -> RoffState
s{ afterConditional = True }
              RoffTokens
t <- RoffLexer m RoffTokens
forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
manToken
              (RoffState -> RoffState) -> ParsecT Sources RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RoffState -> RoffState) -> ParsecT Sources RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
s -> RoffState
s{ afterConditional = False }
              RoffTokens -> RoffLexer m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
t
  case Maybe Bool
mbtest of
    Maybe Bool
Nothing    -> do
      RoffState -> ParsecT Sources RoffState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState RoffState
st  -- reset state, so we don't record macros in skipped section
      LogMessage -> ParsecT Sources RoffState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT Sources RoffState m ())
-> LogMessage -> ParsecT Sources 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 a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty
    Just Bool
True  -> RoffTokens -> RoffLexer m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
ifPart
    Just Bool
False -> do
      RoffState -> ParsecT Sources RoffState m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState RoffState
st
      RoffTokens -> RoffLexer m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty

expression :: PandocMonad m => RoffLexer m (Maybe Bool)
expression :: forall (m :: * -> *). PandocMonad m => RoffLexer m (Maybe Bool)
expression = do
  Text
raw <- Char
-> Char
-> ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
Char -> Char -> ParsecT s st m Text -> ParsecT s st m Text
charsInBalanced Char
'(' Char
')' (Char -> Text
T.singleton (Char -> Text)
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')))
      ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Text
forall s (m :: * -> *) t st.
Stream s m t =>
ParsecT s st m Char -> ParsecT s st m Text
many1Char ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s 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 ()
updateState ((RoffState -> RoffState) -> ParsecT s RoffState m ())
-> (RoffState -> RoffState) -> ParsecT s RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st -> RoffState
st{ lastExpression = v }
      Maybe Bool -> ParsecT s RoffState m (Maybe Bool)
forall a. a -> ParsecT s RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
v

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

lexIncludeFile :: PandocMonad m => [Arg] -> RoffLexer m RoffTokens
lexIncludeFile :: forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexIncludeFile [[LinePart]]
args = do
  SourcePos
pos <- ParsecT Sources 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 Sources RoffState m [String]
forall (m :: * -> *). PandocMonad m => m [String]
getResourcePath
      Maybe Text
result <- [String] -> String -> ParsecT Sources RoffState m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
[String] -> String -> m (Maybe Text)
readFileFromDirs [String]
dirs (String -> ParsecT Sources RoffState m (Maybe Text))
-> String -> ParsecT Sources 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 Sources RoffState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT Sources RoffState m ())
-> LogMessage -> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
CouldNotLoadIncludeFile Text
fp SourcePos
pos
        Just Text
s   -> Text -> ParsecT Sources RoffState m ()
forall (m :: * -> *) u. Monad m => Text -> ParsecT Sources u m ()
addToInput Text
s
      RoffTokens -> RoffLexer m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty
    []    -> RoffTokens -> RoffLexer m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
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 :: forall (m :: * -> *).
PandocMonad m =>
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 Sources RoffState m RoffState
-> ParsecT Sources RoffState m (Map Text RoffTokens)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources 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 a. a -> ParsecT Sources RoffState m a
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 a b. (a -> b -> b) -> b -> [a] -> b
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 a. a -> ParsecT Sources RoffState m a
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 a b. (a -> b) -> Seq a -> Seq b
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 :: forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexStringDef [[LinePart]]
args = do -- string definition
   case [[LinePart]]
args of
     []     -> String -> ParsecT Sources RoffState m ()
forall a. String -> ParsecT Sources RoffState m a
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 Sources RoffState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((RoffState -> RoffState) -> ParsecT Sources RoffState m ())
-> (RoffState -> RoffState) -> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ \RoffState
st ->
         RoffState
st{ customMacros = M.insert stringName ts (customMacros st) }
   RoffTokens -> RoffLexer m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
forall a. Monoid a => a
mempty

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

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

  where

  oneArg :: PandocMonad m => RoffLexer m [LinePart]
  oneArg :: forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
oneArg = do
    ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT Sources RoffState m String
 -> ParsecT Sources RoffState m ())
-> ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources RoffState m String
 -> ParsecT Sources RoffState m String)
-> ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Sources RoffState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 :: forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
plainArg = do
    ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
    [[LinePart]] -> [LinePart]
forall a. Monoid a => [a] -> a
mconcat ([[LinePart]] -> [LinePart])
-> ParsecT Sources RoffState m [[LinePart]]
-> RoffLexer m [LinePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RoffLexer m [LinePart] -> ParsecT Sources RoffState m [[LinePart]]
forall s u (m :: * -> *) a. 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
<|> Lexer m RoffTokens (Token RoffTokens)
RoffLexer m [LinePart]
forall (m :: * -> *) x.
(PandocMonad m, RoffLikeLexer x) =>
Lexer m x (Token x)
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 Sources u m [LinePart]
unescapedQuote)
    where
      unescapedQuote :: ParsecT Sources u m [LinePart]
unescapedQuote = Char -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"' ParsecT Sources u m Char
-> ParsecT Sources u m [LinePart] -> ParsecT Sources u m [LinePart]
forall a b.
ParsecT Sources u m a
-> ParsecT Sources u m b -> ParsecT Sources u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [LinePart] -> ParsecT Sources u m [LinePart]
forall a. a -> ParsecT Sources u m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\""]

  quotedArg :: PandocMonad m => RoffLexer m [LinePart]
  quotedArg :: forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
quotedArg = do
    ParsecT Sources RoffState m Char -> ParsecT Sources RoffState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
    Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"'
    [LinePart]
xs <- [[LinePart]] -> [LinePart]
forall a. Monoid a => [a] -> a
mconcat ([[LinePart]] -> [LinePart])
-> ParsecT Sources RoffState m [[LinePart]]
-> RoffLexer m [LinePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           RoffLexer m [LinePart] -> ParsecT Sources 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
<|> Lexer m RoffTokens (Token RoffTokens)
RoffLexer m [LinePart]
forall (m :: * -> *) x.
(PandocMonad m, RoffLikeLexer x) =>
Lexer m x (Token x)
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 Sources u m [LinePart]
escapedQuote)
    Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"'
    [LinePart] -> RoffLexer m [LinePart]
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
xs
    where
      escapedQuote :: ParsecT Sources u m [LinePart]
escapedQuote = ParsecT Sources u m [LinePart] -> ParsecT Sources u m [LinePart]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources u m [LinePart] -> ParsecT Sources u m [LinePart])
-> ParsecT Sources u m [LinePart] -> ParsecT Sources u m [LinePart]
forall a b. (a -> b) -> a -> b
$ do
        Char -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"'
        Char -> ParsecT Sources u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'"'
        [LinePart] -> ParsecT Sources u m [LinePart]
forall a. a -> ParsecT Sources u m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> LinePart
RoffStr Text
"\""]

-- strings and macros share namespace
resolveText :: PandocMonad m
              => T.Text -> SourcePos -> RoffLexer m [LinePart]
resolveText :: forall (m :: * -> *).
PandocMonad m =>
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 a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq RoffToken
ts of
    [TextLine [LinePart]
xs] -> [LinePart] -> RoffLexer m [LinePart]
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
xs
    [RoffToken]
_          -> do
      LogMessage -> ParsecT Sources RoffState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT Sources RoffState m ())
-> LogMessage -> ParsecT Sources 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 a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [LinePart]
forall a. Monoid a => a
mempty

lexLine :: PandocMonad m => RoffLexer m RoffTokens
lexLine :: forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexLine = do
  RoffMode
mode <- RoffState -> RoffMode
roffMode (RoffState -> RoffMode)
-> ParsecT Sources RoffState m RoffState
-> ParsecT Sources RoffState m RoffMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RoffState m RoffState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case RoffMode
mode of
    RoffMode
CopyMode   -> ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT Sources RoffState m String
 -> ParsecT Sources RoffState m ())
-> ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m ()
forall a b. (a -> b) -> a -> b
$ ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources RoffState m String
 -> ParsecT Sources RoffState m String)
-> ParsecT Sources RoffState m String
-> ParsecT Sources RoffState m String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Sources RoffState m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"\\&"
    RoffMode
NormalMode -> () -> ParsecT Sources RoffState m ()
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  [LinePart]
lnparts <- [[LinePart]] -> [LinePart]
forall a. Monoid a => [a] -> a
mconcat ([[LinePart]] -> [LinePart])
-> ParsecT Sources RoffState m [[LinePart]]
-> ParsecT Sources RoffState m [LinePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RoffState m [LinePart]
-> ParsecT Sources RoffState m [[LinePart]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Sources RoffState m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
linePart
  ParsecT Sources RoffState m ()
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s 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 a. a -> m a
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 a. a -> m a
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 :: forall (m :: * -> *). PandocMonad m => 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
<|> Lexer m RoffTokens (Token RoffTokens)
RoffLexer m [LinePart]
forall (m :: * -> *) x.
(PandocMonad m, RoffLikeLexer x) =>
Lexer m x (Token x)
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

macroArg :: PandocMonad m => RoffLexer m [LinePart]
macroArg :: forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
macroArg = ParsecT Sources RoffState m [LinePart]
-> ParsecT Sources RoffState m [LinePart]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources RoffState m [LinePart]
 -> ParsecT Sources RoffState m [LinePart])
-> ParsecT Sources RoffState m [LinePart]
-> ParsecT Sources RoffState m [LinePart]
forall a b. (a -> b) -> a -> b
$ do
  SourcePos
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Lexer m RoffTokens ()
ParsecT Sources RoffState m ()
forall x (m :: * -> *).
(RoffLikeLexer x, PandocMonad m) =>
Lexer m x ()
forall (m :: * -> *). PandocMonad m => Lexer m RoffTokens ()
backslash
  Char -> ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'$'
  Text
x <- Lexer m RoffTokens Text
ParsecT Sources RoffState m Text
forall (m :: * -> *) x.
(PandocMonad m, RoffLikeLexer x) =>
Lexer m x Text
escapeArg ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
-> ParsecT Sources RoffState m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int
-> ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char, Monad m) =>
Int -> ParsecT s st m Char -> ParsecT s st m Text
countChar Int
1 ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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] -> ParsecT Sources RoffState m [LinePart]
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> LinePart
MacroArg Int
i]
    Maybe Int
Nothing -> do
      LogMessage -> ParsecT Sources RoffState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT Sources RoffState m ())
-> LogMessage -> ParsecT Sources RoffState 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] -> ParsecT Sources RoffState m [LinePart]
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

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

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

spaceTabChar :: PandocMonad m => RoffLexer m [LinePart]
spaceTabChar :: forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
spaceTabChar = do
  Char
c <- ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
  [LinePart] -> RoffLexer m [LinePart]
forall a. a -> ParsecT Sources RoffState m a
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 :: forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexEmptyLine = ParsecT Sources RoffState m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline ParsecT Sources RoffState m Char
-> ParsecT Sources RoffState m RoffTokens
-> ParsecT Sources RoffState m RoffTokens
forall a b.
ParsecT Sources RoffState m a
-> ParsecT Sources RoffState m b -> ParsecT Sources RoffState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RoffTokens -> ParsecT Sources RoffState m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffToken -> RoffTokens
singleTok RoffToken
EmptyLine)

manToken :: PandocMonad m => RoffLexer m RoffTokens
manToken :: forall (m :: * -> *). PandocMonad m => 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 :: forall (m :: * -> *).
PandocMonad m =>
SourcePos -> Text -> m RoffTokens
lexRoff SourcePos
pos Text
txt = do
  Either PandocError RoffTokens
eithertokens <- ParsecT Sources RoffState m RoffTokens
-> RoffState -> Text -> m (Either PandocError RoffTokens)
forall (m :: * -> *) t st a.
(Monad m, ToSources t) =>
ParsecT Sources st m a -> st -> t -> m (Either PandocError a)
readWithM (do SourcePos -> ParsecT Sources 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 Sources RoffState m [RoffTokens]
-> ParsecT Sources RoffState m RoffTokens
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources RoffState m RoffTokens
-> ParsecT Sources RoffState m [RoffTokens]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Sources 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 a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
    Right RoffTokens
tokenz -> RoffTokens -> m RoffTokens
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RoffTokens
tokenz