@@ -34,11 +34,13 @@ Conversion of man to 'Pandoc' document.
3434module Text.Pandoc.Readers.Man (readMan) where
3535
3636import Prelude
37+import Data.Char (toLower)
3738import Data.Default (Default)
3839import Control.Monad (liftM, mzero, guard)
40+import Control.Monad.Trans (lift)
3941import Control.Monad.Except (throwError)
4042import Text.Pandoc.Class (PandocMonad(..), report)
41−import Data.Maybe (catMaybes)
43+import Data.Maybe (catMaybes, isJust)
4244import Data.List (intersperse, intercalate)
4345import qualified Data.Text as T
4446import Text.Pandoc.Builder as B
@@ -73,20 +75,18 @@ readMan opts txt = do
7375 (Foldable.toList . unGroffTokens $ tokenz)
7476 either throwError return eitherdoc
7577
76− where
77−
78− readWithMTokens :: PandocMonad m
79− => ParserT [GroffToken] ManState m a -- ^ parser
80− -> ManState -- ^ initial state
81− -> [GroffToken] -- ^ input
82− -> m (Either PandocError a)
83− readWithMTokens parser state input =
84− let leftF = PandocParsecError . intercalate "\n" $ show <$> input
85− in mapLeft leftF `liftM` runParserT parser state "source" input
78+readWithMTokens :: PandocMonad m
79+ => ParserT [GroffToken] ManState m a -- ^ parser
80+ -> ManState -- ^ initial state
81+ -> [GroffToken] -- ^ input
82+ -> m (Either PandocError a)
83+readWithMTokens parser state input =
84+ let leftF = PandocParsecError . intercalate "\n" $ show <$> input
85+ in mapLeft leftF `liftM` runParserT parser state "source" input
8686
87− mapLeft :: (a -> c) -> Either a b -> Either c b
88− mapLeft f (Left x) = Left $ f x
89− mapLeft _ (Right r) = Right r
87+mapLeft :: (a -> c) -> Either a b -> Either c b
88+mapLeft f (Left x) = Left $ f x
89+mapLeft _ (Right r) = Right r
9090
9191
9292parseMan :: PandocMonad m => ManParser m Pandoc
@@ -113,9 +113,55 @@ parseTable :: PandocMonad m => ManParser m Blocks
113113parseTable = do
114114 let isMTable (MTable{}) = True
115115 isMTable _ = False
116− MTable _opts _aligns _rows pos <- msatisfy isMTable
117− report $ SkippedContent "TABLE" pos
118− return $ B.para (B.text "TABLE")
116+ MTable _opts aligns rows pos <- msatisfy isMTable
117+ case aligns of
118+ [as] -> do
119+ let as' = map (columnTypeToAlignment . columnType) as
120+ if all isJust as'
121+ then do
122+ let alignments = catMaybes as'
123+ let (headerRow', bodyRows') =
124+ case rows of
125+ (h:[x]:bs)
126+ | isHrule x -> (h, bs)
127+ _ -> ([], rows)
128+ headerRow <- mapM parseTableCell headerRow'
129+ bodyRows <- mapM (mapM parseTableCell) bodyRows'
130+ return $ B.table mempty (zip alignments (repeat 0.0))
131+ headerRow bodyRows
132+ else fallback pos
133+ _ -> fallback pos
134+
135+ where
136+
137+ parseTableCell ts = do
138+ st <- getState
139+ let ts' = Foldable.toList $ unGroffTokens ts
140+ res <- lift $ readWithMTokens (mconcat <$> many parseBlock <* eof) st ts'
141+ case res of
142+ Left e -> throwError e
143+ Right x -> return x
144+
145+ isHrule :: GroffTokens -> Bool
146+ isHrule (GroffTokens ss) =
147+ case Foldable.toList ss of
148+ [MLine [RoffStr [c]]] -> c `elem` ['_','-','=']
149+ _ -> False
150+
151+ fallback pos = do
152+ report $ SkippedContent "TABLE" pos
153+ return $ B.para (B.text "TABLE")
154+
155+ columnTypeToAlignment :: Char -> Maybe Alignment
156+ columnTypeToAlignment c =
157+ case toLower c of
158+ 'a' -> Just AlignLeft
159+ 'c' -> Just AlignCenter
160+ 'l' -> Just AlignLeft
161+ 'n' -> Just AlignRight
162+ 'r' -> Just AlignRight
163+ _ -> Nothing
164+
119165
120166parseNewParagraph :: PandocMonad m => ManParser m Blocks
121167parseNewParagraph = do