e148a68 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

WIP

e148a68Jason Felice9 years ago

src/Idris/Package/Parser.hs+11−24

compare with master

unifiedsplit

@@ -5,13 +5,13 @@ Copyright :

5License : BSD3

6Maintainer : The Idris Community.

7-}

8−{-# LANGUAGE CPP, ConstraintKinds, FlexibleInstances, TypeSynonymInstances #-}

8+{-# LANGUAGE CPP, ConstraintKinds, FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}

9module Idris.Package.Parser where

11import Idris.CmdOptions

12import Idris.Imports

13import Idris.Package.Common

14−import Idris.Parser.Helpers (MonadicParsing, eol, iName, identifier, isEol,

14+import Idris.Parser.Helpers (IdrisInnerParser, MonadicParsing, eol, iName, identifier, isEol,

15 lchar, packageName, parseErrorDoc, reserved,

16 runparser, someSpace')

@@ -21,26 +21,13 @@ import Data.List (union)

21import System.Directory (doesFileExist)

22import System.Exit

23import System.FilePath (isValid, takeExtension, takeFileName)

24−import Text.Parser.Token (TokenParsing)

24+import Text.Parser.Token (TokenParsing(..), stringLiteral)

25import qualified Text.PrettyPrint.ANSI.Leijen as PP

26−import Text.Trifecta ((<?>))

26+import Text.Megaparsec ((<?>))

27−import qualified Text.Trifecta as P

27+import qualified Text.Megaparsec as P

28−

28+import qualified Text.Megaparsec.Char as P

29+

29−type PParser = StateT PkgDesc P.Parser

30+type PParser = StateT PkgDesc IdrisInnerParser

30−

31−#if MIN_VERSION_base(4,9,0)

32−instance {-# OVERLAPPING #-} P.DeltaParsing PParser where

33− line = lift P.line

34− {-# INLINE line #-}

35− position = lift P.position

36− {-# INLINE position #-}

37− slicedWith f (StateT m) = StateT $ \s -> P.slicedWith (\(a,s') b -> (f a b, s')) $ m s

38− {-# INLINE slicedWith #-}

39− rend = lift P.rend

40− {-# INLINE rend #-}

41− restOfLine = lift P.restOfLine

42− {-# INLINE restOfLine #-}

43−#endif

45instance {-# OVERLAPPING #-} TokenParsing PParser where

32instance {-# OVERLAPPING #-} TokenParsing PParser where

46 someSpace = someSpace'

33 someSpace = someSpace'

@@ -85,7 +72,7 @@ filename = (do

85 -- This also moves away from tying filenames to identifiers, so

72 -- This also moves away from tying filenames to identifiers, so

86 -- it will also accept hyphens

73 -- it will also accept hyphens

87 -- (https://github.com/idris-lang/Idris-dev/issues/2721)

74 -- (https://github.com/idris-lang/Idris-dev/issues/2721)

88− filename <- P.stringLiteral <* someSpace'

75+ filename <- stringLiteral <* someSpace'

89 -- Through at least version 0.9.19.1, IPKG executable values were

76 -- Through at least version 0.9.19.1, IPKG executable values were

90 -- possibly namespaced identifiers, like foo.bar.baz.

77 -- possibly namespaced identifiers, like foo.bar.baz.

91 <|> show . fst <$> iName []

78 <|> show . fst <$> iName []

@@ -130,7 +117,7 @@ pClause :: PParser ()

130pClause = clause "executable" filename (\st v -> st { execout = Just v })

117pClause = clause "executable" filename (\st v -> st { execout = Just v })

131 <|> clause "main" (fst <$> iName []) (\st v -> st { idris_main = Just v })

118 <|> clause "main" (fst <$> iName []) (\st v -> st { idris_main = Just v })

132 <|> clause "sourcedir" (fst <$> identifier) (\st v -> st { sourcedir = v })

119 <|> clause "sourcedir" (fst <$> identifier) (\st v -> st { sourcedir = v })

133− <|> clause "opts" (pureArgParser . words <$> P.stringLiteral) (\st v -> st { idris_opts = v ++ idris_opts st })

120+ <|> clause "opts" (pureArgParser . words <$> stringLiteral) (\st v -> st { idris_opts = v ++ idris_opts st })

134 <|> clause "pkgs" (commaSep (pPkgName <* someSpace')) (\st ps ->

121 <|> clause "pkgs" (commaSep (pPkgName <* someSpace')) (\st ps ->

135 let pkgs = pureArgParser $ concatMap (\x -> ["-p", show x]) ps

122 let pkgs = pureArgParser $ concatMap (\x -> ["-p", show x]) ps

136 in st { pkgdeps = ps `union` pkgdeps st

123 in st { pkgdeps = ps `union` pkgdeps st

@@ -146,6 +133,6 @@ pClause = clause "executable" filename (\st v -> st { execout = Just v })

146 <|> clause "homepage" textUntilEol (\st v -> st { pkghomepage = Just v })

133 <|> clause "homepage" textUntilEol (\st v -> st { pkghomepage = Just v })

147 <|> clause "sourceloc" textUntilEol (\st v -> st { pkgsourceloc = Just v })

134 <|> clause "sourceloc" textUntilEol (\st v -> st { pkgsourceloc = Just v })

148 <|> clause "bugtracker" textUntilEol (\st v -> st { pkgbugtracker = Just v })

135 <|> clause "bugtracker" textUntilEol (\st v -> st { pkgbugtracker = Just v })

149− <|> clause "brief" P.stringLiteral (\st v -> st { pkgbrief = Just v })

136+ <|> clause "brief" stringLiteral (\st v -> st { pkgbrief = Just v })

150 <|> clause "author" textUntilEol (\st v -> st { pkgauthor = Just v })

137 <|> clause "author" textUntilEol (\st v -> st { pkgauthor = Just v })

151 <|> clause "maintainer" textUntilEol (\st v -> st { pkgmaintainer = Just v })

138 <|> clause "maintainer" textUntilEol (\st v -> st { pkgmaintainer = Just v })

src/Idris/Parser.hs+15−15

@@ -49,6 +49,7 @@ import Data.Foldable (asum)

49import Data.Function

50import Data.Generics.Uniplate.Data (descendM)

51import Data.List

52+import Data.List.NonEmpty (NonEmpty(..))

52import qualified Data.List.Split as Spl

53import qualified Data.List.Split as Spl

53import qualified Data.Map as M

54import qualified Data.Map as M

54import Data.Maybe

55import Data.Maybe

@@ -57,9 +58,9 @@ import qualified Data.Text as T

57import qualified System.Directory as Dir (makeAbsolute)

58import qualified System.Directory as Dir (makeAbsolute)

58import System.FilePath

59import System.FilePath

59import qualified Text.PrettyPrint.ANSI.Leijen as PP

60import qualified Text.PrettyPrint.ANSI.Leijen as PP

60−import Text.Trifecta ((<?>))

61+import Text.Megaparsec ((<?>))

61−import qualified Text.Trifecta as P

62+import qualified Text.Megaparsec as P

62−import qualified Text.Trifecta.Delta as P

63+import qualified Text.Megaparsec.Char as P

64{-

65{-

65@

66@

@@ -432,20 +433,20 @@ syntaxRule syn

432 reservedHL "syntax"

433 reservedHL "syntax"

433 return sty)

434 return sty)

434 syms <- some syntaxSym

435 syms <- some syntaxSym

435− when (all isExpr syms) $ P.unexpected "missing keywords in syntax rule"

436+ when (all isExpr syms) $ P.unexpected . P.Label $ 'm' :| "issing keywords in syntax rule"

436 let ns = mapMaybe getName syms

437 let ns = mapMaybe getName syms

437 when (length ns /= length (nub ns))

438 when (length ns /= length (nub ns))

438− $ P.unexpected "repeated variable in syntax rule"

439+ $ P.unexpected . P.Label $ 'r' :| "epeated variable in syntax rule"

439 lchar '='

440 lchar '='

440 tm <- typeExpr (allowImp syn) >>= uniquifyBinders [n | Binding n <- syms]

441 tm <- typeExpr (allowImp syn) >>= uniquifyBinders [n | Binding n <- syms]

441 terminator

442 terminator

442 return (Rule (mkSimple syms) tm sty)

443 return (Rule (mkSimple syms) tm sty)

443 <|> do reservedHL "decl"; reservedHL "syntax"

444 <|> do reservedHL "decl"; reservedHL "syntax"

444 syms <- some syntaxSym

445 syms <- some syntaxSym

445− when (all isExpr syms) $ P.unexpected "missing keywords in syntax rule"

446+ when (all isExpr syms) $ P.unexpected . P.Label $ 'm' :| "issing keywords in syntax rule"

446 let ns = mapMaybe getName syms

447 let ns = mapMaybe getName syms

447 when (length ns /= length (nub ns))

448 when (length ns /= length (nub ns))

448− $ P.unexpected "repeated variable in syntax rule"

449+ $ P.unexpected . P.Label $ 'r' :| "epeated variable in syntax rule"

449 lchar '='

450 lchar '='

450 openBlock

451 openBlock

451 dec <- some (decl syn)

452 dec <- some (decl syn)

@@ -576,7 +577,7 @@ fnDecl syn = P.try (do notEndBlock

576@

577@

577-}

578-}

578fnDecl' :: SyntaxInfo -> IdrisParser PDecl

579fnDecl' :: SyntaxInfo -> IdrisParser PDecl

579−fnDecl' syn = checkDeclFixity $

580+fnDecl' syn = (checkDeclFixity $

580 do (doc, argDocs, fc, opts', n, nfc, acc) <- P.try (do

581 do (doc, argDocs, fc, opts', n, nfc, acc) <- P.try (do

581 pushIndent

582 pushIndent

582 (doc, argDocs) <- docstring syn

583 (doc, argDocs) <- docstring syn

@@ -594,7 +595,7 @@ fnDecl' syn = checkDeclFixity $

594 return (PTy doc argDocs syn fc opts' n nfc ty)

595 return (PTy doc argDocs syn fc opts' n nfc ty)

595 <|> postulate syn

596 <|> postulate syn

596 <|> caf syn

597 <|> caf syn

597− <|> pattern syn

598+ <|> pattern syn)

598 <?> "function declaration"

599 <?> "function declaration"

599

600

600{-| Parses a series of function and accessbility options

601{-| Parses a series of function and accessbility options

@@ -1512,7 +1513,7 @@ parseElabShellStep ist = runparser (Right <$> do_ defaultSyntax <|> Left <$> ela

1512 spaced parser = indentGt *> parser

1513 spaced parser = indentGt *> parser

1513

1514

1514-- | Parse module header and imports

1515-- | Parse module header and imports

1515−parseImports :: FilePath -> String -> Idris (Maybe (Docstring ()), [String], [ImportInfo], Maybe P.Delta)

1516+parseImports :: FilePath -> String -> Idris (Maybe (Docstring ()), [String], [ImportInfo], Maybe ParseState)

1516parseImports fname input

1517parseImports fname input

1517 = do i <- getIState

1518 = do i <- getIState

1518 case runparser imports i fname input of

1519 case runparser imports i fname input of

@@ -1524,13 +1525,13 @@ parseImports fname input

1524 return x

1525 return x

1525 where imports :: IdrisParser ((Maybe (Docstring ()), [String],

1526 where imports :: IdrisParser ((Maybe (Docstring ()), [String],

1526 [ImportInfo],

1527 [ImportInfo],

1527− Maybe P.Delta),

1528+ Maybe ParseState),

1528 [(FC, OutputAnnotation)], IState)

1529 [(FC, OutputAnnotation)], IState)

1529 imports = do optional shebang

1530 imports = do optional shebang

1530 whiteSpace

1531 whiteSpace

1531 (mdoc, mname, annots) <- moduleHeader

1532 (mdoc, mname, annots) <- moduleHeader

1532 ps_exp <- many import_

1533 ps_exp <- many import_

1533− mrk <- P.mark

1534+ mrk <- P.getParserState

1534 isEof <- lookAheadMatches P.eof

1535 isEof <- lookAheadMatches P.eof

1535 let mrk' = if isEof

1536 let mrk' = if isEof

1536 then Nothing

1537 then Nothing

@@ -1572,8 +1573,7 @@ fixColour True doc = doc

1572

1573

1573-- | A program is a list of declarations, possibly with associated

1574-- | A program is a list of declarations, possibly with associated

1574-- documentation strings.

1575-- documentation strings.

1575−parseProg :: SyntaxInfo -> FilePath -> String -> Maybe P.Delta ->

1576+parseProg :: SyntaxInfo -> FilePath -> String -> Maybe ParseState -> Idris [PDecl]

1576− Idris [PDecl]

1577parseProg syn fname input mrk

1578 = do i <- getIState

1579 case runparser mainProg i fname input of

@@ -1595,7 +1595,7 @@ parseProg syn fname input mrk

1595 mainProg = case mrk of

1596 Nothing -> do i <- get; return ([], i)

1597 Just mrk -> do

1598− P.release mrk

1598+ P.setParserState mrk

1599 ds <- prog syn

1600 i' <- get

1601 return (ds, i')

src/Idris/Parser/Expr.hs+5−5

@@ -5,8 +5,8 @@ Copyright :

5License : BSD3

6Maintainer : The Idris Community.

7-}

8−{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, PatternGuards,

8+{-# LANGUAGE ConstraintKinds, FlexibleContexts, GeneralizedNewtypeDeriving,

9− TupleSections #-}

9+ PatternGuards, TupleSections #-}

10module Idris.Parser.Expr where

12import Idris.AbsSyntax

@@ -26,8 +26,8 @@ import Data.Function (on)

26import Data.List

27import Data.Maybe

28import Text.Parser.Expression

29−import Text.Trifecta ((<?>))

29+import Text.Megaparsec ((<?>))

30−import qualified Text.Trifecta as P

30+import qualified Text.Megaparsec as P

32-- | Allow implicit type declarations

33allowImp :: SyntaxInfo -> SyntaxInfo

@@ -1466,7 +1466,7 @@ VerbatimString_t ::=

1466;

1467@

1468 -}

1469−verbatimStringLiteral :: MonadicParsing m => m (String, FC)

1469+verbatimStringLiteral :: IdrisParser (String, FC)

1470verbatimStringLiteral = P.token $ do (FC f start _) <- getFC

1471 P.try $ string "\"\"\""

1472 str <- P.manyTill P.anyChar $ P.try (string "\"\"\"")

src/Idris/Parser/Helpers.hs+69−86

@@ -5,9 +5,9 @@ Copyright :

5License : BSD3

6Maintainer : The Idris Community.

7-}

8−{-# LANGUAGE CPP, ConstraintKinds, FlexibleInstances,

8+{-# LANGUAGE CPP, ConstraintKinds, FlexibleContexts, FlexibleInstances,

9 GeneralizedNewtypeDeriving, PatternGuards, StandaloneDeriving,

10− TypeSynonymInstances #-}

10+ TypeSynonymInstances, UndecidableInstances #-}

11module Idris.Parser.Helpers where

13import Idris.AbsSyntax

@@ -23,7 +23,6 @@ import Prelude hiding (pi)

23import Control.Applicative

24import Control.Monad

25import Control.Monad.State.Strict

26−import qualified Data.ByteString.UTF8 as UTF8

27import Data.Char

26import Data.Char

28import qualified Data.HashSet as HS

27import qualified Data.HashSet as HS

29import Data.List

28import Data.List

@@ -31,34 +30,40 @@ import qualified Data.Map as M

31import Data.Maybe

30import Data.Maybe

32import qualified Data.Text as T

31import qualified Data.Text as T

33import System.FilePath

32import System.FilePath

33+import Data.List.NonEmpty (fromList)

34−import qualified Text.Parser.Char as Chr

34+import qualified Text.Parser.Char

35−import Text.Parser.LookAhead

35+import qualified Text.Parser.Combinators

36import qualified Text.Parser.Token as Tok

37import qualified Text.PrettyPrint.ANSI.Leijen as PP

38−import Text.Trifecta ((<?>))

38+import Text.Megaparsec ((<?>))

39−import qualified Text.Trifecta as P

39+import qualified Text.Megaparsec as P

40−import qualified Text.Trifecta.Delta as P

40+import qualified Text.Megaparsec.Char as P

41+import qualified Text.Megaparsec.Char.Lexer as P hiding (space)

42+

43+newtype ParseError = ParseError { parseErrorDoc :: PP.Doc }

42-- | Idris parser with state used during parsing

45-- | Idris parser with state used during parsing

43−type IdrisParser = StateT IState P.Parser

46+type IdrisParser = StateT IState IdrisInnerParser

44−

47+type IdrisInnerParser = P.Parsec () String

45−#if MIN_VERSION_base(4,9,0)

48+type ParseState = P.State String

46−instance {-# OVERLAPPING #-} P.DeltaParsing IdrisParser where

49+

47− line = lift P.line

50+-- | Generalized monadic parsing constraint type

48− {-# INLINE line #-}

51+type MonadicParsing m = (P.MonadParsec () String m, Tok.TokenParsing m)

49− position = lift P.position

50− {-# INLINE position #-}

51− slicedWith f (StateT m) = StateT $ \s -> P.slicedWith (\(a,s') b -> (f a b, s')) $ m s

52− {-# INLINE slicedWith #-}

53− rend = lift P.rend

54− {-# INLINE rend #-}

55− restOfLine = lift P.restOfLine

56− {-# INLINE restOfLine #-}

57−#endif

59someSpace' :: MonadicParsing m => m ()

53someSpace' :: MonadicParsing m => m ()

60someSpace' = many (simpleWhiteSpace <|> singleLineComment <|> multiLineComment) *> pure ()

54someSpace' = many (simpleWhiteSpace <|> singleLineComment <|> multiLineComment) *> pure ()

56+instance Text.Parser.Combinators.Parsing IdrisInnerParser where

57+ eof = P.eof

58+ unexpected msg = P.unexpected . P.Label . fromList $ msg

59+ try = P.try

60+ p <?> s = p <?> s --FIXME:?

61+ notFollowedBy = P.notFollowedBy

62+ --FIXME:

63+instance Text.Parser.Char.CharParsing IdrisInnerParser where

64+ satisfy = P.satisfy

65+ --FIXME:??

66+

62instance {-# OVERLAPPING #-} Tok.TokenParsing IdrisParser where

67instance {-# OVERLAPPING #-} Tok.TokenParsing IdrisParser where

63 someSpace = someSpace'

68 someSpace = someSpace'

64 token p = do s <- get

69 token p = do s <- get

@@ -70,18 +75,12 @@ instance {-# OVERLAPPING #-} Tok.TokenParsing IdrisParser where

70 put (s { lastTokenSpan = Just (FC fn (sl, sc) (el, ec)) })

75 put (s { lastTokenSpan = Just (FC fn (sl, sc) (el, ec)) })

71 return r

76 return r

73−-- | Generalized monadic parsing constraint type

74−type MonadicParsing m = (P.DeltaParsing m, LookAheadParsing m, Monad m)

75−

76−newtype ParseError = ParseError { parseErrorDoc :: PP.Doc }

77−

78-- | Helper to run Idris inner parser based stateT parsers

79−runparser :: StateT st P.Parser res -> st -> String -> String -> Either ParseError res

79+runparser :: StateT st IdrisInnerParser res -> st -> String -> String -> Either ParseError res

80runparser p i inputname s =

81− case P.parseString (evalStateT p i)

81+ case P.parse (evalStateT p i) inputname s of

82− (P.Directed (UTF8.fromString inputname) 0 0 0 0) s of

83− P.Failure (P.ErrInfo doc _) -> Left (ParseError doc)

82+ Left _ -> Left $ ParseError undefined --FIXME:

84− P.Success value -> Right value

83+ Right value -> Right value

86highlightP :: FC -> OutputAnnotation -> IdrisParser ()

85highlightP :: FC -> OutputAnnotation -> IdrisParser ()

87highlightP fc annot = do ist <- get

86highlightP fc annot = do ist <- get

@@ -130,7 +129,7 @@ isEol _ = False

130

129

131-- | A parser that succeeds at the end of the line

130-- | A parser that succeeds at the end of the line

132eol :: MonadicParsing m => m ()

131eol :: MonadicParsing m => m ()

133−eol = () <$ P.satisfy isEol <|> lookAhead P.eof <?> "end of line"

132+eol = () <$ P.satisfy isEol <|> P.lookAhead P.eof <?> "end of line"

134

133

135{- | Consumes a single-line comment

134{- | Consumes a single-line comment

136

135

@@ -202,14 +201,15 @@ docComment = do dc <- pushIndent *> docCommentLine

202 return contents)

201 return contents)

203 <?> ""

202 <?> ""

204

203

205− argDocCommentLine = do string "|||"

204+ argDocCommentLine :: IdrisParser (Name, String)

205+ argDocCommentLine = do P.string "|||"

206− many (P.satisfy isSpace)

206+ P.many (P.satisfy isSpace)

207− char '@'

207+ P.char '@'

208− many (P.satisfy isSpace)

208+ P.many (P.satisfy isSpace)

209 n <- fst <$> name

210− many (P.satisfy isSpace)

210+ P.many (P.satisfy isSpace)

211− docs <- many (P.satisfy (not . isEol))

211+ docs <- P.many (P.satisfy (not . isEol))

212− eol ; someSpace'

212+ P.eol ; someSpace'

213 return (n, docs)

214

215-- | Parses some white space

@@ -254,30 +254,29 @@ reservedIdentifiers = HS.fromList

254 ]

255

256identifierOrReserved :: MonadicParsing m => m String

257−identifierOrReserved = P.token $ P.try $ do

257+identifierOrReserved = Tok.token $ P.try $ do

258 c <- P.satisfy isAlpha <|> P.oneOf "_"

259 cs <- P.many (P.satisfy isAlphaNum <|> P.oneOf "_'.")

260 return $ c : cs

261

262char :: MonadicParsing m => Char -> m Char

263−char = Chr.char

263+char = P.char

264

265string :: MonadicParsing m => String -> m String

266−string = Chr.string

266+string = P.string

267

268-- | Parses a character as a token

269lchar :: MonadicParsing m => Char -> m Char

270−lchar = P.token . P.char

270+lchar = Tok.token . P.char

271

272-- | Parses a character as a token, returning the source span of the character

273lcharFC :: MonadicParsing m => Char -> m FC

274lcharFC ch = do (FC file (l, c) _) <- getFC

275− _ <- P.token (char ch)

275+ _ <- Tok.token (P.char ch)

276 return $ FC file (l, c) (l, c+1)

277

278−-- | Parses string as a token

279symbol :: MonadicParsing m => String -> m ()

278symbol :: MonadicParsing m => String -> m ()

280−symbol = void . Tok.symbol

279+symbol = void . P.symbol someSpace'

281

280

282symbolFC :: MonadicParsing m => String -> m FC

281symbolFC :: MonadicParsing m => String -> m FC

283symbolFC str = do (FC file (l, c) _) <- getFC

282symbolFC str = do (FC file (l, c) _) <- getFC

@@ -286,7 +285,7 @@ symbolFC str = do (FC file (l, c) _) <- getFC

286

285

287-- | Parses a reserved identifier

286-- | Parses a reserved identifier

288reserved :: MonadicParsing m => String -> m ()

287reserved :: MonadicParsing m => String -> m ()

289−reserved name = P.token $ P.try $ do

288+reserved name = Tok.token $ P.try $ do

290 P.string name

289 P.string name

291 P.notFollowedBy (P.satisfy isAlphaNum <|> P.oneOf "_'.") <?> "end of " ++ name

290 P.notFollowedBy (P.satisfy isAlphaNum <|> P.oneOf "_'.") <?> "end of " ++ name

292

291

@@ -304,7 +303,7 @@ reservedHL str = reservedFC str >>= flip highlightP AnnKeyword

304-- Taken from Parsec (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007

303-- Taken from Parsec (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007

305-- | Parses a reserved operator

304-- | Parses a reserved operator

306reservedOp :: MonadicParsing m => String -> m ()

305reservedOp :: MonadicParsing m => String -> m ()

307−reservedOp name = P.token $ P.try $

306+reservedOp name = Tok.token $ P.try $

308 do string name

307 do string name

309 P.notFollowedBy operatorLetter <?> ("end of " ++ show name)

308 P.notFollowedBy operatorLetter <?> ("end of " ++ show name)

310

309

@@ -318,8 +317,8 @@ identifier :: (MonadicParsing m) => m (String, FC)

318identifier = P.try $ do

317identifier = P.try $ do

319 (FC f (l, c) _) <- getFC

318 (FC f (l, c) _) <- getFC

320 ident <- identifierOrReserved

319 ident <- identifierOrReserved

321− when (ident `HS.member` reservedIdentifiers) $ P.unexpected $ "reserved " ++ ident

320+ when (ident `HS.member` reservedIdentifiers) $ P.unexpected undefined --FIXME: $ "reserved " ++ ident

322− when (ident == "_") $ P.unexpected "wildcard"

321+ when (ident == "_") $ P.unexpected undefined --FIXME: "wildcard"

323 return (ident, FC f (l, c) (l, c + length ident))

322 return (ident, FC f (l, c) (l, c + length ident))

324

323

325-- | Parses an identifier with possible namespace as a name

324-- | Parses an identifier with possible namespace as a name

@@ -330,8 +329,8 @@ iName bad = maybeWithNS identifier False bad <?> "name"

330maybeWithNS :: (MonadicParsing m) => m (String, FC) -> Bool -> [String] -> m (Name, FC)

329maybeWithNS :: (MonadicParsing m) => m (String, FC) -> Bool -> [String] -> m (Name, FC)

331maybeWithNS parser ascend bad = do

330maybeWithNS parser ascend bad = do

332 fc <- getFC

331 fc <- getFC

333− i <- P.option "" (lookAhead (fst <$> identifier))

332+ i <- P.option "" (P.lookAhead (fst <$> identifier))

334− when (i `elem` bad) $ P.unexpected "reserved identifier"

333+ when (i `elem` bad) $ P.unexpected undefined --FIXME: "reserved identifier"

335 let transf = if ascend then id else reverse

334 let transf = if ascend then id else reverse

336 (x, xs, fc) <- P.choice (transf (parserNoNS parser : parsersNS parser i))

335 (x, xs, fc) <- P.choice (transf (parserNoNS parser : parsersNS parser i))

337 return (mkName (x, xs), fc)

336 return (mkName (x, xs), fc)

@@ -400,7 +399,7 @@ invalidOperators = [":", "=>", "->", "<-", "=", "?=", "|", "**", "==>", "\\", "%

400

399

401-- | Parses an operator

400-- | Parses an operator

402symbolicOperator :: MonadicParsing m => m String

401symbolicOperator :: MonadicParsing m => m String

403−symbolicOperator = do op <- P.token . some $ operatorLetter

402+symbolicOperator = do op <- Tok.token . some $ operatorLetter

404 when (op `elem` (invalidOperators ++ commentMarkers)) $

403 when (op `elem` (invalidOperators ++ commentMarkers)) $

405 fail $ op ++ " is not a valid operator"

404 fail $ op ++ " is not a valid operator"

406 return op

405 return op

@@ -412,32 +411,17 @@ symbolicOperatorFC = do (FC f (l, c) _) <- getFC

412 return (op, FC f (l, c) (l, c + length op))

411 return (op, FC f (l, c) (l, c + length op))

413

412

414{- * Position helpers -}

413{- * Position helpers -}

415−{- | Get filename from position (returns "(interactive)" when no source file is given) -}

416−fileName :: P.Delta -> String

417−fileName (P.Directed fn _ _ _ _) = UTF8.toString fn

418−fileName _ = "(interactive)"

419−

420−{- | Get line number from position -}

421−lineNum :: P.Delta -> Int

422−lineNum (P.Lines l _ _ _) = fromIntegral l + 1

423−lineNum (P.Directed _ l _ _ _) = fromIntegral l + 1

424−lineNum _ = 0

425−

426−{- | Get column number from position -}

427−columnNum :: P.Delta -> Int

428−columnNum pos = fromIntegral (P.column pos) + 1

429−

430−

431{- | Get file position as FC -}

414{- | Get file position as FC -}

432getFC :: MonadicParsing m => m FC

415getFC :: MonadicParsing m => m FC

433−getFC = do s <- P.position

416+getFC = do pos <- P.getPosition

417+ let columnNumber = P.unPos . P.sourceColumn $ pos

418+ let lineNumber = P.unPos . P.sourceLine $ pos

434− let (dir, file) = splitFileName (fileName s)

419+ let (dir, file) = splitFileName (P.sourceName pos)

435− let f = if dir == addTrailingPathSeparator "." then file else fileName s

420+ let f = if dir == addTrailingPathSeparator "." then file else P.sourceName pos

436− return $ FC f (lineNum s, columnNum s) (lineNum s, columnNum s) -- TODO: Change to actual spanning

421+ return $ FC f (lineNumber, columnNumber) (lineNumber, columnNumber) -- TODO: Change to actual spanning

437 -- Issue #1594 on the Issue Tracker.

422 -- Issue #1594 on the Issue Tracker.

438 -- https://github.com/idris-lang/Idris-dev/issues/1594

423 -- https://github.com/idris-lang/Idris-dev/issues/1594

439

424

440−

441{-* Syntax helpers-}

425{-* Syntax helpers-}

442-- | Bind constraints to term

426-- | Bind constraints to term

443bindList :: (RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm) -> [(RigCount, Name, FC, PTerm)] -> PTerm -> PTerm

427bindList :: (RigCount -> Name -> FC -> PTerm -> PTerm -> PTerm) -> [(RigCount, Name, FC, PTerm)] -> PTerm -> PTerm

@@ -447,15 +431,15 @@ bindList b ((r, n, fc, t):bs) sc = b r n fc t (bindList b bs sc)

447{- | @commaSeparated p@ parses one or more occurences of `p`,

431{- | @commaSeparated p@ parses one or more occurences of `p`,

448 separated by commas and optional whitespace. -}

432 separated by commas and optional whitespace. -}

449commaSeparated :: MonadicParsing m => m a -> m [a]

433commaSeparated :: MonadicParsing m => m a -> m [a]

450−commaSeparated p = p `P.sepBy1` (P.spaces >> P.char ',' >> P.spaces)

434+commaSeparated p = p `P.sepBy1` (P.space >> P.char ',' >> P.space)

451

435

452{- * Layout helpers -}

436{- * Layout helpers -}

453

437

454-- | Push indentation to stack

438-- | Push indentation to stack

455pushIndent :: IdrisParser ()

439pushIndent :: IdrisParser ()

456−pushIndent = do pos <- P.position

440+pushIndent = do columnNumber <- indent

457 ist <- get

441 ist <- get

458− put (ist { indent_stack = (fromIntegral (P.column pos) + 1) : indent_stack ist })

442+ put (ist { indent_stack = columnNumber : indent_stack ist })

459

443

460-- | Pops indentation from stack

444-- | Pops indentation from stack

461popIndent :: IdrisParser ()

445popIndent :: IdrisParser ()

@@ -466,8 +450,8 @@ popIndent = do ist <- get

466

450

467

451

468-- | Gets current indentation

452-- | Gets current indentation

469−indent :: IdrisParser Int

453+indent :: MonadicParsing m => m Int

470−indent = liftM ((+1) . fromIntegral . P.column) P.position

454+indent = P.unPos . P.sourceColumn <$> P.getPosition

471

455

472-- | Gets last indentation

456-- | Gets last indentation

473lastIndent :: IdrisParser Int

457lastIndent :: IdrisParser Int

@@ -510,8 +494,7 @@ indentedBlockS p = do openBlock

510

494

511-- | Checks if the following character matches provided parser

495-- | Checks if the following character matches provided parser

512lookAheadMatches :: MonadicParsing m => m a -> m Bool

496lookAheadMatches :: MonadicParsing m => m a -> m Bool

513−lookAheadMatches p = do match <- lookAhead (optional p)

497+lookAheadMatches p = isJust <$> P.lookAhead (P.optional p)

514− return $ isJust match

515

498

516-- | Parses a start of block

499-- | Parses a start of block

517openBlock :: IdrisParser ()

500openBlock :: IdrisParser ()

@@ -555,7 +538,7 @@ terminator = do lchar ';'; popIndent

555 if c <= l then popIndent else fail "not a terminator"

538 if c <= l then popIndent else fail "not a terminator"

556 <|> do isParen <- lookAheadMatches (P.oneOf ")}")

539 <|> do isParen <- lookAheadMatches (P.oneOf ")}")

557 if isParen then popIndent else fail "not a terminator"

540 if isParen then popIndent else fail "not a terminator"

558− <|> lookAhead P.eof

541+ <|> P.lookAhead P.eof

559

542

560-- | Parses and keeps a terminator

543-- | Parses and keeps a terminator

561keepTerminator :: IdrisParser ()

544keepTerminator :: IdrisParser ()

@@ -565,7 +548,7 @@ keepTerminator = () <$ lchar ';'

565 <|> do isParen <- lookAheadMatches (P.oneOf ")}|")

548 <|> do isParen <- lookAheadMatches (P.oneOf ")}|")

566 isIn <- lookAheadMatches (reserved "in")

549 isIn <- lookAheadMatches (reserved "in")

567 unless (isIn || isParen) $ fail "not a terminator"

550 unless (isIn || isParen) $ fail "not a terminator"

568− <|> lookAhead P.eof

551+ <|> P.lookAhead P.eof

569

552

570-- | Checks if application expression does not end

553-- | Checks if application expression does not end

571notEndApp :: IdrisParser ()

554notEndApp :: IdrisParser ()

@@ -577,7 +560,7 @@ notEndBlock :: IdrisParser ()

577notEndBlock = do ist <- get

560notEndBlock = do ist <- get

578 case brace_stack ist of

561 case brace_stack ist of

579 Just lvl : xs -> do i <- indent

562 Just lvl : xs -> do i <- indent

580− isParen <- lookAheadMatches (char ')')

563+ isParen <- lookAheadMatches (P.char ')')

581 when (i < lvl || isParen) (fail "end of block")

564 when (i < lvl || isParen) (fail "end of block")

582 _ -> return ()

565 _ -> return ()

583

566

src/Idris/REPL/Parser.hs+1

@@ -4,6 +4,7 @@ Description : Parser for the REPL commands.

4License : BSD3

5Maintainer : The Idris Community.

6-}

7+{-# LANGUAGE FlexibleContexts #-}

7module Idris.REPL.Parser (

8module Idris.REPL.Parser (

8 parseCmd

9 parseCmd

9 , help

10 , help