8c16ed7 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Merge pull request #779 from purescript/lexer3

8c16ed7Phil Freeman12 years ago

hierarchy/Main.hs+3−3

compare with golang

unifiedsplit

@@ -55,9 +55,9 @@ runModuleName :: P.ModuleName -> String

55runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)

57readInput :: FilePath -> IO (Either Par.ParseError [P.Module])

58−readInput p = do

58+readInput filename = do

59− text <- U.readFile p

59+ content <- U.readFile filename

60− return $ P.runIndentParser p P.parseModules text

60+ return $ fmap (map snd) $ P.parseModulesFromFiles id [(filename, content)]

62compile :: HierarchyOptions -> IO ()

63compile (HierarchyOptions input mOutput) = do

psci/Main.hs+5−3

@@ -127,7 +127,9 @@ getHistoryFilename = do

127-- Loads a file for use with imports.

128--

129loadModule :: FilePath -> IO (Either String [P.Module])

130−loadModule filename = either (Left . show) Right . P.runIndentParser filename P.parseModules <$> U.readFile filename

130+loadModule filename = do

131+ content <- U.readFile filename

132+ return $ either (Left . show) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]

131

133

132-- |

134-- |

133-- Load all modules, including the Prelude

135-- Load all modules, including the Prelude

@@ -441,7 +443,7 @@ handleKindOf typ = do

441-- |

443-- |

442-- Parses the input and returns either a Metacommand or an expression.

444-- Parses the input and returns either a Metacommand or an expression.

443--

445--

444−getCommand :: Bool -> InputT (StateT PSCiState IO) (Either Par.ParseError (Maybe Command))

446+getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))

445getCommand singleLineMode = do

447getCommand singleLineMode = do

446 firstLine <- getInputLine "> "

448 firstLine <- getInputLine "> "

447 case firstLine of

449 case firstLine of

@@ -519,7 +521,7 @@ loop (PSCiOptions singleLineMode files) = do

519 go = do

521 go = do

520 c <- getCommand singleLineMode

522 c <- getCommand singleLineMode

521 case c of

523 case c of

522− Left err -> outputStrLn (show err) >> go

524+ Left err -> outputStrLn err >> go

523 Right Nothing -> go

525 Right Nothing -> go

524 Right (Just Quit) -> outputStrLn quitMessage

526 Right (Just Quit) -> outputStrLn quitMessage

525 Right (Just c') -> runPSCI (handleCommand c') >> go

527 Right (Just c') -> runPSCI (handleCommand c') >> go

psci/Parser.hs+49−79

@@ -17,6 +17,8 @@ module Parser (

17 parseCommand

18 ) where

20+import Prelude hiding (lex)

21+

20import Commands

22import Commands

22import Data.Char (isSpace)

24import Data.Char (isSpace)

@@ -28,85 +30,53 @@ import Text.Parsec hiding ((<|>))

28import qualified Language.PureScript as P

30import qualified Language.PureScript as P

29import qualified Language.PureScript.Parser.Common as C (mark, same)

31import qualified Language.PureScript.Parser.Common as C (mark, same)

31−-- |

32−-- PSCI version of @let@.

33−-- This is essentially let from do-notation.

34−-- However, since we don't support the @Eff@ monad,

35−-- we actually want the normal @let@.

36−--

37−psciLet :: Parsec String P.ParseState Command

38−psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> C.mark (many1 (C.same *> P.parseDeclaration))))

39−

40-- |

33-- |

41-- Parses PSCI metacommands or expressions input from the user.

34-- Parses PSCI metacommands or expressions input from the user.

42--

35--

43−parseCommand :: String -> Either ParseError Command

36+parseCommand :: String -> Either String Command

44−parseCommand = P.runIndentParser "" $ choice

37+parseCommand cmdString =

38+ case splitCommand cmdString of

46− , try psciLet

39+ Just ('?', _) -> return Help

47− , psciExpression

40+ Just ('q', _) -> return Quit

48− ] <* eof

41+ Just ('r', _) -> return Reset

49−

42+ Just ('i', moduleName) -> Import <$> parseRest P.moduleName moduleName

43+ Just ('b', moduleName) -> Browse <$> parseRest P.moduleName moduleName

44+ Just ('m', filename) -> return $ LoadFile (trimEnd filename)

45+ Just ('s', command) -> return $ Show (trimEnd command)

46+ Just ('t', expr) -> TypeOf <$> parseRest P.parseValue expr

47+ Just ('k', ty) -> KindOf <$> parseRest P.parseType ty

48+ Just _ -> Left $ "Unrecognized command. Type :? for help."

49+ Nothing -> parseRest (psciLet <|> psciExpression) cmdString

50+ where

51+ parseRest :: P.TokenParser a -> String -> Either String a

52+ parseRest p s = either (Left . show) Right $ do

53+ ts <- P.lex "" s

54+ P.runTokenParser "" (p <* eof) ts

55+

56+ trimEnd :: String -> String

57+ trimEnd = reverse . dropWhile isSpace . reverse

58+

59+ -- |

60+ -- Split a command into a command char and the trailing string

61+ --

62+ splitCommand :: String -> Maybe (Char, String)

63+ splitCommand (':' : c : s) = Just (c, dropWhile isSpace s)

64+ splitCommand _ = Nothing

65+

50−-- |

66+ -- |

51−-- Parses expressions entered at the PSCI repl.

67+ -- Parses expressions entered at the PSCI repl.

52−--

68+ --

53−psciExpression :: Parsec String P.ParseState Command

69+ psciExpression :: P.TokenParser Command

54−psciExpression = Expression <$> P.parseValue

70+ psciExpression = Expression <$> P.parseValue

55−

71+

56−-- |

57−-- Parses 'Commands.Help' command.

58−--

59−psciHelp :: Parsec String P.ParseState Command

60−psciHelp = Help <$ char '?'

61−

62−-- |

63−-- Parses 'Commands.Import' command.

64−--

65−psciImport :: Parsec String P.ParseState Command

66−psciImport = Import <$> (char 'i' *> P.whiteSpace *> P.moduleName)

67−

68−-- |

69−-- Parses 'Commands.LoadFile' command.

70−--

71−psciLoadFile :: Parsec String P.ParseState Command

72−psciLoadFile = LoadFile . trimEnd <$> (char 'm' *> P.whiteSpace *> manyTill anyChar eof)

73−

74−-- | Trim end of input string

75−trimEnd :: String -> String

76−trimEnd = reverse . dropWhile isSpace . reverse

77−

78−-- |

79−-- Parses 'Commands.Quit' command.

80−--

81−psciQuit :: Parsec String P.ParseState Command

82−psciQuit = Quit <$ char 'q'

83−

84−-- |

85−-- Parses 'Commands.Reload' command.

86−--

87−psciReload :: Parsec String P.ParseState Command

88−psciReload = Reset <$ char 'r'

89−

90−-- |

72+ -- |

91−-- Parses 'Commands.TypeOf' command.

73+ -- PSCI version of @let@.

92−--

74+ -- This is essentially let from do-notation.

93−psciTypeOf :: Parsec String P.ParseState Command

75+ -- However, since we don't support the @Eff@ monad,

94−psciTypeOf = TypeOf <$> (char 't' *> P.whiteSpace *> P.parseValue)

76+ -- we actually want the normal @let@.

95−

96−

97−-- |

98−-- Parses 'Commands.KindOf' command.

99−--

77+ --

100−psciKindOf :: Parsec String P.ParseState Command

78+ psciLet :: P.TokenParser Command

101−psciKindOf = KindOf <$> (char 'k' *> P.whiteSpace *> P.parseType)

79+ psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> manyDecls))

102−

80+ where

103−-- |

81+ manyDecls :: P.TokenParser [P.Declaration]

104−-- Parses 'Commands.Browse' command.

82+ manyDecls = C.mark (many1 (C.same *> P.parseDeclaration))

105−--

106−psciBrowse :: Parsec String P.ParseState Command

107−psciBrowse = Browse <$> (char 'b' *> P.whiteSpace *> P.moduleName)

108−

109−-- |

110−-- Show Command

111−psciShowModules :: Parsec String P.ParseState Command

112−psciShowModules = Show . trimEnd <$> (char 's' *> P.whiteSpace *> manyTill anyChar eof)

purescript.cabal+7−6

@@ -74,6 +74,7 @@ library

74 Language.PureScript.Names

75 Language.PureScript.Options

76 Language.PureScript.Parser

77+ Language.PureScript.Parser.Lexer

77 Language.PureScript.Parser.Common

78 Language.PureScript.Parser.Common

78 Language.PureScript.Parser.Declarations

79 Language.PureScript.Parser.Declarations

79 Language.PureScript.Parser.Kinds

80 Language.PureScript.Parser.Kinds

@@ -112,7 +113,7 @@ library

112 buildable: True

113 buildable: True

113 hs-source-dirs: src

114 hs-source-dirs: src

114 other-modules: Paths_purescript

115 other-modules: Paths_purescript

115− ghc-options: -Wall -O2

116+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2

116

117

117executable psc

118executable psc

118 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

119 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

@@ -122,7 +123,7 @@ executable psc

122 buildable: True

123 buildable: True

123 hs-source-dirs: psc

124 hs-source-dirs: psc

124 other-modules:

125 other-modules:

125− ghc-options: -Wall -O2 -fno-warn-unused-do-bind

126+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind

126

127

127executable psc-make

128executable psc-make

128 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

129 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

@@ -132,7 +133,7 @@ executable psc-make

132 buildable: True

133 buildable: True

133 hs-source-dirs: psc-make

134 hs-source-dirs: psc-make

134 other-modules:

135 other-modules:

135− ghc-options: -Wall -O2 -fno-warn-unused-do-bind

136+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind

136

137

137executable psci

138executable psci

138 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

139 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

@@ -145,7 +146,7 @@ executable psci

145 hs-source-dirs: psci

146 hs-source-dirs: psci

146 other-modules: Commands

147 other-modules: Commands

147 Parser

148 Parser

148− ghc-options: -Wall -O2

149+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2

149

150

150executable psc-docs

151executable psc-docs

151 build-depends: base >=4 && <5, purescript -any, utf8-string -any,

152 build-depends: base >=4 && <5, purescript -any, utf8-string -any,

@@ -154,7 +155,7 @@ executable psc-docs

154 buildable: True

155 buildable: True

155 hs-source-dirs: psc-docs

156 hs-source-dirs: psc-docs

156 other-modules:

157 other-modules:

157− ghc-options: -Wall -O2

158+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2

158

