@@ -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,270 @@ 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+-- | Parse LaTeX from string and return 'Pandoc' document.
63+readLaTeX :: PandocMonad m
64+ => ReaderOptions -- ^ Reader options
65+ -> Text -- ^ String to parse (assumes @'\n'@ line endings)
66+ -> m Pandoc
67+readLaTeX opts ltx = undefined
68+
69+testParser :: LP PandocIO a -> Text -> IO a
70+testParser p t = do
71+ res <- runIOorExplode (runParserT p defaultParserState "name" (tokenize t))
72+ case res of
73+ Left e -> error (show e)
74+ Right r -> return r
75+
76+type LP m = ParserT [Tok] ParserState m
77+
78+rawLaTeXBlock :: PandocMonad m => LP m String
79+rawLaTeXBlock = mzero
80+
81+rawLaTeXInline :: PandocMonad m => LP m Inline
82+rawLaTeXInline = mzero
83+
84+inlineCommand :: PandocMonad m => LP m Inlines
85+inlineCommand = mzero
86+
87+data TokType = CtrlSeq | Spaces | Newline | Symbol | Word | Comment |
88+ Esc1 | Esc2
89+ deriving (Eq, Ord, Show)
90+
91+data Tok = Tok (Line, Column) TokType Text
92+ deriving (Eq, Ord, Show)
93+
94+tokenize :: Text -> [Tok]
95+tokenize = totoks (1, 1)
96+
97+totoks :: (Line, Column) -> Text -> [Tok]
98+totoks (lin,col) t =
99+ case T.uncons t of
100+ Nothing -> []
101+ Just (c, rest)
102+ | c == '\n' ->
103+ Tok (lin, col) Newline (T.singleton '\n')
104+ : totoks (lin + 1,1) rest
105+ | isSpaceOrTab c ->
106+ let (sps, rest') = T.span isSpaceOrTab t
107+ in Tok (lin, col) Spaces sps
108+ : totoks (lin, col + T.length sps) rest'
109+ | isAlphaNum c ->
110+ let (ws, rest') = T.span isAlphaNum t
111+ in Tok (lin, col) Word ws
112+ : totoks (lin, col + T.length ws) rest'
113+ | c == '%' ->
114+ let (cs, rest') = T.break (== '\n') rest
115+ in Tok (lin, col) Comment (T.singleton '%' <> cs)
116+ : totoks (lin, col + 1 + T.length cs) rest'
117+ | c == '\\' ->
118+ case T.uncons rest of
119+ Nothing -> [Tok (lin, col) Symbol (T.singleton c)]
120+ Just (d, rest')
121+ | isLetter d ->
122+ let (ws, rest'') = T.span isLetter rest
123+ in Tok (lin, col) CtrlSeq (T.singleton '\\' <> ws)
124+ : totoks (lin, col + 1 + T.length ws) rest''
125+ | d == '\t' || d == '\n' ->
126+ Tok (lin, col) Symbol (T.singleton '\\')
127+ : totoks (lin, col + 1) rest
128+ | otherwise ->
129+ Tok (lin, col) CtrlSeq (T.pack [c,d])
130+ : totoks (lin, col + 2) rest'
131+ | c == '^' ->
132+ case T.uncons rest of
133+ Just ('^', rest') ->
134+ case T.uncons rest' of
135+ Just (d, rest'')
136+ | isLowerHex d ->
137+ case T.uncons rest'' of
138+ Just (e, rest''') | isLowerHex e ->
139+ Tok (lin, col) Esc2 (T.pack ['^','^',d,e])
140+ : totoks (lin, col + 4) rest'''
141+ _ ->
142+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
143+ : totoks (lin, col + 3) rest''
144+ | d < '\128' ->
145+ Tok (lin, col) Esc1 (T.pack ['^','^',d])
146+ : totoks (lin, col + 3) rest''
147+ _ -> [Tok (lin, col) Symbol (T.singleton '^'),
148+ Tok (lin, col + 1) Symbol (T.singleton '^')]
149+ Nothing -> [Tok (lin, col) Symbol (T.singleton '^')]
150+ | otherwise ->
151+ Tok (lin, col) Symbol (T.singleton c) : totoks (lin, col + 1) rest
152+
153+ where isSpaceOrTab ' ' = True
154+ isSpaceOrTab '\t' = True
155+ isSpaceOrTab _ = False
156+
157+isLowerHex :: Char -> Bool
158+isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
159+
160+untokenize :: [Tok] -> Text
161+untokenize = mconcat . map untoken
162+
163+untoken :: Tok -> Text
164+untoken (Tok _ _ t) = t
165+
166+satisfyTok :: Monad m
167+ => (Tok -> Bool)
168+ -> ParserT [Tok] u m Tok
169+satisfyTok f = tokenPrim (T.unpack . untoken) updatePos matcher
170+ where matcher t | f t = Just t
171+ | otherwise = Nothing
172+ updatePos :: SourcePos -> Tok -> [Tok] -> SourcePos
173+ updatePos spos _ (Tok (lin,col) _ _ : _) =
174+ setSourceColumn (setSourceLine spos lin) col
175+ updatePos spos _ [] = spos
176+
177+anyControlSeq :: PandocMonad m => LP m Tok
178+anyControlSeq = satisfyTok isCtrlSeq <* spaces
179+ where isCtrlSeq (Tok _ CtrlSeq _) = True
180+ isCtrlSeq _ = False
181+
182+spaces :: PandocMonad m => LP m ()
183+spaces = skipMany (satisfyTok (tokTypeIn [Comment, Spaces, Newline]))
184+
185+tokTypeIn :: [TokType] -> Tok -> Bool
186+tokTypeIn toktypes (Tok _ tt _) = tt `elem` toktypes
187+tokTypeIn _ _ = False
188+
189+controlSeq :: PandocMonad m => Text -> LP m Tok
190+controlSeq name = satisfyTok isNamed
191+ where isNamed t@(Tok _ CtrlSeq n) = n == T.singleton '\\' <> name
192+ isNamed _ = False
193+
194+symbol :: PandocMonad m => Char -> LP m Tok
195+symbol c = satisfyTok isc
196+ where isc (Tok _ Symbol d) = case T.uncons d of
197+ Just (c',_) -> c == c'
198+ _ -> False
199+ isc _ = False
200+
201+sp :: PandocMonad m => LP m ()
202+sp = whitespace <|> endline
203+
204+whitespace :: PandocMonad m => LP m ()
205+whitespace = () <$ satisfyTok isSpaceTok
206+ where isSpaceTok (Tok _ Spaces _) = True
207+ isSpaceTok _ = False
208+
209+newlineTok :: PandocMonad m => LP m ()
210+newlineTok = () <$ satisfyTok isNewlineTok
211+ where isNewlineTok (Tok _ Newline _) = True
212+ isNewlineTok _ = False
213+
214+comment :: PandocMonad m => LP m ()
215+comment = () <$ satisfyTok isCommentTok
216+ where isCommentTok (Tok _ Comment _) = True
217+ isCommentTok _ = False
218+
219+anyTok :: PandocMonad m => LP m Tok
220+anyTok = satisfyTok (const True)
221+
222+endline :: PandocMonad m => LP m ()
223+endline = try $ do
224+ newlineTok
225+ lookAhead anyTok
226+ notFollowedBy blankline
227+
228+blankline :: PandocMonad m => LP m ()
229+blankline = try $ do
230+ skipMany (satisfyTok (tokTypeIn [Spaces, Newline]))
231+ newlineTok
232+
233+primEscape :: PandocMonad m => LP m Char
234+primEscape = do
235+ Tok _ toktype t <- satisfyTok (tokTypeIn [Esc1, Esc2])
236+ case toktype of
237+ Esc1 -> case T.uncons t of
238+ Just (c, _)
239+ | c >= '\64' && c <= '\127' -> return (chr (ord c - 64))
240+ | otherwise -> return (chr (ord c + 64))
241+ Nothing -> fail "Empty content of Esc1"
242+ Esc2 -> case safeRead ('0':'x':T.unpack (T.drop 2 t)) of
243+ Just x -> return (chr x)
244+ Nothing -> fail $ "Could not read: " ++ T.unpack t
245+ _ -> fail "Expected an Esc1 or Esc2 token" -- should not happen
246+
247+bgroup :: PandocMonad m => LP m ()
248+bgroup = try $ do
249+ skipMany sp
250+ symbol '{' <|> controlSeq "bgroup" <|> controlSeq "begingroup"
251+ return ()
252+
253+egroup :: PandocMonad m => LP m ()
254+egroup = () <$ (symbol '}' <|> controlSeq "egroup" <|> controlSeq "endgroup")
255+
256+grouped :: (PandocMonad m, Monoid a) => LP m a -> LP m a
257+grouped parser = try $ do
258+ bgroup
259+ -- first we check for an inner 'grouped', because
260+ -- {{a,b}} should be parsed the same as {a,b}
261+ try (grouped parser <* egroup) <|> (mconcat <$> manyTill parser egroup)
262+
263+braced :: PandocMonad m => LP m [Tok]
264+braced = try $ do
265+ bgroup
266+ -- {{a,b}} should be parsed the same as {a,b}
267+ try (braced <* egroup) <|> manyTill anyTok egroup
268+
269+bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a
270+bracketed parser = try $ do
271+ symbol '['
272+ mconcat <$> manyTill parser (symbol ']')
273+
274+inline :: PandocMonad m => LP m Inlines
275+inline = (mempty <$ comment)
276+ <|> (space <$ whitespace)
277+ <|> (softbreak <$ endline)
278+ -- <|> inlineText
279+ -- <|> inlineCommand
280+ -- <|> inlineEnvironment
281+ -- <|> inlineGroup
282+ -- <|> (char '-' *> option (str "-")
283+ -- (char '-' *> option (str "–") (str "—" <$ char '-')))
284+ -- <|> doubleQuote
285+ -- <|> singleQuote
286+ -- <|> (str "”" <$ try (string "''"))
287+ -- <|> (str "”" <$ char '”')
288+ -- <|> (str "’" <$ char '\'')
289+ -- <|> (str "’" <$ char '’')
290+ -- <|> (str "\160" <$ char '~')
291+ -- <|> mathDisplay (string "$$" *> mathChars <* string "$$")
292+ -- <|> mathInline (char '$' *> mathChars <* char '$')
293+ -- <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
294+ -- <|> (str . (:[]) <$> primEscape)
295+ -- <|> (do res <- oneOf "#&~^'`\"[]"
296+ -- pos <- getPosition
297+ -- report $ ParsingUnescaped [res] pos
298+ -- return $ str [res])
299+
300+{-
301+inlines :: PandocMonad m => LP m Inlines
302+inlines = mconcat <$> many (notFollowedBy (char '}') *> inline)
303+
304+inlineGroup :: PandocMonad m => LP m Inlines
305+inlineGroup = do
306+ ils <- grouped inline
307+ if isNull ils
308+ then return mempty
309+ else return $ spanWith nullAttr ils
310+ -- we need the span so we can detitlecase bibtex entries;
311+ -- we need to know when something is {C}apitalized
312+-}
313+
314+{-
60315-- | Parse LaTeX from string and return 'Pandoc' document.
61316readLaTeX :: PandocMonad m
62317 => ReaderOptions -- ^ Reader options
@@ -69,6 +324,7 @@ readLaTeX opts ltx = do
69324 Right result -> return result
70325 Left e -> throwError e
71326
327+
72328parseLaTeX :: PandocMonad m => LP m Pandoc
73329parseLaTeX = do
74330 bs <- blocks
@@ -88,8 +344,6 @@ parseLaTeX = do
88344 else id) doc'
89345 return $ Pandoc meta bs'
90346
91−type LP m = ParserT String ParserState m
92−
93347anyControlSeq :: PandocMonad m => LP m String
94348anyControlSeq = do
95349 char '\\'
@@ -127,8 +381,8 @@ endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)
127381isLowerHex :: Char -> Bool
128382isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
129383
130−tildeEscape :: PandocMonad m => LP m Char
131−tildeEscape = try $ do
384+primEscape :: PandocMonad m => LP m Char
385+primEscape = try $ do
132386 string "^^"
133387 c <- satisfy (\x -> x >= '\0' && x <= '\128')
134388 d <- if isLowerHex c
@@ -251,7 +505,7 @@ inline = (mempty <$ comment)
251505 <|> mathDisplay (string "$$" *> mathChars <* string "$$")
252506 <|> mathInline (char '$' *> mathChars <* char '$')
253507 <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
254− <|> (str . (:[]) <$> tildeEscape)
508+ <|> (str . (:[]) <$> primEscape)
255509 <|> (do res <- oneOf "#&~^'`\"[]"
256510 pos <- getPosition
257511 report $ ParsingUnescaped [res] pos
@@ -1570,3 +1824,4 @@ removeDoubleQuotes ('"':xs) =
15701824 '"':ys -> reverse ys
15711825 _ -> '"':xs
15721826removeDoubleQuotes xs = xs
1827+-}