aeson-qq 0.6.0 → 0.6.1
raw patch · 4 files changed
+292/−2 lines, 4 filesdep +parsecdep −json-qqPVP ok
version bump matches the API change (PVP)
Dependencies added: parsec
Dependencies removed: json-qq
API changes (from Hackage documentation)
Files
- aeson-qq.cabal +7/−2
- src/Data/JSON/QQ.hs +208/−0
- test/Data/Aeson/QQSpec.hs +65/−0
- test/Person.hs +12/−0
aeson-qq.cabal view
@@ -1,5 +1,5 @@ name: aeson-qq-version: 0.6.0+version: 0.6.1 synopsis: Json Quasiquatation for Haskell. description: @aeson-qq@ provides json quasiquatation for Haskell. .@@ -28,12 +28,14 @@ src exposed-modules: Data.Aeson.QQ+ other-modules:+ Data.JSON.QQ build-depends: base >= 4.6 && < 5 , text , vector , aeson >= 0.7- , json-qq == 0.4.1+ , parsec , template-haskell , haskell-src-meta >= 0.1.0 @@ -46,6 +48,9 @@ test main-is: Spec.hs+ other-modules:+ Person+ Data.Aeson.QQSpec build-depends: base >= 4.6 && < 5 , aeson-qq
+ src/Data/JSON/QQ.hs view
@@ -0,0 +1,208 @@+{-# OPTIONS_GHC -XTemplateHaskell -XQuasiQuotes -XUndecidableInstances #-}++-- | This package expose the parser @jsonParser@.+--+-- Only developers that develop new json quasiquoters should use this library!+--+-- See @text-json-qq@ and @aeson-qq@ for usage.+--++module Data.JSON.QQ (+ JsonValue (..),+ HashKey (..),+ parsedJson+) where++import Language.Haskell.TH+import Language.Haskell.TH.Quote++import Data.Data+import Data.Maybe++import Data.Ratio+import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Error++import Language.Haskell.Meta.Parse++parsedJson :: String -> Either ParseError JsonValue+parsedJson txt = parse jpValue "txt" txt++-------+-- Internal representation++data JsonValue =+ JsonNull+ | JsonString String+ | JsonNumber Bool Rational+ | JsonObject [(HashKey,JsonValue)]+ | JsonArray [JsonValue]+ | JsonIdVar String+ | JsonBool Bool+ | JsonCode Exp++data HashKey =+ HashVarKey String+ | HashStringKey String++------+-- Grammar+-- jp = json parsec+-----++(=>>) :: Monad m => m a -> b -> m b+x =>> y = x >> return y+++(>>>=) :: Monad m => m a -> (a -> b) -> m b+x >>>= y = x >>= return . y++type JsonParser = Parser JsonValue++-- data QQJsCode =+-- QQjs JSValue+-- | QQcode String++jsonParser :: JsonParser+jsonParser = do+ spaces+ res <- jpTrue <|> jpFalse <|> try jpIdVar <|> jpNull <|> jpString <|> jpObject <|> jpNumber <|> jpArray <|> jpCode+ spaces+ return res++jpValue = jsonParser++jpTrue :: JsonParser+jpTrue = jpBool "true" True++jpFalse :: JsonParser+jpFalse = jpBool "false" False++jpBool :: String -> Bool -> JsonParser+jpBool txt b = string txt =>> JsonBool b++jpCode :: JsonParser+jpCode = do+ string "<|"+ parseExp' >>>= JsonCode+ where+ parseExp' = do+ str <- untilString+ case (parseExp str) of+ Left l -> fail l+ Right r -> return r+++++jpIdVar :: JsonParser+jpIdVar = between (string "<<") (string ">>") symbol >>>= JsonIdVar+++jpNull :: JsonParser+jpNull = do+ string "null" =>> JsonNull++jpString :: JsonParser+jpString = between (char '"') (char '"') (option [""] $ many chars) >>= return . JsonString . concat -- do++jpNumber :: JsonParser+jpNumber = do+ val <- float+ return $ JsonNumber False (toRational val)++jpObject :: JsonParser+jpObject = do+ list <- between (char '{') (char '}') (commaSep jpHash)+ return $ JsonObject $ list+ where+ jpHash :: CharParser () (HashKey,JsonValue) -- (String,JsonValue)+ jpHash = do+ spaces+ name <- varKey <|> symbolKey <|> quotedStringKey+ spaces+ char ':'+ spaces+ value <- jpValue+ spaces+ return (name,value)++symbolKey :: CharParser () HashKey+symbolKey = symbol >>>= HashStringKey++quotedStringKey :: CharParser () HashKey+quotedStringKey = quotedString >>>= HashStringKey++varKey :: CharParser () HashKey+varKey = do+ char '$'+ sym <- symbol+ return $ HashVarKey sym++jpArray :: CharParser () JsonValue+jpArray = between (char '[') (char ']') (commaSep jpValue) >>>= JsonArray++-------+-- helpers for parser/grammar++untilString :: Parser String+untilString = do+ n0 <- option "" $ many1 (noneOf "|")+ char '|'+ n1 <- option "" $ many1 (noneOf ">")+ char '>'+ if not $ null n1+ then do n2 <- untilString+ return $ concat [n0,n1,n2]+ else return $ concat [n0,n1]++++float :: CharParser st Double+float = do+ isMinus <- option ' ' (char '-')+ d <- many1 digit+ o <- option "" withDot+ e <- option "" withE+ return $ (read $ isMinus : d ++ o ++ e :: Double)++withE = do+ e <- char 'e' <|> char 'E'+ plusMinus <- option "" (string "+" <|> string "-")+ d <- many digit+ return $ e : plusMinus ++ d++withDot = do+ o <- char '.'+ d <- many digit+ return $ o:d++quotedString :: CharParser () String+quotedString = between (char '"') (char '"') (option [""] $ many chars) >>>= concat++symbol :: CharParser () String+symbol = many1 (noneOf "\\ \":;><$")++commaSep p = p `sepBy` (char ',')++chars :: CharParser () String+chars = do+ try (string "\\\"")+ <|> try (string "\\/")+ <|> try (string "\\\\")+ <|> try (string "\\b")+ <|> try (string "\\f")+ <|> try (string "\\n")+ <|> try (string "\\r")+ <|> try (string "\\t")+ <|> try (unicodeChars)+ <|> many1 (noneOf "\\\"")++unicodeChars :: CharParser () String+unicodeChars = do+ u <- string "\\u"+ d1 <- hexDigit+ d2 <- hexDigit+ d3 <- hexDigit+ d4 <- hexDigit+ return $ u ++ [d1] ++ [d2] ++ [d3] ++ [d4]
+ test/Data/Aeson/QQSpec.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}+module Data.Aeson.QQSpec (main, spec) where++import Test.Hspec++import Data.Char+import Data.Aeson++import qualified Person+import Data.Aeson.QQ++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "aesonQQ" $ do+ it "handles escape sequences" $ do+ [aesonQQ|{foo: "ba r.\".\\.r\n"}|] `shouldBe` object [("foo", "ba r.\\\".\\\\.r\\n")]++ it "can construct arrays" $ do+ [aesonQQ|[null, {foo: 23}]|] `shouldBe` toJSON [Null, object [("foo", Number 23.0)]]++ it "can construct true, false and null" $ do+ [aesonQQ|[true, false, null]|] `shouldBe` toJSON [Bool True, Bool False, Null]++ it "accepts quotes around field names" $ do+ [aesonQQ|{"foo": "bar"}|] `shouldBe` object [("foo", "bar")]++ it "can parse multiline strings" $ do+ [aesonQQ|+ [ {+ user:+ "Joe"},+ {user: "John"}]+ |] `shouldBe` toJSON [object [("user", "Joe")], object [("user", "John")]]++ it "can interpolate JSON values" $ do+ let x = object [("foo", Number 23)]+ [aesonQQ|[null, <|x|>]|] `shouldBe` toJSON [Null, x]++ it "can interpolate field names" $ do+ let foo = "zoo"+ [aesonQQ|{$foo: "bar"}|] `shouldBe` object [("zoo", "bar")]++ it "can interpolate numbers" $ do+ let x = 23 :: Int+ [aesonQQ|[null, {foo: <|x|>}]|] `shouldBe` toJSON [Null, object [("foo", Number 23)]]++ it "can interpolate strings" $ do+ let foo = "bar" :: String+ [aesonQQ|{foo: <|foo|>}|] `shouldBe` object [("foo", "bar")]++ it "can interpolate data types" $ do+ let foo = Person.Person "Joe" 23+ [aesonQQ|<|foo|>|] `shouldBe` object [("name", "Joe"), ("age", Number 23)]++ it "can interpolate simple expressions" $ do+ let x = 23 :: Int+ y = 42+ [aesonQQ|{foo: <|x + y|>}|] `shouldBe` object [("foo", Number 65)]++ it "can interpolate more complicated expressions" $ do+ let name = "Joe"+ [aesonQQ|{name: <|map toUpper name|>}|] `shouldBe` object [("name", "JOE")]
+ test/Person.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}+module Person where++import GHC.Generics+import Data.Aeson++data Person = Person {+ name :: String+, age :: Int+} deriving (Eq, Show, Generic)++instance ToJSON Person