{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
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
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
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
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
char '\\'
char '*'
cs <- escapeArg <|> countChar 1 anyChar
s <- linePartsToText <$> resolveText cs pos
addToInput 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
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(do cs <- escapeArg <|> countChar 1 anyChar
resolveText cs pos)
<|> mempty <$ 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
'\\'
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 mode of
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
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 M.lookup name 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"]
escE :: forall (m :: * -> *).
PandocMonad m =>
Lexer m RoffTokens (Token RoffTokens)
escE = do
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 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
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
font' <- if T.null font || font == "P"
then prevFont <$> getState
else return $ foldr processFontLetter defaultFontSpec $ T.unpack font
updateState $ \RoffState
st -> RoffState
st{ prevFont = currentFont st
, currentFont = font' }
return [Font 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
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
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'
lexComment :: PandocMonad m => RoffLexer m RoffTokens
= 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 -> ParsecT Sources RoffState 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
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
st <- getState
guard $ sourceColumn pos == 1 || afterConditional st
char '.' <|> char '\''
skipMany spacetab
macroName <- manyChar (satisfy isAlphaNum)
case macroName of
Text
"nop" -> RoffTokens -> ParsecT Sources RoffState 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 -> ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m RoffTokens
lexConditional Text
"ie"
Text
"if" -> Text -> ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m RoffTokens
lexConditional Text
"if"
Text
"el" -> Text -> ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m RoffTokens
lexConditional Text
"el"
Text
"while" -> Text -> ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m RoffTokens
lexConditional Text
"while"
Text
_ -> do
args <- RoffLexer m [[LinePart]]
forall (m :: * -> *). PandocMonad m => RoffLexer m [[LinePart]]
lexArgs
case macroName of
Text
"" -> RoffTokens -> ParsecT Sources RoffState 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 -> ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
SourcePos -> RoffLexer m RoffTokens
lexTable SourcePos
pos
Text
"de" -> [[LinePart]] -> ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexMacroDef [[LinePart]]
args
Text
"de1" -> [[LinePart]] -> ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexMacroDef [[LinePart]]
args
Text
"ds" -> [[LinePart]] -> ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexStringDef [[LinePart]]
args
Text
"ds1" -> [[LinePart]] -> ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexStringDef [[LinePart]]
args
Text
"sp" -> RoffTokens -> ParsecT Sources RoffState m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffTokens -> ParsecT Sources RoffState m RoffTokens)
-> RoffTokens -> ParsecT Sources RoffState m RoffTokens
forall a b. (a -> b) -> a -> b
$ RoffToken -> RoffTokens
singleTok RoffToken
EmptyLine
Text
"so" -> [[LinePart]] -> ParsecT Sources RoffState m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> RoffLexer m RoffTokens
lexIncludeFile [[LinePart]]
args
Text
_ -> Text
-> [[LinePart]]
-> SourcePos
-> ParsecT Sources RoffState 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
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
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
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 lookup "tab" 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' }
spaces
skipMany lexComment
spaces
rows <- lexTableRows
morerows <- many $ try $ do
string ".T&"
skipMany spacetab
newline
lexTableRows
string ".TE"
skipMany spacetab
eofline
return $ singleTok $ Tbl opts (rows <> concat morerows) pos
lexTableRows :: PandocMonad m => RoffLexer m [TableRow]
lexTableRows :: forall (m :: * -> *). PandocMonad m => RoffLexer m [TableRow]
lexTableRows = do
aligns <- RoffLexer m [[CellFormat]]
forall (m :: * -> *). PandocMonad m => RoffLexer m [[CellFormat]]
tableFormatSpec
spaces
skipMany $ lexComment
<|> try (mempty <$ (string ".sp" >> skipMany spaceChar >> newline))
spaces
rows <- many (notFollowedBy (try (string ".TE") <|> try (string ".T&")) >>
tableRow)
return $ zip aligns rows
tableCell :: PandocMonad m => RoffLexer m RoffTokens
tableCell :: forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
tableCell = do
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(enclosedCell <|> simpleCell) >>= lexRoff pos . 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
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
many (notFollowedBy (char tabChar <|> newline) >> anyChar)
tableRow :: PandocMonad m => RoffLexer m [RoffTokens]
tableRow :: forall (m :: * -> *). PandocMonad m => RoffLexer m [RoffTokens]
tableRow = do
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
c <- tableCell
cs <- many $ try (char tabChar >> tableCell)
skipMany spacetab
eofline
skipMany lexComment
return (c: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
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
v <- option "" $ try $ do
skipMany spacetab
char '('
manyTillChar anyChar (char ')')
skipMany spacetab
optional (char ',' >> skipMany spacetab)
return (k,v)
tableFormatSpec :: PandocMonad m => RoffLexer m [[CellFormat]]
tableFormatSpec :: forall (m :: * -> *). PandocMonad m => RoffLexer m [[CellFormat]]
tableFormatSpec = do
first <- RoffLexer m [CellFormat]
forall (m :: * -> *). PandocMonad m => RoffLexer m [CellFormat]
tableFormatSpecLine
rest <- many $ try $ (newline <|> char ',') *> tableFormatSpecLine
let speclines = [CellFormat]
first[CellFormat] -> [[CellFormat]] -> [[CellFormat]]
forall a. a -> [a] -> [a]
:[[CellFormat]]
rest
spaces
char '.'
return $ speclines <> repeat (lastDef [] speclines)
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
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)
c <- oneOf ['a','A','c','C','l','L','n','N','r','R','s','S','^','_','-',
'=','|']
suffixes <- many $ try (skipMany spacetab *> countChar 1 digit) <|>
(do x <- oneOf ['b','B','d','D','e','E','f','F','i','I','m','M',
'p','P','t','T','u','U','v','V','w','W','x','X', 'z','Z']
num <- case toLower 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
'('
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
')')
return ("(" <> xs <> ")")) 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
""
return $ T.pack $ x : num)
pipeSuffix' <- option False $ True <$ string "|"
return $ CellFormat
{ columnType = c
, pipePrefix = pipePrefix'
, pipeSuffix = pipeSuffix'
, columnSuffixes = suffixes }
lexConditional :: PandocMonad m => T.Text -> RoffLexer m RoffTokens
lexConditional :: forall (m :: * -> *).
PandocMonad m =>
Text -> RoffLexer m RoffTokens
lexConditional Text
mname = do
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
skipMany spacetab
mbtest <- if mname == "el"
then fmap not . lastExpression <$> getState
else expression
skipMany spacetab
st <- getState
ifPart <- do
optional $ try $ char '\\' >> newline
lexGroup
<|> do updateState $ \RoffState
s -> RoffState
s{ afterConditional = True }
t <- manToken
updateState $ \RoffState
s -> RoffState
s{ afterConditional = False }
return t
case 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
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
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
returnValue $
case 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
Text
"t" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
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]
-> 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 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 ParsecT Sources RoffState 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
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
case args of
([LinePart]
f:[[LinePart]]
_) -> do
let fp :: Text
fp = [LinePart] -> Text
linePartsToText [LinePart]
f
dirs <- ParsecT Sources RoffState m [String]
forall (m :: * -> *). PandocMonad m => m [String]
getResourcePath
result <- readFileFromDirs dirs $ T.unpack fp
case 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
return mempty
[] -> RoffTokens -> ParsecT Sources RoffState 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
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 M.lookup macroName macros of
Maybe RoffTokens
Nothing -> RoffTokens -> ParsecT Sources RoffState m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffTokens -> ParsecT Sources RoffState m RoffTokens)
-> RoffTokens -> ParsecT Sources RoffState 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 -> ParsecT Sources RoffState m RoffTokens
forall a. a -> ParsecT Sources RoffState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RoffTokens -> ParsecT Sources RoffState m RoffTokens)
-> RoffTokens -> ParsecT Sources RoffState 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
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 -> ParsecT Sources RoffState 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
(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 }
(macroName, 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)
([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 () -> 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
_ <- RoffLexer m [[LinePart]]
forall (m :: * -> *). PandocMonad m => RoffLexer m [[LinePart]]
lexArgs
return ()
ts <- mconcat <$> manyTill manToken stop
updateState $ \RoffState
st ->
RoffState
st{ customMacros = M.insert macroName ts (customMacros st)
, roffMode = NormalMode }
return mempty
lexArgs :: PandocMonad m => RoffLexer m [Arg]
lexArgs :: forall (m :: * -> *). PandocMonad m => RoffLexer m [[LinePart]]
lexArgs = do
args <- 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]
many (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
$ 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
skipMany spacetab
eofline
return 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"
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]
quotedArg 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
<|> ParsecT Sources RoffState m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
plainArg
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]]
-> 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]
macroArg 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
<|> Lexer m RoffTokens (Token RoffTokens)
ParsecT Sources RoffState m [LinePart]
forall (m :: * -> *) x.
(PandocMonad m, RoffLikeLexer x) =>
Lexer m x (Token x)
escape 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
<|> ParsecT Sources RoffState m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
regularText 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
<|> ParsecT Sources RoffState 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
'"'
xs <- [[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]
many (ParsecT Sources RoffState m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
macroArg 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
<|> Lexer m RoffTokens (Token RoffTokens)
ParsecT Sources RoffState m [LinePart]
forall (m :: * -> *) x.
(PandocMonad m, RoffLikeLexer x) =>
Lexer m x (Token x)
escape 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
<|> ParsecT Sources RoffState m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
regularText
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
<|> ParsecT Sources RoffState m [LinePart]
forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
spaceTabChar 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
<|> ParsecT Sources RoffState m [LinePart]
forall {u}. ParsecT Sources u m [LinePart]
escapedQuote)
char '"'
return 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
"\""]
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 ts <- Text -> [[LinePart]] -> SourcePos -> RoffLexer m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
Text -> [[LinePart]] -> SourcePos -> RoffLexer m RoffTokens
resolveMacro Text
stringname [] SourcePos
pos
case Foldable.toList ts of
[TextLine [LinePart]
xs] -> [LinePart] -> ParsecT Sources RoffState 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] -> 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
lexLine :: PandocMonad m => RoffLexer m RoffTokens
lexLine :: forall (m :: * -> *). PandocMonad m => RoffLexer m RoffTokens
lexLine = do
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 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 ()
lnparts <- mconcat <$> many1 linePart
eofline
go lnparts
where
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
pos <- ParsecT Sources RoffState m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
backslash
char '$'
x <- escapeArg <|> countChar 1 digit
case safeRead 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
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 \\\""
return [RoffStr 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] -> 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
"\""]
spaceTabChar :: PandocMonad m => RoffLexer m [LinePart]
spaceTabChar :: forall (m :: * -> *). PandocMonad m => RoffLexer m [LinePart]
spaceTabChar = do
c <- ParsecT Sources RoffState m Char
forall s (m :: * -> *) u.
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
spacetab
return [RoffStr $ T.singleton 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
lexRoff :: PandocMonad m => SourcePos -> T.Text -> m RoffTokens
lexRoff :: forall (m :: * -> *).
PandocMonad m =>
SourcePos -> Text -> m RoffTokens
lexRoff SourcePos
pos Text
txt = do
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 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