git.iko.soy/typeable/pandoc
on master help sign in
Man reader: handle tables.
8f9ab3dJohn MacFarlane
src/Text/Pandoc/Readers/Man.hs+63−17
compare with master
unifiedsplit
@@ -34,11 +34,13 @@ Conversion of man to 'Pandoc' document.
34module Text.Pandoc.Readers.Man (readMan) where
34module Text.Pandoc.Readers.Man (readMan) where
35
35
36import Prelude
36import Prelude
37+import Data.Char (toLower)
37import Data.Default (Default)
38import Data.Default (Default)
38import Control.Monad (liftM, mzero, guard)
39import Control.Monad (liftM, mzero, guard)
40+import Control.Monad.Trans (lift)
39import Control.Monad.Except (throwError)
41import Control.Monad.Except (throwError)
40import Text.Pandoc.Class (PandocMonad(..), report)
42import Text.Pandoc.Class (PandocMonad(..), report)
41−import Data.Maybe (catMaybes)
43+import Data.Maybe (catMaybes, isJust)
42import Data.List (intersperse, intercalate)
44import Data.List (intersperse, intercalate)
43import qualified Data.Text as T
45import qualified Data.Text as T
44import Text.Pandoc.Builder as B
46import Text.Pandoc.Builder as B
@@ -73,20 +75,18 @@ readMan opts txt = do
73 (Foldable.toList . unGroffTokens $ tokenz)
75 (Foldable.toList . unGroffTokens $ tokenz)
74 either throwError return eitherdoc
76 either throwError return eitherdoc
75
77
76− where
77−
78− readWithMTokens :: PandocMonad m
78+readWithMTokens :: PandocMonad m
79− => ParserT [GroffToken] ManState m a -- ^ parser
79+ => ParserT [GroffToken] ManState m a -- ^ parser
80− -> ManState -- ^ initial state
80+ -> ManState -- ^ initial state
81− -> [GroffToken] -- ^ input
81+ -> [GroffToken] -- ^ input
82− -> m (Either PandocError a)
82+ -> m (Either PandocError a)
83− readWithMTokens parser state input =
83+readWithMTokens parser state input =
84− let leftF = PandocParsecError . intercalate "\n" $ show <$> input
84+ let leftF = PandocParsecError . intercalate "\n" $ show <$> input
85− in mapLeft leftF `liftM` runParserT parser state "source" input
85+ in mapLeft leftF `liftM` runParserT parser state "source" input
86
86
87− mapLeft :: (a -> c) -> Either a b -> Either c b
87+mapLeft :: (a -> c) -> Either a b -> Either c b
88− mapLeft f (Left x) = Left $ f x
88+mapLeft f (Left x) = Left $ f x
89− mapLeft _ (Right r) = Right r
89+mapLeft _ (Right r) = Right r
90
90
91
91
92parseMan :: PandocMonad m => ManParser m Pandoc
92parseMan :: PandocMonad m => ManParser m Pandoc
@@ -113,9 +113,55 @@ parseTable :: PandocMonad m => ManParser m Blocks
113parseTable = do
113parseTable = do
114 let isMTable (MTable{}) = True
114 let isMTable (MTable{}) = True
115 isMTable _ = False
115 isMTable _ = False
116− MTable _opts _aligns _rows pos <- msatisfy isMTable
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
117− report $ SkippedContent "TABLE" pos
152+ report $ SkippedContent "TABLE" pos
118− return $ B.para (B.text "TABLE")
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+
119
165
120parseNewParagraph :: PandocMonad m => ManParser m Blocks
166parseNewParagraph :: PandocMonad m => ManParser m Blocks
121parseNewParagraph = do
167parseNewParagraph = do