@@ -40,6 +40,7 @@ import Control.Monad
4040import Control.Monad.Except (throwError)
4141import Data.Char (chr, isAlphaNum, isLetter, ord)
4242import Data.Text (Text, unpack)
43+import qualified Data.Text as T
4344import Data.List (intercalate, isPrefixOf)
4445import qualified Data.Map as M
4546import Data.Maybe (fromMaybe, maybeToList)
@@ -47,16 +48,373 @@ import Safe (minimumDef)
4748import System.FilePath (addExtension, replaceExtension, takeExtension)
4849import Text.Pandoc.Builder
4950import Text.Pandoc.Class (PandocMonad, PandocPure, lookupEnv, readFileFromDirs,
50− report, setResourcePath, getResourcePath)
51+ report, setResourcePath, getResourcePath,
52+ runIOorExplode, PandocIO)
5153import Text.Pandoc.Highlighting (fromListingsLanguage, languagesByExtension)
5254import Text.Pandoc.ImageSize (numUnit, showFl)
5355import Text.Pandoc.Logging
5456import Text.Pandoc.Options
5557import Text.Pandoc.Parsing hiding (many, mathDisplay, mathInline, optional,
56− space, (<|>))
58+ space, (<|>), spaces, blankline)
5759import Text.Pandoc.Shared
5860import Text.Pandoc.Walk
5961
62+import Text.Pandoc.Extensions (getDefaultExtensions)
63+
64+-- | Parse LaTeX from string and return 'Pandoc' document.
65+readLaTeX :: PandocMonad m
66+ => ReaderOptions -- ^ Reader options
67+ -> Text -- ^ String to parse (assumes @'\n'@ line endings)
68+ -> m Pandoc
69+readLaTeX opts ltx = undefined
70+
71+testParser :: LP PandocIO a -> Text -> IO a
72+testParser p t = do
73+ res <- runIOorExplode (runParserT p defaultParserState{
74+ stateOptions = def{ readerExtensions =
75+ getDefaultExtensions "latex" }} "name" (tokenize t))
76+ case res of
77+ Left e -> error (show e)
78+ Right r -> return r
79+
80+type LP m = ParserT [Tok] ParserState m
81+
82+rawLaTeXBlock :: PandocMonad m => LP m String
83+rawLaTeXBlock = mzero
84+
85+rawLaTeXInline :: PandocMonad m => LP m Inline
86+rawLaTeXInline = mzero
87+
88+inlineCommand :: PandocMonad m => LP m Inlines
89+inlineCommand = mzero
90+
91+data TokType = CtrlSeq | Spaces | Newline | Symbol | Word | Comment |
92+ Esc1 | Esc2
93+ deriving (Eq, Ord, Show)
94+
95+data Tok = Tok (Line, Column) TokType Text
96+ deriving (Eq, Ord, Show)
97+
98+tokenize :: Text -> [Tok]
99+tokenize = totoks (1, 1)
100+
101+totoks :: (Line, Column) -> Text -> [Tok]
102+totoks (lin,col) t =
103+ case T.uncons t of
104+ Nothing -> []
105+ Just (c, rest)
106+ | c == '\n' ->
107+ Tok (lin, col) Newline (T.singleton '\n')
108+ : totoks (lin + 1,1) rest
109+ | isSpaceOrTab c ->
110+ let (sps, rest') = T.span isSpaceOrTab t
111+ in Tok (lin, col) Spaces sps
112+ : totoks (lin, col + T.length sps) rest'
113+ | isAlphaNum c ->
114+ let (ws, rest') = T.span isAlphaNum t
115+ in Tok (lin, col) Word ws
116+ : totoks (lin, col + T.length ws) rest'
117+ | c == '%' ->
118+ let (cs, rest') = T.break (== '\n') rest
119+ in Tok (lin, col) Comment (T.singleton '%' <> cs)
120+ : totoks (lin, col + 1 + T.length cs) rest'
121+ | c == '\\' ->
122+ case T.uncons rest of
123+ Nothing -> [Tok (lin, col) Symbol (T.singleton c)]
124+ Just (d, rest')
125+ | isLetter d ->
126+ let (ws, rest'') = T.span isLetter rest
127+ in Tok (lin, col) CtrlSeq (T.singleton '\\' <> ws)
128+ : totoks (lin, col + 1 + T.length ws) rest''
129+ | d == '\t' || d == '\n' ->
130+ Tok (lin, col) Symbol (T.singleton '\\')
131+ : totoks (lin, col + 1) rest
132+ | otherwise ->
133+ Tok (lin, col) CtrlSeq (T.pack [c,d])
134+ : totoks (lin, col + 2) rest'
135+ | c == '^' ->
136+ case T.uncons rest of
137+ Just ('^', rest') ->
138+ case T.uncons rest' of
139+ Just (d, rest'')
140+ | isLowerHex d ->
141+ case T.uncons rest'' of
142+ Just (e, rest''') | isLowerHex e ->
143+ Tok (lin, col) Esc2 (T.pack ['^','^',d,e])
144+ : totoks (lin, col + 4) rest'''
145+ _ ->
146+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
147+ : totoks (lin, col + 3) rest''
148+ | d < '\128' ->
149+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
150+ : totoks (lin, col + 3) rest''
151+ _ -> [Tok (lin, col) Symbol (T.singleton '^'),
152+ Tok (lin, col + 1) Symbol (T.singleton '^')]
153+ Nothing -> [Tok (lin, col) Symbol (T.singleton '^')]
154+ | otherwise ->
155+ Tok (lin, col) Symbol (T.singleton c) : totoks (lin, col + 1) rest
156+
157+ where isSpaceOrTab ' ' = True
158+ isSpaceOrTab '\t' = True
159+ isSpaceOrTab _ = False
160+
161+isLowerHex :: Char -> Bool
162+isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
163+
164+untokenize :: [Tok] -> Text
165+untokenize = mconcat . map untoken
166+
167+untoken :: Tok -> Text
168+untoken (Tok _ _ t) = t
169+
170+satisfyTok :: Monad m
171+ => (Tok -> Bool)
172+ -> ParserT [Tok] u m Tok
173+satisfyTok f = tokenPrim (T.unpack . untoken) updatePos matcher
174+ where matcher t | f t = Just t
175+ | otherwise = Nothing
176+ updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
177+ updatePos spos _ (Tok (lin,col) _ _ : _) =
178+ setSourceColumn (setSourceLine spos lin) col
179+ updatePos spos _ [] = spos
180+
181+anyControlSeq :: PandocMonad m => LP m Tok
182+anyControlSeq = satisfyTok isCtrlSeq <* spaces
183+ where isCtrlSeq (Tok _ CtrlSeq _) = True
184+ isCtrlSeq _ = False
185+
186+spaces :: PandocMonad m => LP m ()
187+spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
188+
189+spaces1 :: PandocMonad m => LP m ()
190+spaces1 = skipMany1 (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
191+
192+tokTypeIn :: [TokType] -> Tok -> Bool
193+tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes
194+tokTypeIn _ _ = False
195+
196+controlSeq :: PandocMonad m => Text -> LP m Tok
197+controlSeq name = satisfyTok isNamed
198+ where isNamed t@(Tok _ CtrlSeq n) = n == T.singleton '\\' <> name
199+ isNamed _ = False
200+
201+symbol :: PandocMonad m => Char -> LP m Tok
202+symbol c = satisfyTok isc
203+ where isc (Tok _ Symbol d) = case T.uncons d of
204+ Just (c',_) -> c == c'
205+ _ -> False
206+ isc _ = False
207+
208+symbolIn :: PandocMonad m => [Char] -> LP m Tok
209+symbolIn cs = satisfyTok isInCs
210+ where isInCs (Tok _ Symbol d) = case T.uncons d of
211+ Just (c,_) -> c `elem` cs
212+ _ -> False
213+ isInCs _ = False
214+
215+sp :: PandocMonad m => LP m ()
216+sp = whitespace <|> endline
217+
218+whitespace :: PandocMonad m => LP m ()
219+whitespace = () <$ satisfyTok isSpaceTok
220+ where isSpaceTok (Tok _ Spaces _) = True
221+ isSpaceTok _ = False
222+
223+newlineTok :: PandocMonad m => LP m ()
224+newlineTok = () <$ satisfyTok isNewlineTok
225+
226+isNewlineTok :: Tok -> Bool
227+isNewlineTok (Tok _ Newline _) = True
228+isNewlineTok _ = False
229+
230+comment :: PandocMonad m => LP m ()
231+comment = () <$ satisfyTok isCommentTok
232+ where isCommentTok (Tok _ Comment _) = True
233+ isCommentTok _ = False
234+
235+anyTok :: PandocMonad m => LP m Tok
236+anyTok = satisfyTok (const True)
237+
238+endline :: PandocMonad m => LP m ()
239+endline = try $ do
240+ newlineTok
241+ lookAhead anyTok
242+ notFollowedBy blankline
243+
244+blankline :: PandocMonad m => LP m ()
245+blankline = try $ do
246+ skipMany (satisfyTok (tokTypeIn [Spaces, Newline]))
247+ newlineTok
248+
249+primEscape :: PandocMonad m => LP m Char
250+primEscape = do
251+ Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])
252+ case toktype of
253+ Esc1 -> case T.uncons t of
254+ Just (c, _)
255+ | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))
256+ | otherwise -> return (chr (ord c + 64))
257+ Nothing -> fail "Empty content of Esc1"
258+ Esc2 -> case safeRead ('0':'x':T.unpack (T.drop 2 t)) of
259+ Just x -> return (chr x)
260+ Nothing -> fail $ "Could not read: " ++ T.unpack t
261+ _ -> fail "Expected an Esc1 or Esc2 token" -- should not happen
262+
263+bgroup :: PandocMonad m => LP m ()
264+bgroup = try $ do
265+ skipMany sp
266+ symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"
267+ return ()
268+
269+egroup :: PandocMonad m => LP m ()
270+egroup = () <$ (symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup")
271+
272+grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a
273+grouped parser = try $ do
274+ bgroup
275+ -- first we check for an inner 'grouped', because
276+ -- {{a,b}} should be parsed the same as {a,b}
277+ try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)
278+
279+braced :: PandocMonad m => LP m [Tok]
280+braced = try $ do
281+ bgroup
282+ -- {{a,b}} should be parsed the same as {a,b}
283+ try (braced <* egroup) <|> manyTill anyTok egroup
284+
285+bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
286+bracketed parser = try $ do
287+ symbol '['
288+ mconcat <$> manyTill parser (symbol ']')
289+
290+-- inline elements:
291+
292+inlineText :: PandocMonad m => LP m Inlines
293+inlineText = (str . T.unpack . untoken) <$> satisfyTok isWordTok
294+ where isWordTok (Tok _ Word _) = True
295+ isWordTok _ = False
296+
297+inlineGroup :: PandocMonad m => LP m Inlines
298+inlineGroup = do
299+ ils <- grouped inline
300+ if isNull ils
301+ then return mempty
302+ else return $ spanWith nullAttr ils
303+ -- we need the span so we can detitlecase bibtex entries;
304+ -- we need to know when something is {C}apitalized
305+
306+doLHSverb :: PandocMonad m => LP m Inlines
307+doLHSverb =
308+ (codeWith ("",["haskell"],[]) . T.unpack . untokenize)
309+ <$> manyTill (satisfyTok (not . isNewlineTok)) (symbol '|')
310+
311+lit :: String -> LP m Inlines
312+lit = pure . str
313+
314+doubleQuote :: PandocMonad m => LP m Inlines
315+doubleQuote = do
316+ quoted' doubleQuoted (try $ count 2 $ symbol '`')
317+ (void $ try $ count 2 $ symbol '\'')
318+ <|> quoted' doubleQuoted ((:[]) <$> symbol '“') (void $ symbol '”')
319+ -- the following is used by babel for localized quotes:
320+ <|> quoted' doubleQuoted (try $ sequence [symbol '"', symbol '`'])
321+ (void $ try $ sequence [symbol '"', symbol '\''])
322+ <|> quoted' doubleQuoted ((:[]) <$> symbol '"')
323+ (void $ symbol '"')
324+
325+singleQuote :: PandocMonad m => LP m Inlines
326+singleQuote = do
327+ quoted' singleQuoted ((:[]) <$> symbol '`')
328+ (try $ symbol '\'' >>
329+ notFollowedBy (satisfyTok startsWithLetter))
330+ <|> quoted' singleQuoted ((:[]) <$> symbol '‘')
331+ (try $ symbol '’' >>
332+ notFollowedBy (satisfyTok startsWithLetter))
333+ where startsWithLetter (Tok _ Word t) =
334+ case T.uncons t of
335+ Just (c, _) | isLetter c -> True
336+ _ -> False
337+ startsWithLetter _ = False
338+
339+quoted' :: PandocMonad m
340+ => (Inlines -> Inlines)
341+ -> LP m [Tok]
342+ -> LP m ()
343+ -> LP m Inlines
344+quoted' f starter ender = do
345+ startchs <- (T.unpack . untokenize) <$> starter
346+ smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
347+ if smart
348+ then do
349+ ils <- many (notFollowedBy ender >> inline)
350+ (ender >> return (f (mconcat ils))) <|>
351+ (<> mconcat ils) <$>
352+ lit (case startchs of
353+ "``" -> "“"
354+ "`" -> "‘"
355+ cs -> cs)
356+ else lit startchs
357+
358+inline :: PandocMonad m => LP m Inlines
359+inline = (mempty <$ comment)
360+ <|> (space <$ whitespace)
361+ <|> (softbreak <$ endline)
362+ <|> inlineText
363+ -- <|> inlineCommand
364+ -- <|> inlineEnvironment
365+ <|> inlineGroup
366+ <|> (symbol '-' *>
367+ option (str "-") (symbol '-' *>
368+ option (str "–") (str "—" <$ symbol '-')))
369+ <|> doubleQuote
370+ <|> singleQuote
371+ <|> (str "”" <$ try (symbol '\'' >> symbol '\''))
372+ <|> (str "”" <$ symbol '”')
373+ <|> (str "’" <$ symbol '\'')
374+ <|> (str "’" <$ symbol '’')
375+ <|> (str "\160" <$ symbol '~')
376+ -- <|> mathDisplay (string "$$" *> mathChars <* string "$$")
377+ -- <|> mathInline (char '$' *> mathChars <* char '$')
378+ <|> (guardEnabled Ext_literate_haskell *> symbol '|' *> doLHSverb)
379+ <|> (str . (:[]) <$> primEscape)
380+ <|> (do res <- symbolIn "#&~^'`\"[]"
381+ pos <- getPosition
382+ let s = T.unpack (untoken res)
383+ report $ ParsingUnescaped s pos
384+ return $ str s)
385+
386+inlines :: PandocMonad m => LP m Inlines
387+inlines = mconcat <$> many inline
388+
389+-- PREVIOUSLY HAD (notFollowedBy (char '}') *> inline)
390+
391+-- block elements:
392+
393+paragraph :: PandocMonad m => LP m Blocks
394+paragraph = do
395+ x <- trimInlines . mconcat <$> many1 inline
396+ if x == mempty
397+ then return mempty
398+ else return $ para x
399+
400+block :: PandocMonad m => LP m Blocks
401+block = (mempty <$ spaces1)
402+ -- <|> environment
403+ -- <|> include
404+ -- <|> macro
405+ -- <|> blockCommand
406+ <|> paragraph
407+ <|> grouped block
408+
409+blocks :: PandocMonad m => LP m Blocks
410+blocks = mconcat <$> many block
411+
412+
413+{-
414+
415+-}
416+
417+{-
60418-- | Parse LaTeX from string and return 'Pandoc' document.
61419readLaTeX :: PandocMonad m
62420 => ReaderOptions -- ^ Reader options
@@ -69,6 +427,7 @@ readLaTeX opts ltx = do
69427 Right result -> return result
70428 Left e -> throwError e
71429
430+
72431parseLaTeX :: PandocMonad m => LP m Pandoc
73432parseLaTeX = do
74433 bs <- blocks
@@ -88,8 +447,6 @@ parseLaTeX = do
88447 else id) doc'
89448 return $ Pandoc meta bs'
90449
91−type LP m = ParserT String ParserState m
92−
93450anyControlSeq :: PandocMonad m => LP m String
94451anyControlSeq = do
95452 char '\\'
@@ -127,8 +484,8 @@ endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)
127484isLowerHex :: Char -> Bool
128485isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
129486
130−tildeEscape :: PandocMonad m => LP m Char
131−tildeEscape = try $ do
487+primEscape :: PandocMonad m => LP m Char
488+primEscape = try $ do
132489 string "^^"
133490 c <- satisfy (\x -> x >= '\0' && x <= '\128')
134491 d <- if isLowerHex c
@@ -200,37 +557,6 @@ mathChars =
200557 isOrdChar '\\' = False
201558 isOrdChar _ = True
202559
203−quoted' :: PandocMonad m => (Inlines -> Inlines) -> LP m String -> LP m () -> LP m Inlines
204−quoted' f starter ender = do
205− startchs <- starter
206− smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
207− if smart
208− then do
209− ils <- many (notFollowedBy ender >> inline)
210− (ender >> return (f (mconcat ils))) <|>
211− (<> mconcat ils) <$>
212− lit (case startchs of
213− "``" -> "“"
214− "`" -> "‘"
215− _ -> startchs)
216− else lit startchs
217−
218−doubleQuote :: PandocMonad m => LP m Inlines
219−doubleQuote = do
220− quoted' doubleQuoted (try $ string "``") (void $ try $ string "''")
221− <|> quoted' doubleQuoted (string "“") (void $ char '”')
222− -- the following is used by babel for localized quotes:
223− <|> quoted' doubleQuoted (try $ string "\"`") (void $ try $ string "\"'")
224− <|> quoted' doubleQuoted (string "\"") (void $ char '"')
225−
226−singleQuote :: PandocMonad m => LP m Inlines
227−singleQuote = do
228− smart <- extensionEnabled Ext_smart <$> getOption readerExtensions
229− if smart
230− then quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter)
231− <|> quoted' singleQuoted (string "‘") (try $ char '’' >> notFollowedBy letter)
232− else str <$> many1 (oneOf "`\'‘’")
233−
234560inline :: PandocMonad m => LP m Inlines
235561inline = (mempty <$ comment)
236562 <|> (space <$ whitespace)
@@ -251,7 +577,7 @@ inline = (mempty <$ comment)
251577 <|> mathDisplay (string "$$" *> mathChars <* string "$$")
252578 <|> mathInline (char '$' *> mathChars <* char '$')
253579 <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
254− <|> (str . (:[]) <$> tildeEscape)
580+ <|> (str . (:[]) <$> primEscape)
255581 <|> (do res <- oneOf "#&~^'`\"[]"
256582 pos <- getPosition
257583 report $ ParsingUnescaped [res] pos
@@ -744,9 +1070,6 @@ dolstinline = do
7441070 marker <- char '{' <|> anyChar
7451071 codeWith ("",classes,[]) <$> manyTill (satisfy (/='\n')) (char '}' <|> char marker)
7461072
747−doLHSverb :: PandocMonad m => LP m Inlines
748−doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')
749−
7501073-- converts e.g. \SI{1}[\$]{} to "$ 1" or \SI{1}{\euro} to "1 €"
7511074dosiunitx :: PandocMonad m => LP m Inlines
7521075dosiunitx = do
@@ -762,9 +1085,6 @@ dosiunitx = do
7621085 emptyOr160 unit,
7631086 unit]
7641087
765−lit :: String -> LP m Inlines
766−lit = pure . str
767−
7681088accent :: (Char -> String) -> Inlines -> LP m Inlines
7691089accent f ils =
7701090 case toList ils of
@@ -1570,3 +1890,4 @@ removeDoubleQuotes ('"':xs) =
15701890 '"':ys -> reverse ys
15711891 _ -> '"':xs
15721892removeDoubleQuotes xs = xs
1893+-}