159

159executable hierarchy

160executable hierarchy

160 build-depends: base >=4 && <5, purescript -any, utf8-string -any, optparse-applicative >= 0.10.0,

161 build-depends: base >=4 && <5, purescript -any, utf8-string -any, optparse-applicative >= 0.10.0,

@@ -163,7 +164,7 @@ executable hierarchy

163 buildable: True

164 buildable: True

164 hs-source-dirs: hierarchy

165 hs-source-dirs: hierarchy

165 other-modules:

166 other-modules:

166− ghc-options: -Wall -O2

167+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2

167

168

168test-suite tests

169test-suite tests

169 build-depends: base >=4 && <5, containers -any, directory -any,

170 build-depends: base >=4 && <5, containers -any, directory -any,

src/Language/PureScript.hs+1−1

@@ -219,7 +219,7 @@ make outputDir opts ms prefix = do

219 rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do

220 let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"

221 externs <- readTextFile externsFile

222− externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs

222+ externsModules <- liftError . fmap (map snd) . either (Left . show) Right $ P.parseModulesFromFiles id [(externsFile, externs)]

223 case externsModules of

224 [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'

225 _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"

src/Language/PureScript/Parser.hs+1

@@ -31,4 +31,5 @@ import Language.PureScript.Parser.Common as P

31import Language.PureScript.Parser.Types as P

32import Language.PureScript.Parser.State as P

33import Language.PureScript.Parser.Kinds as P

34+import Language.PureScript.Parser.Lexer as P

34import Language.PureScript.Parser.Declarations as P

35import Language.PureScript.Parser.Declarations as P

src/Language/PureScript/Parser/Common.hs+26−280

@@ -17,299 +17,46 @@

18module Language.PureScript.Parser.Common where

20−import Data.Functor.Identity

21import Control.Applicative

20import Control.Applicative

22−import Control.Monad

21+import Control.Monad (guard)

23−import Language.PureScript.Parser.State

24−import qualified Text.Parsec as P

25−import qualified Text.Parsec.Token as PT

23+import Language.PureScript.Parser.Lexer

24+import Language.PureScript.Parser.State

27import Language.PureScript.Names

25import Language.PureScript.Names

29−-- |

27+import qualified Text.Parsec as P

30−-- A list of purescript reserved identifiers

31−--

32−reservedPsNames :: [String]

33−reservedPsNames = [ "data"

34− , "newtype"

35− , "type"

36− , "foreign"

37− , "import"

38− , "infixl"

39− , "infixr"

40− , "infix"

41− , "class"

42− , "instance"

43− , "module"

44− , "case"

45− , "of"

46− , "if"

47− , "then"

48− , "else"

49− , "do"

50− , "let"

51− , "true"

52− , "false"

53− , "in"

54− , "where"

55− ]

56−

57−-- |

58−-- The characters allowed for use in operators

59−--

60−opChars :: [Char]

61−opChars = ":!#$%&*+./<=>?@\\^|-~"

62−

63−-- |

64−-- A list of reserved identifiers for types

65−--

66−reservedTypeNames :: [String]

67−reservedTypeNames = [ "forall"

68− , "where" ]

69−

70−-- |

71−-- A list of reserved operators

72−--

73−reservedOpNames :: [String]

74−reservedOpNames = [ "=>", "->", "=", ".", "\\", "|" ]

75−

76−-- |

77−-- Valid first characters for an identifier

78−--

79−identStart :: P.Parsec String u Char

80−identStart = P.lower <|> P.oneOf "_"

81−

82−-- |

83−-- Valid identifier characters

84−--

85−identLetter :: P.Parsec String u Char

86−identLetter = P.alphaNum <|> P.oneOf "_'"

87−

88−-- |

89−-- Valid first characters for an operator

90−--

91−opStart :: P.Parsec String u Char

92−opStart = P.oneOf opChars

93−

94−-- |

95−-- Valid operators characters

96−--

97−opLetter :: P.Parsec String u Char

98−opLetter = P.oneOf opChars

99−

100−-- |

101−-- The PureScript language definition

102−--

103−langDef :: PT.GenLanguageDef String u Identity

104−langDef = PT.LanguageDef

105− { PT.reservedNames = reservedPsNames

106− , PT.reservedOpNames = reservedOpNames

107− , PT.commentStart = "{-"

108− , PT.commentEnd = "-}"

109− , PT.commentLine = "--"

110− , PT.nestedComments = True

111− , PT.identStart = identStart

112− , PT.identLetter = identLetter

113− , PT.opStart = opStart

114− , PT.opLetter = opLetter

115− , PT.caseSensitive = True

116− }

117−

118−-- |

119−-- A token parser based on the language definition

120−--

121−tokenParser :: PT.GenTokenParser String u Identity

122−tokenParser = PT.makeTokenParser langDef

123−

124−-- |

125−-- Parse a token

126−--

127−lexeme :: P.Parsec String u a -> P.Parsec String u a

128−lexeme = PT.lexeme tokenParser

129−

130−-- |

131−-- Parse an identifier

132−--

133−identifier :: P.Parsec String u String

134−identifier = PT.identifier tokenParser

135−

136−-- |

137−-- Parse an identifier in a more permissive position

138−--

139−identifierName :: P.Parsec String u String

140−identifierName = lexeme $ (:) <$> identStart <*> many identLetter

141−

142−-- |

143−-- Parse a reserved word

144−--

145−reserved :: String -> P.Parsec String u ()

146−reserved = PT.reserved tokenParser

147−

148−-- |

149−-- Parse a reserved operator

150−--

151−reservedOp :: String -> P.Parsec String u ()

152−reservedOp = PT.reservedOp tokenParser

153−

154−-- |

155−-- Parse an operator

156−--

157−operator :: P.Parsec String u String

158−operator = PT.operator tokenParser

159−

160−-- |

161−-- Parse a string literal

162−--

163−stringLiteral :: P.Parsec String u String

164−stringLiteral = lexeme blockString <|> PT.stringLiteral tokenParser

165− where delimeter = P.try (P.string "\"\"\"")

166− blockString = delimeter >> P.manyTill P.anyChar delimeter

167−

168−-- |

169−-- Parse whitespace

170−--

171−whiteSpace :: P.Parsec String u ()

172−whiteSpace = PT.whiteSpace tokenParser

173−

174−-- |

175−-- Semicolon

176−--

177−semi :: P.Parsec String u String

178−semi = PT.semi tokenParser

179−

180−-- |

181−-- Colon

182−--

183−colon :: P.Parsec String u String

184−colon = PT.colon tokenParser

185−

186−-- |

187−-- Period

188−--

189−dot :: P.Parsec String u String

190−dot = PT.dot tokenParser

191−

192−-- |

193−-- Comma

194−--

195−comma :: P.Parsec String u String

196−comma = PT.comma tokenParser

197−

198−-- |

199−-- Backtick

200−--

201−tick :: P.Parsec String u Char

202−tick = lexeme $ P.char '`'

203−

204−-- |

205−-- Pipe character

206−--

207−pipe :: P.Parsec String u Char

208−pipe = lexeme $ P.char '|'

209−

210−-- |

211−-- Natural number

212−--

213−natural :: P.Parsec String u Integer

214−natural = PT.natural tokenParser

215

216−-- |

217−-- Parse a proper name

218−--

219−properName :: P.Parsec String u ProperName

29+properName :: TokenParser ProperName

220−properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many P.alphaNum P.<?> "name")

30+properName = ProperName <$> uname

221

222-- |

32-- |

223-- Parse a module name

33-- Parse a module name

224--

34--

225−moduleName :: P.Parsec String ParseState ModuleName

35+moduleName :: TokenParser ModuleName

226−moduleName = ModuleName <$> P.try (sepBy properName dot)

36+moduleName = part []

37+ where

38+ part path = (do name <- ProperName <$> P.try qualifier

39+ part (path `snoc` name))

40+ <|> (ModuleName . snoc path <$> properName)

41+ snoc path name = path ++ [name]

227

228-- |

43-- |

229-- Parse a qualified name, i.e. M.name or just name

44-- Parse a qualified name, i.e. M.name or just name

230--

45--

231−parseQualified :: P.Parsec String ParseState a -> P.Parsec String ParseState (Qualified a)

46+parseQualified :: TokenParser a -> TokenParser (Qualified a)

232parseQualified parser = part []

47parseQualified parser = part []

233 where

48 where

234− part path = (do name <- P.try (properName <* delimiter)

49+ part path = (do name <- ProperName <$> P.try qualifier

235 part (updatePath path name))

50 part (updatePath path name))

236 <|> (Qualified (qual path) <$> P.try parser)

51 <|> (Qualified (qual path) <$> P.try parser)

237− delimiter = indented *> dot <* P.notFollowedBy dot

238 updatePath path name = path ++ [name]

52 updatePath path name = path ++ [name]

239 qual path = if null path then Nothing else Just $ ModuleName path

53 qual path = if null path then Nothing else Just $ ModuleName path

240

241−-- |

242−-- Parse an integer or floating point value

243−--

244−integerOrFloat :: P.Parsec String u (Either Integer Double)

245−integerOrFloat = (Right <$> P.try (PT.float tokenParser) <|>

246− Left <$> P.try (PT.natural tokenParser)) P.<?> "number"

247−

248-- |

55-- |

249-- Parse an identifier or parenthesized operator

56-- Parse an identifier or parenthesized operator

250--

57--

251−parseIdent :: P.Parsec String ParseState Ident

58+parseIdent :: TokenParser Ident

252−parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)

59+parseIdent = (Ident <$> identifier) <|> (Op <$> parens symbol)

253−

254−-- |

255−-- Parse a token inside square brackets

256−--

257−squares :: P.Parsec String ParseState a -> P.Parsec String ParseState a

258−squares = P.between (lexeme $ P.char '[') (lexeme $ indented *> P.char ']') . (indented *>)

259−

260−-- |

261−-- Parse a token inside parentheses

262−--

263−parens :: P.Parsec String ParseState a -> P.Parsec String ParseState a

264−parens = P.between (lexeme $ P.char '(') (lexeme $ indented *> P.char ')') . (indented *>)

265−

266−-- |

267−-- Parse a token inside braces

268−--

269−braces :: P.Parsec String ParseState a -> P.Parsec String ParseState a

270−braces = P.between (lexeme $ P.char '{') (lexeme $ indented *> P.char '}') . (indented *>)

271−

272−-- |

273−-- Parse a token inside angle brackets

274−--

275−angles :: P.Parsec String ParseState a -> P.Parsec String ParseState a

