@@ -1,178 +0,0 @@
1−-- This code was copied from the 'haddock' package, modified, and integrated
2−-- into Pandoc by David Lazar.
3−{
4−{-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
5−-- The above warning supression flag is a temporary kludge.
6−-- While working on this module you are encouraged to remove it and fix
7−-- any warnings in the module. See
8−-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
9−-- for details
10−
11−module Text.Pandoc.Readers.Haddock.Parse (parseString, parseParas) where
12−
13−import Text.Pandoc.Readers.Haddock.Lex
14−import Text.Pandoc.Builder
15−import Text.Pandoc.Shared (trim, trimr)
16−import Data.Generics (everywhere, mkT)
17−import Data.Char (isSpace)
18−import Data.Maybe (fromMaybe)
19−import Data.List (stripPrefix, intersperse)
20−import Data.Monoid (mempty, mconcat)
21−}
22−
23−%expect 0
24−
25−%tokentype { LToken }
26−
27−%token
28− '/' { (TokSpecial '/',_) }
29− '@' { (TokSpecial '@',_) }
30− '[' { (TokDefStart,_) }
31− ']' { (TokDefEnd,_) }
32− DQUO { (TokSpecial '\"',_) }
33− URL { (TokURL $$,_) }
34− PIC { (TokPic $$,_) }
35− ANAME { (TokAName $$,_) }
36− '/../' { (TokEmphasis $$,_) }
37− '-' { (TokBullet,_) }
38− '(n)' { (TokNumber,_) }
39− '>..' { (TokBirdTrack $$,_) }
40− PROP { (TokProperty $$,_) }
41− PROMPT { (TokExamplePrompt $$,_) }
42− RESULT { (TokExampleResult $$,_) }
43− EXP { (TokExampleExpression $$,_) }
44− IDENT { (TokIdent $$,_) }
45− PARA { (TokPara,_) }
46− STRING { (TokString $$,_) }
47−
48−%monad { Either [LToken] }
49−
50−%name parseParas doc
51−%name parseString seq
52−
53−%%
54−
55−doc :: { Blocks }
56− : apara PARA doc { $1 <> $3 }
57− | PARA doc { $2 }
58− | apara { $1 }
59− | {- empty -} { mempty }
60−
61−apara :: { Blocks }
62− : ulpara { bulletList [$1] }
63− | olpara { orderedList [$1] }
64− | defpara { definitionList [$1] }
65− | para { $1 }
66−
67−ulpara :: { Blocks }
68− : '-' para { $2 }
69−
70−olpara :: { Blocks }
71− : '(n)' para { $2 }
72−
73−defpara :: { (Inlines, [Blocks]) }
74− : '[' seq ']' seq { (trimInlines $2, [plain $ trimInlines $4]) }
75−
76−para :: { Blocks }
77− : seq { para' $1 }
78− | codepara { codeBlockWith ([], ["haskell"], []) $1 }
79− | property { $1 }
80− | examples { $1 }
81−
82−codepara :: { String }
83− : '>..' codepara { $1 ++ $2 }
84− | '>..' { $1 }
85−
86−property :: { Blocks }
87− : PROP { makeProperty $1 }
88−
89−examples :: { Blocks }
90− : example examples { $1 <> $2 }
91− | example { $1 }
92−
93−example :: { Blocks }
94− : PROMPT EXP result { makeExample $1 $2 (lines $3) }
95− | PROMPT EXP { makeExample $1 $2 [] }
96−
97−result :: { String }
98− : RESULT result { $1 ++ $2 }
99− | RESULT { $1 }
100−
101−seq :: { Inlines }
102− : elem seq { $1 <> $2 }
103− | elem { $1 }
104−
105−elem :: { Inlines }
106− : elem1 { $1 }
107− | '@' seq1 '@' { monospace $2 }
108−
109−seq1 :: { Inlines }
110− : PARA seq1 { linebreak <> $2 }
111− | elem1 seq1 { $1 <> $2 }
112− | elem1 { $1 }
113−
114−elem1 :: { Inlines }
115− : STRING { text $1 }
116− | '/../' { emph (str $1) }
117− | URL { makeHyperlink $1 }
118− | PIC { image $1 $1 mempty }
119− | ANAME { mempty } -- TODO
120− | IDENT { codeWith ([], ["haskell"], []) $1 }
121− | DQUO strings DQUO { codeWith ([], ["haskell"], []) $2 }
122−
123−strings :: { String }
124− : STRING { $1 }
125− | STRING strings { $1 ++ $2 }
126−
127−{
128−happyError :: [LToken] -> Either [LToken] a
129−happyError toks = Left toks
130−
131−para' :: Inlines -> Blocks
132−para' = para . trimInlines
133−
134−monospace :: Inlines -> Inlines
135−monospace = everywhere (mkT go)
136− where
137− go (Str s) = Code nullAttr s
138− go x = x
139−
140−-- | Create a `Hyperlink` from given string.
141−--
142−-- A hyperlink consists of a URL and an optional label. The label is separated
143−-- from the url by one or more whitespace characters.
144−makeHyperlink :: String -> Inlines
145−makeHyperlink input = case break isSpace $ trim input of
146− (url, "") -> link url url (str url)
147− (url, lb) -> link url url (trimInlines $ text lb)
148−
149−makeProperty :: String -> Blocks
150−makeProperty s = case trim s of
151− 'p':'r':'o':'p':'>':xs ->
152− codeBlockWith ([], ["property"], []) (dropWhile isSpace xs)
153− xs ->
154− error $ "makeProperty: invalid input " ++ show xs
155−
156−-- | Create an 'Example', stripping superfluous characters as appropriate
157−makeExample :: String -> String -> [String] -> Blocks
158−makeExample prompt expression result =
159− para $ codeWith ([], ["haskell","expr"], []) (trim expression)
160− <> linebreak
161− <> (mconcat $ intersperse linebreak $ map coder result')
162− where
163− -- 1. drop trailing whitespace from the prompt, remember the prefix
164− prefix = takeWhile isSpace prompt
165−
166− -- 2. drop, if possible, the exact same sequence of whitespace
167− -- characters from each result line
168− --
169− -- 3. interpret lines that only contain the string "<BLANKLINE>" as an
170− -- empty line
171− result' = map (substituteBlankLine . tryStripPrefix prefix) result
172− where
173− tryStripPrefix xs ys = fromMaybe ys $ stripPrefix xs ys
174−
175− substituteBlankLine "<BLANKLINE>" = ""
176− substituteBlankLine line = line
177− coder = codeWith ([], ["result"], [])
178−}