5ad0ec5 · elk · git.iko.soy

git.iko.soy/elk

Parse documentation and infix declarations more safely

commit5ad0ec5b7ad18742945cf80cd3074e551e35c4aa authorEvan Czaplicki <info@elm-lang.org> dateThu 17 Oct 2013, 13:40 (13 years ago) parentf43af4b

4 files changed+59−53

compare with master

unifiedsplit

compiler/Docs.hs+1−18 compiler/Parse/Expression.hs+21−21 compiler/Parse/Helpers.hs+34−4 compiler/Parse/Parse.hs+3−10

compiler/Docs.hs+1−18

@@ -77,24 +77,7 @@ moduleDocs = do

7777 return (List.intercalate "." names, exports, structure)

7878

7979document :: IParser [(String, Declaration t v, String)]

80−document = go []

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 ]

80+document = onFreshLines (\t ts -> ts ++ [t]) [] docThing

9881

9982docThing :: IParser (String, Declaration t v, String)

10083docThing = uncommentable <|> commented <|> uncommented ""

compiler/Parse/Expression.hs+21−21

@@ -47,28 +47,28 @@ negative = do

4747-------- Complex Terms --------

4848

4949listTerm :: IParser (Expr t v)

50−listTerm = markdown <|> braces (range <|> ExplicitList <$> commaSep expr)

50+listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)

5151 where

52− range = try $ do lo <- expr

53− whitespace >> string ".." >> whitespace

54− Range lo <$> expr

55−

56− markdown = try (string "[markdown|") >> closeMarkdown "" []

57− where

58− closeMarkdown md exprs =

59− choice [ do try (string "|]")

60− let toMD = Pan.readMarkdown Pan.def . filter (/='\r')

61− return $ Markdown (toMD md) (reverse exprs)

62− , do try (string "{{")

63− whitespace

64− e <- expr

65− whitespace

66− string "}}"

67− let span = "<span id=\"md" ++ show (length exprs) ++ "\" style=\"font-family:monospace;\">{{ ... }}</span>"

68− closeMarkdown (md ++ span) (e:exprs)

69− , do c <- anyChar

70− closeMarkdown (md ++ [c]) exprs

71− ]

52+ range = do

53+ lo <- expr

54+ whitespace >> string ".." >> whitespace

55+ Range lo <$> expr

56+

57+ markdown' = do

58+ (rawText, exprs) <- markdown interpolation

59+ let md = Pan.readMarkdown Pan.def (filter (/='\r') rawText)

60+ return (Markdown md exprs)

61+

62+ span xs = "<span id=\"md" ++ show (length xs) ++

63+ "\" style=\"font-family:monospace;\">{{ ... }}</span>"

64+

65+ interpolation md exprs = do

66+ try (string "{{")

67+ whitespace

68+ e <- expr

69+ whitespace

70+ string "}}"

71+ return (md ++ span exprs, exprs ++ [e])

7272

7373parensTerm :: IParser (LExpr t v)

7474parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)

compiler/Parse/Helpers.hs+34−4

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

11module Parse.Helpers where

3+import Prelude hiding (until)

34import Control.Applicative ((<$>),(<*>))

45import Control.Monad

56import Control.Monad.State

@@ -237,17 +238,36 @@ closeComment =

237238 , concat <$> sequence [ try (string "{-"), closeComment, closeComment ]

238239 ]

239240

241+until :: IParser a -> IParser b -> IParser b

242+until p end = go

243+ where

244+ go = end <|> (p >> go)

245+

240246anyUntil :: IParser String -> IParser String

241247anyUntil end = go

242248 where

243249 go = end <|> (:) <$> anyChar <*> go

244250

245−anyThen :: IParser a -> IParser a

246−anyThen end = go

251+ignoreUntil :: IParser a -> IParser (Maybe a)

252+ignoreUntil end = go

247253 where

248254 ignore p = const () <$> p

249− go = end <|> do ignore multiComment <|> ignore anyChar

250− go

255+ filler = choice [ ignore multiComment

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)

251271

252272withSource :: IParser a -> IParser (String, a)

253273withSource p = do

@@ -266,3 +286,13 @@ anyUntilPos pos = go

266286 True -> return []

267287 False -> (:) <$> anyChar <*> go

268288

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 =

5959 intercalate " " (Map.keys overlap)

6060 ]

6161

62−parseFixities = infixes []

63− where

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

71− Right False -> infixes ops

62+parseFixities = do

63+ decls <- onFreshLines (:) [] infixDecl

64+ return $ Map.fromList [ (op,(lvl,assoc)) | Fixity assoc lvl op <- decls ]

7265

7366setupParser :: IParser a -> String -> Either [P.Doc] a

7467setupParser p source =