276−angles = P.between (lexeme $ P.char '<') (lexeme $ indented *> P.char '>') . (indented *>)

277−

278−-- |

279−-- Parse zero or more values separated by a separator token

280−--

281−sepBy :: P.Parsec String ParseState a -> P.Parsec String ParseState sep -> P.Parsec String ParseState [a]

282−sepBy p s = P.sepBy (indented *> p) (indented *> s)

283−

284−-- |

285−-- Parse one or more values separated by a separator token

286−--

287−sepBy1 :: P.Parsec String ParseState a -> P.Parsec String ParseState sep -> P.Parsec String ParseState [a]

288−sepBy1 p s = P.sepBy1 (indented *> p) (indented *> s)

289−

290−-- |

291−-- Parse zero or more values separated by semicolons

292−--

293−semiSep :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]

294−semiSep = flip sepBy semi

295−

296−-- |

297−-- Parse one or more values separated by semicolons

298−--

299−semiSep1 :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]

300−semiSep1 = flip sepBy1 semi

301−

302−-- |

303−-- Parse zero or more values separated by commas

304−--

305−commaSep :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]

306−commaSep = flip sepBy comma

307−

308−-- |

309−-- Parse one or more values separated by commas

310−--

311−commaSep1 :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]

312−commaSep1 = flip sepBy1 comma

313

314-- |

61-- |

315-- Run the first parser, then match the second if possible, applying the specified function on a successful match

62-- Run the first parser, then match the second if possible, applying the specified function on a successful match

@@ -343,13 +90,13 @@ buildPostfixParser fs first = do

343-- |

90-- |

344-- Parse an identifier in backticks or an operator

91-- Parse an identifier in backticks or an operator

345--

92--

346−parseIdentInfix :: P.Parsec String ParseState (Qualified Ident)

93+parseIdentInfix :: TokenParser (Qualified Ident)

347−parseIdentInfix = P.between tick tick (parseQualified (Ident <$> identifier)) <|> (parseQualified (Op <$> operator))

94+parseIdentInfix = P.between tick tick (parseQualified (Ident <$> identifier)) <|> (parseQualified (Op <$> symbol))

348

349-- |

96-- |

350-- Mark the current indentation level

97-- Mark the current indentation level

351--

98--

352−mark :: P.Parsec String ParseState a -> P.Parsec String ParseState a

99+mark :: P.Parsec s ParseState a -> P.Parsec s ParseState a

353mark p = do

100mark p = do

354 current <- indentationLevel <$> P.getState

101 current <- indentationLevel <$> P.getState

355 pos <- P.sourceColumn <$> P.getPosition

102 pos <- P.sourceColumn <$> P.getPosition

@@ -361,7 +108,7 @@ mark p = do

361-- |

108-- |

362-- Check that the current identation level matches a predicate

109-- Check that the current identation level matches a predicate

363--

110--

364−checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String ParseState ()

111+checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec s ParseState ()

365checkIndentation rel = do

112checkIndentation rel = do

366 col <- P.sourceColumn <$> P.getPosition

113 col <- P.sourceColumn <$> P.getPosition

367 current <- indentationLevel <$> P.getState

114 current <- indentationLevel <$> P.getState

@@ -370,18 +117,17 @@ checkIndentation rel = do

370-- |

117-- |

371-- Check that the current indentation level is past the current mark

118-- Check that the current indentation level is past the current mark

372--

119--

373−indented :: P.Parsec String ParseState ()

120+indented :: P.Parsec s ParseState ()

374indented = checkIndentation (>) P.<?> "indentation"

121indented = checkIndentation (>) P.<?> "indentation"

375

122

376-- |

123-- |

377-- Check that the current indentation level is at the same indentation as the current mark

124-- Check that the current indentation level is at the same indentation as the current mark

378--

125--

379−same :: P.Parsec String ParseState ()

126+same :: P.Parsec s ParseState ()

380same = checkIndentation (==) P.<?> "no indentation"

127same = checkIndentation (==) P.<?> "no indentation"

381

128

382-- |

129-- |

383−-- Run a parser which supports indentation

130+-- Run a parser

384--

131--

385−runIndentParser :: FilePath -> P.Parsec String ParseState a -> String -> Either P.ParseError a

132+runTokenParser :: FilePath -> TokenParser a -> [PositionedToken] -> Either P.ParseError a

386−runIndentParser filePath p = P.runParser p (ParseState 0) filePath

133+runTokenParser filePath p = P.runParser p (ParseState 0) filePath

387−

src/Language/PureScript/Parser/Declarations.hs+127−123

@@ -26,6 +26,8 @@ module Language.PureScript.Parser.Declarations (

26 parseBinderNoParens,

27) where

29+import Prelude hiding (lex)

30+

29import Data.Maybe (isJust, fromMaybe)

31import Data.Maybe (isJust, fromMaybe)

30import Data.Traversable (forM)

32import Data.Traversable (forM)

@@ -33,11 +35,11 @@ import Control.Applicative

33import Control.Arrow ((+++))

35import Control.Arrow ((+++))

35import Language.PureScript.Kinds

37import Language.PureScript.Kinds

36−import Language.PureScript.Parser.State

37import Language.PureScript.Parser.Common

38import Language.PureScript.Parser.Common

38import Language.PureScript.AST

39import Language.PureScript.AST

39import Language.PureScript.Parser.Types

40import Language.PureScript.Parser.Types

40import Language.PureScript.Parser.Kinds

41import Language.PureScript.Parser.Kinds

42+import Language.PureScript.Parser.Lexer

41import Language.PureScript.CodeGen.JS.AST

43import Language.PureScript.CodeGen.JS.AST

42import Language.PureScript.Environment

44import Language.PureScript.Environment

@@ -58,43 +60,43 @@ withSourceSpan f p = do

58 where

60 where

59 toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)

61 toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)

61−kindedIdent :: P.Parsec String ParseState (String, Maybe Kind)

63+kindedIdent :: TokenParser (String, Maybe Kind)

62kindedIdent = (, Nothing) <$> identifier

64kindedIdent = (, Nothing) <$> identifier

63− <|> parens ((,) <$> identifier <*> (Just <$> (indented *> lexeme (P.string "::") *> indented *> parseKind)))

65+ <|> parens ((,) <$> identifier <*> (Just <$> (indented *> doubleColon *> indented *> parseKind)))

65−parseDataDeclaration :: P.Parsec String ParseState Declaration

67+parseDataDeclaration :: TokenParser Declaration

66parseDataDeclaration = do

68parseDataDeclaration = do

67 dtype <- (reserved "data" *> return Data) <|> (reserved "newtype" *> return Newtype)

69 dtype <- (reserved "data" *> return Data) <|> (reserved "newtype" *> return Newtype)

68 name <- indented *> properName

70 name <- indented *> properName

69 tyArgs <- many (indented *> kindedIdent)

71 tyArgs <- many (indented *> kindedIdent)

70 ctors <- P.option [] $ do

72 ctors <- P.option [] $ do

71− _ <- lexeme $ indented *> P.char '='

73+ indented *> equals

72− sepBy1 ((,) <$> properName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe

74+ P.sepBy1 ((,) <$> properName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe

73 return $ DataDeclaration dtype name tyArgs ctors

75 return $ DataDeclaration dtype name tyArgs ctors

75−parseTypeDeclaration :: P.Parsec String ParseState Declaration

77+parseTypeDeclaration :: TokenParser Declaration

76parseTypeDeclaration =

78parseTypeDeclaration =

77− TypeDeclaration <$> P.try (parseIdent <* lexeme (indented *> P.string "::"))

79+ TypeDeclaration <$> P.try (parseIdent <* indented <* doubleColon)

78 <*> parsePolyType

80 <*> parsePolyType

80−parseTypeSynonymDeclaration :: P.Parsec String ParseState Declaration

82+parseTypeSynonymDeclaration :: TokenParser Declaration

81parseTypeSynonymDeclaration =

83parseTypeSynonymDeclaration =

82 TypeSynonymDeclaration <$> (P.try (reserved "type") *> indented *> properName)

84 TypeSynonymDeclaration <$> (P.try (reserved "type") *> indented *> properName)

83 <*> many (indented *> kindedIdent)

85 <*> many (indented *> kindedIdent)

84− <*> (lexeme (indented *> P.char '=') *> noWildcards parsePolyType)

86+ <*> (indented *> equals *> noWildcards parsePolyType)

86−parseValueDeclaration :: P.Parsec String ParseState Declaration

88+parseValueDeclaration :: TokenParser Declaration

87parseValueDeclaration = do

89parseValueDeclaration = do

88 name <- parseIdent

90 name <- parseIdent

89 binders <- P.many parseBinderNoParens

91 binders <- P.many parseBinderNoParens

90 value <- Left <$> (C.indented *>

92 value <- Left <$> (C.indented *>

91 P.many1 ((,) <$> parseGuard

93 P.many1 ((,) <$> parseGuard

92− <*> (lexeme (indented *> P.char '=') *> parseValueWithWhereClause)

94+ <*> (indented *> equals *> parseValueWithWhereClause)

93 ))

95 ))

94− <|> Right <$> (lexeme (indented *> P.char '=') *> parseValueWithWhereClause)

96+ <|> Right <$> (indented *> equals *> parseValueWithWhereClause)

95 return $ ValueDeclaration name Value binders value

97 return $ ValueDeclaration name Value binders value

96 where

98 where

97− parseValueWithWhereClause :: P.Parsec String ParseState Expr

99+ parseValueWithWhereClause :: TokenParser Expr

98 parseValueWithWhereClause = do

100 parseValueWithWhereClause = do

99 value <- parseValue

101 value <- parseValue

100 whereClause <- P.optionMaybe $ do

102 whereClause <- P.optionMaybe $ do

@@ -104,42 +106,42 @@ parseValueDeclaration = do

104 C.mark $ P.many1 (C.same *> parseLocalDeclaration)

106 C.mark $ P.many1 (C.same *> parseLocalDeclaration)

105 return $ maybe value (`Let` value) whereClause

107 return $ maybe value (`Let` value) whereClause

106

108

107−parseExternDeclaration :: P.Parsec String ParseState Declaration

109+parseExternDeclaration :: TokenParser Declaration

108parseExternDeclaration = P.try (reserved "foreign") *> indented *> reserved "import" *> indented *>

110parseExternDeclaration = P.try (reserved "foreign") *> indented *> reserved "import" *> indented *>

109 (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)

111 (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)

110− <*> (lexeme (indented *> P.string "::") *> parseKind)

112+ <*> (indented *> doubleColon *> parseKind)

111 <|> (do reserved "instance"

113 <|> (do reserved "instance"

112− name <- parseIdent <* lexeme (indented *> P.string "::")

114+ name <- parseIdent <* indented <* doubleColon

113 deps <- P.option [] $ do

115 deps <- P.option [] $ do

114 deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

116 deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

115 indented

117 indented

116− reservedOp "=>"

118+ rfatArrow

117 return deps

119 return deps

118 className <- indented *> parseQualified properName

120 className <- indented *> parseQualified properName

119 tys <- P.many (indented *> noWildcards parseTypeAtom)

121 tys <- P.many (indented *> noWildcards parseTypeAtom)

120 return $ ExternInstanceDeclaration name deps className tys)

122 return $ ExternInstanceDeclaration name deps className tys)

121 <|> (do ident <- parseIdent

123 <|> (do ident <- parseIdent

122 js <- P.optionMaybe (JSRaw <$> stringLiteral)

124 js <- P.optionMaybe (JSRaw <$> stringLiteral)

123− ty <- lexeme (indented *> P.string "::") *> noWildcards parsePolyType

125+ ty <- indented *> doubleColon *> noWildcards parsePolyType

124 return $ ExternDeclaration (if isJust js then InlineJavascript else ForeignImport) ident js ty))

126 return $ ExternDeclaration (if isJust js then InlineJavascript else ForeignImport) ident js ty))

