a2ed874 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Revert "Revert "Checkpoint - custom LaTeXState.""

a2ed874John MacFarlane9 years ago

src/Text/Pandoc/Readers/LaTeX.hs+86−19

compare with master

unifiedsplit

@@ -1,4 +1,6 @@

1{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

2{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE ScopedTypeVariables #-}

3{-

5{-

@@ -39,10 +41,12 @@ import Control.Applicative (many, optional, (<|>))

39import Control.Monad

41import Control.Monad

40import Control.Monad.Except (throwError)

42import Control.Monad.Except (throwError)

41import Data.Char (chr, isAlphaNum, isLetter, ord, isDigit)

43import Data.Char (chr, isAlphaNum, isLetter, ord, isDigit)

44+import Data.Default

42import Data.Text (Text, unpack)

45import Data.Text (Text, unpack)

43import qualified Data.Text as T

46import qualified Data.Text as T

44import Data.List (intercalate, isPrefixOf)

47import Data.List (intercalate, isPrefixOf)

45import qualified Data.Map as M

48import qualified Data.Map as M

49+import qualified Data.Set as Set

46import Data.Maybe (fromMaybe, maybeToList)

50import Data.Maybe (fromMaybe, maybeToList)

47import Safe (minimumDef)

51import Safe (minimumDef)

48import System.FilePath (addExtension, replaceExtension, takeExtension)

52import System.FilePath (addExtension, replaceExtension, takeExtension)

@@ -70,7 +74,7 @@ readLaTeX :: PandocMonad m

70 -> Text -- ^ String to parse (assumes @'\n'@ line endings)

74 -> Text -- ^ String to parse (assumes @'\n'@ line endings)

71 -> m Pandoc

75 -> m Pandoc

72readLaTeX opts ltx = do

76readLaTeX opts ltx = do

73− parsed <- runParserT parseLaTeX def{ stateOptions = opts } "source"

77+ parsed <- runParserT parseLaTeX def{ sOptions = opts } "source"

74 (tokenize (crFilter ltx))

78 (tokenize (crFilter ltx))

75 case parsed of

79 case parsed of

76 Right result -> return result

80 Right result -> return result

@@ -81,7 +85,7 @@ parseLaTeX = do

81 bs <- blocks

85 bs <- blocks

82 eof

86 eof

83 st <- getState

87 st <- getState

84− let meta = stateMeta st

88+ let meta = sMeta st

85 let doc' = doc bs

89 let doc' = doc bs

86 let headerLevel (Header n _ _) = [n]

90 let headerLevel (Header n _ _) = [n]

87 headerLevel _ = []

91 headerLevel _ = []

@@ -97,22 +101,85 @@ parseLaTeX = do

101

98testParser :: LP PandocIO a -> Text -> IO a

102testParser :: LP PandocIO a -> Text -> IO a

99testParser p t = do

103testParser p t = do

100− res <- runIOorExplode (runParserT p defaultParserState{

104+ res <- runIOorExplode (runParserT p defaultLaTeXState{

101− stateOptions = def{ readerExtensions =

105+ sOptions = def{ readerExtensions =

102 getDefaultExtensions "latex" }} "name" (tokenize t))

106 getDefaultExtensions "latex" }} "name" (tokenize t))

103 case res of

107 case res of

104 Left e -> error (show e)

108 Left e -> error (show e)

105 Right r -> return r

109 Right r -> return r

106

110

111+data Macro = Macro -- TODO

112+ deriving Show

113+

114+data LaTeXState = LaTeXState{ sOptions :: ReaderOptions

115+ , sMeta :: Meta

116+ , sQuoteContext :: QuoteContext

117+ , sMacros :: [Macro]

118+ , sContainers :: [String]

119+ , sHeaders :: M.Map Inlines String

120+ , sLogMessages :: [LogMessage]

121+ , sIdentifiers :: Set.Set String }

122+ deriving Show

123+

124+defaultLaTeXState :: LaTeXState

125+defaultLaTeXState = LaTeXState{ sOptions = def

126+ , sMeta = nullMeta

127+ , sQuoteContext = NoQuote

128+ , sMacros = []

129+ , sContainers = []

130+ , sHeaders = M.empty

131+ , sLogMessages = []

132+ , sIdentifiers = Set.empty }

133+

134+instance PandocMonad m => HasQuoteContext LaTeXState m where

135+ getQuoteContext = sQuoteContext <$> getState

136+ withQuoteContext context parser = do

137+ oldState <- getState

138+ let oldQuoteContext = sQuoteContext oldState

139+ setState oldState { sQuoteContext = context }

140+ result <- parser

141+ newState <- getState

142+ setState newState { sQuoteContext = oldQuoteContext }

143+ return result

144+

145+instance HasLogMessages LaTeXState where

146+ addLogMessage msg st = st{ sLogMessages = msg : sLogMessages st }

147+ getLogMessages st = reverse $ sLogMessages st

148+

149+instance HasIdentifierList LaTeXState where

150+ extractIdentifierList = sIdentifiers

151+ updateIdentifierList f st = st{ sIdentifiers = f $ sIdentifiers st }

152+

153+instance HasIncludeFiles LaTeXState where

154+ getIncludeFiles = sContainers

155+ addIncludeFile f s = s{ sContainers = f : sContainers s }

156+ dropLatestIncludeFile s = s { sContainers = drop 1 $ sContainers s }

157+

158+instance HasHeaderMap LaTeXState where

159+ extractHeaderMap = sHeaders

160+ updateHeaderMap f st = st{ sHeaders = f $ sHeaders st }

161+

162+instance HasReaderOptions LaTeXState where

163+ extractReaderOptions = sOptions

164+

165+instance HasMeta LaTeXState where

166+ setMeta field val st =

167+ st{ sMeta = setMeta field val $ sMeta st }

168+ deleteMeta field st =

169+ st{ sMeta = deleteMeta field $ sMeta st }

170+

171+instance Default LaTeXState where

172+ def = defaultLaTeXState

173+

107−type LP m = ParserT [Tok] ParserState m

174+type LP m = ParserT [Tok] LaTeXState m

108−

175+

109−rawLaTeXBlock :: PandocMonad m => ParserT String ParserState m String

176+rawLaTeXBlock :: PandocMonad m => ParserT String LaTeXState m String

110rawLaTeXBlock = mzero

177rawLaTeXBlock = mzero

111

178

112−rawLaTeXInline :: PandocMonad m => ParserT String ParserState m Inline

179+rawLaTeXInline :: PandocMonad m => ParserT String LaTeXState m Inline

113rawLaTeXInline = mzero

180rawLaTeXInline = mzero

114

181

115−inlineCommand :: PandocMonad m => ParserT String ParserState m Inlines

182+inlineCommand :: PandocMonad m => ParserT String LaTeXState m Inlines

116inlineCommand = mzero

183inlineCommand = mzero

117

184

@@ -206,11 +273,11 @@ satisfyTok f =

206 setSourceColumn (setSourceLine spos lin) col

273 setSourceColumn (setSourceLine spos lin) col

207 updatePos spos _ [] = spos

274 updatePos spos _ [] = spos

208

275

209−-- TODO use something other than ParserState

276+-- TODO use something other than LaTeXState

210doMacros :: PandocMonad m => LP m ()

277doMacros :: PandocMonad m => LP m ()

211doMacros = do

278doMacros = do

212 inp <- getInput

279 inp <- getInput

213− macros <- stateMacros <$> getState

280+ macros <- sMacros <$> getState

214 case inp of

281 case inp of

215 t@(Tok spos CtrlSeq txt) : ts

282 t@(Tok spos CtrlSeq txt) : ts

216 | txt == "\\macro" -> do -- TODO actually check macros

283 | txt == "\\macro" -> do -- TODO actually check macros

@@ -419,8 +486,8 @@ quoted' f starter ender = do

419enquote :: PandocMonad m => LP m Inlines

486enquote :: PandocMonad m => LP m Inlines

420enquote = do

487enquote = do

421 skipopts

488 skipopts

422− context <- stateQuoteContext <$> getState

489+ quoteContext <- sQuoteContext <$> getState

423− if context == InDoubleQuote

490+ if quoteContext == InDoubleQuote

424 then singleQuoted <$> withQuoteContext InSingleQuote tok

491 then singleQuoted <$> withQuoteContext InSingleQuote tok

425 else doubleQuoted <$> withQuoteContext InDoubleQuote tok

492 else doubleQuoted <$> withQuoteContext InDoubleQuote tok

426

493

@@ -1119,7 +1186,7 @@ ignoreBlocks name = (name, p)

1119

1186

1120addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()

1187addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()

1121addMeta field val = updateState $ \st ->

1188addMeta field val = updateState $ \st ->

1122− st{ stateMeta = addMetaField field val $ stateMeta st }

1189+ st{ sMeta = addMetaField field val $ sMeta st }

1123

1190

1124authors :: PandocMonad m => LP m ()

1191authors :: PandocMonad m => LP m ()

1125authors = try $ do

1192authors = try $ do

@@ -1165,7 +1232,7 @@ closing = do

1165 let extractInlines (MetaBlocks [Plain ys]) = ys

1232 let extractInlines (MetaBlocks [Plain ys]) = ys

1166 extractInlines (MetaBlocks [Para ys ]) = ys

1233 extractInlines (MetaBlocks [Para ys ]) = ys

1167 extractInlines _ = []

1234 extractInlines _ = []

1168− let sigs = case lookupMeta "author" (stateMeta st) of

1235+ let sigs = case lookupMeta "author" (sMeta st) of

1169 Just (MetaList xs) ->

1236 Just (MetaList xs) ->

1170 para $ trimInlines $ fromList $

1237 para $ trimInlines $ fromList $

1171 intercalate [LineBreak] $ map extractInlines xs

1238 intercalate [LineBreak] $ map extractInlines xs

@@ -1371,7 +1438,7 @@ blocks = mconcat <$> many block

1371--

1438--

1372-- addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()

1439-- addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()

1373-- addMeta field val = updateState $ \st ->

1440-- addMeta field val = updateState $ \st ->

1374−-- st{ stateMeta = addMetaField field val $ stateMeta st }

1441+-- st{ sMeta = addMetaField field val $ sMeta st }

1375--

1442--

1376-- splitBibs :: String -> [Inlines]

1443-- splitBibs :: String -> [Inlines]

1377-- splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')

1444-- splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')

@@ -1464,10 +1531,10 @@ blocks = mconcat <$> many block

1464-- where strToCode (Str s) = Code nullAttr s

1531-- where strToCode (Str s) = Code nullAttr s

1465-- strToCode x = x

1532-- strToCode x = x

1466--

1533--

1467−-- rawLaTeXBlock :: PandocMonad m => ParserT String ParserState String

1534+-- rawLaTeXBlock :: PandocMonad m => ParserT String LaTeXState String

1468-- rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))

1535-- rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))

1469--

1536--

1470−-- rawLaTeXInline :: PandocMonad m => ParserT String ParserState Inline

1537+-- rawLaTeXInline :: PandocMonad m => ParserT String LaTeXState Inline

1471-- rawLaTeXInline = do

1538-- rawLaTeXInline = do

1472-- raw <- (snd <$> withRaw inlineCommand)

1539-- raw <- (snd <$> withRaw inlineCommand)

1473-- <|> (snd <$> withRaw inlineEnvironment)

1540-- <|> (snd <$> withRaw inlineEnvironment)

@@ -1504,7 +1571,7 @@ blocks = mconcat <$> many block

1504-- bs <- blocks

1571-- bs <- blocks

1505-- st <- getState

1572-- st <- getState

1506-- -- add signature (author) and address (title)

1573-- -- add signature (author) and address (title)

1507−-- let addr = case lookupMeta "address" (stateMeta st) of

1574+-- let addr = case lookupMeta "address" (sMeta st) of

1508-- Just (MetaBlocks [Plain xs]) ->

1575-- Just (MetaBlocks [Plain xs]) ->

1509-- para $ trimInlines $ fromList xs

1576-- para $ trimInlines $ fromList xs

1510-- _ -> mempty

1577-- _ -> mempty