-- -- Haddock - A Haskell Documentation Tool -- -- (c) Simon Marlow 2002 -- -- This file was modified and integrated into GHC by David Waern 2006. -- Then moved back into Haddock by Isaac Dupree in 2009 :-) -- Then copied into Pandoc by David Lazar in 2013 :-D { {-# LANGUAGE BangPatterns #-} -- Generated by Alex {-# OPTIONS -Wwarn -w #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details module Text.Pandoc.Readers.Haddock.Lex ( Token(..), LToken, tokenise, tokenPos ) where import Data.Char import Numeric (readHex) } %wrapper "posn" $ws = $white # \n $digit = [0-9] $hexdigit = [0-9a-fA-F] $special = [\"\@] $alphanum = [A-Za-z0-9] $ident = [$alphanum \'\_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~\:] :- -- beginning of a paragraph <0,para> { $ws* \n ; $ws* \> { begin birdtrack } $ws* prop \> .* \n { strtoken TokProperty `andBegin` property} $ws* \>\>\> { strtoken TokExamplePrompt `andBegin` exampleexpr } $ws* [\*\-] { token TokBullet `andBegin` string } $ws* \[ { token TokDefStart `andBegin` def } $ws* \( $digit+ \) { token TokNumber `andBegin` string } $ws* $digit+ \. { token TokNumber `andBegin` string } $ws* { begin string } } -- beginning of a line { $ws* \> { begin birdtrack } $ws* \>\>\> { strtoken TokExamplePrompt `andBegin` exampleexpr } $ws* \n { token TokPara `andBegin` para } -- ^ Here, we really want to be able to say -- $ws* (\n | ) { token TokPara `andBegin` para} -- because otherwise a trailing line of whitespace will result in -- a spurious TokString at the end of a docstring. We don't have , -- though (NOW I realise what it was for :-). To get around this, we always -- append \n to the end of a docstring. () { begin string } } .* \n? { strtokenNL TokBirdTrack `andBegin` line } () { token TokPara `andBegin` para } { $ws* \n { token TokPara `andBegin` para } $ws* \>\>\> { strtoken TokExamplePrompt `andBegin` exampleexpr } () { begin exampleresult } } .* \n { strtokenNL TokExampleExpression `andBegin` example } .* \n { strtokenNL TokExampleResult `andBegin` example } { $special { strtoken $ \s -> TokSpecial (head s) } \<\< [^\>]* \>\> { strtoken $ \s -> TokPic (init $ init $ tail $ tail s) } \< [^\>]* \> { strtoken $ \s -> TokURL (init (tail s)) } \# [^\#]* \# { strtoken $ \s -> TokAName (init (tail s)) } \/ [^\/]* \/ { strtoken $ \s -> TokEmphasis (init (tail s)) } [\'\`] $ident+ [\'\`] { strtoken $ \s -> TokIdent (init (tail s)) } \\ . { strtoken (TokString . tail) } "&#" $digit+ \; { strtoken $ \s -> TokString [chr (read (init (drop 2 s)))] } "&#" [xX] $hexdigit+ \; { strtoken $ \s -> case readHex (init (drop 3 s)) of [(n,_)] -> TokString [chr n] } -- allow special characters through if they don't fit one of the previous -- patterns. [\/\'\`\<\#\&\\] { strtoken TokString } [^ $special \/ \< \# \n \'\` \& \\ \]]* \n { strtokenNL TokString `andBegin` line } [^ $special \/ \< \# \n \'\` \& \\ \]]+ { strtoken TokString } } { \] { token TokDefEnd `andBegin` string } } -- ']' doesn't have any special meaning outside of the [...] at the beginning -- of a definition paragraph. { \] { strtoken TokString } } { -- | A located token type LToken = (Token, AlexPosn) data Token = TokPara | TokNumber | TokBullet | TokDefStart | TokDefEnd | TokSpecial Char | TokIdent String | TokString String | TokURL String | TokPic String | TokEmphasis String | TokAName String | TokBirdTrack String | TokProperty String | TokExamplePrompt String | TokExampleExpression String | TokExampleResult String deriving Show tokenPos :: LToken -> (Int, Int) tokenPos t = let AlexPn _ line col = snd t in (line, col) type StartCode = Int type Action = AlexPosn -> String -> StartCode -> (StartCode -> [LToken]) -> [LToken] tokenise :: String -> (Int, Int) -> [LToken] tokenise str (line, col) = go (posn,'\n',[],eofHack str) para where posn = AlexPn 0 line col go inp@(pos,_,_,str) sc = case alexScan inp sc of AlexEOF -> [] AlexError _ -> [] AlexSkip inp' len -> go inp' sc AlexToken inp' len act -> act pos (take len str) sc (\sc -> go inp' sc) -- NB. we add a final \n to the string, (see comment in the beginning of line -- production above). eofHack str = str++"\n" andBegin :: Action -> StartCode -> Action andBegin act new_sc = \pos str _ cont -> act pos str new_sc cont token :: Token -> Action token t = \pos _ sc cont -> (t, pos) : cont sc strtoken, strtokenNL :: (String -> Token) -> Action strtoken t = \pos str sc cont -> (t str, pos) : cont sc strtokenNL t = \pos str sc cont -> (t (filter (/= '\r') str), pos) : cont sc -- ^ We only want LF line endings in our internal doc string format, so we -- filter out all CRs. begin :: StartCode -> Action begin sc = \_ _ _ cont -> cont sc }