3ef0720 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Stop building whitespace strings

3ef0720Evan Czaplicki10 years ago

src/Parse/Expression.hs+2−2

compare with master

unifiedsplit

@@ -178,8 +178,8 @@ appExpr :: IParser Src.RawExpr

178appExpr =

179 expecting "an expression" $

180 do t <- term

181− ts <- constrainedSpacePrefix term $ \str ->

181+ ts <- constrainedSpacePrefix term $ \hasSpace ->

182− if null str then notFollowedBy (char '-') else return ()

182+ if hasSpace then return () else notFollowedBy (char '-')

183 return $

184 case ts of

185 [] -> t

src/Parse/Helpers.hs+98−59

@@ -123,13 +123,13 @@ commitIf check p =

123 try (lookAhead check) >> p

124

125

126−anyUntil :: IParser String -> IParser String

126+anyUntil :: IParser () -> IParser ()

127anyUntil end =

128− go

128+ let

129− where

130 go =

129 go =

131− end <|> (:) <$> anyChar <*> go

130+ end <|> (anyChar >> go)

132−

131+ in

132+ go

133

134

135followedBy :: IParser a -> IParser b -> IParser a

@@ -194,7 +194,7 @@ spacePrefix p =

194 constrainedSpacePrefix p (\_ -> return ())

195

196

197−constrainedSpacePrefix :: IParser a -> (String -> IParser ()) -> IParser [a]

197+constrainedSpacePrefix :: IParser a -> (Bool -> IParser ()) -> IParser [a]

198constrainedSpacePrefix parser constraint =

199 many $ choice

200 [ try (spacing >> lookAhead (oneOf "[({\"'")) >> parser

@@ -202,8 +202,8 @@ constrainedSpacePrefix parser constraint =

202 ]

203 where

204 spacing = do

205− n <- whitespace

205+ bool <- whitespace

206− constraint n <?> Syntax.whitespace

206+ constraint bool

207 indented

208

209

@@ -212,26 +212,28 @@ constrainedSpacePrefix parser constraint =

212

213

214surround :: Char -> Char -> String -> IParser a -> IParser a

215−surround a z name p = do

215+surround start end name parser =

216− char a

216+ do char start

217− v <- padded p

217+ whitespace

218+ value <- parser

219+ whitespace

218− char z <?> unwords ["a closing", name, show z]

220+ char end <?> unwords ["a closing", name, show end]

219− return v

221+ return value

220

222

221

223

222braces :: IParser a -> IParser a

224braces :: IParser a -> IParser a

223−braces =

225+braces parser =

224− surround '[' ']' "brace"

226+ surround '[' ']' "brace" parser

225

227

226

228

227parens :: IParser a -> IParser a

229parens :: IParser a -> IParser a

228−parens =

230+parens parser =

229− surround '(' ')' "paren"

231+ surround '(' ')' "paren" parser

230

232

231

233

232brackets :: IParser a -> IParser a

234brackets :: IParser a -> IParser a

233−brackets =

235+brackets parser =

234− surround '{' '}' "bracket"

236+ surround '{' '}' "bracket" parser

235

237

236

238

237

239

@@ -300,22 +302,37 @@ padded p =

300 return out

302 return out

301

303

302

304

305+plus :: IParser a -> IParser ()

306+plus parser =

307+ parser >> star parser

308+

309+

310+star :: IParser a -> IParser ()

311+star parser =

312+ choice

313+ [ parser >> star parser

314+ , return ()

315+ ]

316+

317+

303−spaces :: IParser String

318+spaces :: IParser ()

304spaces =

319spaces =

305− let space = string " " <|> multiComment <?> Syntax.whitespace

320+ plus $ expecting Syntax.whitespace $

306− in

321+ choice

307− concat <$> many1 space

322+ [ string " " >> return ()

323+ , multiComment

324+ ]

308

325

309

326

310−forcedWS :: IParser String

327+forcedWS :: IParser ()

311forcedWS =

328forcedWS =

312 do failIfTabFound

329 do failIfTabFound

313− ws <- many1 (spaces <|> newline)

330+ plus (spaces <|> newline)

314 failIfTabFound

331 failIfTabFound

315 column <- sourceColumn <$> getPosition

332 column <- sourceColumn <$> getPosition

