From 899fa1b53117e967ec5f201fb24b1fea9944f1f6 Mon Sep 17 00:00:00 2001
From: Danny Navarro <j@dannynavarro.net>
Date: Fri, 18 Sep 2015 18:11:11 +0200
Subject: [PATCH] Handle escaped quotes for GraphQL String Values

This also includes a new type for Value String.

The tests fail now, although it parses successfully. I'll use a pretty
printer in next commit so that it's easier to spot the differences.
Onces this is working I'll add the rest of the escaped characters.
---
 Data/GraphQL/AST.hs    |  4 +++-
 Data/GraphQL/Parser.hs | 16 ++++++++++++++--
 2 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/Data/GraphQL/AST.hs b/Data/GraphQL/AST.hs
index 7e8c9b5..45bc519 100644
--- a/Data/GraphQL/AST.hs
+++ b/Data/GraphQL/AST.hs
@@ -66,12 +66,14 @@ data Value = ValueVariable Variable
            -- GraphQL Float is double precison
            | ValueFloat Double
            | ValueBoolean Bool
-           | ValueString Text
+           | ValueString StringValue
            | ValueEnum Name
            | ValueList ListValue
            | ValueObject ObjectValue
              deriving (Eq,Show)
 
+newtype StringValue = StringValue Text deriving (Eq,Show)
+
 newtype ListValue = ListValue [Value] deriving (Eq,Show)
 
 newtype ObjectValue = ObjectValue [ObjectField] deriving (Eq,Show)
diff --git a/Data/GraphQL/Parser.hs b/Data/GraphQL/Parser.hs
index 1bc497b..09190b0 100644
--- a/Data/GraphQL/Parser.hs
+++ b/Data/GraphQL/Parser.hs
@@ -14,6 +14,7 @@ import Data.Char
 import Data.Foldable (traverse_)
 
 import Data.Text (Text, append)
+import qualified Data.Text as T
 import Data.Attoparsec.Text
   ( Parser
   , (<?>)
@@ -28,6 +29,7 @@ import Data.Attoparsec.Text
   , peekChar
   , sepBy1
   , signed
+  , takeText
   , takeWhile
   , takeWhile1
   )
@@ -156,13 +158,23 @@ value = ValueVariable <$> variable
     <|> ValueInt      <$> tok (signed decimal)
     <|> ValueFloat    <$> tok (signed double)
     <|> ValueBoolean  <$> bool
-    -- TODO: Handle escape characters, unicode, etc
-    <|> ValueString   <$> quotes name
+    <|> ValueString   <$> stringValue
     -- `true` and `false` have been tried before
     <|> ValueEnum     <$> name
     <|> ValueList     <$> listValue
     <|> ValueObject   <$> objectValue
 
+
+stringValue :: Parser StringValue
+stringValue = StringValue <$> quotes (T.foldl' step mempty <$> takeText)
+  where
+    -- TODO: Handle unicode and the rest of escaped chars.
+    step acc c
+        | T.null acc = T.singleton c
+        | T.last acc == '\\' = if c == '"' then T.init acc `T.snoc` '"'
+                                           else acc `T.snoc` c
+        | otherwise = acc `T.snoc` c
+
 -- Notice it can be empty
 listValue :: Parser ListValue
 listValue = ListValue <$> brackets (many value)