renamed ‘MegaParsec’ → ‘Megaparsec’, close #10

This commit is contained in:
mrkkrp 2015-08-01 22:24:45 +06:00
parent 3c69bc8f48
commit 3ef5e5e621
28 changed files with 132 additions and 132 deletions

View File

@ -1,6 +1,6 @@
# Authors
The following people have contributed to MegaParsec/Parsec library. Due to
The following people have contributed to Megaparsec/Parsec library. Due to
the fact that original Parsec project has not been keeping this sort of
file, many contributors are missing from this list, if you've contributed to
Parsec project in the Past, please open an issue or a pull request, so we

View File

@ -1,4 +1,4 @@
## MegaParsec 4.0.0
## Megaparsec 4.0.0
* Cosmetic changes in entire source code, numerous improvements and
elimination of warnings.

View File

@ -1,4 +1,4 @@
Copyright © 2015 MegaParsec contributors<br>
Copyright © 2015 Megaparsec contributors<br>
Copyright © 2007 Paolo Martini<br>
Copyright © 19992000 Daan Leijen

View File

@ -1,26 +1,26 @@
# MegaParsec
# Megaparsec
[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause)
[![Build Status](https://travis-ci.org/mrkkrp/megaparsec.svg?branch=master)](https://travis-ci.org/mrkkrp/megaparsec)
This is industrial-strength monadic parser combinator library. MegaParsec is
This is industrial-strength monadic parser combinator library. Megaparsec is
a fork of original Parsec library written by Daan Leijen. This library is
different from Parsec in the following ways:
* Original Parsec consists of quite ancient code-base and has certain
stylistic problems that's anyone who tries to compile Parsec with `-Wall`
option can notice. This has been refreshed in MegaParsec. The changes are
option can notice. This has been refreshed in Megaparsec. The changes are
mainly cosmetic but not limited to them.
* Some quirks and old «buggy features» (as well as plain bugs) are fixed.
* Original Parsec uses rather weak collection of tests: a test per bug,
obviously to prevent regression. Our aim is to write complete test-suite
with QuickCheck to cover 100% of MegaParsec code. You can understand need
with QuickCheck to cover 100% of Megaparsec code. You can understand need
for this test-suite if you look at `CHANGELOG.md` file that includes
Parsec-era changes. The word «regression» mentioned quite frequently.
* MegaParsec looks into future, it does not contain code that serves for
* Megaparsec looks into future, it does not contain code that serves for
compatibility purposes, it also requires more recent version of `base`.
* Finally, we have fixed numerous typos and other minor flaws.
@ -42,7 +42,7 @@ merged quickly if they are good).
## License
Copyright © 2015 MegaParsec contributors<br>
Copyright © 2015 Megaparsec contributors<br>
Copyright © 2007 Paolo Martini<br>
Copyright © 19992000 Daan Leijen

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : BSD3
@ -15,13 +15,13 @@
-- parse the result of your own tokenizer you should start with the following
-- imports:
--
-- > import Text.MegaParsec.Prim
-- > import Text.MegaParsec.Combinator
-- > import Text.Megaparsec.Prim
-- > import Text.Megaparsec.Combinator
--
-- Then you can implement your own version of 'satisfy' on top of the
-- 'tokenPrim' primitive.
module Text.MegaParsec
module Text.Megaparsec
(
-- * Parsers
ParsecT
@ -122,11 +122,11 @@ where
import qualified Control.Applicative as A
import Text.MegaParsec.Char
import Text.MegaParsec.Combinator
import Text.MegaParsec.Error
import Text.MegaParsec.Pos
import Text.MegaParsec.Prim
import Text.Megaparsec.Char
import Text.Megaparsec.Combinator
import Text.Megaparsec.Error
import Text.Megaparsec.Pos
import Text.Megaparsec.Prim
-- $assocbo
--

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.ByteString
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.ByteString
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- License : BSD3
--
@ -10,14 +10,14 @@
--
-- Convenience definitions for working with 'C.ByteString's.
module Text.MegaParsec.ByteString
module Text.Megaparsec.ByteString
( Parser
, GenParser
, parseFromFile )
where
import Text.MegaParsec.Error
import Text.MegaParsec.Prim
import Text.Megaparsec.Error
import Text.Megaparsec.Prim
import qualified Data.ByteString.Char8 as C

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.ByteString.Lazy
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.ByteString.Lazy
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- License : BSD3
--
@ -10,14 +10,14 @@
--
-- Convenience definitions for working with lazy 'C.ByteString's.
module Text.MegaParsec.ByteString.Lazy
module Text.Megaparsec.ByteString.Lazy
( Parser
, GenParser
, parseFromFile )
where
import Text.MegaParsec.Error
import Text.MegaParsec.Prim
import Text.Megaparsec.Error
import Text.Megaparsec.Prim
import qualified Data.ByteString.Lazy.Char8 as C

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Char
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Char
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : BSD3
@ -11,7 +11,7 @@
--
-- Commonly used character parsers.
module Text.MegaParsec.Char
module Text.Megaparsec.Char
( oneOf
, noneOf
, spaces
@ -36,8 +36,8 @@ where
import Control.Applicative ((<|>))
import Data.Char
import Text.MegaParsec.Pos
import Text.MegaParsec.Prim
import Text.Megaparsec.Pos
import Text.Megaparsec.Prim
-- | @oneOf cs@ succeeds if the current character is in the supplied
-- list of characters @cs@. Returns the parsed character. See also

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Combinator
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Combinator
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : BSD3
@ -11,7 +11,7 @@
--
-- Commonly used generic combinators.
module Text.MegaParsec.Combinator
module Text.Megaparsec.Combinator
( choice
, count
, between
@ -38,7 +38,7 @@ where
import Control.Applicative ((<|>), many, some)
import Control.Monad
import Text.MegaParsec.Prim
import Text.Megaparsec.Prim
-- | @choice ps@ tries to apply the parsers in the list @ps@ in order,
-- until one of them succeeds. Returns the value of the succeeding parser.

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Error
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Error
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : BSD3
@ -11,7 +11,7 @@
--
-- Parse errors.
module Text.MegaParsec.Error
module Text.Megaparsec.Error
( Message (SysUnExpect, UnExpect, Expect, Message)
, messageString
, ParseError
@ -29,7 +29,7 @@ where
import Data.List (nub, sort, intercalate)
import Text.MegaParsec.Pos
import Text.Megaparsec.Pos
-- | This abstract data type represents parse error messages. There are
-- four kinds of messages:

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Expr
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Expr
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : BSD3
@ -12,7 +12,7 @@
-- A helper module to parse \"expressions\".
-- Builds a parser given a table of operators and associativities.
module Text.MegaParsec.Expr
module Text.Megaparsec.Expr
( Assoc (..)
, Operator (..)
, OperatorTable
@ -22,8 +22,8 @@ where
import Control.Applicative ((<|>))
import Data.List (foldl')
import Text.MegaParsec.Combinator
import Text.MegaParsec.Prim
import Text.Megaparsec.Combinator
import Text.Megaparsec.Prim
-- | This data type specifies the associativity of operators: left, right
-- or none.

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Language
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Language
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : BSD3
@ -12,7 +12,7 @@
-- A helper module that defines some language definitions that can be used
-- to instantiate a token parser (see "Text.Parsec.Token").
module Text.MegaParsec.Language
module Text.Megaparsec.Language
( LanguageDef
, emptyDef
, haskellStyle
@ -23,8 +23,8 @@ where
import Control.Monad.Identity
import Text.MegaParsec
import Text.MegaParsec.Token
import Text.Megaparsec
import Text.Megaparsec.Token
-- | This is the most minimal token definition. It is recommended to use
-- this definition as the basis for other definitions. @emptyDef@ has no

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Perm
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Perm
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : BSD3
@ -16,7 +16,7 @@
-- /Parsing Permutation Phrases,/ by Arthur Baars, Andres Loh and Doaitse
-- Swierstra. Published as a functional pearl at the Haskell Workshop 2001.
module Text.MegaParsec.Perm
module Text.Megaparsec.Perm
( StreamPermParser -- abstract
, permute
, (<||>)
@ -27,7 +27,7 @@ where
import Control.Monad.Identity
import Text.MegaParsec
import Text.Megaparsec
infixl 1 <||>, <|?>
infixl 2 <$$>, <$?>

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Pos
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Pos
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : BSD3
@ -11,7 +11,7 @@
--
-- Textual source positions.
module Text.MegaParsec.Pos
module Text.Megaparsec.Pos
( SourceName
, Line
, Column

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Prim
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Prim
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : BSD3
@ -13,7 +13,7 @@
{-# OPTIONS_HADDOCK not-home #-}
module Text.MegaParsec.Prim
module Text.Megaparsec.Prim
( State (..)
, Stream (..)
, Consumed (..)
@ -67,8 +67,8 @@ import Control.Monad.Error.Class
import qualified Control.Applicative as A
import Text.MegaParsec.Pos
import Text.MegaParsec.Error
import Text.Megaparsec.Pos
import Text.Megaparsec.Error
-- | This is Parsec state, this is parametrized over stream type @s@, and
-- user state @u@.
@ -329,7 +329,7 @@ sysUnExpectError msg pos = Error (newErrorMessage (SysUnExpect msg) pos)
-- The parsers 'fail', ('<?>') and @unexpected@ are the three parsers used
-- to generate error messages. Of these, only ('<?>') is commonly used. For
-- an example of the use of @unexpected@, see the definition of
-- 'Text.MegaParsec.Combinator.notFollowedBy'.
-- 'Text.Megaparsec.Combinator.notFollowedBy'.
unexpected :: Stream s m t => String -> ParsecT s u m a
unexpected msg = ParsecT $ \s _ _ _ eerr ->
@ -523,7 +523,7 @@ token showToken tokpos = tokenPrim showToken nextpos
-- returns it. The resulting parser will use @showToks@ to pretty-print the
-- collection of tokens.
--
-- This can be used to example to write 'Text.MegaParsec.Char.string':
-- This can be used to example to write 'Text.Megaparsec.Char.string':
--
-- > string = tokens show updatePosString
@ -572,7 +572,7 @@ tokens showTokens nextposs tts@(tok:toks)
-- @nextPos pos t toks@.
--
-- This is the most primitive combinator for accepting tokens. For example,
-- the 'Text.MegaParsec.Char.char' parser could be implemented as:
-- the 'Text.Megaparsec.Char.char' parser could be implemented as:
--
-- > char c = tokenPrim showChar nextPos testChar
-- > where showChar x = "'" ++ x ++ "'"
@ -647,7 +647,7 @@ manyAccum acc p =
manyErr :: forall t . t
manyErr =
error
"Text.MegaParsec.Prim.many: combinator 'many' is applied to a parser \
"Text.Megaparsec.Prim.many: combinator 'many' is applied to a parser \
\that accepts an empty string."
-- Parser state combinators

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.String
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.String
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- License : BSD3
--
@ -10,14 +10,14 @@
--
-- Make Strings an instance of 'Stream' with 'Char' token type.
module Text.MegaParsec.String
module Text.Megaparsec.String
( Parser
, GenParser
, parseFromFile )
where
import Text.MegaParsec.Error
import Text.MegaParsec.Prim
import Text.Megaparsec.Error
import Text.Megaparsec.Prim
-- | Different modules corresponding to various types of streams (@String@,
-- @Text@, @ByteString@) define it differently, so user can use \"abstract\"

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Text
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Text
-- Copyright : © 2015 Megaparsec contributors
-- © 2011 Antoine Latter
-- License : BSD3
--
@ -10,14 +10,14 @@
--
-- Convenience definitions for working with 'Text.Text'.
module Text.MegaParsec.Text
module Text.Megaparsec.Text
( Parser
, GenParser
, parseFromFile )
where
import Text.MegaParsec.Error
import Text.MegaParsec.Prim
import Text.Megaparsec.Error
import Text.Megaparsec.Prim
import qualified Data.Text as T
import qualified Data.Text.IO as T

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Text.Lazy
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Text.Lazy
-- Copyright : © 2015 Megaparsec contributors
-- © 2011 Antoine Latter
-- License : BSD3
--
@ -10,14 +10,14 @@
--
-- Convenience definitions for working with lazy 'Text.Text'.
module Text.MegaParsec.Text.Lazy
module Text.Megaparsec.Text.Lazy
( Parser
, GenParser
, parseFromFile )
where
import Text.MegaParsec.Error
import Text.MegaParsec.Prim
import Text.Megaparsec.Error
import Text.Megaparsec.Prim
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as T

View File

@ -1,6 +1,6 @@
-- |
-- Module : Text.MegaParsec.Token
-- Copyright : © 2015 MegaParsec contributors
-- Module : Text.Megaparsec.Token
-- Copyright : © 2015 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : BSD3
@ -14,7 +14,7 @@
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Text.MegaParsec.Token
module Text.Megaparsec.Token
( LanguageDef (..)
, TokenParser (..)
, makeTokenParser )
@ -25,9 +25,9 @@ import Control.Monad (void)
import Data.Char (isAlpha, toLower, toUpper, isSpace)
import Data.List (nub, sort)
import Text.MegaParsec.Prim
import Text.MegaParsec.Char
import Text.MegaParsec.Combinator
import Text.Megaparsec.Prim
import Text.Megaparsec.Char
import Text.Megaparsec.Combinator
-- Language definition

View File

@ -1,8 +1,8 @@
-- -*- Mode: Haskell; -*-
--
-- Criterion benmarks for MegaParsec, main module.
-- Criterion benmarks for Megaparsec, main module.
--
-- Copyright © 2015 MegaParsec contributors
-- Copyright © 2015 Megaparsec contributors
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are

View File

@ -1,8 +1,8 @@
-- -*- Mode: Haskell-Cabal; -*-
--
-- Cabal config for MegaParsec.
-- Cabal config for Megaparsec.
--
-- Copyright © 2015 MegaParsec contributors
-- Copyright © 2015 Megaparsec contributors
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
@ -32,7 +32,7 @@ version: 4.0.0
cabal-version: >= 1.10
license: BSD3
license-file: LICENSE.md
author: MegaParsec contributors,
author: Megaparsec contributors,
Paolo Martini <paolo@nemail.it>,
Daan Leijen <daan@microsoft.com>
@ -44,7 +44,7 @@ synopsis: Monadic parser combinators
build-type: Simple
description:
This is industrial-strength monadic parser combinator library. MegaParsec
This is industrial-strength monadic parser combinator library. Megaparsec
is a fork of original Parsec library written by Daan Leijen.
extra-source-files: AUTHORS.md, CHANGELOG.md
@ -63,21 +63,21 @@ library
, MultiParamTypeClasses
, PolymorphicComponents
, UndecidableInstances
exposed-modules: Text.MegaParsec
, Text.MegaParsec.String
, Text.MegaParsec.ByteString
, Text.MegaParsec.ByteString.Lazy
, Text.MegaParsec.Text
, Text.MegaParsec.Text.Lazy
, Text.MegaParsec.Pos
, Text.MegaParsec.Error
, Text.MegaParsec.Prim
, Text.MegaParsec.Char
, Text.MegaParsec.Combinator
, Text.MegaParsec.Token
, Text.MegaParsec.Expr
, Text.MegaParsec.Language
, Text.MegaParsec.Perm
exposed-modules: Text.Megaparsec
, Text.Megaparsec.String
, Text.Megaparsec.ByteString
, Text.Megaparsec.ByteString.Lazy
, Text.Megaparsec.Text
, Text.Megaparsec.Text.Lazy
, Text.Megaparsec.Pos
, Text.Megaparsec.Error
, Text.Megaparsec.Prim
, Text.Megaparsec.Char
, Text.Megaparsec.Combinator
, Text.Megaparsec.Token
, Text.Megaparsec.Expr
, Text.Megaparsec.Language
, Text.Megaparsec.Perm
ghc-options: -O2 -Wall
default-language: Haskell2010

View File

@ -5,9 +5,9 @@ import Test.HUnit hiding (Test)
import Test.Framework
import Test.Framework.Providers.HUnit
import Text.MegaParsec
import Text.MegaParsec.Language (haskellDef)
import qualified Text.MegaParsec.Token as P
import Text.Megaparsec
import Text.Megaparsec.Language (haskellDef)
import qualified Text.Megaparsec.Token as P
main :: Test
main =

View File

@ -1,10 +1,10 @@
module Bugs.Bug35 (main) where
import Text.MegaParsec
import Text.MegaParsec.Language
import Text.MegaParsec.String
import qualified Text.MegaParsec.Token as Token
import Text.Megaparsec
import Text.Megaparsec.Language
import Text.Megaparsec.String
import qualified Text.Megaparsec.Token as Token
import Test.HUnit hiding (Test)
import Test.Framework

View File

@ -3,10 +3,10 @@ module Bugs.Bug39 (main) where
import Data.Either (isLeft, isRight)
import Text.MegaParsec
import Text.MegaParsec.Language
import Text.MegaParsec.String
import qualified Text.MegaParsec.Token as Token
import Text.Megaparsec
import Text.Megaparsec.Language
import Text.Megaparsec.String
import qualified Text.Megaparsec.Token as Token
import Test.HUnit hiding (Test)
import Test.Framework

View File

@ -5,8 +5,8 @@ import Test.HUnit hiding (Test)
import Test.Framework
import Test.Framework.Providers.HUnit
import Text.MegaParsec
import Text.MegaParsec.String
import Text.Megaparsec
import Text.Megaparsec.String
import Util

View File

@ -1,11 +1,11 @@
module Bugs.Bug9 (main) where
import Text.MegaParsec
import Text.MegaParsec.Language (haskellStyle)
import Text.MegaParsec.String (Parser)
import Text.MegaParsec.Expr
import qualified Text.MegaParsec.Token as P
import Text.Megaparsec
import Text.Megaparsec.Language (haskellStyle)
import Text.Megaparsec.String (Parser)
import Text.Megaparsec.Expr
import qualified Text.Megaparsec.Token as P
import Test.HUnit hiding (Test)
import Test.Framework

View File

@ -1,8 +1,8 @@
module Util where
import Text.MegaParsec
import Text.MegaParsec.String (Parser)
import Text.Megaparsec
import Text.Megaparsec.String (Parser)
-- | Returns the error messages associated with a failed parse.

View File

@ -1,8 +1,8 @@
-- -*- Mode: Haskell; -*-
--
-- QuickCheck tests for MegaParsec, main module.
-- QuickCheck tests for Megaparsec, main module.
--
-- Copyright © 2015 MegaParsec contributors
-- Copyright © 2015 Megaparsec contributors
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are