316 if column == 1

333 if column == 1

317 then fail badWhiteSpaceMessage

334 then fail badWhiteSpaceMessage

318− else return (concat ws)

335+ else return ()

319

336

320

337

321badWhiteSpaceMessage :: String

338badWhiteSpaceMessage :: String

@@ -335,25 +352,27 @@ failIfTabFound =

335

352

336

353

337-- Just eats whitespace until the next meaningful character.

354-- Just eats whitespace until the next meaningful character.

338−dumbWhitespace :: IParser String

355+dumbWhitespace :: IParser ()

339dumbWhitespace =

356dumbWhitespace =

340− concat <$> many (spaces <|> newline)

357+ star (spaces <|> newline)

341

358

342

359

343−whitespace :: IParser String

360+whitespace :: IParser Bool

344whitespace =

361whitespace =

362+ choice

345− option "" forcedWS

363+ [ forcedWS >> return True

364+ , return False

365+ ]

346

366

347

367

348−freshLine :: IParser String

368+freshLine :: IParser ()

349freshLine =

369freshLine =

350− try (

370+ expecting Syntax.freshLine $ try $

351− do ws <- many1 (spaces <|> newline)

371+ do plus (spaces <|> newline)

352− column <- sourceColumn <$> getPosition

372+ column <- sourceColumn <$> getPosition

353− if column == 1

373+ if column == 1

354− then return (concat ws)

374+ then return ()

355− else fail badFreshLineMessage

375+ else fail badFreshLineMessage

356− ) <?> Syntax.freshLine

357

376

358

377

359badFreshLineMessage :: String

378badFreshLineMessage :: String

@@ -362,39 +381,59 @@ badFreshLineMessage =

362 ++ "starts with stuff, not with spaces or comments."

381 ++ "starts with stuff, not with spaces or comments."

363

382

364

383

365−newline :: IParser String

384+newline :: IParser ()

366newline =

385newline =

367 simpleNewline <|> lineComment <?> Syntax.newline

386 simpleNewline <|> lineComment <?> Syntax.newline

368

387

369

388

370−simpleNewline :: IParser String

389+simpleNewline :: IParser ()

371simpleNewline =

390simpleNewline =

372− try (string "\r\n") <|> string "\n"

391+ do try (string "\r\n") <|> string "\n"

392+ return ()

373

393

374

394

375−lineComment :: IParser String

395+lineComment :: IParser ()

376lineComment =

396lineComment =

377 do try (string "--")

397 do try (string "--")

378− comment <- anyUntil $ simpleNewline <|> (eof >> return "\n")

398+ anyUntil (simpleNewline <|> eof)

379− return ("--" ++ comment)

380−

381−

382−docComment :: IParser String

383−docComment =

384− do try (string "{-|")

385− contents <- closeComment

386− return (init (init contents))

387

399

388

400

389−multiComment :: IParser String

401+multiComment :: IParser ()

390multiComment =

402multiComment =

391− (++) <$> try (string "{-" <* notFollowedBy (string "|")) <*> closeComment

403+ do try (string "{-" >> notFollowedBy (string "|"))

404+ closeComment

392

405

393

406

394−closeComment :: IParser String

407+closeComment :: IParser ()

395closeComment =

408closeComment =

396− anyUntil $

409+ choice

397− choice $

410+ [ expecting "the end of a comment -}" $

411+ do try (string "-}")

412+ return ()

413+ , do try (string "{-")

414+ closeComment

415+ closeComment

416+ , do anyChar

417+ closeComment

418+ ]

419+

420+

421+docComment :: IParser String

422+docComment =

423+ do try (string "{-|")

424+ builder <- closeDocComment id

425+ return (builder "")

426+

427+

428+closeDocComment :: (String -> String) -> IParser (String -> String)

429+closeDocComment builder =

430+ choice

398− [ try (string "-}") <?> "the end of a comment -}"

431+ [ expecting "the end of a comment -}" $

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

432+ do try (string "-}")

433+ return builder

434+ , do try (string "{-")

435+ addComment <- closeDocComment (\end -> "{-" ++ end)

436+ closeDocComment (\end -> builder (addComment ("-}" ++ end)))

437+ , do c <- anyChar

438+ closeDocComment (\end -> builder (c:end))

400− ]

439+ ]