90e0077 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

introduce the `padded` function to use fewer `whitespace` markers

90e0077Evan Czaplicki13 years ago

compiler/Parse/Declaration.hs+9−10

compare with master

unifiedsplit

@@ -27,7 +27,7 @@ alias = do

27 forcedWS

28 alias <- capVar

29 args <- spacePrefix lowVar

30− whitespace ; string "=" ; whitespace

30+ padded equals

31 tipe <- Type.expr

32 return (TypeAlias alias args tipe)

@@ -37,7 +37,7 @@ datatype = do

37 forcedWS

38 name <- capVar <?> "name of data-type"

39 args <- spacePrefix lowVar

40− whitespace ; string "=" ; whitespace

40+ padded equals

41 tcs <- pipeSep1 Type.constructor

42 return $ Datatype name args tcs

@@ -47,7 +47,7 @@ infixDecl = do

47 assoc <- choice [ reserved "infixl" >> return L

48 , reserved "infix" >> return N

49 , reserved "infixr" >> return R ]

50− whitespace

50+ forcedWS

51 n <- digit

52 forcedWS

53 Fixity assoc (read [n]) <$> anyOp

@@ -61,11 +61,11 @@ foreignDef = do

62exportEvent :: IParser (Declaration t v)

63exportEvent = do

64− try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace

64+ try (reserved "export") >> padded (reserved "jsevent")

65 eventName <- jsVar

66 whitespace

67 elmVar <- lowVar

68− whitespace ; hasType ; whitespace

68+ padded hasType

69 tipe <- Type.expr

70 case tipe of

71 T.Data "Signal" [t] ->

@@ -76,13 +76,12 @@ exportEvent = do

77importEvent :: IParser (Declaration t v)

78importEvent = do

79− try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace

79+ try (reserved "import") >> padded (reserved "jsevent")

80 eventName <- jsVar

81− whitespace

81+ baseValue <- padded Expr.term

82− baseValue <- Expr.term <?> "Base case for imported signal (signals cannot be undefined)"

82+ <?> "Base case for imported signal (signals cannot be undefined)"

83− whitespace

84 elmVar <- lowVar <?> "Name of imported signal"

83 elmVar <- lowVar <?> "Name of imported signal"

85− whitespace ; hasType ; whitespace

84+ padded hasType

86 tipe <- Type.expr

85 tipe <- Type.expr

87 case tipe of

86 case tipe of

88 T.Data "Signal" [t] ->

87 T.Data "Signal" [t] ->

compiler/Parse/Expression.hs+15−19

@@ -51,7 +51,7 @@ listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)

51 where

52 range = do

53 lo <- expr

54− whitespace >> string ".." >> whitespace

54+ padded (string "..")

55 Range lo <$> expr

57 markdown' = do

@@ -66,9 +66,7 @@ listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)

67 interpolation uid md exprs = do

68 try (string "{{")

69− whitespace

70− e <- expr

69+ e <- padded expr

71− whitespace

72 string "}}"

70 string "}}"

73 return (md ++ span uid (length exprs), exprs ++ [e])

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

@@ -100,7 +98,7 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

100 where field = do

98 where field = do

101 label <- rLabel

99 label <- rLabel

102 patterns <- spacePrefix Pattern.term

100 patterns <- spacePrefix Pattern.term

103− whitespace >> string "=" >> whitespace

101+ padded equals

104 body <- expr

102 body <- expr

105 return (label, makeFunction patterns body)

103 return (label, makeFunction patterns body)

106

104

@@ -108,24 +106,21 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

108

106

109 change = do

107 change = do

110 lbl <- rLabel

108 lbl <- rLabel

111− whitespace >> string "<-" >> whitespace

109+ padded (string "<-")

112 (,) lbl <$> expr

110 (,) lbl <$> expr

113

111

114 remove r = addLocation (string "-" >> whitespace >> Remove r <$> rLabel)

112 remove r = addLocation (string "-" >> whitespace >> Remove r <$> rLabel)

115

113

116 insert r = addLocation $ do

114 insert r = addLocation $ do

117 string "|" >> whitespace

115 string "|" >> whitespace

118− Insert r <$> rLabel <*>

116+ Insert r <$> rLabel <*> (padded equals >> expr)

119− (whitespace >> string "=" >> whitespace >> expr)

120

117

121 modify r = addLocation

118 modify r = addLocation

122 (string "|" >> whitespace >> Modify r <$> commaSep1 change)

119 (string "|" >> whitespace >> Modify r <$> commaSep1 change)

123

120

124 misc = try $ do

121 misc = try $ do

125 record <- addLocation (Var <$> rLabel)

122 record <- addLocation (Var <$> rLabel)

126− whitespace

127− opt <- optionMaybe (remove record)

123+ opt <- padded (optionMaybe (remove record))

128− whitespace

129 case opt of

124 case opt of

130 Just e -> try (insert e) <|> return e

125 Just e -> try (insert e) <|> return e

131 Nothing -> try (insert record) <|> try (modify record)

126 Nothing -> try (insert record) <|> try (modify record)

@@ -159,7 +154,7 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

159 where

154 where

160 normal = do

155 normal = do