125

127

126−parseAssociativity :: P.Parsec String ParseState Associativity

128+parseAssociativity :: TokenParser Associativity

127parseAssociativity =

129parseAssociativity =

128 (P.try (reserved "infixl") >> return Infixl) <|>

130 (P.try (reserved "infixl") >> return Infixl) <|>

129 (P.try (reserved "infixr") >> return Infixr) <|>

131 (P.try (reserved "infixr") >> return Infixr) <|>

130 (P.try (reserved "infix") >> return Infix)

132 (P.try (reserved "infix") >> return Infix)

131

133

132−parseFixity :: P.Parsec String ParseState Fixity

134+parseFixity :: TokenParser Fixity

133parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural)

135parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural)

134

136

135−parseFixityDeclaration :: P.Parsec String ParseState Declaration

137+parseFixityDeclaration :: TokenParser Declaration

136parseFixityDeclaration = do

138parseFixityDeclaration = do

137 fixity <- parseFixity

139 fixity <- parseFixity

138 indented

140 indented

139− name <- operator

141+ name <- symbol

140 return $ FixityDeclaration fixity name

142 return $ FixityDeclaration fixity name

141

143

142−parseImportDeclaration :: P.Parsec String ParseState Declaration

144+parseImportDeclaration :: TokenParser Declaration

143parseImportDeclaration = do

145parseImportDeclaration = do

144 reserved "import"

146 reserved "import"

145 indented

147 indented

@@ -169,20 +171,20 @@ parseImportDeclaration = do

169 return $ fromMaybe Unqualified (expectedType <$> idents)

171 return $ fromMaybe Unqualified (expectedType <$> idents)

170

172

171

173

172−parseDeclarationRef :: P.Parsec String ParseState DeclarationRef

174+parseDeclarationRef :: TokenParser DeclarationRef

173parseDeclarationRef = withSourceSpan PositionedDeclarationRef $

175parseDeclarationRef = withSourceSpan PositionedDeclarationRef $

174 ValueRef <$> parseIdent

176 ValueRef <$> parseIdent

175 <|> do name <- properName

177 <|> do name <- properName

176− dctors <- P.optionMaybe $ parens (lexeme (P.string "..") *> pure Nothing <|> Just <$> commaSep properName)

178+ dctors <- P.optionMaybe $ parens (symbol' ".." *> pure Nothing <|> Just <$> commaSep properName)

177 return $ maybe (TypeClassRef name) (TypeRef name) dctors

179 return $ maybe (TypeClassRef name) (TypeRef name) dctors

178

180

179−parseTypeClassDeclaration :: P.Parsec String ParseState Declaration

181+parseTypeClassDeclaration :: TokenParser Declaration

180parseTypeClassDeclaration = do

182parseTypeClassDeclaration = do

181 reserved "class"

183 reserved "class"

182 implies <- P.option [] $ do

184 implies <- P.option [] $ do

183 indented

185 indented

184 implies <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

186 implies <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

185− reservedOp "<="

187+ lfatArrow

186 return implies

188 return implies

187 className <- indented *> properName

189 className <- indented *> properName

188 idents <- P.many (indented *> kindedIdent)

190 idents <- P.many (indented *> kindedIdent)

@@ -191,14 +193,14 @@ parseTypeClassDeclaration = do

191 mark (P.many (same *> positioned parseTypeDeclaration))

193 mark (P.many (same *> positioned parseTypeDeclaration))

192 return $ TypeClassDeclaration className idents implies members

194 return $ TypeClassDeclaration className idents implies members

193

195

194−parseTypeInstanceDeclaration :: P.Parsec String ParseState Declaration

196+parseTypeInstanceDeclaration :: TokenParser Declaration

195parseTypeInstanceDeclaration = do

197parseTypeInstanceDeclaration = do

196 reserved "instance"

198 reserved "instance"

197− name <- parseIdent <* lexeme (indented *> P.string "::")

199+ name <- parseIdent <* indented <* doubleColon

198 deps <- P.optionMaybe $ do

200 deps <- P.optionMaybe $ do

199 deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

201 deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

200 indented

202 indented

201− reservedOp "=>"

203+ rfatArrow

202 return deps

204 return deps

203 className <- indented *> parseQualified properName

205 className <- indented *> parseQualified properName

204 ty <- P.many (indented *> (noWildcards parseTypeAtom))

206 ty <- P.many (indented *> (noWildcards parseTypeAtom))

@@ -207,13 +209,13 @@ parseTypeInstanceDeclaration = do

207 mark (P.many (same *> positioned parseValueDeclaration))

209 mark (P.many (same *> positioned parseValueDeclaration))

208 return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty members

210 return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty members

209

211

210−positioned :: P.Parsec String ParseState Declaration -> P.Parsec String ParseState Declaration

212+positioned :: TokenParser Declaration -> TokenParser Declaration

211positioned d = withSourceSpan PositionedDeclaration d

213positioned d = withSourceSpan PositionedDeclaration d

212

214

213-- |

215-- |

214-- Parse a single declaration

216-- Parse a single declaration

215--

217--

216−parseDeclaration :: P.Parsec String ParseState Declaration

218+parseDeclaration :: TokenParser Declaration

217parseDeclaration = positioned (P.choice

219parseDeclaration = positioned (P.choice

218 [ parseDataDeclaration

220 [ parseDataDeclaration

219 , parseTypeDeclaration

221 , parseTypeDeclaration

@@ -226,7 +228,7 @@ parseDeclaration = positioned (P.choice

226 , parseTypeInstanceDeclaration

228 , parseTypeInstanceDeclaration

227 ]) P.<?> "declaration"

229 ]) P.<?> "declaration"

228

230

229−parseLocalDeclaration :: P.Parsec String ParseState Declaration

231+parseLocalDeclaration :: TokenParser Declaration

230parseLocalDeclaration = positioned (P.choice

232parseLocalDeclaration = positioned (P.choice

231 [ parseTypeDeclaration

233 [ parseTypeDeclaration

232 , parseValueDeclaration

234 , parseValueDeclaration

@@ -235,13 +237,13 @@ parseLocalDeclaration = positioned (P.choice

235-- |

237-- |

236-- Parse a module header and a collection of declarations

238-- Parse a module header and a collection of declarations

237--

239--

238−parseModule :: P.Parsec String ParseState Module

240+parseModule :: TokenParser Module

239parseModule = do

241parseModule = do

240 reserved "module"

242 reserved "module"

241 indented

243 indented

242 name <- moduleName

244 name <- moduleName

243 exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef

245 exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef

244− _ <- lexeme $ P.string "where"

246+ reserved "where"

245 decls <- mark (P.many (same *> parseDeclaration))

247 decls <- mark (P.many (same *> parseDeclaration))

246 return $ Module name decls exports

248 return $ Module name decls exports

247

249

@@ -250,9 +252,11 @@ parseModule = do

250--

252--

251parseModulesFromFiles :: (k -> String) -> [(k, String)] -> Either P.ParseError [(k, Module)]

253parseModulesFromFiles :: (k -> String) -> [(k, String)] -> Either P.ParseError [(k, Module)]

252parseModulesFromFiles toFilePath input =

254parseModulesFromFiles toFilePath input =

253− fmap collect . forM input $ \(filename, content) -> do

255+ fmap collect . forM input $ \(k, content) -> do

254− ms <- runIndentParser (toFilePath filename) parseModules content

256+ let filename = toFilePath k

257+ ts <- lex filename content

258+ ms <- runTokenParser filename parseModules ts

255− return (filename, ms)

259+ return (k, ms)

256 where

260 where

257 collect :: [(k, [v])] -> [(k, v)]

261 collect :: [(k, [v])] -> [(k, v)]

258 collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]

262 collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]

@@ -260,77 +264,77 @@ parseModulesFromFiles toFilePath input =

260-- |

264-- |

261-- Parse a collection of modules

265-- Parse a collection of modules

262--

266--

263−parseModules :: P.Parsec String ParseState [Module]

267+parseModules :: TokenParser [Module]

264−parseModules = whiteSpace *> mark (P.many (same *> parseModule)) <* P.eof

268+parseModules = mark (P.many (same *> parseModule)) <* P.eof

265

269

266−booleanLiteral :: P.Parsec String ParseState Bool

270+booleanLiteral :: TokenParser Bool

267−booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)

271+booleanLiteral = (reserved "true" >> return True) P.<|> (reserved "false" >> return False)

268

272

269−parseNumericLiteral :: P.Parsec String ParseState Expr

273+parseNumericLiteral :: TokenParser Expr

270−parseNumericLiteral = NumericLiteral <$> C.integerOrFloat

274+parseNumericLiteral = NumericLiteral <$> number

271

275

272−parseStringLiteral :: P.Parsec String ParseState Expr

276+parseStringLiteral :: TokenParser Expr

273−parseStringLiteral = StringLiteral <$> C.stringLiteral

277+parseStringLiteral = StringLiteral <$> stringLiteral

274

278

275−parseBooleanLiteral :: P.Parsec String ParseState Expr

279+parseBooleanLiteral :: TokenParser Expr

276parseBooleanLiteral = BooleanLiteral <$> booleanLiteral

280parseBooleanLiteral = BooleanLiteral <$> booleanLiteral

277

281

278−parseArrayLiteral :: P.Parsec String ParseState Expr

282+parseArrayLiteral :: TokenParser Expr

279−parseArrayLiteral = ArrayLiteral <$> C.squares (C.commaSep parseValue)

283+parseArrayLiteral = ArrayLiteral <$> squares (commaSep parseValue)

280

284

281−parseObjectLiteral :: P.Parsec String ParseState Expr

285+parseObjectLiteral :: TokenParser Expr

282−parseObjectLiteral = ObjectLiteral <$> C.braces (C.commaSep parseIdentifierAndValue)

286+parseObjectLiteral = ObjectLiteral <$> braces (commaSep parseIdentifierAndValue)

283

287

284−parseIdentifierAndValue :: P.Parsec String ParseState (String, Expr)

288+parseIdentifierAndValue :: TokenParser (String, Expr)

285−parseIdentifierAndValue = (,) <$> (C.indented *> (C.identifierName <|> C.stringLiteral) <* C.indented <* C.colon)

289+parseIdentifierAndValue = (,) <$> (C.indented *> (lname <|> stringLiteral) <* C.indented <* colon)

286 <*> (C.indented *> parseValue)

290 <*> (C.indented *> parseValue)

287

291

288−parseAbs :: P.Parsec String ParseState Expr

292+parseAbs :: TokenParser Expr

289parseAbs = do

293parseAbs = do

290− C.reservedOp "\\"

294+ symbol' "\\"

291 args <- P.many1 (C.indented *> (Abs <$> (Left <$> P.try C.parseIdent <|> Right <$> parseBinderNoParens)))

295 args <- P.many1 (C.indented *> (Abs <$> (Left <$> P.try C.parseIdent <|> Right <$> parseBinderNoParens)))

292− C.indented *> C.reservedOp "->"

296+ C.indented *> rarrow

293 value <- parseValue

297 value <- parseValue

294 return $ toFunction args value

298 return $ toFunction args value

295 where

299 where

296 toFunction :: [Expr -> Expr] -> Expr -> Expr

300 toFunction :: [Expr -> Expr] -> Expr -> Expr

297 toFunction args value = foldr ($) value args

301 toFunction args value = foldr ($) value args

298

302

299−parseVar :: P.Parsec String ParseState Expr

303+parseVar :: TokenParser Expr

300parseVar = Var <$> C.parseQualified C.parseIdent

304parseVar = Var <$> C.parseQualified C.parseIdent

301

305

302−parseConstructor :: P.Parsec String ParseState Expr

306+parseConstructor :: TokenParser Expr

303parseConstructor = Constructor <$> C.parseQualified C.properName

307parseConstructor = Constructor <$> C.parseQualified C.properName

304

308

305−parseCase :: P.Parsec String ParseState Expr

309+parseCase :: TokenParser Expr

306−parseCase = Case <$> P.between (P.try (C.reserved "case")) (C.indented *> C.reserved "of") (return <$> parseValue)

310+parseCase = Case <$> P.between (P.try (reserved "case")) (C.indented *> reserved "of") (return <$> parseValue)

307 <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))

311 <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))

