26ec347 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Change how whitespace is checked

26ec347Evan Czaplicki10 years ago

src/Parse/Helpers.hs+38−22

compare with master

unifiedsplit

@@ -4,10 +4,10 @@ module Parse.Helpers

4 ( module Parse.Primitives

5 , SParser

6 , qualifiedVar, qualifiedCapVar

7− , equals, rightArrow, hasType, comma, pipe, cons, dot, underscore, lambda

7+ , equals, rightArrow, hasType, comma, pipe, cons, dot, minus, underscore, lambda

8 , leftParen, rightParen, leftSquare, rightSquare, leftCurly, rightCurly

9 , addLocation

10− , spaces, checkSpaces

10+ , spaces, checkSpace, checkAligned, checkFreshline

11 )

12 where

@@ -25,7 +25,7 @@ import qualified Reporting.Region as R

27type SParser a =

28− Parser (a, R.Position, Space)

28+ Parser (a, R.Position, SPos)

@@ -55,7 +55,7 @@ qualifiedVarHelp allCaps vars =

55 [ do var <- capVar

56 qualifiedVarHelp allCaps (var:vars)

57 , if allCaps then

58− failure (error "TODO")

58+ failure False -- TODO

59 else

60 do var <- lowVar

61 return (Text.intercalate "." (reverse (var:vars)))

@@ -117,6 +117,12 @@ dot =

117 Prim.text "."

118

119

120+{-# INLINE minus #-}

121+minus :: Parser ()

122+minus =

123+ Prim.text "-"

124+

125+

120{-# INLINE underscore #-}

126{-# INLINE underscore #-}

121underscore :: Parser ()

127underscore :: Parser ()

122underscore =

128underscore =

@@ -190,21 +196,31 @@ addLocation parser =

190

196

191spaces :: Parser ()

197spaces :: Parser ()

192spaces =

198spaces =

193− do space <- whitespace

199+ do (SPos (R.Position _ col)) <- whitespace

194− case space of

200+ indent <- getIndent

201+ if col > indent && col > 1

195− None -> return ()

202+ then return ()

196− AfterIndent -> return ()

203+ else failure False -- TODO

197− BeforeIndent -> failure (error "TODO")

204+

198− Aligned -> failure (error "TODO")

205+

199− Freshline -> failure (error "TODO")

206+checkSpace :: SPos -> Parser ()

200−

207+checkSpace (SPos (R.Position _ col)) =

201−

208+ do indent <- getIndent

202−checkSpaces :: Space -> Parser ()

209+ if col > indent && col > 1

203−checkSpaces space =

210+ then return ()

204− case space of

211+ else deadend False -- TODO

212+

213+

214+checkAligned :: SPos -> Parser ()

215+checkAligned (SPos (R.Position _ col)) =

216+ do indent <- getIndent

217+ if col == indent

205− None -> return ()

218+ then return ()

206− AfterIndent -> return ()

219+ else deadend False -- TODO

207− BeforeIndent -> deadend (error "TODO")

220+

208− Aligned -> deadend (error "TODO")

221+

222+checkFreshline :: SPos -> Parser ()

223+checkFreshline (SPos (R.Position _ col)) =

224+ if col == 1

225+ then return ()

209− Freshline -> deadend (error "TODO")

226+ else deadend False -- TODO

210−

src/Parse/Primitives.hs+90−46

@@ -9,7 +9,7 @@ module Parse.Primitives

9 , lowVar, capVar, infixOp

10 , getPosition, getCol

11 , getIndent, setIndent

12− , Space(..), whitespace

12+ , SPos(..), whitespace

13 , docComment

14 , string, character

15 , digit, number

@@ -166,8 +166,8 @@ oneOf parsers =

166

167allTheOptionsFailed :: Parser a

168allTheOptionsFailed =

169− Parser $ \_ _ _ _ eerr ->

169+ Parser $ \(State _ _ _ _ row col) _ _ _ eerr ->

170− eerr $ error "TODO allTheOptionsFailed"

170+ eerr (Error row col)

171

172

173oneOfHelp :: Parser a -> Parser a -> Parser a

@@ -177,7 +177,7 @@ oneOfHelp parser1 parser2 =

177 meerr err =

178 let

179 neok y state' = eok y state'

180− neerr err' = eerr (error "TODO oneOfHelp" err err')

180+ neerr _err' = eerr err -- TODO merge things properly

181 in

182 _run parser2 state cok cerr neok neerr

183 in

@@ -199,14 +199,14 @@ instance Monad Parser where

199 cok' x state1 =

200 let

201 peok y state2 = cok y state2

202− peerr err = cerr (error "TODO >>= cok" err)

202+ peerr err = cerr err -- TODO is this correct?

203 in

204 _run (callback x) state1 cok cerr peok peerr

205

206 eok' x state1 =

207 let

208 peok y state2 = eok y state2

209− peerr err = eerr (error "TODO >>= eok" err)

209+ peerr err = eerr err -- TODO is this correct?

210 in

211 _run (callback x) state1 cok cerr peok peerr

212 in

@@ -228,7 +228,7 @@ text (Text.Text tArray tOffset tLen) =

228 cok () (State array (offset + tLen) (length - tLen) indent newRow newCol)

229

230 else

231− eerr (error "TODO text")

231+ eerr (Error row col)

232

233

234moveCursor :: Text.Array -> Int -> Int -> Int -> Int -> (# Int, Int #)

@@ -259,7 +259,7 @@ keyword (Text.Text tArray tOffset tLen) =

259 Parser $ \(State array offset length indent row col) cok _ _ eerr ->

260 if tLen <= length && Text.equal tArray tOffset array offset tLen then

261

262− if Char.isAlphaNum (peekChar array (offset + tLen)) then

262+ if isInnerVarChar (peekChar array (offset + tLen)) then

263 eerr (error "TODO keyword 1")

264 else

265 let

@@ -269,7 +269,7 @@ keyword (Text.Text tArray tOffset tLen) =

269 cok () (State array (offset + tLen) (length - tLen) indent newRow newCol)

270

271 else

272− eerr (error "TODO keyword 2")

272+ eerr (Error row col)

273

274

275keywords :: Set.Set Text

@@ -369,13 +369,19 @@ varPrimHelp array offset length col =

369 let

370 (Text.Iter char size) = peek array offset -- TODO look for latin chars directly?

371 in

372− if Char.isAlphaNum char || char == '_' then

372+ if isInnerVarChar char then

373 varPrimHelp array (offset + size) (length - size) (col + 1)

374

375 else

376 (# offset, length, col #)

377

378

379+{-# INLINE isInnerVarChar #-}

380+isInnerVarChar :: Char -> Bool

381+isInnerVarChar char =

382+ Char.isAlphaNum char || char == '_'

383+

384+

379

385

380-- INFIX OPS

386-- INFIX OPS

381

387

@@ -461,16 +467,11 @@ setIndent indent =

461-- WHITESPACE

467-- WHITESPACE

462

468

463

469

464−data Space

470+newtype SPos =

465− = None

471+ SPos Region.Position

466− | Freshline

467− | BeforeIndent

468− | Aligned

469− | AfterIndent

470− deriving (Eq)

471

472

473

473−whitespace :: Parser Space

474+whitespace :: Parser SPos

474whitespace =

475whitespace =

475 Parser $ \(State array offset length indent row col) cok cerr _ _ ->

476 Parser $ \(State array offset length indent row col) cok cerr _ _ ->

476 case eatSpaces array offset length row col of

477 case eatSpaces array offset length row col of

@@ -478,20 +479,9 @@ whitespace =

478 cerr err

479 cerr err

479

480

480 Right (newOffset, newLength, newRow, newCol) ->

481 Right (newOffset, newLength, newRow, newCol) ->

481− let

482+ cok

482− !space =

483+ (SPos (Region.Position newRow newCol))

483− if newOffset == offset then

484− None -- TODO empty success?

485− else if newCol == 1 then

486− Freshline

487− else if newCol > indent then

488− AfterIndent

489− else if newCol == indent then

490− Aligned

491− else

492− BeforeIndent

493− in

494− cok space (State array newOffset newLength indent newRow newCol)

484+ (State array newOffset newLength indent newRow newCol)

495

485

496

486

497eatSpaces :: Text.Array -> Int -> Int -> Int -> Int -> Either Error ( Int, Int, Int, Int )

487eatSpaces :: Text.Array -> Int -> Int -> Int -> Int -> Either Error ( Int, Int, Int, Int )

@@ -661,16 +651,26 @@ string =

661 if word /= 0x0022 {- " -} then

651 if word /= 0x0022 {- " -} then

662 eerr (Error row col)

652 eerr (Error row col)

663

653

664− else if Text.unsafeIndex array (offset + 1) == 0x0022 {- " -} && Text.unsafeIndex array (offset + 2) == 0x0022 {- " -} then

665− error "TODO multiString"

666−

667 else

654 else

655+ let

656+ stringResult =

657+ if length >= 3 && isQuote array (offset + 1) && isQuote array (offset + 2) then

658+ multiString array (offset + 3) (length - 3) row (col + 3) (offset + 3) mempty

659+ else

668− case singleString array (offset + 1) (length - 1) row (col + 1) (offset + 1) mempty of

660+ singleString array (offset + 1) (length - 1) row (col + 1) (offset + 1) mempty

661+ in

662+ case stringResult of

669− Left msg ->

663+ Left msg ->

670− cerr msg

664+ cerr msg

665+

666+ Right ( newOffset, newLength, newCol, str ) ->

667+ cok str (State array newOffset newLength indent row newCol)

671

668

672− Right ( newOffset, newLength, newCol, str ) ->

669+

673− cok str (State array newOffset newLength indent row newCol)

670+{-# INLINE isQuote #-}

671+isQuote :: Text.Array -> Int -> Bool

672+isQuote array offset =

673+ Text.unsafeIndex array offset == 0x0022 {- " -}

674

675

676

@@ -744,7 +744,7 @@ eatEscape array offset length row col =

744

745 Just (newOffset, code) ->

746 if code <= 0x10FFFF then

747− Right ( newOffset - offset + 1, toEnum (fromInteger code) )

747+ Right ( 1 + (newOffset - offset), toEnum (fromInteger code) )

748 else

749 Left (Error row col)

750

@@ -754,7 +754,7 @@ eatEscape array offset length row col =

754

755eatHex :: Text.Array -> Int -> Int -> Integer -> Maybe ( Int, Integer )

756eatHex array offset length n =

757− if length == 0 then

757+ if length < 3 then

758 Nothing

759

760 else

@@ -775,6 +775,50 @@ eatHex array offset length n =

775

776

777

778+-- MULTI STRINGS

779+

780+

781+multiString :: Text.Array -> Int -> Int -> Int -> Int -> Int -> LB.Builder -> Either Error ( Int, Int, Int, Text.Text )

782+multiString array offset length row col initialOffset builder =

783+ if length == 0 then

784+ Left (Error row col)

785+

786+ else

787+ let

788+ !word = Text.unsafeIndex array offset

789+ in

790+ if word == 0x0022 {- " -} && isQuote array (offset + 1) && isQuote array (offset + 2) then

791+ let

792+ finalBuilder =

793+ mappend builder $ LB.fromText $

794+ Text.Text array initialOffset (offset - initialOffset)

795+

796+ str =

797+ LT.toStrict (LB.toLazyTextWith (offset - initialOffset) finalBuilder)

798+ in

799+ Right ( offset + 3, length - 3, col + 3, str )

800+

801+ else if word == 0x005C {- \ -} then

802+ case eatEscape array (offset + 1) (length - 1) row (col + 1) of

803+ Left err ->

804+ Left err

805+

806+ Right ( size, char ) ->

807+ let

808+ !newOffset = offset + size

809+ chunk = Text.Text array initialOffset (offset - initialOffset)

810+ newBuilder = mappend builder (mappend (LB.fromText chunk) (LB.singleton char))

811+ in

812+ multiString array newOffset (length - size) row (col + size) newOffset newBuilder

813+

814+ else if word < 0xD800 || word > 0xDBFF then

815+ multiString array (offset + 1) (length - 1) row (col + 1) initialOffset builder

816+

817+ else

818+ multiString array (offset + 2) (length - 2) row (col + 1) initialOffset builder

819+

820+

821+

778-- CHARACTER

822-- CHARACTER

779

823

780

824

@@ -798,14 +842,14 @@ character =

798

842

799 Right ( size, char ) ->

843 Right ( size, char ) ->

800 let

844 let

801− !newOffset = offset + size

845+ !newOffset = offset + size + 1

802− !newLength = length + size

846+ !newLength = length - size - 1

803 in

847 in

804 if newLength == 0 then

848 if newLength == 0 then

805 cerr (Error row col)

849 cerr (Error row col)

806

850

807 else if Text.unsafeIndex array newOffset == 0x0027 {- ' -} then

851 else if Text.unsafeIndex array newOffset == 0x0027 {- ' -} then

808− cok char (State array newOffset newLength indent row (col + size + 2))

852+ cok char (State array (newOffset + 1) (newLength - 1) indent row (col + size + 2))

809

853

810 else

854 else

811 cerr (Error row col)

855 cerr (Error row col)

@@ -828,7 +872,7 @@ characterHelp array offset length row col =

828 else if word < 0xD800 || word > 0xDBFF then

872 else if word < 0xD800 || word > 0xDBFF then

829 Right (1, unsafeChr word)

873 Right (1, unsafeChr word)

830

874

831− else if length > 0 then

875+ else if length > 2 then

832 Right (2, chr2 word (Text.unsafeIndex array offset))

876 Right (2, chr2 word (Text.unsafeIndex array offset))

833

877

834 else

878 else