161 bool <- expr

156 bool <- expr

162− whitespace ; reserved "then" ; whitespace

157+ padded (reserved "then")

163 thenBranch <- expr

158 thenBranch <- expr

164 whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace

159 whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace

165 elseBranch <- expr

160 elseBranch <- expr

@@ -167,14 +162,14 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

167 (Location.sameAs elseBranch (Var "otherwise"), elseBranch)]

162 (Location.sameAs elseBranch (Var "otherwise"), elseBranch)]

168 multiIf = MultiIf <$> spaceSep1 iff

163 multiIf = MultiIf <$> spaceSep1 iff

169 where iff = do string "|" ; whitespace

164 where iff = do string "|" ; whitespace

170− b <- expr ; whitespace ; string "->" ; whitespace

165+ b <- expr ; padded arrow

171 (,) b <$> expr

166 (,) b <$> expr

172

167

173lambdaExpr :: IParser (LExpr t v)

168lambdaExpr :: IParser (LExpr t v)

174lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

169lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

175 whitespace

170 whitespace

176 args <- spaceSep1 Pattern.term

171 args <- spaceSep1 Pattern.term

177− whitespace ; arrow ; whitespace

172+ padded arrow

178 body <- expr

173 body <- expr

179 return (makeFunction args body)

174 return (makeFunction args body)

180

175

@@ -185,14 +180,15 @@ letExpr :: IParser (Expr t v)

185letExpr = do

180letExpr = do

186 reserved "let" ; whitespace

181 reserved "let" ; whitespace

187 defs <- defSet

182 defs <- defSet

188− whitespace ; reserved "in" ; whitespace

183+ padded (reserved "in")

189 Let defs <$> expr

184 Let defs <$> expr

190

185

191caseExpr :: IParser (Expr t v)

186caseExpr :: IParser (Expr t v)

192caseExpr = do

187caseExpr = do

193− reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace

188+ reserved "case"; e <- padded expr; reserved "of"; whitespace

194 Case e <$> (with <|> without)

189 Case e <$> (with <|> without)

195− where case_ = do p <- Pattern.expr; whitespace; arrow; whitespace

190+ where case_ = do p <- Pattern.expr

191+ padded arrow

196 (,) p <$> expr

192 (,) p <$> expr

197 with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))

193 with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))

198 without = block (do c <- case_ ; whitespace ; return c)

194 without = block (do c <- case_ ; whitespace ; return c)

@@ -229,7 +225,7 @@ makeFunction args body@(L s _) =

229definition :: IParser (Def t v)

225definition :: IParser (Def t v)

230definition = withPos $ do

226definition = withPos $ do

231 (name:args) <- defStart

227 (name:args) <- defStart

232− whitespace >> string "=" >> whitespace

228+ padded equals

233 body <- expr

229 body <- expr

234 return . Def name $ makeFunction args body

230 return . Def name $ makeFunction args body

235

231

@@ -238,7 +234,7 @@ typeAnnotation = TypeAnnotation <$> try start <*> Type.expr

238 where

234 where

239 start = do

235 start = do

240 v <- lowVar <|> parens symOp

236 v <- lowVar <|> parens symOp

241− whitespace ; hasType ; whitespace

237+ padded hasType

242 return v

238 return v

243

239

244def :: IParser (Def t v)

240def :: IParser (Def t v)

compiler/Parse/Helpers.hs+11−2

@@ -93,6 +93,15 @@ symOp = do op <- many1 (satisfy Help.isSymbol)

93 "\8728" -> return "."

94 _ -> return op

96+padded :: IParser a -> IParser a

97+padded p = do whitespace

98+ out <- p

99+ whitespace

100+ return out

101+

102+equals :: IParser String

103+equals = string "="

104+

96arrow :: IParser String

105arrow :: IParser String

97arrow = string "->" <|> string "\8594" <?> "arrow (->)"

106arrow = string "->" <|> string "\8594" <?> "arrow (->)"

107

@@ -106,7 +115,7 @@ commitIf check p = commit <|> try p

106spaceySepBy1 :: IParser b -> IParser a -> IParser [a]

115spaceySepBy1 :: IParser b -> IParser a -> IParser [a]

107spaceySepBy1 sep p = do

116spaceySepBy1 sep p = do

108 a <- p

117 a <- p

109− (a:) <$> many (commitIf (whitespace >> sep) (whitespace >> sep >> whitespace >> p))

118+ (a:) <$> many (commitIf (whitespace >> sep) (padded sep >> p))

110

119

111

120

112commaSep1 :: IParser a -> IParser [a]

121commaSep1 :: IParser a -> IParser [a]

@@ -154,7 +163,7 @@ betwixt a b c = do char a ; out <- c

154 char b <?> "closing '" ++ [b] ++ "'" ; return out

163 char b <?> "closing '" ++ [b] ++ "'" ; return out

155

164

156surround a z name p = do

165surround a z name p = do

157− char a ; whitespace ; v <- p ; whitespace

166+ char a ; v <- padded p

158 char z <?> unwords ["closing", name, show z]

167 char z <?> unwords ["closing", name, show z]

159 return v

168 return v

160

169