{-# 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 (isLetter, 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 <- takeWhileP 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 $ (char '\\' >> anyChar)
<|> (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 <- (Char -> Bool) -> ParsecT Sources RoffState m Text
forall (m :: * -> *) u.
Monad m =>
(Char -> Bool) -> ParsecT Sources u m Text
takeWhile1P Char -> Bool
isLetter
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
<|> (Char -> Bool) -> ParsecT Sources RoffState m Text
forall (m :: * -> *) u.
Monad m =>
(Char -> Bool) -> ParsecT Sources u m Text
takeWhile1P (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\t' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')
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 <- (Char -> Bool) -> ParsecT Sources RoffState m Text
forall (m :: * -> *) u.
Monad m =>
(Char -> Bool) -> ParsecT Sources u m Text
takeWhile1P (\Char
c -> Bool -> Bool
not (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'))
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