308

312

309−parseCaseAlternative :: P.Parsec String ParseState CaseAlternative

313+parseCaseAlternative :: TokenParser CaseAlternative

310parseCaseAlternative = CaseAlternative <$> (return <$> parseBinder)

314parseCaseAlternative = CaseAlternative <$> (return <$> parseBinder)

311 <*> (Left <$> (C.indented *>

315 <*> (Left <$> (C.indented *>

312 P.many1 ((,) <$> parseGuard

316 P.many1 ((,) <$> parseGuard

313− <*> (lexeme (indented *> C.reservedOp "->") *> parseValue)

317+ <*> (indented *> rarrow *> parseValue)

314 ))

318 ))

315− <|> Right <$> (lexeme (indented *> C.reservedOp "->") *> parseValue))

319+ <|> Right <$> (indented *> rarrow *> parseValue))

316 P.<?> "case alternative"

320 P.<?> "case alternative"

317

321

318−parseIfThenElse :: P.Parsec String ParseState Expr

322+parseIfThenElse :: TokenParser Expr

319−parseIfThenElse = IfThenElse <$> (P.try (C.reserved "if") *> C.indented *> parseValue)

323+parseIfThenElse = IfThenElse <$> (P.try (reserved "if") *> C.indented *> parseValue)

320− <*> (C.indented *> C.reserved "then" *> C.indented *> parseValue)

324+ <*> (C.indented *> reserved "then" *> C.indented *> parseValue)

321− <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue)

325+ <*> (C.indented *> reserved "else" *> C.indented *> parseValue)

322

326

323−parseLet :: P.Parsec String ParseState Expr

327+parseLet :: TokenParser Expr

324parseLet = do

328parseLet = do

325− C.reserved "let"

329+ reserved "let"

326 C.indented

330 C.indented

327 ds <- C.mark $ P.many1 (C.same *> parseLocalDeclaration)

331 ds <- C.mark $ P.many1 (C.same *> parseLocalDeclaration)

328 C.indented

332 C.indented

329− C.reserved "in"

333+ reserved "in"

330 result <- parseValue

334 result <- parseValue

331 return $ Let ds result

335 return $ Let ds result

332

336

333−parseValueAtom :: P.Parsec String ParseState Expr

337+parseValueAtom :: TokenParser Expr

334parseValueAtom = P.choice

338parseValueAtom = P.choice

335 [ P.try parseNumericLiteral

339 [ P.try parseNumericLiteral

336 , P.try parseStringLiteral

340 , P.try parseStringLiteral

@@ -344,32 +348,32 @@ parseValueAtom = P.choice

344 , parseIfThenElse

348 , parseIfThenElse

345 , parseDo

349 , parseDo

346 , parseLet

350 , parseLet

347− , Parens <$> C.parens parseValue ]

351+ , Parens <$> parens parseValue ]

348

352

349−parsePropertyUpdate :: P.Parsec String ParseState (String, Expr)

353+parsePropertyUpdate :: TokenParser (String, Expr)

350parsePropertyUpdate = do

354parsePropertyUpdate = do

351− name <- C.lexeme (C.identifierName <|> C.stringLiteral)

355+ name <- lname <|> stringLiteral

352− _ <- C.lexeme $ C.indented *> P.char '='

356+ _ <- C.indented *> equals

353 value <- C.indented *> parseValue

357 value <- C.indented *> parseValue

354 return (name, value)

358 return (name, value)

355

359

356−parseAccessor :: Expr -> P.Parsec String ParseState Expr

360+parseAccessor :: Expr -> TokenParser Expr

357parseAccessor (Constructor _) = P.unexpected "constructor"

361parseAccessor (Constructor _) = P.unexpected "constructor"

358−parseAccessor obj = P.try $ Accessor <$> (C.indented *> C.dot *> P.notFollowedBy C.opLetter *> C.indented *> (C.identifierName <|> C.stringLiteral)) <*> pure obj

362+parseAccessor obj = P.try $ Accessor <$> (C.indented *> dot *> C.indented *> (lname <|> stringLiteral)) <*> pure obj

359

363

360−parseDo :: P.Parsec String ParseState Expr

364+parseDo :: TokenParser Expr

361parseDo = do

365parseDo = do

362− C.reserved "do"

366+ reserved "do"

363 C.indented

367 C.indented

364 Do <$> C.mark (P.many (C.same *> C.mark parseDoNotationElement))

368 Do <$> C.mark (P.many (C.same *> C.mark parseDoNotationElement))

365

369

366−parseDoNotationLet :: P.Parsec String ParseState DoNotationElement

370+parseDoNotationLet :: TokenParser DoNotationElement

367−parseDoNotationLet = DoNotationLet <$> (C.reserved "let" *> C.indented *> C.mark (P.many1 (C.same *> parseLocalDeclaration)))

371+parseDoNotationLet = DoNotationLet <$> (reserved "let" *> C.indented *> C.mark (P.many1 (C.same *> parseLocalDeclaration)))

368

372

369−parseDoNotationBind :: P.Parsec String ParseState DoNotationElement

373+parseDoNotationBind :: TokenParser DoNotationElement

370−parseDoNotationBind = DoNotationBind <$> parseBinder <*> (C.indented *> C.reservedOp "<-" *> parseValue)

374+parseDoNotationBind = DoNotationBind <$> parseBinder <*> (C.indented *> larrow *> parseValue)

371

375

372−parseDoNotationElement :: P.Parsec String ParseState DoNotationElement

376+parseDoNotationElement :: TokenParser DoNotationElement

373parseDoNotationElement = P.choice

377parseDoNotationElement = P.choice

