{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.Man (readMan) where
import Data.Char (toLower)
import Data.Default (Default)
import Control.Monad (mzero, guard, void)
import Control.Monad.Trans (lift)
import Control.Monad.Except (throwError)
import Data.Maybe (catMaybes, isJust)
import Data.List (intersperse)
import qualified Data.Text as T
import Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad(..), report)
import Text.Pandoc.Logging (LogMessage(..))
import Text.Pandoc.Options
import Text.Pandoc.Parsing
import Text.Pandoc.Walk (query)
import Text.Pandoc.Readers.Roff
import qualified Text.Pandoc.Parsing as P
import qualified Data.Foldable as Foldable
import Text.Pandoc.Shared (extractSpaces)
data ManState = ManState { ManState -> ReaderOptions
readerOptions :: ReaderOptions
, ManState -> Meta
metadata :: Meta
, ManState -> Bool
tableCellsPlain :: Bool
} deriving Int -> ManState -> ShowS
[ManState] -> ShowS
ManState -> String
(Int -> ManState -> ShowS)
-> (ManState -> String) -> ([ManState] -> ShowS) -> Show ManState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ManState -> ShowS
showsPrec :: Int -> ManState -> ShowS
$cshow :: ManState -> String
show :: ManState -> String
$cshowList :: [ManState] -> ShowS
showList :: [ManState] -> ShowS
Show
instance Default ManState where
def :: ManState
def = ManState { readerOptions :: ReaderOptions
readerOptions = ReaderOptions
forall a. Default a => a
def
, metadata :: Meta
metadata = Meta
nullMeta
, tableCellsPlain :: Bool
tableCellsPlain = Bool
True }
type ManParser m = P.ParsecT [RoffToken] ManState m
readMan :: (PandocMonad m, ToSources a)
=> ReaderOptions
-> a
-> m Pandoc
readMan :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMan ReaderOptions
opts a
s = do
let Sources [(SourcePos, Text)]
inps = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
s
tokenz <- [RoffTokens] -> RoffTokens
forall a. Monoid a => [a] -> a
mconcat ([RoffTokens] -> RoffTokens) -> m [RoffTokens] -> m RoffTokens
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((SourcePos, Text) -> m RoffTokens)
-> [(SourcePos, Text)] -> m [RoffTokens]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((SourcePos -> Text -> m RoffTokens)
-> (SourcePos, Text) -> m RoffTokens
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourcePos -> Text -> m RoffTokens
forall (m :: * -> *).
PandocMonad m =>
SourcePos -> Text -> m RoffTokens
lexRoff) [(SourcePos, Text)]
inps
let state = ManState
forall a. Default a => a
def {readerOptions = opts} :: ManState
eitherdoc <- readWithMTokens parseMan state
(Foldable.toList . unRoffTokens $ tokenz)
either (throwError . fromParsecError (Sources inps)) return eitherdoc
readWithMTokens :: PandocMonad m
=> ParsecT [RoffToken] ManState m a
-> ManState
-> [RoffToken]
-> m (Either ParseError a)
readWithMTokens :: forall (m :: * -> *) a.
PandocMonad m =>
ParsecT [RoffToken] ManState m a
-> ManState -> [RoffToken] -> m (Either ParseError a)
readWithMTokens ParsecT [RoffToken] ManState m a
parser ManState
state [RoffToken]
input =
ParsecT [RoffToken] ManState m a
-> ManState -> String -> [RoffToken] -> m (Either ParseError a)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT ParsecT [RoffToken] ManState m a
parser ManState
state String
"source" [RoffToken]
input
parseMan :: PandocMonad m => ManParser m Pandoc
parseMan :: forall (m :: * -> *). PandocMonad m => ManParser m Pandoc
parseMan = do
bs <- ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlock ParsecT [RoffToken] ManState m [Blocks]
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m [Blocks]
forall a b.
ParsecT [RoffToken] ManState m a
-> ParsecT [RoffToken] ManState m b
-> ParsecT [RoffToken] ManState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
meta <- metadata <$> getState
let (Pandoc _ blocks) = doc $ mconcat bs
return $ Pandoc meta blocks
parseBlock :: PandocMonad m => ManParser m Blocks
parseBlock :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlock = [ParsecT [RoffToken] ManState m Blocks]
-> ParsecT [RoffToken] ManState m Blocks
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseList
, ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseDefinitionList
, ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseHeader
, ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseTable
, ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseTitle
, ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseCodeBlock
, ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlockQuote
, ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseNewParagraph
, ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parsePara
, ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
skipUnknownMacro
]
parseTable :: PandocMonad m => ManParser m Blocks
parseTable :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseTable = do
(ManState -> ManState) -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ManState -> ManState) -> ParsecT [RoffToken] ManState m ())
-> (ManState -> ManState) -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ \ManState
st -> ManState
st { tableCellsPlain = True }
let isTbl :: RoffToken -> Bool
isTbl Tbl{} = Bool
True
isTbl RoffToken
_ = Bool
False
Tbl _opts rows pos <- (RoffToken -> Bool) -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isTbl
case rows of
(([CellFormat]
as,[RoffTokens]
_):[TableRow]
_) -> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
let as' :: [Maybe Alignment]
as' = (CellFormat -> Maybe Alignment)
-> [CellFormat] -> [Maybe Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Maybe Alignment
columnTypeToAlignment (Char -> Maybe Alignment)
-> (CellFormat -> Char) -> CellFormat -> Maybe Alignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellFormat -> Char
columnType) [CellFormat]
as
Bool -> ParsecT [RoffToken] ManState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [RoffToken] ManState m ())
-> Bool -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ (Maybe Alignment -> Bool) -> [Maybe Alignment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe Alignment -> Bool
forall a. Maybe a -> Bool
isJust [Maybe Alignment]
as'
let alignments :: [Alignment]
alignments = [Maybe Alignment] -> [Alignment]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Alignment]
as'
let (TableRow
headerRow', [TableRow]
bodyRows') =
case [TableRow]
rows of
(TableRow
h:TableRow
x:[TableRow]
bs)
| TableRow -> Bool
isHrule TableRow
x -> (TableRow
h, [TableRow]
bs)
[TableRow]
_ -> (([],[]), [TableRow]
rows)
headerRow <- (RoffTokens -> ParsecT [RoffToken] ManState m Blocks)
-> [RoffTokens] -> ParsecT [RoffToken] ManState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RoffTokens -> ParsecT [RoffToken] ManState m Blocks
forall {m :: * -> *} {s}.
PandocMonad m =>
RoffTokens -> ParsecT s ManState m Blocks
parseTableCell ([RoffTokens] -> ParsecT [RoffToken] ManState m [Blocks])
-> [RoffTokens] -> ParsecT [RoffToken] ManState m [Blocks]
forall a b. (a -> b) -> a -> b
$ TableRow -> [RoffTokens]
forall a b. (a, b) -> b
snd TableRow
headerRow'
bodyRows <- mapM (mapM parseTableCell . snd) bodyRows'
isPlainTable <- tableCellsPlain <$> getState
let widths = if Bool
isPlainTable
then ColWidth -> [ColWidth]
forall a. a -> [a]
repeat ColWidth
ColWidthDefault
else ColWidth -> [ColWidth]
forall a. a -> [a]
repeat (ColWidth -> [ColWidth]) -> ColWidth -> [ColWidth]
forall a b. (a -> b) -> a -> b
$ Double -> ColWidth
ColWidth (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Alignment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
alignments))
return $ B.table B.emptyCaption (zip alignments widths)
(TableHead nullAttr $ toHeaderRow headerRow)
[TableBody nullAttr 0 [] $ map toRow bodyRows]
(TableFoot nullAttr [])) ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> SourcePos -> ParsecT [RoffToken] ManState m Blocks
forall {m :: * -> *}. PandocMonad m => SourcePos -> m Blocks
fallback SourcePos
pos
[] -> SourcePos -> ParsecT [RoffToken] ManState m Blocks
forall {m :: * -> *}. PandocMonad m => SourcePos -> m Blocks
fallback SourcePos
pos
where
parseTableCell :: RoffTokens -> ParsecT s ManState m Blocks
parseTableCell RoffTokens
ts = do
st <- ParsecT s ManState m ManState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
let ts' = Seq RoffToken -> [RoffToken]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq RoffToken -> [RoffToken]) -> Seq RoffToken -> [RoffToken]
forall a b. (a -> b) -> a -> b
$ RoffTokens -> Seq RoffToken
unRoffTokens RoffTokens
ts
let plaintcell = ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks)
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall a b. (a -> b) -> a -> b
$ do
ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
Inlines -> Blocks
plain (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines (Inlines -> Blocks)
-> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInlines ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m Inlines
forall a b.
ParsecT [RoffToken] ManState m a
-> ParsecT [RoffToken] ManState m b
-> ParsecT [RoffToken] ManState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
let blockstcell = ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks)
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall a b. (a -> b) -> a -> b
$ do
ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
[Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [RoffToken] ManState m [Blocks]
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m [Blocks]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlock ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m Blocks
forall a b.
ParsecT [RoffToken] ManState m a
-> ParsecT [RoffToken] ManState m b
-> ParsecT [RoffToken] ManState m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
res <- if null ts'
then return $ Right mempty
else lift $ readWithMTokens plaintcell st ts'
case res of
Left ParseError
_ -> do
res' <- m (Either ParseError Blocks)
-> ParsecT s ManState m (Either ParseError Blocks)
forall (m :: * -> *) a. Monad m => m a -> ParsecT s ManState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either ParseError Blocks)
-> ParsecT s ManState m (Either ParseError Blocks))
-> m (Either ParseError Blocks)
-> ParsecT s ManState m (Either ParseError Blocks)
forall a b. (a -> b) -> a -> b
$ ParsecT [RoffToken] ManState m Blocks
-> ManState -> [RoffToken] -> m (Either ParseError Blocks)
forall (m :: * -> *) a.
PandocMonad m =>
ParsecT [RoffToken] ManState m a
-> ManState -> [RoffToken] -> m (Either ParseError a)
readWithMTokens ParsecT [RoffToken] ManState m Blocks
blockstcell ManState
st [RoffToken]
ts'
case res' of
Left ParseError
_ -> String -> ParsecT s ManState m Blocks
forall a. String -> ParsecT s ManState m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"Could not parse table cell"
Right Blocks
x -> do
(ManState -> ManState) -> ParsecT s ManState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((ManState -> ManState) -> ParsecT s ManState m ())
-> (ManState -> ManState) -> ParsecT s ManState m ()
forall a b. (a -> b) -> a -> b
$ \ManState
s -> ManState
s{ tableCellsPlain = False }
Blocks -> ParsecT s ManState m Blocks
forall a. a -> ParsecT s ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
x
Right Blocks
x -> Blocks -> ParsecT s ManState m Blocks
forall a. a -> ParsecT s ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
x
isHrule :: TableRow -> Bool
isHrule :: TableRow -> Bool
isHrule ([CellFormat
cellfmt], [RoffTokens]
_) = CellFormat -> Char
columnType CellFormat
cellfmt Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'_',Char
'-',Char
'=']
isHrule ([CellFormat]
_, [RoffTokens Seq RoffToken
ss]) =
case Seq RoffToken -> [RoffToken]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq RoffToken
ss of
[TextLine [RoffStr (Text -> String
T.unpack -> [Char
c])]] -> Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'_',Char
'-',Char
'=']
[RoffToken]
_ -> Bool
False
isHrule TableRow
_ = Bool
False
fallback :: SourcePos -> m Blocks
fallback SourcePos
pos = do
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
"TABLE" SourcePos
pos
Blocks -> m Blocks
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Text -> Inlines
B.text Text
"TABLE")
columnTypeToAlignment :: Char -> Maybe Alignment
columnTypeToAlignment :: Char -> Maybe Alignment
columnTypeToAlignment Char
c =
case Char -> Char
toLower Char
c of
Char
'a' -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
AlignLeft
Char
'c' -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
AlignCenter
Char
'l' -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
AlignLeft
Char
'n' -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
AlignRight
Char
'r' -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just Alignment
AlignRight
Char
_ -> Maybe Alignment
forall a. Maybe a
Nothing
toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Blocks] -> [Cell]) -> [Blocks] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
simpleCell
toHeaderRow :: [Blocks] -> [Row]
toHeaderRow [Blocks]
l = [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
parseNewParagraph :: PandocMonad m => ManParser m Blocks
parseNewParagraph :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseNewParagraph = do
Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"P" ManParser m RoffToken
-> ManParser m RoffToken -> ManParser m RoffToken
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"PP" ManParser m RoffToken
-> ManParser m RoffToken -> ManParser m RoffToken
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"LP" ManParser m RoffToken
-> ManParser m RoffToken -> ManParser m RoffToken
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
Blocks -> ParsecT [RoffToken] ManState m Blocks
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
msatisfy :: Monad m
=> (RoffToken -> Bool) -> P.ParsecT [RoffToken] st m RoffToken
msatisfy :: forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
predic = (RoffToken -> String)
-> (SourcePos -> RoffToken -> [RoffToken] -> SourcePos)
-> (RoffToken -> Maybe RoffToken)
-> ParsecT [RoffToken] st m RoffToken
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
P.tokenPrim RoffToken -> String
forall a. Show a => a -> String
show SourcePos -> RoffToken -> [RoffToken] -> SourcePos
forall {p}. SourcePos -> p -> [RoffToken] -> SourcePos
nextPos RoffToken -> Maybe RoffToken
testTok
where
testTok :: RoffToken -> Maybe RoffToken
testTok RoffToken
t = if RoffToken -> Bool
predic RoffToken
t then RoffToken -> Maybe RoffToken
forall a. a -> Maybe a
Just RoffToken
t else Maybe RoffToken
forall a. Maybe a
Nothing
nextPos :: SourcePos -> p -> [RoffToken] -> SourcePos
nextPos SourcePos
_pos p
_x (ControlLine Text
_ [[LinePart]]
_ SourcePos
pos':[RoffToken]
_) = SourcePos
pos'
nextPos SourcePos
pos p
_x [RoffToken]
_xs = SourcePos -> String -> SourcePos
P.updatePosString
(SourcePos -> Int -> SourcePos
P.setSourceColumn
(SourcePos -> Int -> SourcePos
P.setSourceLine SourcePos
pos (Int -> SourcePos) -> Int -> SourcePos
forall a b. (a -> b) -> a -> b
$
SourcePos -> Int
P.sourceLine SourcePos
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
1) String
""
mtoken :: PandocMonad m => ManParser m RoffToken
mtoken :: forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mtoken = (RoffToken -> Bool) -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy (Bool -> RoffToken -> Bool
forall a b. a -> b -> a
const Bool
True)
mline :: PandocMonad m => ManParser m RoffToken
mline :: forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mline = (RoffToken -> Bool) -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isTextLine where
isTextLine :: RoffToken -> Bool
isTextLine (TextLine [LinePart]
_) = Bool
True
isTextLine RoffToken
_ = Bool
False
memptyLine :: PandocMonad m => ManParser m RoffToken
memptyLine :: forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine = (RoffToken -> Bool) -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isEmptyLine where
isEmptyLine :: RoffToken -> Bool
isEmptyLine RoffToken
EmptyLine = Bool
True
isEmptyLine RoffToken
_ = Bool
False
mmacro :: PandocMonad m => T.Text -> ManParser m RoffToken
mmacro :: forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
mk = (RoffToken -> Bool) -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isControlLine where
isControlLine :: RoffToken -> Bool
isControlLine (ControlLine Text
mk' [[LinePart]]
_ SourcePos
_) | Text
mk Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
mk' = Bool
True
| Bool
otherwise = Bool
False
isControlLine RoffToken
_ = Bool
False
mmacroAny :: PandocMonad m => ManParser m RoffToken
mmacroAny :: forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mmacroAny = (RoffToken -> Bool) -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isControlLine where
isControlLine :: RoffToken -> Bool
isControlLine ControlLine{} = Bool
True
isControlLine RoffToken
_ = Bool
False
parseTitle :: PandocMonad m => ManParser m Blocks
parseTitle :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseTitle = do
(ControlLine _ args _) <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"TH"
let adjustMeta =
case [[LinePart]]
args of
([LinePart]
x:[LinePart]
y:[LinePart]
z:[[LinePart]]
_) -> Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"title" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x) (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"section" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
y) (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"date" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
z)
[[LinePart]
x,[LinePart]
y] -> Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"title" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x) (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"section" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
y)
[[LinePart]
x] -> Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"title" ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x)
[] -> Meta -> Meta
forall a. a -> a
id
updateState $ \ManState
st -> ManState
st{ metadata = adjustMeta $ metadata st }
return mempty
linePartsToInlines :: [LinePart] -> Inlines
linePartsToInlines :: [LinePart] -> Inlines
linePartsToInlines = Bool -> [LinePart] -> Inlines
go Bool
False
where
go :: Bool -> [LinePart] -> Inlines
go :: Bool -> [LinePart] -> Inlines
go Bool
_ [] = Inlines
forall a. Monoid a => a
mempty
go Bool
mono (MacroArg Int
_:[LinePart]
xs) = Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
xs
go Bool
mono (RoffStr Text
s : RoffStr Text
t : [LinePart]
xs) = Bool -> [LinePart] -> Inlines
go Bool
mono (Text -> LinePart
RoffStr (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)LinePart -> [LinePart] -> [LinePart]
forall a. a -> [a] -> [a]
:[LinePart]
xs)
go Bool
mono (RoffStr Text
s : [LinePart]
xs)
| Bool
mono = Text -> Inlines
code Text
s Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
xs
| Bool
otherwise = Text -> Inlines
text Text
s Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
xs
go Bool
mono (Font FontSpec
fs: [LinePart]
xs)
| Int
litals Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
litals Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lbolds Bool -> Bool -> Bool
&& Int
litals Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lmonos
= (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
emph (Bool -> [LinePart] -> Inlines
go Bool
mono (FontSpec -> LinePart
Font FontSpec
fs{ fontItalic = False } LinePart -> [LinePart] -> [LinePart]
forall a. a -> [a] -> [a]
:
(LinePart -> LinePart) -> [LinePart] -> [LinePart]
forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\FontSpec
s -> FontSpec
s{ fontItalic = False }))
[LinePart]
itals)) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
italsrest
| Int
lbolds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
lbolds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lmonos
= (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
strong (Bool -> [LinePart] -> Inlines
go Bool
mono (FontSpec -> LinePart
Font FontSpec
fs{ fontBold = False } LinePart -> [LinePart] -> [LinePart]
forall a. a -> [a] -> [a]
:
(LinePart -> LinePart) -> [LinePart] -> [LinePart]
forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\FontSpec
s -> FontSpec
s{ fontBold = False }))
[LinePart]
bolds)) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
boldsrest
| Int
lmonos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
= Bool -> [LinePart] -> Inlines
go Bool
True (FontSpec -> LinePart
Font FontSpec
fs{ fontMonospace = False } LinePart -> [LinePart] -> [LinePart]
forall a. a -> [a] -> [a]
:
(LinePart -> LinePart) -> [LinePart] -> [LinePart]
forall a b. (a -> b) -> [a] -> [b]
map ((FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec (\FontSpec
s -> FontSpec
s { fontMonospace = False }))
[LinePart]
monos) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
monosrest
| Bool
otherwise = Bool -> [LinePart] -> Inlines
go Bool
mono [LinePart]
xs
where
adjustFontSpec :: (FontSpec -> FontSpec) -> LinePart -> LinePart
adjustFontSpec FontSpec -> FontSpec
f (Font FontSpec
fspec) = FontSpec -> LinePart
Font (FontSpec -> FontSpec
f FontSpec
fspec)
adjustFontSpec FontSpec -> FontSpec
_ LinePart
x = LinePart
x
withFont :: (FontSpec -> Bool) -> LinePart -> Bool
withFont FontSpec -> Bool
f (Font FontSpec
fspec) = FontSpec -> Bool
f FontSpec
fspec
withFont FontSpec -> Bool
_ LinePart
_ = Bool
False
litals :: Int
litals = [LinePart] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LinePart]
itals
lbolds :: Int
lbolds = [LinePart] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LinePart]
bolds
lmonos :: Int
lmonos = [LinePart] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LinePart]
monos
([LinePart]
itals, [LinePart]
italsrest) =
if FontSpec -> Bool
fontItalic FontSpec
fs
then (LinePart -> Bool) -> [LinePart] -> ([LinePart], [LinePart])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((FontSpec -> Bool) -> LinePart -> Bool
withFont (Bool -> Bool
not (Bool -> Bool) -> (FontSpec -> Bool) -> FontSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSpec -> Bool
fontItalic)) [LinePart]
xs
else ([], [LinePart]
xs)
([LinePart]
bolds, [LinePart]
boldsrest) =
if FontSpec -> Bool
fontBold FontSpec
fs
then (LinePart -> Bool) -> [LinePart] -> ([LinePart], [LinePart])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((FontSpec -> Bool) -> LinePart -> Bool
withFont (Bool -> Bool
not (Bool -> Bool) -> (FontSpec -> Bool) -> FontSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSpec -> Bool
fontBold)) [LinePart]
xs
else ([], [LinePart]
xs)
([LinePart]
monos, [LinePart]
monosrest) =
if FontSpec -> Bool
fontMonospace FontSpec
fs
then (LinePart -> Bool) -> [LinePart] -> ([LinePart], [LinePart])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((FontSpec -> Bool) -> LinePart -> Bool
withFont (Bool -> Bool
not (Bool -> Bool) -> (FontSpec -> Bool) -> FontSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSpec -> Bool
fontMonospace)) [LinePart]
xs
else ([], [LinePart]
xs)
parsePara :: PandocMonad m => ManParser m Blocks
parsePara :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parsePara = Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
trimInlines (Inlines -> Blocks)
-> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInlines
parseInlines :: PandocMonad m => ManParser m Inlines
parseInlines :: forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInlines = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space ([Inlines] -> Inlines)
-> ParsecT [RoffToken] ManState m [Inlines]
-> ParsecT [RoffToken] ManState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInline
parseInline :: PandocMonad m => ManParser m Inlines
parseInline :: forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInline = ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m Inlines
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m Inlines)
-> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m Inlines
forall a b. (a -> b) -> a -> b
$ do
tok <- ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mtoken
case tok of
TextLine [LinePart]
lparts -> Inlines -> ParsecT [RoffToken] ManState m Inlines
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT [RoffToken] ManState m Inlines)
-> Inlines -> ParsecT [RoffToken] ManState m Inlines
forall a b. (a -> b) -> a -> b
$ [LinePart] -> Inlines
linePartsToInlines [LinePart]
lparts
ControlLine Text
mname [[LinePart]]
args SourcePos
pos -> Text
-> [[LinePart]]
-> SourcePos
-> ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> [[LinePart]] -> SourcePos -> ManParser m Inlines
handleInlineMacro Text
mname [[LinePart]]
args SourcePos
pos
RoffToken
_ -> ParsecT [RoffToken] ManState m Inlines
forall a. ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
handleInlineMacro :: PandocMonad m
=> T.Text -> [Arg] -> SourcePos -> ManParser m Inlines
handleInlineMacro :: forall (m :: * -> *).
PandocMonad m =>
Text -> [[LinePart]] -> SourcePos -> ManParser m Inlines
handleInlineMacro Text
mname [[LinePart]]
args SourcePos
_pos =
case Text
mname of
Text
"UR" -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseLink [[LinePart]]
args
Text
"MT" -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseEmailLink [[LinePart]]
args
Text
"B" -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseBold [[LinePart]]
args
Text
"I" -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseItalic [[LinePart]]
args
Text
"br" -> Inlines -> ManParser m Inlines
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
linebreak
Text
"BI" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
strong, Inlines -> Inlines
emph] [[LinePart]]
args
Text
"IB" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
emph, Inlines -> Inlines
strong] [[LinePart]]
args
Text
"IR" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
emph, Inlines -> Inlines
forall a. a -> a
id] [[LinePart]]
args
Text
"RI" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
forall a. a -> a
id, Inlines -> Inlines
emph] [[LinePart]]
args
Text
"BR" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
strong, Inlines -> Inlines
forall a. a -> a
id] [[LinePart]]
args
Text
"RB" -> [Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines
forall a. a -> a
id, Inlines -> Inlines
strong] [[LinePart]]
args
Text
"SY" -> Inlines -> ManParser m Inlines
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
strong (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space
([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ ([LinePart] -> Inlines) -> [[LinePart]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [LinePart] -> Inlines
linePartsToInlines [[LinePart]]
args
Text
"YS" -> Inlines -> ManParser m Inlines
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Text
"OP" -> case [[LinePart]]
args of
([LinePart]
x:[[LinePart]]
ys) -> Inlines -> ManParser m Inlines
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ManParser m Inlines) -> Inlines -> ManParser m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"[" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
[Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ((Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
strong ([LinePart] -> Inlines
linePartsToInlines [LinePart]
x) Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
:
([LinePart] -> Inlines) -> [[LinePart]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map ((Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> ([LinePart] -> Inlines) -> [LinePart] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LinePart] -> Inlines
linePartsToInlines) [[LinePart]]
ys)
Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"]"
[] -> Inlines -> ManParser m Inlines
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Text
_ -> ManParser m Inlines
forall a. ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
parseBold :: PandocMonad m => [Arg] -> ManParser m Inlines
parseBold :: forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseBold [] = do
TextLine lparts <- ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mline
return $ extractSpaces strong $ linePartsToInlines lparts
parseBold [[LinePart]]
args = Inlines -> ParsecT [RoffToken] ManState m Inlines
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT [RoffToken] ManState m Inlines)
-> Inlines -> ParsecT [RoffToken] ManState m Inlines
forall a b. (a -> b) -> a -> b
$
(Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
strong (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$
[Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ ([LinePart] -> Inlines) -> [[LinePart]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [LinePart] -> Inlines
linePartsToInlines [[LinePart]]
args
parseItalic :: PandocMonad m => [Arg] -> ManParser m Inlines
parseItalic :: forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseItalic [] = do
TextLine lparts <- ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mline
return $ extractSpaces emph $ linePartsToInlines lparts
parseItalic [[LinePart]]
args = Inlines -> ParsecT [RoffToken] ManState m Inlines
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT [RoffToken] ManState m Inlines)
-> Inlines -> ParsecT [RoffToken] ManState m Inlines
forall a b. (a -> b) -> a -> b
$
(Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
emph (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$
[Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.space ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ ([LinePart] -> Inlines) -> [[LinePart]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [LinePart] -> Inlines
linePartsToInlines [[LinePart]]
args
parseAlternatingFonts :: [Inlines -> Inlines]
-> [Arg]
-> ManParser m Inlines
parseAlternatingFonts :: forall (m :: * -> *).
[Inlines -> Inlines] -> [[LinePart]] -> ManParser m Inlines
parseAlternatingFonts [Inlines -> Inlines]
constructors [[LinePart]]
args = Inlines -> ParsecT [RoffToken] ManState m Inlines
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> ParsecT [RoffToken] ManState m Inlines)
-> Inlines -> ParsecT [RoffToken] ManState m Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$
((Inlines -> Inlines) -> [LinePart] -> Inlines)
-> [Inlines -> Inlines] -> [[LinePart]] -> [Inlines]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Inlines -> Inlines
f [LinePart]
arg -> Inlines -> Inlines
f ([LinePart] -> Inlines
linePartsToInlines [LinePart]
arg)) ([Inlines -> Inlines] -> [Inlines -> Inlines]
forall a. HasCallStack => [a] -> [a]
cycle [Inlines -> Inlines]
constructors) [[LinePart]]
args
lineInl :: PandocMonad m => ManParser m Inlines
lineInl :: forall (m :: * -> *). PandocMonad m => ManParser m Inlines
lineInl = do
(TextLine fragments) <- ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mline
return $ linePartsToInlines fragments
bareIP :: PandocMonad m => ManParser m RoffToken
bareIP :: forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
bareIP = (RoffToken -> Bool) -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isBareIP where
isBareIP :: RoffToken -> Bool
isBareIP (ControlLine Text
"IP" [] SourcePos
_) = Bool
True
isBareIP RoffToken
_ = Bool
False
endmacro :: PandocMonad m => T.Text -> ManParser m ()
endmacro :: forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
name = ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
name)
ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT [RoffToken] ManState m RoffToken
forall {st}. ParsecT [RoffToken] st m RoffToken
newBlockMacro)
ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
where
newBlockMacro :: ParsecT [RoffToken] st m RoffToken
newBlockMacro = (RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
forall (m :: * -> *) st.
Monad m =>
(RoffToken -> Bool) -> ParsecT [RoffToken] st m RoffToken
msatisfy RoffToken -> Bool
isNewBlockMacro
isNewBlockMacro :: RoffToken -> Bool
isNewBlockMacro (ControlLine Text
"SH" [[LinePart]]
_ SourcePos
_) = Bool
True
isNewBlockMacro (ControlLine Text
"SS" [[LinePart]]
_ SourcePos
_) = Bool
True
isNewBlockMacro RoffToken
_ = Bool
False
parseCodeBlock :: PandocMonad m => ManParser m Blocks
parseCodeBlock :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseCodeBlock = ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks)
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall a b. (a -> b) -> a -> b
$ do
ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
bareIP
ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Text -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"in")
toks <- (Text -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"nf" ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m [Maybe Text]
-> ParsecT [RoffToken] ManState m [Maybe Text]
forall a b.
ParsecT [RoffToken] ManState m a
-> ParsecT [RoffToken] ManState m b
-> ParsecT [RoffToken] ManState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [RoffToken] ManState m (Maybe Text)
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m [Maybe Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [RoffToken] ManState m (Maybe Text)
codeline (Text -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
"fi"))
ParsecT [RoffToken] ManState m [Maybe Text]
-> ParsecT [RoffToken] ManState m [Maybe Text]
-> ParsecT [RoffToken] ManState m [Maybe Text]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text -> ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"EX" ParsecT [RoffToken] ManState m RoffToken
-> ParsecT [RoffToken] ManState m [Maybe Text]
-> ParsecT [RoffToken] ManState m [Maybe Text]
forall a b.
ParsecT [RoffToken] ManState m a
-> ParsecT [RoffToken] ManState m b
-> ParsecT [RoffToken] ManState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT [RoffToken] ManState m (Maybe Text)
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m [Maybe Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [RoffToken] ManState m (Maybe Text)
codeline (Text -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
"EE"))
optional (mmacro "in")
return $ codeBlock (T.intercalate "\n" $ catMaybes toks)
where
codeline :: ParsecT [RoffToken] ManState m (Maybe Text)
codeline = do
tok <- ParsecT [RoffToken] ManState m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mtoken
case tok of
ControlLine Text
"PP" [[LinePart]]
_ SourcePos
_ -> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text))
-> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
ControlLine Text
mname [[LinePart]]
args SourcePos
pos ->
(Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Inlines -> Text) -> Inlines -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Text) -> Inlines -> Text
forall c. Monoid c => (Inline -> c) -> Inlines -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
getText (Inlines -> Maybe Text)
-> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> [[LinePart]]
-> SourcePos
-> ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *).
PandocMonad m =>
Text -> [[LinePart]] -> SourcePos -> ManParser m Inlines
handleInlineMacro Text
mname [[LinePart]]
args SourcePos
pos) ParsecT [RoffToken] ManState m (Maybe Text)
-> ParsecT [RoffToken] ManState m (Maybe Text)
-> ParsecT [RoffToken] ManState m (Maybe Text)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
do LogMessage -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [RoffToken] ManState m ())
-> LogMessage -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mname) SourcePos
pos
Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
Tbl [TableOption]
_ [TableRow]
_ SourcePos
pos -> do
LogMessage -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [RoffToken] ManState m ())
-> LogMessage -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent Text
"TABLE" SourcePos
pos
Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text))
-> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"TABLE"
RoffToken
EmptyLine -> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text))
-> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
TextLine [LinePart]
ss
| Bool -> Bool
not ([LinePart] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LinePart]
ss)
, (LinePart -> Bool) -> [LinePart] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LinePart -> Bool
isFontToken [LinePart]
ss -> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
| Bool
otherwise -> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text))
-> Maybe Text -> ParsecT [RoffToken] ManState m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [LinePart] -> Text
linePartsToText [LinePart]
ss
isFontToken :: LinePart -> Bool
isFontToken Font{} = Bool
True
isFontToken LinePart
_ = Bool
False
getText :: Inline -> T.Text
getText :: Inline -> Text
getText (Str Text
s) = Text
s
getText Inline
Space = Text
" "
getText (Code Attr
_ Text
s) = Text
s
getText Inline
SoftBreak = Text
"\n"
getText Inline
LineBreak = Text
"\n"
getText Inline
_ = Text
""
parseHeader :: PandocMonad m => ManParser m Blocks
= do
ControlLine name args _ <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"SH" ManParser m RoffToken
-> ManParser m RoffToken -> ManParser m RoffToken
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"SS"
contents <- if null args
then option mempty lineInl
else return $ mconcat $ intersperse B.space
$ map linePartsToInlines args
let lvl = if Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"SH" then Int
1 else Int
2
return $ header lvl contents
parseBlockQuote :: PandocMonad m => ManParser m Blocks
parseBlockQuote :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlockQuote = Blocks -> Blocks
blockQuote (Blocks -> Blocks)
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
( (Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"RS" ManParser m RoffToken
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall a b.
ParsecT [RoffToken] ManState m a
-> ParsecT [RoffToken] ManState m b
-> ParsecT [RoffToken] ManState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [RoffToken] ManState m [Blocks]
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m [Blocks]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlock (Text -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
"RE")))
ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [RoffToken] ManState m Blocks
parseIndentedParagraphs
)
where
parseIndentedParagraphs :: ParsecT [RoffToken] ManState m Blocks
parseIndentedParagraphs = ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks)
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall a b. (a -> b) -> a -> b
$ do
ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
bareIP
first <- ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parsePara ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseCodeBlock
rest <- many $ try (memptyLine *> (parsePara <|> parseCodeBlock))
pure (first <> mconcat rest)
data ListType = Ordered ListAttributes
| Bullet
| Definition T.Text
listTypeMatches :: Maybe ListType -> ListType -> Bool
listTypeMatches :: Maybe ListType -> ListType -> Bool
listTypeMatches Maybe ListType
Nothing ListType
_ = Bool
True
listTypeMatches (Just ListType
Bullet) ListType
Bullet = Bool
True
listTypeMatches (Just (Ordered (Int
_,ListNumberStyle
x,ListNumberDelim
y))) (Ordered (Int
_,ListNumberStyle
x',ListNumberDelim
y'))
= ListNumberStyle
x ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberStyle
x' Bool -> Bool -> Bool
&& ListNumberDelim
y ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
y'
listTypeMatches (Just (Definition Text
_)) (Definition Text
_) = Bool
True
listTypeMatches (Just ListType
_) ListType
_ = Bool
False
listItem :: PandocMonad m => Maybe ListType -> ManParser m (ListType, Blocks)
listItem :: forall (m :: * -> *).
PandocMonad m =>
Maybe ListType -> ManParser m (ListType, Blocks)
listItem Maybe ListType
mbListType = ParsecT [RoffToken] ManState m (ListType, Blocks)
-> ParsecT [RoffToken] ManState m (ListType, Blocks)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [RoffToken] ManState m (ListType, Blocks)
-> ParsecT [RoffToken] ManState m (ListType, Blocks))
-> ParsecT [RoffToken] ManState m (ListType, Blocks)
-> ParsecT [RoffToken] ManState m (ListType, Blocks)
forall a b. (a -> b) -> a -> b
$ do
(ControlLine _ args _) <- Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"IP"
case args of
([LinePart]
arg1 : [[LinePart]]
_) -> do
let cs :: Text
cs = [LinePart] -> Text
linePartsToText [LinePart]
arg1
let cs' :: Text
cs' = if Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
cs Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')') Text
cs) then Text
cs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." else Text
cs
let lt :: ListType
lt = case Parsec Text ParserState (Int, ListNumberStyle, ListNumberDelim)
-> ParserState
-> String
-> Text
-> Either ParseError (Int, ListNumberStyle, ListNumberDelim)
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parsec Text ParserState (Int, ListNumberStyle, ListNumberDelim)
forall s (m :: * -> *).
(Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s ParserState m (Int, ListNumberStyle, ListNumberDelim)
anyOrderedListMarker ParserState
defaultParserState
String
"list marker" Text
cs' of
Right (Int
start, ListNumberStyle
listtype, ListNumberDelim
listdelim)
| Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
cs' -> (Int, ListNumberStyle, ListNumberDelim) -> ListType
Ordered (Int
start, ListNumberStyle
listtype, ListNumberDelim
listdelim)
| Bool
otherwise -> (Int, ListNumberStyle, ListNumberDelim) -> ListType
Ordered (Int
start, ListNumberStyle
listtype, ListNumberDelim
DefaultDelim)
Left ParseError
_
| Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\183" Bool -> Bool -> Bool
|| Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"-" Bool -> Bool -> Bool
|| Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"*" Bool -> Bool -> Bool
|| Text
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"+"
-> ListType
Bullet
| Bool
otherwise -> Text -> ListType
Definition Text
cs
Bool -> ParsecT [RoffToken] ManState m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [RoffToken] ManState m ())
-> Bool -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ Maybe ListType -> ListType -> Bool
listTypeMatches Maybe ListType
mbListType ListType
lt
ManParser m RoffToken -> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
inls <- Inlines
-> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m Inlines
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Inlines
forall a. Monoid a => a
mempty ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInlines
skipMany memptyLine
continuations <- mconcat <$> many continuation
return (lt, para inls <> continuations)
[] -> ParsecT [RoffToken] ManState m (ListType, Blocks)
forall a. ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
parseList :: PandocMonad m => ManParser m Blocks
parseList :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseList = ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks)
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall a b. (a -> b) -> a -> b
$ do
x@(lt, _) <- Maybe ListType -> ManParser m (ListType, Blocks)
forall (m :: * -> *).
PandocMonad m =>
Maybe ListType -> ManParser m (ListType, Blocks)
listItem Maybe ListType
forall a. Maybe a
Nothing
xs <- many (listItem (Just lt))
let toDefItem (Definition Text
t, a
bs) = (Text -> Inlines
B.text Text
t, [a
bs])
toDefItem (ListType, a)
_ = (Inlines, [a])
forall a. Monoid a => a
mempty
return $ case lt of
ListType
Bullet -> [Blocks] -> Blocks
bulletList ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ ((ListType, Blocks) -> Blocks) -> [(ListType, Blocks)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (ListType, Blocks) -> Blocks
forall a b. (a, b) -> b
snd ((ListType, Blocks)
x(ListType, Blocks) -> [(ListType, Blocks)] -> [(ListType, Blocks)]
forall a. a -> [a] -> [a]
:[(ListType, Blocks)]
xs)
Ordered (Int, ListNumberStyle, ListNumberDelim)
lattr -> (Int, ListNumberStyle, ListNumberDelim) -> [Blocks] -> Blocks
orderedListWith (Int, ListNumberStyle, ListNumberDelim)
lattr ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall a b. (a -> b) -> a -> b
$ ((ListType, Blocks) -> Blocks) -> [(ListType, Blocks)] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (ListType, Blocks) -> Blocks
forall a b. (a, b) -> b
snd ((ListType, Blocks)
x(ListType, Blocks) -> [(ListType, Blocks)] -> [(ListType, Blocks)]
forall a. a -> [a] -> [a]
:[(ListType, Blocks)]
xs)
Definition Text
_ -> [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> [(Inlines, [Blocks])] -> Blocks
forall a b. (a -> b) -> a -> b
$ ((ListType, Blocks) -> (Inlines, [Blocks]))
-> [(ListType, Blocks)] -> [(Inlines, [Blocks])]
forall a b. (a -> b) -> [a] -> [b]
map (ListType, Blocks) -> (Inlines, [Blocks])
forall {a}. (ListType, a) -> (Inlines, [a])
toDefItem ((ListType, Blocks)
x(ListType, Blocks) -> [(ListType, Blocks)] -> [(ListType, Blocks)]
forall a. a -> [a] -> [a]
:[(ListType, Blocks)]
xs)
continuation :: PandocMonad m => ManParser m Blocks
continuation :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
continuation =
(Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"RS" ManParser m RoffToken
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall a b.
ParsecT [RoffToken] ManState m a
-> ParsecT [RoffToken] ManState m b
-> ParsecT [RoffToken] ManState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> ParsecT [RoffToken] ManState m [Blocks]
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m ()
-> ParsecT [RoffToken] ManState m [Blocks]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseBlock (Text -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => Text -> ManParser m ()
endmacro Text
"RE")))
ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine ManParser m RoffToken
-> ManParser m RoffToken -> ManParser m RoffToken
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
bareIP) ManParser m RoffToken
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall a b.
ParsecT [RoffToken] ManState m a
-> ParsecT [RoffToken] ManState m b
-> ParsecT [RoffToken] ManState m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parsePara ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
-> ParsecT [RoffToken] ManState m Blocks
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [RoffToken] ManState m Blocks
forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseCodeBlock))
definitionListItem :: PandocMonad m
=> ManParser m (Inlines, [Blocks])
definitionListItem :: forall (m :: * -> *).
PandocMonad m =>
ManParser m (Inlines, [Blocks])
definitionListItem = ParsecT [RoffToken] ManState m (Inlines, [Blocks])
-> ParsecT [RoffToken] ManState m (Inlines, [Blocks])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [RoffToken] ManState m (Inlines, [Blocks])
-> ParsecT [RoffToken] ManState m (Inlines, [Blocks]))
-> ParsecT [RoffToken] ManState m (Inlines, [Blocks])
-> ParsecT [RoffToken] ManState m (Inlines, [Blocks])
forall a b. (a -> b) -> a -> b
$ do
Text -> ManParser m RoffToken
forall (m :: * -> *).
PandocMonad m =>
Text -> ManParser m RoffToken
mmacro Text
"TP"
ManParser m RoffToken -> ParsecT [RoffToken] ManState m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
memptyLine
term <- ManParser m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
parseInline
skipMany memptyLine
moreterms <- many $ try $ do
mmacro "TQ"
parseInline
skipMany memptyLine
firstBlock <- parseBlock
otherBlocks <- mconcat <$> many continuation
return ( mconcat (intersperse B.linebreak (term:moreterms))
, [firstBlock <> otherBlocks])
parseDefinitionList :: PandocMonad m => ManParser m Blocks
parseDefinitionList :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
parseDefinitionList = [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> ParsecT [RoffToken] ManState m [(Inlines, [Blocks])]
-> ParsecT [RoffToken] ManState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m (Inlines, [Blocks])
-> ParsecT [RoffToken] ManState m [(Inlines, [Blocks])]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [RoffToken] ManState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
ManParser m (Inlines, [Blocks])
definitionListItem
parseLink :: PandocMonad m => [Arg] -> ManParser m Inlines
parseLink :: forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseLink [[LinePart]]
args = do
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT [RoffToken] ManState m [Inlines]
-> ParsecT [RoffToken] ManState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
lineInl
ControlLine _ endargs _ <- mmacro "UE"
let url = case [[LinePart]]
args of
[] -> Text
""
([LinePart]
x:[[LinePart]]
_) -> [LinePart] -> Text
linePartsToText [LinePart]
x
return $ link url "" contents <>
case endargs of
[] -> Inlines
forall a. Monoid a => a
mempty
([LinePart]
x:[[LinePart]]
_) -> [LinePart] -> Inlines
linePartsToInlines [LinePart]
x
parseEmailLink :: PandocMonad m => [Arg] -> ManParser m Inlines
parseEmailLink :: forall (m :: * -> *).
PandocMonad m =>
[[LinePart]] -> ManParser m Inlines
parseEmailLink [[LinePart]]
args = do
contents <- [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ParsecT [RoffToken] ManState m [Inlines]
-> ParsecT [RoffToken] ManState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [RoffToken] ManState m Inlines
-> ParsecT [RoffToken] ManState m [Inlines]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [RoffToken] ManState m Inlines
forall (m :: * -> *). PandocMonad m => ManParser m Inlines
lineInl
ControlLine _ endargs _ <- mmacro "ME"
let url = case [[LinePart]]
args of
[] -> Text
""
([LinePart]
x:[[LinePart]]
_) -> Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [LinePart] -> Text
linePartsToText [LinePart]
x
return $ link url "" contents <>
case endargs of
[] -> Inlines
forall a. Monoid a => a
mempty
([LinePart]
x:[[LinePart]]
_) -> [LinePart] -> Inlines
linePartsToInlines [LinePart]
x
skipUnknownMacro :: PandocMonad m => ManParser m Blocks
skipUnknownMacro :: forall (m :: * -> *). PandocMonad m => ManParser m Blocks
skipUnknownMacro = do
tok <- ManParser m RoffToken
forall (m :: * -> *). PandocMonad m => ManParser m RoffToken
mmacroAny
case tok of
ControlLine Text
mkind [[LinePart]]
_ SourcePos
pos -> do
LogMessage -> ParsecT [RoffToken] ManState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ParsecT [RoffToken] ManState m ())
-> LogMessage -> ParsecT [RoffToken] ManState m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
SkippedContent (Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mkind) SourcePos
pos
Blocks -> ParsecT [RoffToken] ManState m Blocks
forall a. a -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
RoffToken
_ -> String -> ParsecT [RoffToken] ManState m Blocks
forall a. String -> ParsecT [RoffToken] ManState m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"the impossible happened"