git.iko.soy/elk
on master help sign in
Parse documentation and infix declarations more safely
5ad0ec5Evan Czaplicki
compiler/Docs.hs+1−18
compare with master
unifiedsplit
@@ -77,24 +77,7 @@ moduleDocs = do
77 return (List.intercalate "." names, exports, structure)
77 return (List.intercalate "." names, exports, structure)
78
78
79document :: IParser [(String, Declaration t v, String)]
79document :: IParser [(String, Declaration t v, String)]
80−document = go []
80+document = onFreshLines (\t ts -> ts ++ [t]) [] docThing
81− where
82− go things = do
83− thing <- optionMaybe docThing
84− let things' = case thing of
85− Nothing -> things
86− Just t -> things ++ [t]
87− done <- chompUntilFreshLine
88− case done of
89− True -> return things'
90− False -> go things'
91−
92−-- returns whether the end of file has been reached
93−chompUntilFreshLine :: IParser Bool
94−chompUntilFreshLine =
95− anyThen . choice $
96− [ try (simpleNewline >> notFollowedBy (string " ")) >> return False
97− , eof >> return True ]
98
81
99docThing :: IParser (String, Declaration t v, String)
82docThing :: IParser (String, Declaration t v, String)
100docThing = uncommentable <|> commented <|> uncommented ""
83docThing = uncommentable <|> commented <|> uncommented ""
compiler/Parse/Expression.hs+21−21
@@ -47,28 +47,28 @@ negative = do
47-------- Complex Terms --------
47-------- Complex Terms --------
48
48
49listTerm :: IParser (Expr t v)
49listTerm :: IParser (Expr t v)
50−listTerm = markdown <|> braces (range <|> ExplicitList <$> commaSep expr)
50+listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)
51 where
51 where
52− range = try $ do lo <- expr
52+ range = do
53+ lo <- expr
53− whitespace >> string ".." >> whitespace
54+ whitespace >> string ".." >> whitespace
54− Range lo <$> expr
55+ Range lo <$> expr
55−
56+
56− markdown = try (string "[markdown|") >> closeMarkdown "" []
57+ markdown' = do
57− where
58+ (rawText, exprs) <- markdown interpolation
58− closeMarkdown md exprs =
59− choice [ do try (string "|]")
60− let toMD = Pan.readMarkdown Pan.def . filter (/='\r')
59+ let md = Pan.readMarkdown Pan.def (filter (/='\r') rawText)
61− return $ Markdown (toMD md) (reverse exprs)
60+ return (Markdown md exprs)
62− , do try (string "{{")
61+
63− whitespace
62+ span xs = "<span id=\"md" ++ show (length xs) ++
64− e <- expr
65− whitespace
66− string "}}"
67− let span = "<span id=\"md" ++ show (length exprs) ++ "\" style=\"font-family:monospace;\">{{ ... }}</span>"
63+ "\" style=\"font-family:monospace;\">{{ ... }}</span>"
68− closeMarkdown (md ++ span) (e:exprs)
64+
69− , do c <- anyChar
65+ interpolation md exprs = do
70− closeMarkdown (md ++ [c]) exprs
66+ try (string "{{")
71− ]
67+ whitespace
68+ e <- expr
69+ whitespace
70+ string "}}"
71+ return (md ++ span exprs, exprs ++ [e])
72
72
73parensTerm :: IParser (LExpr t v)
73parensTerm :: IParser (LExpr t v)
74parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
74parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
compiler/Parse/Helpers.hs+34−4
@@ -1,5 +1,6 @@
1module Parse.Helpers where
1module Parse.Helpers where
2
2
3+import Prelude hiding (until)
3import Control.Applicative ((<$>),(<*>))
4import Control.Applicative ((<$>),(<*>))
4import Control.Monad
5import Control.Monad
5import Control.Monad.State
6import Control.Monad.State
@@ -237,17 +238,36 @@ closeComment =
237 , concat <$> sequence [ try (string "{-"), closeComment, closeComment ]
238 , concat <$> sequence [ try (string "{-"), closeComment, closeComment ]
238 ]
239 ]
239
240
241+until :: IParser a -> IParser b -> IParser b
242+until p end = go
243+ where
244+ go = end <|> (p >> go)
245+
240anyUntil :: IParser String -> IParser String
246anyUntil :: IParser String -> IParser String
241anyUntil end = go
247anyUntil end = go
242 where
248 where
243 go = end <|> (:) <$> anyChar <*> go
249 go = end <|> (:) <$> anyChar <*> go
244
250
245−anyThen :: IParser a -> IParser a
251+ignoreUntil :: IParser a -> IParser (Maybe a)
246−anyThen end = go
252+ignoreUntil end = go
247 where
253 where
248 ignore p = const () <$> p
254 ignore p = const () <$> p
249− go = end <|> do ignore multiComment <|> ignore anyChar
255+ filler = choice [ ignore multiComment
250− go
256+ , ignore (markdown (\_ _ -> mzero))
257+ , ignore anyChar
258+ ]
259+ go = choice [ Just <$> end
260+ , filler `until` choice [ const Nothing <$> eof, newline >> go ]
261+ ]
262+
263+onFreshLines :: (a -> b -> b) -> b -> IParser a -> IParser b
264+onFreshLines insert init thing = go init
265+ where
266+ go values = do
267+ optionValue <- ignoreUntil thing
268+ case optionValue of
269+ Nothing -> return values
270+ Just v -> go (insert v values)
251
271
252withSource :: IParser a -> IParser (String, a)
272withSource :: IParser a -> IParser (String, a)
253withSource p = do
273withSource p = do
@@ -266,3 +286,13 @@ anyUntilPos pos = go
266 True -> return []
286 True -> return []
267 False -> (:) <$> anyChar <*> go
287 False -> (:) <$> anyChar <*> go
268
288
289+markdown :: (String -> [a] -> IParser (String, [a])) -> IParser (String, [a])
290+markdown interpolation = try (string "[markdown|") >> closeMarkdown "" []
291+ where
292+ closeMarkdown md stuff =
293+ choice [ do try (string "|]")
294+ return (md, stuff)
295+ , uncurry closeMarkdown =<< interpolation md stuff
296+ , do c <- anyChar
297+ closeMarkdown (md ++ [c]) stuff
298+ ]
compiler/Parse/Parse.hs+3−10
@@ -59,16 +59,9 @@ setupParserWithTable table p source =
59 intercalate " " (Map.keys overlap)
59 intercalate " " (Map.keys overlap)
60 ]
60 ]
61
61
62−parseFixities = infixes []
62+parseFixities = do
63− where
63+ decls <- onFreshLines (:) [] infixDecl
64− eatLine = anyThen (const False <$> simpleNewline <|> const True <$> eof)
65−
66− infixes ops = do
67− next <- Left <$> infixDecl <|> Right <$> eatLine
68− case next of
69− Left (Fixity assoc lvl op) -> infixes ((op,(lvl,assoc)) : ops)
70− Right True -> return $ Map.fromList ops
64+ return $ Map.fromList [ (op,(lvl,assoc)) | Fixity assoc lvl op <- decls ]
71− Right False -> infixes ops
72
65
73setupParser :: IParser a -> String -> Either [P.Doc] a
66setupParser :: IParser a -> String -> Either [P.Doc] a
74setupParser p source =
67setupParser p source =