55d679e · typeable/pandoc

src/Text/Pandoc/Lua.hs+9−9

compare with master

unifiedsplit

@@ -15,8 +15,8 @@ You should have received a copy of the GNU General Public License

15along with this program; if not, write to the Free Software

16Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

17-}

18−{-# LANGUAGE FlexibleContexts #-}

18+{-# LANGUAGE FlexibleContexts #-}

19−{-# LANGUAGE FlexibleInstances #-}

19+{-# LANGUAGE FlexibleInstances #-}

20{-# LANGUAGE MultiParamTypeClasses #-}

21{- |

22 Module : Text.Pandoc.Lua

@@ -30,12 +30,12 @@ Pandoc lua utils.

30-}

31module Text.Pandoc.Lua ( runLuaFilter, pushPandocModule ) where

32

33−import Control.Monad ( (>=>), when )

33+import Control.Monad (unless, when, (>=>))

34−import Control.Monad.Trans ( MonadIO(..) )

34+import Control.Monad.Trans (MonadIO (..))

35−import Data.Map ( Map )

35+import Data.Map (Map)

36−import Scripting.Lua ( LuaState, StackValue(..) )

36+import Scripting.Lua (LuaState, StackValue (..))

37import Text.Pandoc.Definition

38−import Text.Pandoc.Lua.PandocModule ( pushPandocModule )

38+import Text.Pandoc.Lua.PandocModule (pushPandocModule)

39import Text.Pandoc.Lua.StackInstances ()

40import Text.Pandoc.Walk

41

@@ -80,7 +80,7 @@ pushGlobalFilter lua =

80 *> Lua.rawseti lua (-2) 1

81

82runAll :: [LuaFilter] -> Pandoc -> IO Pandoc

83−runAll [] = return

83+runAll [] = return

84runAll (x:xs) = walkMWithLuaFilter x >=> runAll xs

85

86walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc

@@ -225,7 +225,7 @@ instance StackValue LuaFilterFunction where

225 push lua v = pushFilterFunction lua v

226 peek lua i = do

227 isFn <- Lua.isfunction lua i

228− when (not isFn) (error $ "Not a function at index " ++ (show i))

228+ unless isFn (error $ "Not a function at index " ++ (show i))

229 Lua.pushvalue lua i

230 push lua ("PANDOC_FILTER_FUNCTIONS"::String)

231 Lua.rawget lua Lua.registryindex

src/Text/Pandoc/Lua/Compat.hs+2−2

@@ -28,13 +28,13 @@ Compatibility helpers for hslua

28-}

29module Text.Pandoc.Lua.Compat ( loadstring ) where

30

31−import Scripting.Lua ( LuaState )

31+import Scripting.Lua (LuaState)

32import qualified Scripting.Lua as Lua

33

34-- | Interpret string as lua code and load into the lua environment.

35loadstring :: LuaState -> String -> String -> IO Int

36#if MIN_VERSION_hslua(0,5,0)

37−loadstring lua script _ = Lua.loadstring lua script

37+loadstring lua script _ = Lua.loadstring lua script

38#else

39loadstring lua script cn = Lua.loadstring lua script cn

40#endif

src/Text/Pandoc/Lua/PandocModule.hs+12−14

@@ -27,25 +27,23 @@ Pandoc module for lua.

27-}

28module Text.Pandoc.Lua.PandocModule ( pushPandocModule ) where

29

30+import Control.Monad (unless)

30−import Data.ByteString.Char8 ( unpack )

31+import Data.ByteString.Char8 (unpack)

31−import Data.Default ( Default(..) )

32+import Data.Default (Default (..))

32−import Scripting.Lua ( LuaState, call, push, pushhsfunction, rawset)

33+import Scripting.Lua (LuaState, call, push, pushhsfunction, rawset)

33−import Text.Pandoc.Class hiding ( readDataFile )

34+import Text.Pandoc.Class hiding (readDataFile)

34−import Text.Pandoc.Definition ( Pandoc )

35+import Text.Pandoc.Definition (Pandoc)

35−import Text.Pandoc.Lua.Compat ( loadstring )

36+import Text.Pandoc.Lua.Compat (loadstring)

36import Text.Pandoc.Lua.StackInstances ()

37import Text.Pandoc.Lua.StackInstances ()

37−import Text.Pandoc.Readers ( Reader(..), getReader )

38+import Text.Pandoc.Readers (Reader (..), getReader)

38−import Text.Pandoc.Shared ( readDataFile )

39+import Text.Pandoc.Shared (readDataFile)

39

40

40-- | Push the "pandoc" on the lua stack.

41-- | Push the "pandoc" on the lua stack.

41pushPandocModule :: LuaState -> IO ()

42pushPandocModule :: LuaState -> IO ()

42pushPandocModule lua = do

43pushPandocModule lua = do

43 script <- pandocModuleScript

44 script <- pandocModuleScript

44 status <- loadstring lua script "pandoc.lua"

45 status <- loadstring lua script "pandoc.lua"

45− if (status /= 0)

46− then return ()

47− else do

48− call lua 0 1

46+ unless (status /= 0) $ call lua 0 1

49 push lua "__read"

47 push lua "__read"

50 pushhsfunction lua read_doc

48 pushhsfunction lua read_doc

51 rawset lua (-3)

49 rawset lua (-3)

@@ -57,13 +55,13 @@ pandocModuleScript = unpack <$> readDataFile Nothing "pandoc.lua"

57read_doc :: String -> String -> IO (Either String Pandoc)

55read_doc :: String -> String -> IO (Either String Pandoc)

58read_doc formatSpec content = do

56read_doc formatSpec content = do

59 case getReader formatSpec of

57 case getReader formatSpec of

60− Left s -> return $ Left s

58+ Left s -> return $ Left s

61 Right reader ->

59 Right reader ->

62 case reader of

60 case reader of

63 StringReader r -> do

61 StringReader r -> do

64 res <- runIO $ r def content

62 res <- runIO $ r def content

65 case res of

63 case res of

66− Left s -> return . Left $ show s

64+ Left s -> return . Left $ show s

67 Right pd -> return $ Right pd

65 Right pd -> return $ Right pd

68 _ -> return $ Left "Only string formats are supported at the moment."

66 _ -> return $ Left "Only string formats are supported at the moment."

69

67

src/Text/Pandoc/Lua/SharedInstances.hs+6−6

@@ -16,9 +16,9 @@ You should have received a copy of the GNU General Public License

16along with this program; if not, write to the Free Software

17Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

18-}

19−{-# LANGUAGE CPP #-}

19+{-# LANGUAGE CPP #-}

20−{-# LANGUAGE FlexibleInstances #-}

20+{-# LANGUAGE FlexibleInstances #-}

21−{-# LANGUAGE LambdaCase #-}

21+{-# LANGUAGE LambdaCase #-}

22#if !MIN_VERSION_base(4,8,0)

23{-# LANGUAGE OverlappingInstances #-}

24#endif

@@ -36,8 +36,8 @@ Shared StackValue instances for pandoc and generic types.

36-}

37module Text.Pandoc.Lua.SharedInstances () where

38

39−import Scripting.Lua ( LTYPE(..), StackValue(..), newtable )

39+import Scripting.Lua (LTYPE (..), StackValue (..), newtable)

40−import Text.Pandoc.Lua.Util ( addRawInt, addValue, getRawInt, keyValuePairs )

40+import Text.Pandoc.Lua.Util (addRawInt, addValue, getRawInt, keyValuePairs)

41

42import qualified Data.Map as M

43import qualified Text.Pandoc.UTF8 as UTF8

@@ -112,5 +112,5 @@ instance (StackValue a, StackValue b) => StackValue (Either a b) where

112 peek lua idx = peek lua idx >>= \case

113 Just left -> return . Just $ Left left

114 Nothing -> fmap Right <$> peek lua idx

115− valuetype (Left x) = valuetype x

115+ valuetype (Left x) = valuetype x

116 valuetype (Right x) = valuetype x

src/Text/Pandoc/Lua/StackInstances.hs+6−6

@@ -17,7 +17,7 @@ along with this program; if not, write to the Free Software

17Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

18-}

19{-# LANGUAGE FlexibleInstances #-}

20−{-# LANGUAGE LambdaCase #-}

20+{-# LANGUAGE LambdaCase #-}

21{-# OPTIONS_GHC -fno-warn-orphans #-}

22{- |

23 Module : Text.Pandoc.Lua.StackInstances

@@ -32,13 +32,13 @@ StackValue instances for pandoc types.

32-}

33module Text.Pandoc.Lua.StackInstances () where

34

35−import Control.Applicative ( (<|>) )

35+import Control.Applicative ((<|>))

36−import Scripting.Lua

37− ( LTYPE(..), LuaState, StackValue(..), ltype, newtable, objlen )

36+import Scripting.Lua (LTYPE (..), LuaState, StackValue (..), ltype, newtable,

37+ objlen)

38import Text.Pandoc.Definition

39import Text.Pandoc.Lua.SharedInstances ()

40−import Text.Pandoc.Lua.Util ( addValue, getTable, pushViaConstructor )

40+import Text.Pandoc.Lua.Util (addValue, getTable, pushViaConstructor)

41−import Text.Pandoc.Shared ( safeRead )

41+import Text.Pandoc.Shared (safeRead)

42

43instance StackValue Pandoc where

44 push lua (Pandoc meta blocks) = do

src/Text/Pandoc/Lua/Util.hs+2−4

@@ -42,10 +42,8 @@ module Text.Pandoc.Lua.Util

42 , pushViaConstructor

43 ) where

44

45−import Scripting.Lua

45+import Scripting.Lua (LuaState, StackValue (..), call, getglobal2, gettable,

46− ( LuaState, StackValue(..)

47− , call, getglobal2, gettable, next, pop, pushnil, rawgeti, rawseti, settable

46+ next, pop, pushnil, rawgeti, rawseti, settable)

48− )

49

47

50-- | Adjust the stack index, assuming that @n@ new elements have been pushed on

48-- | Adjust the stack index, assuming that @n@ new elements have been pushed on

51-- the stack.

49-- the stack.

src/Text/Pandoc/Readers/Org/Blocks.hs+1−1

@@ -351,7 +351,7 @@ switchesAsAttributes = try $ do

351 Just num -> ("startFrom", num):kv

352 Nothing -> kv

353 cls' = case pol of

354− SwitchPlus -> "continuedSourceBlock":cls

354+ SwitchPlus -> "continuedSourceBlock":cls

355 SwitchMinus -> cls

356 in ("numberLines":cls', kv')

357 addToAttr _ x = x

src/Text/Pandoc/Readers/Org/DocumentTree.hs+3−3

@@ -35,14 +35,14 @@ module Text.Pandoc.Readers.Org.DocumentTree

35import Control.Arrow ((***))

36import Control.Monad (guard, void)

37import Data.Char (toLower, toUpper)

38−import Data.List ( intersperse )

38+import Data.List (intersperse)

39import Data.Monoid ((<>))

40import Text.Pandoc.Builder (Blocks, Inlines)

41import Text.Pandoc.Class (PandocMonad)

42import Text.Pandoc.Definition

43import Text.Pandoc.Readers.Org.BlockStarts

44−import Text.Pandoc.Readers.Org.Parsing

45import Text.Pandoc.Readers.Org.ParserState

44import Text.Pandoc.Readers.Org.ParserState

45+import Text.Pandoc.Readers.Org.Parsing

46

47import qualified Data.Map as Map

48import qualified Text.Pandoc.Builder as B

@@ -78,7 +78,7 @@ documentTree blocks inline = do

78 getTitle metamap =

79 case Map.lookup "title" metamap of

80 Just (MetaInlines inlns) -> inlns

81− _ -> []

81+ _ -> []

82

83newtype Tag = Tag { fromTag :: String }

84 deriving (Show, Eq)

src/Text/Pandoc/Readers/Org/Inlines.hs+6−7

@@ -343,11 +343,10 @@ orgRefCiteKey =

343 let citeKeySpecialChars = "-_:\\./," :: String

344 isCiteKeySpecialChar c = c `elem` citeKeySpecialChars

345 isCiteKeyChar c = isAlphaNum c || isCiteKeySpecialChar c

346−

346+ endOfCitation = try $ do

347− in try $ many1Till (satisfy isCiteKeyChar)

347+ many $ satisfy isCiteKeySpecialChar

348− $ try . lookAhead $ do

348+ satisfy $ not . isCiteKeyChar

349− many . satisfy $ isCiteKeySpecialChar

349+ in try $ satisfy isCiteKeyChar `many1Till` lookAhead endOfCitation

350− satisfy $ not . isCiteKeyChar

351

350

352

351

353-- | Supported citation types. Only a small subset of org-ref types is

352-- | Supported citation types. Only a small subset of org-ref types is

@@ -415,7 +414,7 @@ referencedNote = try $ do

415 return $ do

414 return $ do

416 notes <- asksF orgStateNotes'

415 notes <- asksF orgStateNotes'

417 case lookup ref notes of

416 case lookup ref notes of

418− Nothing -> return $ B.str $ "[" ++ ref ++ "]"

417+ Nothing -> return . B.str $ "[" ++ ref ++ "]"

419 Just contents -> do

418 Just contents -> do

420 st <- askF

419 st <- askF

421 let contents' = runF contents st{ orgStateNotes' = [] }

420 let contents' = runF contents st{ orgStateNotes' = [] }

@@ -439,7 +438,7 @@ explicitOrImageLink = try $ do

439 src <- srcF

438 src <- srcF

440 case cleanLinkString title of

439 case cleanLinkString title of

441 Just imgSrc | isImageFilename imgSrc ->

440 Just imgSrc | isImageFilename imgSrc ->

442− pure $ B.link src "" $ B.image imgSrc mempty mempty

441+ pure . B.link src "" $ B.image imgSrc mempty mempty

443 _ ->

442 _ ->

444 linkToInlinesF src =<< title'

443 linkToInlinesF src =<< title'

445

444

src/Text/Pandoc/Readers/Org/Meta.hs+5−5

@@ -75,9 +75,9 @@ declarationLine :: PandocMonad m => OrgParser m ()

75declarationLine = try $ do

76 key <- map toLower <$> metaKey

77 (key', value) <- metaValue key

78− when (key' /= "results") $

78+ let addMetaValue st =

79− updateState $ \st ->

80− st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }

79+ st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }

80+ when (key' /= "results") $ updateState addMetaValue

81

82metaKey :: Monad m => OrgParser m String

83metaKey = map toLower <$> many1 (noneOf ": \n\r")

@@ -236,8 +236,8 @@ macroDefinition = try $ do

236 expansionPart = try $ many (notFollowedBy placeholder *> noneOf "\n\r")

237

238 alternate :: [a] -> [a] -> [a]

239− alternate [] ys = ys

239+ alternate [] ys = ys

240− alternate xs [] = xs

240+ alternate xs [] = xs

241 alternate (x:xs) (y:ys) = x : y : alternate xs ys

242

243 reorder :: [Int] -> [String] -> [String]

src/Text/Pandoc/Readers/Org/ParserState.hs+9−10

@@ -1,5 +1,5 @@

1−{-# LANGUAGE FlexibleInstances #-}

1+{-# LANGUAGE FlexibleInstances #-}

2−{-# LANGUAGE MultiParamTypeClasses #-}

2+{-# LANGUAGE MultiParamTypeClasses #-}

3{-

5

@@ -60,15 +60,14 @@ import qualified Data.Set as Set

60

61import Text.Pandoc.Builder (Blocks, Inlines)

62import Text.Pandoc.Definition (Meta (..), nullMeta)

63−import Text.Pandoc.Options (ReaderOptions (..))

64import Text.Pandoc.Logging

63import Text.Pandoc.Logging

64+import Text.Pandoc.Options (ReaderOptions (..))

65−import Text.Pandoc.Parsing (HasHeaderMap (..), HasIdentifierList (..),

65+import Text.Pandoc.Parsing (Future, HasHeaderMap (..), HasIdentifierList (..),

66− HasLogMessages (..),

67− HasLastStrPosition (..), HasQuoteContext (..),

66+ HasIncludeFiles (..), HasLastStrPosition (..),

68− HasReaderOptions (..), HasIncludeFiles (..),

67+ HasLogMessages (..), HasQuoteContext (..),

69− ParserContext (..),

68+ HasReaderOptions (..), ParserContext (..),

70− QuoteContext (..), SourcePos, Future,

69+ QuoteContext (..), SourcePos, askF, asksF, returnF,

71− askF, asksF, returnF, runF, trimInlinesF)

70+ runF, trimInlinesF)

72

71

73-- | This is used to delay evaluation until all relevant information has been

72-- | This is used to delay evaluation until all relevant information has been

74-- parsed and made available in the parser state.

73-- parsed and made available in the parser state.

src/Text/Pandoc/Writers/Org.hs+14−16

@@ -34,7 +34,7 @@ Conversion of 'Pandoc' documents to Emacs Org-Mode.

34

35Org-Mode: <http://orgmode.org>

36-}

37−module Text.Pandoc.Writers.Org ( writeOrg) where

37+module Text.Pandoc.Writers.Org (writeOrg) where

38import Control.Monad.State

39import Data.Char (isAlphaNum, toLower)

40import Data.List (intersect, intersperse, isPrefixOf, partition, transpose)

@@ -77,9 +77,9 @@ pandocToOrg (Pandoc meta blocks) = do

77 body <- blockListToOrg blocks

78 notes <- gets (reverse . stNotes) >>= notesToOrg

79 hasMath <- gets stHasMath

80− let main = render colwidth $ foldl ($+$) empty $ [body, notes]

80+ let main = render colwidth . foldl ($+$) empty $ [body, notes]

81 let context = defField "body" main

82− $ defField "math" hasMath

82+ . defField "math" hasMath

83 $ metadata

84 case writerTemplate opts of

85 Nothing -> return main

@@ -88,8 +88,7 @@ pandocToOrg (Pandoc meta blocks) = do

88-- | Return Org representation of notes.

89notesToOrg :: PandocMonad m => [[Block]] -> Org m Doc

90notesToOrg notes =

91− mapM (\(num, note) -> noteToOrg num note) (zip [1..] notes) >>=

91+ vsep <$> zipWithM noteToOrg [1..] notes

92− return . vsep

93

92

94-- | Return Org representation of a note.

93-- | Return Org representation of a note.

95noteToOrg :: PandocMonad m => Int -> [Block] -> Org m Doc

94noteToOrg :: PandocMonad m => Int -> [Block] -> Org m Doc

@@ -221,16 +220,16 @@ blockToOrg (Table caption' _ _ headers rows) = do

221 -- FIXME: Org doesn't allow blocks with height more than 1.

220 -- FIXME: Org doesn't allow blocks with height more than 1.

222 let hpipeBlocks blocks = hcat [beg, middle, end]

221 let hpipeBlocks blocks = hcat [beg, middle, end]

223 where h = maximum (1 : map height blocks)

222 where h = maximum (1 : map height blocks)

224− sep' = lblock 3 $ vcat (map text $ replicate h " | ")

223+ sep' = lblock 3 $ vcat (replicate h (text " | "))

225− beg = lblock 2 $ vcat (map text $ replicate h "| ")

224+ beg = lblock 2 $ vcat (replicate h (text "| "))

226− end = lblock 2 $ vcat (map text $ replicate h " |")

225+ end = lblock 2 $ vcat (replicate h (text " |"))

227 middle = hcat $ intersperse sep' blocks

226 middle = hcat $ intersperse sep' blocks

228 let makeRow = hpipeBlocks . zipWith lblock widthsInChars

227 let makeRow = hpipeBlocks . zipWith lblock widthsInChars

229 let head' = makeRow headers'

228 let head' = makeRow headers'

230 rows' <- mapM (\row -> do cols <- mapM blockListToOrg row

229 rows' <- mapM (\row -> do cols <- mapM blockListToOrg row

231 return $ makeRow cols) rows

230 return $ makeRow cols) rows

232 let border ch = char '|' <> char ch <>

231 let border ch = char '|' <> char ch <>

233− (hcat $ intersperse (char ch <> char '+' <> char ch) $

232+ (hcat . intersperse (char ch <> char '+' <> char ch) $

234 map (\l -> text $ replicate l ch) widthsInChars) <>

233 map (\l -> text $ replicate l ch) widthsInChars) <>

235 char ch <> char '|'

234 char ch <> char '|'

236 let body = vcat rows'

235 let body = vcat rows'

@@ -251,8 +250,7 @@ blockToOrg (OrderedList (start, _, delim) items) = do

251 let maxMarkerLength = maximum $ map length markers

250 let maxMarkerLength = maximum $ map length markers

252 let markers' = map (\m -> let s = maxMarkerLength - length m

251 let markers' = map (\m -> let s = maxMarkerLength - length m

253 in m ++ replicate s ' ') markers

252 in m ++ replicate s ' ') markers

254− contents <- mapM (\(item, num) -> orderedListItemToOrg item num) $

253+ contents <- zipWithM orderedListItemToOrg markers' items

255− zip markers' items

256 -- ensure that sublists have preceding blank line

254 -- ensure that sublists have preceding blank line

257 return $ blankline $$ vcat contents $$ blankline

255 return $ blankline $$ vcat contents $$ blankline

258blockToOrg (DefinitionList items) = do

256blockToOrg (DefinitionList items) = do

@@ -279,8 +277,8 @@ definitionListItemToOrg :: PandocMonad m

279 => ([Inline], [[Block]]) -> Org m Doc

277 => ([Inline], [[Block]]) -> Org m Doc

280definitionListItemToOrg (label, defs) = do

278definitionListItemToOrg (label, defs) = do

281 label' <- inlineListToOrg label

279 label' <- inlineListToOrg label

282− contents <- liftM vcat $ mapM blockListToOrg defs

280+ contents <- vcat <$> mapM blockListToOrg defs

283− return $ hang 2 "- " $ label' <> " :: " <> (contents <> cr)

281+ return . hang 2 "- " $ label' <> " :: " <> (contents <> cr)

284

282

285-- | Convert list of key/value pairs to Org :PROPERTIES: drawer.

283-- | Convert list of key/value pairs to Org :PROPERTIES: drawer.

286propertiesDrawer :: Attr -> Doc

284propertiesDrawer :: Attr -> Doc

@@ -312,13 +310,13 @@ attrHtml (ident, classes, kvs) =

312blockListToOrg :: PandocMonad m

310blockListToOrg :: PandocMonad m

313 => [Block] -- ^ List of block elements

311 => [Block] -- ^ List of block elements

314 -> Org m Doc

312 -> Org m Doc

315−blockListToOrg blocks = mapM blockToOrg blocks >>= return . vcat

313+blockListToOrg blocks = vcat <$> mapM blockToOrg blocks

316

314

317-- | Convert list of Pandoc inline elements to Org.

315-- | Convert list of Pandoc inline elements to Org.

318inlineListToOrg :: PandocMonad m

316inlineListToOrg :: PandocMonad m

319 => [Inline]

317 => [Inline]

320 -> Org m Doc

318 -> Org m Doc

321−inlineListToOrg lst = mapM inlineToOrg lst >>= return . hcat

319+inlineListToOrg lst = hcat <$> mapM inlineToOrg lst

322

320

323-- | Convert Pandoc inline element to Org.

321-- | Convert Pandoc inline element to Org.

324inlineToOrg :: PandocMonad m => Inline -> Org m Doc

322inlineToOrg :: PandocMonad m => Inline -> Org m Doc

@@ -350,7 +348,7 @@ inlineToOrg (Quoted DoubleQuote lst) = do

350 return $ "\"" <> contents <> "\""

348 return $ "\"" <> contents <> "\""

351inlineToOrg (Cite _ lst) = inlineListToOrg lst

349inlineToOrg (Cite _ lst) = inlineListToOrg lst

352inlineToOrg (Code _ str) = return $ "=" <> text str <> "="

350inlineToOrg (Code _ str) = return $ "=" <> text str <> "="

353−inlineToOrg (Str str) = return $ text $ escapeString str

351+inlineToOrg (Str str) = return . text $ escapeString str

354inlineToOrg (Math t str) = do

352inlineToOrg (Math t str) = do

355 modify $ \st -> st{ stHasMath = True }

353 modify $ \st -> st{ stHasMath = True }

356 return $ if t == InlineMath

354 return $ if t == InlineMath