From bedf64c653a701215aef5e08f05a5c58c8d6097f Mon Sep 17 00:00:00 2001
From: Vladislav Zavialov <vlad.z.4096@gmail.com>
Date: Wed, 13 Dec 2017 16:13:50 +0300
Subject: [PATCH] Add an IsString instance and tests for it

---
 CHANGELOG.md                 |  5 +++++
 Text/Megaparsec.hs           |  5 +++++
 tests/Text/MegaparsecSpec.hs | 36 +++++++++++++++++++++++++++++++++++-
 3 files changed, 45 insertions(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 72eb74ea..d95174be 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,8 @@
+## Megaparsec 6.3.0
+
+* Added an `IsString` instance for `ParsecT`. Now it is possible to
+  write `"abc"` rather than `string "abc"`.
+
 ## Megaparsec 6.2.1
 
 * Made implementation of `sconcat` and `mconcat` of `ParsecT` more
diff --git a/Text/Megaparsec.hs b/Text/Megaparsec.hs
index c8207435..f00b4c65 100644
--- a/Text/Megaparsec.hs
+++ b/Text/Megaparsec.hs
@@ -133,6 +133,7 @@ import Data.Maybe (fromJust)
 import Data.Proxy
 import Data.Semigroup hiding (option)
 import Data.Set (Set)
+import Data.String (IsString (..))
 import Data.Typeable (Typeable)
 import Debug.Trace
 import GHC.Generics
@@ -322,6 +323,10 @@ instance (Stream s, Monoid a) => Monoid (ParsecT e s m a) where
   mconcat = fmap mconcat . sequence
   {-# INLINE mconcat #-}
 
+instance (a ~ Tokens s, IsString a, Eq a, Stream s, Ord e)
+    => IsString (ParsecT e s m a) where
+  fromString s = tokens (==) (fromString s)
+
 instance Functor (ParsecT e s m) where
   fmap = pMap
 
diff --git a/tests/Text/MegaparsecSpec.hs b/tests/Text/MegaparsecSpec.hs
index 2f5f73ea..bc850464 100644
--- a/tests/Text/MegaparsecSpec.hs
+++ b/tests/Text/MegaparsecSpec.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiWayIf        #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Rank2Types        #-}
 {-# LANGUAGE RecordWildCards   #-}
 {-# LANGUAGE RecursiveDo       #-}
@@ -23,6 +24,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (fromMaybe, listToMaybe, isJust)
 import Data.Monoid
 import Data.Proxy
+import Data.String
 import Data.Void
 import Prelude hiding (span, concat)
 import Test.Hspec
@@ -41,6 +43,8 @@ import qualified Data.List                   as DL
 import qualified Data.List.NonEmpty          as NE
 import qualified Data.Semigroup              as G
 import qualified Data.Set                    as E
+import qualified Data.Text                   as T
+import qualified Data.ByteString             as BS
 
 #if !MIN_VERSION_QuickCheck(2,8,2)
 instance (Arbitrary a, Ord a) => Arbitrary (E.Set a) where
@@ -212,6 +216,30 @@ spec = do
         let p = pure [a] `mappend` pure [b]
         prs p "" `shouldParse` ([a,b] :: [Int])
 
+  describe "ParsecT IsString instance" $ do
+    describe "equivalence to 'string'" $ do
+      it "for String" $ property $ \s i ->
+        eqParser
+          (string s)
+          (fromString s)
+          (i :: String)
+      it "for Text" $ property $ \s i ->
+        eqParser
+          (string (T.pack s))
+          (fromString s)
+          (i :: T.Text)
+      it "for ByteString" $ property $ \s i ->
+        eqParser
+          (string (fromString s :: BS.ByteString))
+          (fromString s)
+          (i :: BS.ByteString)
+    it "can handle Unicode" $ do
+        let
+          r = "פּאַרסער 解析器" :: BS.ByteString
+          p :: Parsec Void BS.ByteString BS.ByteString
+          p = BS.concat <$> sequenceA ["פּאַ", "רסער", " 解析器"]
+        parse p "" r `shouldParse` r
+
   describe "ParsecT Functor instance" $ do
     it "obeys identity law" $
       property $ \n ->
@@ -370,7 +398,7 @@ spec = do
                   x <- S.get
                   if x < n then S.modify (+ 1) else empty
                 v :: S.State Integer (Either (ParseError Char Void) ())
-                v = runParserT p "" ""
+                v = runParserT p "" ("" :: String)
             S.execState v 0 `shouldBe` n
 
     describe "some" $ do
@@ -1780,3 +1808,9 @@ emulateStrParsing st@(State i (pos:|z) tp w) s =
          , Left $ err (pos:|z) (etoks s <> utoks (take l i)) )
   where
     l = length s
+
+eqParser :: (Eq a, Eq (Token i))
+  => Parsec Void i a
+  -> Parsec Void i a
+  -> i -> Bool
+eqParser p1 p2 i = runParser p1 "" i == runParser p2 "" i