42ba781 · typeable/pandoc

git.iko.soy/typeable/pandoc

Added literate haskell support for markdown reader.

+ Added stateLiterateHaskell to parser state. + Added parser for lhsCodeBlock to Markdown reader. + Added --lhs-in option, to treat input as literate haskell. + If first source has extension .lhs, assume --lhs-in. git-svn-id: https://pandoc.googlecode.com/svn/trunk@1497 788f1e2b-df1e-0410-8736-df70ead52e1b

commit42ba781b3dcb15a3a8fd4169fa03eeb316f05125 authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> dateTue 2 Dec 2008, 22:41 (18 years ago) parent035f0ff

3 files changed+53−9

compare with master

unifiedsplit

Main.hs+24−9 Text/Pandoc/Readers/Markdown.hs+27 Text/Pandoc/Shared.hs+2

Main.hs+24−9

@@ -146,6 +146,7 @@ data Opt = Opt

146146 , optReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst

147147 , optWrapText :: Bool -- ^ Wrap text

148148 , optSanitizeHTML :: Bool -- ^ Sanitize HTML

149+ , optLHSIn :: Bool -- ^ Treat input as literate haskell

149150#ifdef _CITEPROC

150151 , optModsFile :: String

151152 , optCslFile :: String

@@ -179,6 +180,7 @@ defaultOpts = Opt

179180 , optReferenceLinks = False

180181 , optWrapText = True

181182 , optSanitizeHTML = False

183+ , optLHSIn = False

182184#ifdef _CITEPROC

183185 , optModsFile = []

184186 , optCslFile = []

@@ -288,6 +290,11 @@ options =

288290 (\opt -> return opt { optSanitizeHTML = True }))

289291 "" -- "Sanitize HTML"

290292

293+ , Option "" ["lhs-in"]

294+ (NoArg

295+ (\opt -> return opt { optLHSIn = True }))

296+ "" -- "Treat input as literate haskell"

297+

291298 , Option "" ["toc", "table-of-contents"]

292299 (NoArg

293300 (\opt -> return opt { optTableOfContents = True }))

@@ -419,6 +426,11 @@ defaultReaderName (x:xs) =

419426 ".native" -> "native"

420427 _ -> defaultReaderName xs

421428

429+-- Returns True if extension of first source is .lhs

430+lhsExtension :: [FilePath] -> Bool

431+lhsExtension (x:_) = takeExtension x == ".lhs"

432+lhsExtension _ = False

433+

422434-- Determine default writer based on output file extension

423435defaultWriterName :: FilePath -> String

424436defaultWriterName "-" = "html" -- no output file

@@ -498,6 +510,7 @@ main = do

498510 , optReferenceLinks = referenceLinks

499511 , optWrapText = wrap

500512 , optSanitizeHTML = sanitize

513+ , optLHSIn = lhsIn

501514#ifdef _CITEPROC

502515 , optModsFile = modsFile

503516 , optCslFile = cslFile

@@ -556,17 +569,19 @@ main = do

556569#endif

557570

558571 let startParserState =

559− defaultParserState { stateParseRaw = parseRaw,

560− stateTabStop = tabStop,

561− stateSanitizeHTML = sanitize,

562− stateStandalone = standalone',

572+ defaultParserState { stateParseRaw = parseRaw,

573+ stateTabStop = tabStop,

574+ stateSanitizeHTML = sanitize,

575+ stateLiterateHaskell = lhsIn ||

576+ lhsExtension sources,

577+ stateStandalone = standalone',

563578#ifdef _CITEPROC

564− stateCitations = map citeKey refs,

579+ stateCitations = map citeKey refs,

565580#endif

566− stateSmart = smart || writerName' `elem`

567− ["latex", "context"],

568− stateColumns = columns,

569− stateStrict = strict }

581+ stateSmart = smart || writerName' `elem`

582+ ["latex", "context"],

583+ stateColumns = columns,

584+ stateStrict = strict }

570585 let csslink = if null css

571586 then ""

572587 else concatMap

Text/Pandoc/Readers/Markdown.hs+27

@@ -45,6 +45,7 @@ import Text.Pandoc.Readers.HTML ( rawHtmlBlock, anyHtmlBlockTag,

4545 htmlBlockElement, unsanitaryURI )

4646import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )

4747import Text.ParserCombinators.Parsec

48+import Control.Monad (when)

4849

4950-- | Read markdown from an input string and return a Pandoc document.

5051readMarkdown :: ParserState -> String -> Pandoc

@@ -102,6 +103,12 @@ failUnlessSmart = do

102103 state <- getState

103104 if stateSmart state then return () else fail "Smart typography feature"

104105

106+-- | Fail unless we're in literate haskell mode.

107+failUnlessLHS :: GenParser tok ParserState ()

108+failUnlessLHS = do

109+ state <- getState

110+ if stateLiterateHaskell state then return () else fail "Literate haskell feature"

111+

105112-- | Parse a sequence of inline elements between square brackets,

106113-- including inlines between balanced pairs of square brackets.

107114inlinesInBalancedBrackets :: GenParser Char ParserState Inline

@@ -268,6 +275,7 @@ block = do

268275 , header

269276 , table

270277 , codeBlockIndented

278+ , lhsCodeBlock

271279 , blockQuote

272280 , hrule

273281 , bulletList

@@ -393,6 +401,25 @@ codeBlockIndented = do

393401 optional blanklines

394402 return $ CodeBlock ("",[],[]) $ stripTrailingNewlines $ concat contents

395403

404+lhsCodeBlock :: GenParser Char ParserState Block

405+lhsCodeBlock = do

406+ failUnlessLHS

407+ pos <- getPosition

408+ when (sourceColumn pos /= 1) $ fail "Not in first column"

409+ lns <- many1 birdTrackLine

410+ -- if (as is normal) there is always a space after >, drop it

411+ let lns' = if all (\ln -> null ln || take 1 ln == " ") lns

412+ then map (drop 1) lns

413+ else lns

414+ blanklines

415+ return $ CodeBlock ("",["haskell"],[]) $ intercalate "\n" lns'

416+

417+birdTrackLine :: GenParser Char st [Char]

418+birdTrackLine = do

419+ char '>'

420+ manyTill anyChar newline

421+

422+

396423--

397424-- block quotes

398425--

Text/Pandoc/Shared.hs+2

@@ -635,6 +635,7 @@ data ParserState = ParserState

635635 stateDate :: String, -- ^ Date of document

636636 stateStrict :: Bool, -- ^ Use strict markdown syntax?

637637 stateSmart :: Bool, -- ^ Use smart typography?

638+ stateLiterateHaskell :: Bool, -- ^ Treat input as literate haskell

638639 stateColumns :: Int, -- ^ Number of columns in terminal

639640 stateHeaderTable :: [HeaderType] -- ^ Ordered list of header types used

640641 }

@@ -658,6 +659,7 @@ defaultParserState =

658659 stateDate = [],

659660 stateStrict = False,

660661 stateSmart = False,

662+ stateLiterateHaskell = False,

661663 stateColumns = 80,

662664 stateHeaderTable = [] }

663665