374 [ P.try parseDoNotationBind

378 [ P.try parseDoNotationBind

375 , parseDoNotationLet

379 , parseDoNotationLet

@@ -378,7 +382,7 @@ parseDoNotationElement = P.choice

378-- |

382-- |

379-- Parse a value

383-- Parse a value

380--

384--

381−parseValue :: P.Parsec String ParseState Expr

385+parseValue :: TokenParser Expr

382parseValue = withSourceSpan PositionedValue

386parseValue = withSourceSpan PositionedValue

383 (P.buildExpressionParser operators

387 (P.buildExpressionParser operators

384 . C.buildPostfixParser postfixTable2

388 . C.buildPostfixParser postfixTable2

@@ -386,68 +390,68 @@ parseValue = withSourceSpan PositionedValue

386 where

390 where

387 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

391 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

388 postfixTable1 = [ parseAccessor

392 postfixTable1 = [ parseAccessor

389− , \v -> P.try $ flip ObjectUpdate <$> (C.indented *> C.braces (C.commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]

393+ , \v -> P.try $ flip ObjectUpdate <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]

390 postfixTable2 = [ \v -> P.try (flip App <$> (C.indented *> indexersAndAccessors)) <*> pure v

394 postfixTable2 = [ \v -> P.try (flip App <$> (C.indented *> indexersAndAccessors)) <*> pure v

391− , \v -> flip (TypedValue True) <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) <*> pure v

395+ , \v -> flip (TypedValue True) <$> (P.try (C.indented *> doubleColon) *> parsePolyType) <*> pure v

392 ]

396 ]

393− operators = [ [ P.Prefix (C.lexeme (P.try (C.indented *> P.char '-') >> return UnaryMinus))

397+ operators = [ [ P.Prefix (P.try (C.indented *> symbol' "-") >> return UnaryMinus)

394 ]

398 ]

395− , [ P.Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident ->

399+ , [ P.Infix (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident ->

396− return (BinaryNoParens ident))) P.AssocRight

400+ return (BinaryNoParens ident)) P.AssocRight

397 ]

401 ]

398 ]

402 ]

399

403

400−parseStringBinder :: P.Parsec String ParseState Binder

404+parseStringBinder :: TokenParser Binder

401−parseStringBinder = StringBinder <$> C.stringLiteral

405+parseStringBinder = StringBinder <$> stringLiteral

402

406

403−parseBooleanBinder :: P.Parsec String ParseState Binder

407+parseBooleanBinder :: TokenParser Binder

404parseBooleanBinder = BooleanBinder <$> booleanLiteral

408parseBooleanBinder = BooleanBinder <$> booleanLiteral

405

409

406−parseNumberBinder :: P.Parsec String ParseState Binder

410+parseNumberBinder :: TokenParser Binder

407−parseNumberBinder = NumberBinder <$> (C.lexeme sign <*> C.integerOrFloat)

411+parseNumberBinder = NumberBinder <$> (sign <*> number)

408 where

412 where

409− sign :: P.Parsec String ParseState (Either Integer Double -> Either Integer Double)

413+ sign :: TokenParser (Either Integer Double -> Either Integer Double)

410− sign = (P.char '-' >> return (negate +++ negate))

414+ sign = (symbol' "-" >> return (negate +++ negate))

411− <|> (P.char '+' >> return id)

415+ <|> (symbol' "+" >> return id)

412 <|> return id

416 <|> return id

413

417

414−parseVarBinder :: P.Parsec String ParseState Binder

418+parseVarBinder :: TokenParser Binder

415parseVarBinder = VarBinder <$> C.parseIdent

419parseVarBinder = VarBinder <$> C.parseIdent

416

420

417−parseNullaryConstructorBinder :: P.Parsec String ParseState Binder

421+parseNullaryConstructorBinder :: TokenParser Binder

418−parseNullaryConstructorBinder = ConstructorBinder <$> C.lexeme (C.parseQualified C.properName) <*> pure []

422+parseNullaryConstructorBinder = ConstructorBinder <$> C.parseQualified C.properName <*> pure []

419

423

420−parseConstructorBinder :: P.Parsec String ParseState Binder

424+parseConstructorBinder :: TokenParser Binder

421−parseConstructorBinder = ConstructorBinder <$> C.lexeme (C.parseQualified C.properName) <*> many (C.indented *> parseBinderNoParens)

425+parseConstructorBinder = ConstructorBinder <$> C.parseQualified C.properName <*> many (C.indented *> parseBinderNoParens)

422

426

423−parseObjectBinder :: P.Parsec String ParseState Binder

427+parseObjectBinder :: TokenParser Binder

424−parseObjectBinder = ObjectBinder <$> C.braces (C.commaSep (C.indented *> parseIdentifierAndBinder))

428+parseObjectBinder = ObjectBinder <$> braces (commaSep (C.indented *> parseIdentifierAndBinder))

425

429

426−parseArrayBinder :: P.Parsec String ParseState Binder

430+parseArrayBinder :: TokenParser Binder

427−parseArrayBinder = C.squares $ ArrayBinder <$> C.commaSep (C.indented *> parseBinder)

431+parseArrayBinder = squares $ ArrayBinder <$> commaSep (C.indented *> parseBinder)

428

432

429−parseNamedBinder :: P.Parsec String ParseState Binder

433+parseNamedBinder :: TokenParser Binder

430−parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* C.lexeme (P.char '@'))

434+parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* at)

431 <*> (C.indented *> parseBinder)

435 <*> (C.indented *> parseBinder)

432

436

433−parseNullBinder :: P.Parsec String ParseState Binder

437+parseNullBinder :: TokenParser Binder

434−parseNullBinder = C.lexeme (P.char '_' *> P.notFollowedBy C.identLetter) *> return NullBinder

438+parseNullBinder = reserved "_" *> return NullBinder

435

439

436−parseIdentifierAndBinder :: P.Parsec String ParseState (String, Binder)

440+parseIdentifierAndBinder :: TokenParser (String, Binder)

437parseIdentifierAndBinder = do

441parseIdentifierAndBinder = do

438− name <- C.lexeme (C.identifierName <|> C.stringLiteral)

442+ name <- lname <|> stringLiteral

439− _ <- C.lexeme $ C.indented *> (P.char '=' <|> P.char ':')

443+ C.indented *> (equals <|> colon)

440 binder <- C.indented *> parseBinder

444 binder <- C.indented *> parseBinder

441 return (name, binder)

445 return (name, binder)

442

446

443-- |

447-- |

444-- Parse a binder

448-- Parse a binder

445--

449--

446−parseBinder :: P.Parsec String ParseState Binder

450+parseBinder :: TokenParser Binder

447parseBinder = withSourceSpan PositionedBinder (P.buildExpressionParser operators parseBinderAtom P.<?> "expression")

451parseBinder = withSourceSpan PositionedBinder (P.buildExpressionParser operators parseBinderAtom P.<?> "expression")

448 where

452 where

449− operators = [ [ P.Infix ( C.lexeme (P.try $ C.indented *> C.reservedOp ":") >> return ConsBinder) P.AssocRight ] ]

453+ operators = [ [ P.Infix (P.try $ C.indented *> colon *> return ConsBinder) P.AssocRight ] ]

450− parseBinderAtom :: P.Parsec String ParseState Binder

454+ parseBinderAtom :: TokenParser Binder

451 parseBinderAtom = P.choice (map P.try

455 parseBinderAtom = P.choice (map P.try

452 [ parseNullBinder

456 [ parseNullBinder

453 , parseStringBinder

457 , parseStringBinder

@@ -458,12 +462,12 @@ parseBinder = withSourceSpan PositionedBinder (P.buildExpressionParser operators

458 , parseConstructorBinder

462 , parseConstructorBinder

459 , parseObjectBinder

463 , parseObjectBinder

460 , parseArrayBinder

464 , parseArrayBinder

461− , C.parens parseBinder ]) P.<?> "binder"

465+ , parens parseBinder ]) P.<?> "binder"

462

466

463-- |

467-- |

464-- Parse a binder as it would appear in a top level declaration

468-- Parse a binder as it would appear in a top level declaration

465--

469--

466−parseBinderNoParens :: P.Parsec String ParseState Binder

470+parseBinderNoParens :: TokenParser Binder

467parseBinderNoParens = P.choice (map P.try

471parseBinderNoParens = P.choice (map P.try

468 [ parseNullBinder

472 [ parseNullBinder

469 , parseStringBinder

473 , parseStringBinder

@@ -474,11 +478,11 @@ parseBinderNoParens = P.choice (map P.try

474 , parseNullaryConstructorBinder

478 , parseNullaryConstructorBinder

475 , parseObjectBinder

479 , parseObjectBinder

476 , parseArrayBinder

480 , parseArrayBinder

477− , C.parens parseBinder ]) P.<?> "binder"

481+ , parens parseBinder ]) P.<?> "binder"

478-- |

482-- |

479-- Parse a guard

483-- Parse a guard

480--

484--

481−parseGuard :: P.Parsec String ParseState Guard

485+parseGuard :: TokenParser Guard

482−parseGuard = C.pipe *> C.indented *> parseValue

486+parseGuard = pipe *> C.indented *> parseValue

483

487

484

488

src/Language/PureScript/Parser/Kinds.hs+9−9

@@ -18,19 +18,19 @@ module Language.PureScript.Parser.Kinds (

18) where

20import Language.PureScript.Kinds

21−import Language.PureScript.Parser.State

22import Language.PureScript.Parser.Common

21import Language.PureScript.Parser.Common

22+import Language.PureScript.Parser.Lexer

23import Control.Applicative

24import qualified Text.Parsec as P

25import qualified Text.Parsec.Expr as P

27−parseStar :: P.Parsec String ParseState Kind

27+parseStar :: TokenParser Kind

28−parseStar = const Star <$> lexeme (P.char '*')

28+parseStar = const Star <$> symbol' "*"

30−parseBang :: P.Parsec String ParseState Kind

30+parseBang :: TokenParser Kind

31−parseBang = const Bang <$> lexeme (P.char '!')

31+parseBang = const Bang <$> symbol' "!"

33−parseTypeAtom :: P.Parsec String ParseState Kind

33+parseTypeAtom :: TokenParser Kind

34parseTypeAtom = indented *> P.choice (map P.try

35 [ parseStar

36 , parseBang

@@ -38,8 +38,8 @@ parseTypeAtom = indented *> P.choice (map P.try

38-- |

39-- Parse a kind

40--

41−parseKind :: P.Parsec String ParseState Kind

41+parseKind :: TokenParser Kind

42parseKind = P.buildExpressionParser operators parseTypeAtom P.<?> "kind"

43 where

44− operators = [ [ P.Prefix (lexeme (P.char '#') >> return Row) ]

44+ operators = [ [ P.Prefix (symbol' "#" >> return Row) ]

45− , [ P.Infix (lexeme (P.try (P.string "->")) >> return FunKind) P.AssocRight ] ]

45+ , [ P.Infix ((P.try rarrow) >> return FunKind) P.AssocRight ] ]

src/Language/PureScript/Parser/Lexer.hsnew file+476

@@ -0,0 +1,476 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Language.PureScript.Parser.Lexer

4+-- Copyright : (c) Phil Freeman 2014

5+-- License : MIT

6+--

7+-- Maintainer : Phil Freeman <paf31@cantab.net>

8+-- Stability : experimental

9+-- Portability :

10+--

11+-- |

12+-- The first step in the parsing process - turns source code into a list of lexemes

13+--

14+-----------------------------------------------------------------------------

15+

16+{-# LANGUAGE TupleSections #-}

17+

18+module Language.PureScript.Parser.Lexer

19+ ( PositionedToken(..)

20+ , Token()

21+ , TokenParser()

22+ , lex

23+ , token

24+ , match

25+ , lparen

26+ , rparen

27+ , parens

28+ , lbrace

29+ , rbrace

30+ , braces

31+ , lsquare

32+ , rsquare

33+ , squares

34+ , indent

35+ , indentAt

36+ , larrow

37+ , rarrow

38+ , lfatArrow

39+ , rfatArrow

40+ , colon

41+ , doubleColon

42+ , equals

43+ , pipe

44+ , tick

45+ , dot

46+ , comma

47+ , semi

48+ , at

49+ , semiSep

50+ , semiSep1

51+ , commaSep

52+ , commaSep1

53+ , lname

54+ , qualifier

55+ , uname

56+ , uname'

57+ , reserved

58+ , symbol

59+ , symbol'

60+ , identifier

61+ , stringLiteral

62+ , number

63+ , natural

64+ , reservedPsNames

65+ , reservedTypeNames

66+ , opChars

67+ )

68+ where

69+

70+import Prelude hiding (lex)

71+

72+import Data.Functor (void)

73+import Data.Functor.Identity

74+

75+import Control.Applicative

76+

77+import Language.PureScript.Parser.State

78+

79+import qualified Text.Parsec as P

80+import qualified Text.Parsec.Token as PT

81+

82+data Comment

83+ = LineComment String

84+ | BlockComment String

85+ deriving (Show, Eq, Ord)

86+

87+data Token

88+ = LParen

89+ | RParen

90+ | LBrace

91+ | RBrace

92+ | LSquare

93+ | RSquare

94+ | Indent Int

95+ | LArrow

96+ | RArrow

97+ | LFatArrow

98+ | RFatArrow

99+ | Colon

100+ | DoubleColon

101+ | Equals

102+ | Pipe

103+ | Tick

104+ | Dot

105+ | Comma

106+ | Semi

107+ | At

108+ | LName String

109+ | UName String

110+ | Qualifier String

111+ | Symbol String

112+ | StringLiteral String

113+ | Number (Either Integer Double)

114+ deriving (Show, Eq, Ord)

115+

116+prettyPrintToken :: Token -> String

117+prettyPrintToken LParen = "("

118+prettyPrintToken RParen = ")"

119+prettyPrintToken LBrace = "{"

120+prettyPrintToken RBrace = "}"

121+prettyPrintToken LSquare = "["

122+prettyPrintToken RSquare = "]"

123+prettyPrintToken LArrow = "<-"

124+prettyPrintToken RArrow = "->"

125+prettyPrintToken LFatArrow = "<="

126+prettyPrintToken RFatArrow = "=>"

127+prettyPrintToken Colon = ":"

128+prettyPrintToken DoubleColon = "::"

129+prettyPrintToken Equals = "="

130+prettyPrintToken Pipe = "|"

131+prettyPrintToken Tick = "`"

132+prettyPrintToken Dot = "."

133+prettyPrintToken Comma = ","

134+prettyPrintToken Semi = ";"

135+prettyPrintToken At = "@"

136+prettyPrintToken (Indent n) = "indentation at level " ++ show n

137+prettyPrintToken (LName s) = show s

138+prettyPrintToken (UName s) = show s

139+prettyPrintToken (Qualifier _) = "qualifier"

140+prettyPrintToken (Symbol s) = s

141+prettyPrintToken (StringLiteral s) = show s

142+prettyPrintToken (Number n) = either show show n

143+

144+data PositionedToken = PositionedToken

145+ { ptSourcePos :: P.SourcePos

146+ , ptToken :: Token

147+ , ptComments :: [Comment]

148+ } deriving (Eq)

149+

150+instance Show PositionedToken where

151+ show = show . ptToken

152+

153+lex :: FilePath -> String -> Either P.ParseError [PositionedToken]

154+lex filePath input = P.parse parseTokens filePath input

155+

156+parseTokens :: P.Parsec String u [PositionedToken]

157+parseTokens = whitespace *> P.many parsePositionedToken <* P.skipMany parseComment <* P.eof

158+

159+whitespace :: P.Parsec String u ()

160+whitespace = P.skipMany (P.oneOf " \t\r\n")

161+

162+parseComment :: P.Parsec String u Comment

163+parseComment = (BlockComment <$> blockComment <|> LineComment <$> lineComment) <* whitespace

164+ where

165+ blockComment :: P.Parsec String u String

166+ blockComment = P.try $ P.string "{-" *> P.manyTill P.anyChar (P.try (P.string "-}"))

167+

168+ lineComment :: P.Parsec String u String

169+ lineComment = P.try $ P.string "--" *> P.manyTill P.anyChar (P.try (void (P.char '\n') <|> P.eof))

170+

171+parsePositionedToken :: P.Parsec String u PositionedToken

172+parsePositionedToken = P.try $ do

173+ comments <- P.many parseComment

174+ pos <- P.getPosition

175+ tok <- parseToken

176+ return $ PositionedToken pos tok comments

177+

178+parseToken :: P.Parsec String u Token

179+parseToken = P.choice

180+ [ P.try $ P.string "<-" *> P.notFollowedBy symbolChar *> pure LArrow

181+ , P.try $ P.string "<=" *> P.notFollowedBy symbolChar *> pure LFatArrow

182+ , P.try $ P.string "->" *> P.notFollowedBy symbolChar *> pure RArrow

183+ , P.try $ P.string "=>" *> P.notFollowedBy symbolChar *> pure RFatArrow

184+ , P.try $ P.string "::" *> P.notFollowedBy symbolChar *> pure DoubleColon

185+ , P.try $ P.char '(' *> pure LParen

186+ , P.try $ P.char ')' *> pure RParen

187+ , P.try $ P.char '{' *> pure LBrace

188+ , P.try $ P.char '}' *> pure RBrace

189+ , P.try $ P.char '[' *> pure LSquare

190+ , P.try $ P.char ']' *> pure RSquare

191+ , P.try $ P.char '`' *> pure Tick

192+ , P.try $ P.char ',' *> pure Comma

193+ , P.try $ P.char '=' *> P.notFollowedBy symbolChar *> pure Equals

194+ , P.try $ P.char ':' *> P.notFollowedBy symbolChar *> pure Colon

195+ , P.try $ P.char '|' *> P.notFollowedBy symbolChar *> pure Pipe

196+ , P.try $ P.char '.' *> P.notFollowedBy symbolChar *> pure Dot

197+ , P.try $ P.char ';' *> P.notFollowedBy symbolChar *> pure Semi

198+ , P.try $ P.char '@' *> P.notFollowedBy symbolChar *> pure At

199+ , LName <$> parseLName

200+ , do uName <- parseUName

201+ (Qualifier uName <$ P.char '.') <|> pure (UName uName)

202+ , Symbol <$> parseSymbol

203+ , StringLiteral <$> parseStringLiteral

204+ , Number <$> parseNumber

205+ ] <* whitespace

206+

207+ where

208+ parseLName :: P.Parsec String u String

209+ parseLName = (:) <$> identStart <*> P.many identLetter

210+

211+ parseUName :: P.Parsec String u String

212+ parseUName = (:) <$> P.upper <*> P.many P.alphaNum

213+

214+ parseSymbol :: P.Parsec String u String

215+ parseSymbol = P.many1 symbolChar

216+

217+ identStart :: P.Parsec String u Char

218+ identStart = P.lower <|> P.oneOf "_"

219+

220+ identLetter :: P.Parsec String u Char

221+ identLetter = P.alphaNum <|> P.oneOf "_'"

222+

223+ symbolChar :: P.Parsec String u Char

224+ symbolChar = P.oneOf opChars

225+

226+ parseStringLiteral :: P.Parsec String u String

227+ parseStringLiteral = blockString <|> PT.stringLiteral tokenParser

228+ where

229+ delimeter = P.try (P.string "\"\"\"")

230+ blockString = delimeter >> P.manyTill P.anyChar delimeter

231+

232+ parseNumber :: P.Parsec String u (Either Integer Double)

233+ parseNumber = (Right <$> P.try (PT.float tokenParser) <|>

234+ Left <$> P.try (PT.natural tokenParser)) P.<?> "number"

235+

236+-- |

237+-- We use Text.Parsec.Token to implement the string and number lexemes

238+--

239+langDef :: PT.GenLanguageDef String u Identity

240+langDef = PT.LanguageDef

241+ { PT.reservedNames = []

242+ , PT.reservedOpNames = []

243+ , PT.commentStart = ""

244+ , PT.commentEnd = ""

245+ , PT.commentLine = ""

246+ , PT.nestedComments = True

247+ , PT.identStart = fail "Identifiers not supported"

248+ , PT.identLetter = fail "Identifiers not supported"

249+ , PT.opStart = fail "Operators not supported"

250+ , PT.opLetter = fail "Operators not supported"

251+ , PT.caseSensitive = True

252+ }

253+

254+-- |

255+-- A token parser based on the language definition

256+--

257+tokenParser :: PT.GenTokenParser String u Identity

258+tokenParser = PT.makeTokenParser langDef

259+

260+type TokenParser a = P.Parsec [PositionedToken] ParseState a

261+

262+token :: (Token -> Maybe a) -> TokenParser a

263+token f = P.token (prettyPrintToken . ptToken) ptSourcePos (f . ptToken)

264+

265+match :: Token -> TokenParser ()

266+match tok = token (\tok' -> if tok == tok' then Just () else Nothing) P.<?> prettyPrintToken tok

267+

268+lparen :: TokenParser ()

269+lparen = match LParen

270+

271+rparen :: TokenParser ()

272+rparen = match RParen

273+

274+parens :: TokenParser a -> TokenParser a

275+parens = P.between lparen rparen

276+

277+lbrace :: TokenParser ()

278+lbrace = match LBrace

279+

280+rbrace :: TokenParser ()

281+rbrace = match RBrace

282+

283+braces :: TokenParser a -> TokenParser a

284+braces = P.between lbrace rbrace

285+

286+lsquare :: TokenParser ()

287+lsquare = match LSquare

288+

289+rsquare :: TokenParser ()

290+rsquare = match RSquare

291+

292+squares :: TokenParser a -> TokenParser a

293+squares = P.between lsquare rsquare

294+

295+indent :: TokenParser Int

296+indent = token go P.<?> "indentation"

297+ where

298+ go (Indent n) = Just n

299+ go _ = Nothing

300+

301+indentAt :: P.Column -> TokenParser ()

302+indentAt n = token go P.<?> "indentation at level " ++ show n

303+ where

304+ go (Indent n') | n == n' = Just ()

305+ go _ = Nothing

306+

307+larrow :: TokenParser ()

308+larrow = match LArrow

309+

310+rarrow :: TokenParser ()

311+rarrow = match RArrow

312+

313+lfatArrow :: TokenParser ()

314+lfatArrow = match LFatArrow

315+

316+rfatArrow :: TokenParser ()

317+rfatArrow = match RFatArrow

318+

319+colon :: TokenParser ()

320+colon = match Colon

321+

322+doubleColon :: TokenParser ()

323+doubleColon = match DoubleColon

324+

325+equals :: TokenParser ()

326+equals = match Equals

327+

328+pipe :: TokenParser ()

329+pipe = match Pipe

330+

331+tick :: TokenParser ()

332+tick = match Tick

333+

334+dot :: TokenParser ()

335+dot = match Dot

336+

337+comma :: TokenParser ()

338+comma = match Comma

339+

340+semi :: TokenParser ()

341+semi = match Semi

342+

343+at :: TokenParser ()

344+at = match At

345+

346+-- |

347+-- Parse zero or more values separated by semicolons

348+--

349+semiSep :: TokenParser a -> TokenParser [a]

350+semiSep = flip P.sepBy semi

351+

352+-- |

353+-- Parse one or more values separated by semicolons

354+--

355+semiSep1 :: TokenParser a -> TokenParser [a]

356+semiSep1 = flip P.sepBy1 semi

357+

358+-- |

359+-- Parse zero or more values separated by commas

360+--

361+commaSep :: TokenParser a -> TokenParser [a]

362+commaSep = flip P.sepBy comma

363+

364+-- |

365+-- Parse one or more values separated by commas

366+--

367+commaSep1 :: TokenParser a -> TokenParser [a]

368+commaSep1 = flip P.sepBy1 comma

369+

370+lname :: TokenParser String

371+lname = token go P.<?> "identifier"

372+ where

373+ go (LName s) = Just s

374+ go _ = Nothing

375+

376+qualifier :: TokenParser String

377+qualifier = token go P.<?> "qualifier"

378+ where

379+ go (Qualifier s) = Just s

380+ go _ = Nothing

381+

382+reserved :: String -> TokenParser ()

383+reserved s = token go P.<?> show s

384+ where

385+ go (LName s') | s == s' = Just ()

386+ go _ = Nothing

387+

388+uname :: TokenParser String

389+uname = token go P.<?> "proper name"

390+ where

391+ go (UName s) = Just s

392+ go _ = Nothing

393+

394+uname' :: String -> TokenParser ()

395+uname' s = token go P.<?> show s

396+ where

397+ go (UName s') | s == s' = Just ()

398+ go _ = Nothing

399+

400+symbol :: TokenParser String

401+symbol = token go P.<?> "symbol"

402+ where

403+ go (Symbol s) = Just s

404+ go Colon = Just ":"

405+ go LFatArrow = Just "<="

406+ go _ = Nothing

407+

408+symbol' :: String -> TokenParser ()

409+symbol' s = token go P.<?> show s

410+ where

411+ go (Symbol s') | s == s' = Just ()

412+ go Colon | s == ":" = Just ()

413+ go LFatArrow | s == "<=" = Just ()

414+ go _ = Nothing

415+

416+stringLiteral :: TokenParser String

417+stringLiteral = token go P.<?> "string literal"

418+ where

419+ go (StringLiteral s) = Just s

420+ go _ = Nothing

421+

422+number :: TokenParser (Either Integer Double)

423+number = token go P.<?> "number"

424+ where

425+ go (Number n) = Just n

426+ go _ = Nothing

427+

428+natural :: TokenParser Integer

429+natural = token go P.<?> "natural"

430+ where

431+ go (Number (Left n)) = Just n

432+ go _ = Nothing

433+

434+identifier :: TokenParser String

435+identifier = token go P.<?> "identifier"

436+ where

437+ go (LName s) | s `notElem` reservedPsNames = Just s

438+ go _ = Nothing

439+

440+-- |

441+-- A list of purescript reserved identifiers

442+--

443+reservedPsNames :: [String]

444+reservedPsNames = [ "data"

445+ , "newtype"

446+ , "type"

447+ , "foreign"

448+ , "import"

449+ , "infixl"

450+ , "infixr"

451+ , "infix"

452+ , "class"

453+ , "instance"

454+ , "module"

455+ , "case"

456+ , "of"

457+ , "if"

458+ , "then"

459+ , "else"

460+ , "do"

461+ , "let"

462+ , "true"

463+ , "false"

464+ , "in"

465+ , "where"

466+ ]

467+

468+reservedTypeNames :: [String]

469+reservedTypeNames = [ "forall", "where" ]

470+

471+-- |

472+-- The characters allowed for use in operators

473+--

474+opChars :: [Char]

475+opChars = ":!#$%&*+./<=>?@\\^|-~"

476+

src/Language/PureScript/Parser/Types.hs+25−25

@@ -24,46 +24,46 @@ import Control.Applicative

24import Control.Monad (when, unless)

26import Language.PureScript.Types

27−import Language.PureScript.Parser.State

28import Language.PureScript.Parser.Common

27import Language.PureScript.Parser.Common

29import Language.PureScript.Parser.Kinds

28import Language.PureScript.Parser.Kinds

29+import Language.PureScript.Parser.Lexer

30import Language.PureScript.Environment

32import qualified Text.Parsec as P

33import qualified Text.Parsec.Expr as P

35−parseArray :: P.Parsec String ParseState Type

35+parseArray :: TokenParser Type

36parseArray = squares $ return tyArray

38−parseArrayOf :: P.Parsec String ParseState Type

38+parseArrayOf :: TokenParser Type

39parseArrayOf = squares $ TypeApp tyArray <$> parseType

41−parseFunction :: P.Parsec String ParseState Type

41+parseFunction :: TokenParser Type

42−parseFunction = parens $ P.try (lexeme (P.string "->")) >> return tyFunction

42+parseFunction = parens $ rarrow >> return tyFunction

44−parseObject :: P.Parsec String ParseState Type

44+parseObject :: TokenParser Type

45parseObject = braces $ TypeApp tyObject <$> parseRow

47−parseTypeWildcard :: P.Parsec String ParseState Type

47+parseTypeWildcard :: TokenParser Type

48−parseTypeWildcard = lexeme (P.char '_') >> return TypeWildcard

48+parseTypeWildcard = reserved "_" >> return TypeWildcard

50−parseTypeVariable :: P.Parsec String ParseState Type

50+parseTypeVariable :: TokenParser Type

51parseTypeVariable = do

52 ident <- identifier

53 when (ident `elem` reservedTypeNames) $ P.unexpected ident

54 return $ TypeVar ident

56−parseTypeConstructor :: P.Parsec String ParseState Type

56+parseTypeConstructor :: TokenParser Type

57parseTypeConstructor = TypeConstructor <$> parseQualified properName

59−parseForAll :: P.Parsec String ParseState Type

59+parseForAll :: TokenParser Type

60parseForAll = mkForAll <$> (P.try (reserved "forall") *> P.many1 (indented *> identifier) <* indented <* dot)

61 <*> parseConstrainedType

63-- |

64-- Parse a type as it appears in e.g. a data constructor

65--

66−parseTypeAtom :: P.Parsec String ParseState Type

66+parseTypeAtom :: TokenParser Type

67parseTypeAtom = indented *> P.choice (map P.try

68 [ parseArray

69 , parseArrayOf

@@ -76,7 +76,7 @@ parseTypeAtom = indented *> P.choice (map P.try

76 , parens parseRow

77 , parens parsePolyType ])

79−parseConstrainedType :: P.Parsec String ParseState Type

79+parseConstrainedType :: TokenParser Type

80parseConstrainedType = do

81 constraints <- P.optionMaybe . P.try $ do

82 constraints <- parens . commaSep1 $ do

@@ -84,24 +84,24 @@ parseConstrainedType = do

84 indented

85 ty <- P.many parseTypeAtom

86 return (className, ty)

87− _ <- lexeme $ P.string "=>"

87+ _ <- rfatArrow

88 return constraints

89 indented

90 ty <- parseType

91 return $ maybe ty (flip ConstrainedType ty) constraints

93−parseAnyType :: P.Parsec String ParseState Type

93+parseAnyType :: TokenParser Type

94parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable parseTypeAtom) P.<?> "type"

95 where

96 operators = [ [ P.Infix (return TypeApp) P.AssocLeft ]

97− , [ P.Infix (P.try (lexeme (P.string "->")) >> return function) P.AssocRight ] ]

97+ , [ P.Infix (rarrow >> return function) P.AssocRight ] ]

98− postfixTable = [ \t -> KindedType t <$> (P.try (lexeme (indented *> P.string "::")) *> parseKind)

98+ postfixTable = [ \t -> KindedType t <$> (P.try (indented *> doubleColon) *> parseKind)

99 ]

100

101-- |

102-- Parse a monotype

103--

104−parseType :: P.Parsec String ParseState Type

104+parseType :: TokenParser Type

105parseType = do

106 ty <- parseAnyType

107 unless (isMonoType ty) $ P.unexpected "polymorphic type"

@@ -110,23 +110,23 @@ parseType = do

110-- |

111-- Parse a polytype

112--

113−parsePolyType :: P.Parsec String ParseState Type

113+parsePolyType :: TokenParser Type

114parsePolyType = parseAnyType

115

116-- |

117-- Parse an atomic type with no wildcards

118--

119−noWildcards :: P.Parsec String ParseState Type -> P.Parsec String ParseState Type

119+noWildcards :: TokenParser Type -> TokenParser Type

120noWildcards p = do

121 ty <- p

122 when (containsWildcards ty) $ P.unexpected "type wildcard"

123 return ty

124

125−parseNameAndType :: P.Parsec String ParseState t -> P.Parsec String ParseState (String, t)

125+parseNameAndType :: TokenParser t -> TokenParser (String, t)

126−parseNameAndType p = (,) <$> (indented *> (identifierName <|> stringLiteral) <* indented <* lexeme (P.string "::")) <*> p

126+parseNameAndType p = (,) <$> (indented *> (lname <|> stringLiteral) <* indented <* doubleColon) <*> p

127

128−parseRowEnding :: P.Parsec String ParseState Type

128+parseRowEnding :: TokenParser Type

129−parseRowEnding = P.option REmpty (TypeVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))

129+parseRowEnding = P.option REmpty (TypeVar <$> (indented *> pipe *> indented *> identifier))

130

131−parseRow :: P.Parsec String ParseState Type

131+parseRow :: TokenParser Type

132parseRow = (curry rowFromList <$> commaSep (parseNameAndType parsePolyType) <*> parseRowEnding) P.<?> "row"

src/Language/PureScript/Pretty/Common.hs+1−1

@@ -17,7 +17,7 @@ module Language.PureScript.Pretty.Common where

18import Control.Monad.State

19import Data.List (intercalate)

20−import Language.PureScript.Parser.Common (reservedPsNames, opChars)

20+import Language.PureScript.Parser.Lexer (reservedPsNames, opChars)

22-- |

23-- Wrap a string in parentheses