aeson-qq-0.8.2/0000755000000000000000000000000013120002374011423 5ustar0000000000000000aeson-qq-0.8.2/LICENSE0000644000000000000000000000212513120002374012430 0ustar0000000000000000Copyright (c) 2014 Zalora South East Asia Pte. Ltd Copyright (c) 2010 Oscar Finnsson Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. aeson-qq-0.8.2/Setup.hs0000644000000000000000000000005613120002374013060 0ustar0000000000000000import Distribution.Simple main = defaultMain aeson-qq-0.8.2/aeson-qq.cabal0000644000000000000000000000374013120002374014137 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.18.0. -- -- see: https://github.com/sol/hpack name: aeson-qq version: 0.8.2 synopsis: JSON quasiquoter for Haskell description: @aeson-qq@ provides a JSON quasiquoter for Haskell. . This package exposes the function `aesonQQ` that compile-time converts a string representation of a JSON value into a `Data.Aeson.Value`. `aesonQQ` has the signature . >aesonQQ :: QuasiQuoter . Consult the @README@ for documentation: homepage: https://github.com/sol/aeson-qq#readme bug-reports: https://github.com/sol/aeson-qq/issues license: MIT license-file: LICENSE author: Oscar Finnsson maintainer: Simon Hengel category: JSON build-type: Simple cabal-version: >= 1.10 source-repository head type: git location: https://github.com/sol/aeson-qq library ghc-options: -Wall hs-source-dirs: src exposed-modules: Data.Aeson.QQ other-modules: Data.JSON.QQ Paths_aeson_qq default-language: Haskell2010 build-depends: base >= 4.5 && < 5 , base-compat , text , attoparsec , scientific , vector , aeson >= 0.6 , parsec , template-haskell , haskell-src-meta >= 0.1.0 test-suite spec type: exitcode-stdio-1.0 ghc-options: -Wall hs-source-dirs: src test main-is: Spec.hs other-modules: Data.Aeson.QQ Data.JSON.QQ Data.Aeson.QQSpec Data.JSON.QQSpec Person default-language: Haskell2010 build-depends: base >= 4.5 && < 5 , base-compat , text , attoparsec , scientific , vector , aeson >= 0.6 , parsec , template-haskell , haskell-src-meta >= 0.1.0 , hspec , ghc-prim aeson-qq-0.8.2/test/0000755000000000000000000000000013120002374012402 5ustar0000000000000000aeson-qq-0.8.2/test/Spec.hs0000644000000000000000000000005413120002374013627 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} aeson-qq-0.8.2/test/Person.hs0000644000000000000000000000035613120002374014210 0ustar0000000000000000{-# 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 aeson-qq-0.8.2/test/Data/0000755000000000000000000000000013120002374013253 5ustar0000000000000000aeson-qq-0.8.2/test/Data/Aeson/0000755000000000000000000000000013120002374014320 5ustar0000000000000000aeson-qq-0.8.2/test/Data/Aeson/QQSpec.hs0000644000000000000000000000405113120002374016010 0ustar0000000000000000{-# 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")] aeson-qq-0.8.2/test/Data/JSON/0000755000000000000000000000000013120002374014024 5ustar0000000000000000aeson-qq-0.8.2/test/Data/JSON/QQSpec.hs0000644000000000000000000000325013120002374015514 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Data.JSON.QQSpec (main, spec) where import Test.Hspec import Data.JSON.QQ main :: IO () main = hspec spec spec :: Spec spec = do describe "parsedJson" $ do it "parses JSON" $ do let Right value = parsedJson "{foo: 23}" value `shouldBe` JsonObject [(HashStringKey "foo", JsonNumber 23)] it "parses decimal numbers" $ do let Right value = parsedJson "{foo: 5.97}" value `shouldBe` JsonObject [(HashStringKey "foo", JsonNumber 5.97)] context "empty objects" $ do it "parses empty objects (regression test)" $ do let Right value = parsedJson "{}" value `shouldBe` JsonObject [] it "parses empty objects that include whitespace (regression test)" $ do let Right value = parsedJson "{ }" value `shouldBe` JsonObject [] it "parses empty objects that include newlines (regression test)" $ do let Right value = parsedJson "{\n}" value `shouldBe` JsonObject [] context "empty arrays" $ do it "parses empty arrays" $ do let Right value = parsedJson "[ ]" value `shouldBe` JsonArray [] it "parses empty arrays that include whitespace (regression test)" $ do let Right value = parsedJson "[ ]" value `shouldBe` JsonArray [] it "parses empty objects that include newlines (regression test)" $ do let Right value = parsedJson "[\n]" value `shouldBe` JsonArray [] it "fails on excess input" $ do let Left err = parsedJson "{foo: 23} some excess input" show err `shouldBe` "\"txt\" (line 1, column 11):\nunexpected 's'\nexpecting space or end of input" aeson-qq-0.8.2/src/0000755000000000000000000000000013120002374012212 5ustar0000000000000000aeson-qq-0.8.2/src/Data/0000755000000000000000000000000013120002374013063 5ustar0000000000000000aeson-qq-0.8.2/src/Data/Aeson/0000755000000000000000000000000013120002374014130 5ustar0000000000000000aeson-qq-0.8.2/src/Data/Aeson/QQ.hs0000644000000000000000000000302713120002374015007 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- | Have a look at the for -- documentation. module Data.Aeson.QQ (aesonQQ) where import Prelude () import Prelude.Compat import Language.Haskell.TH import Language.Haskell.TH.Quote import qualified Data.Vector as V import qualified Data.Text as T import Data.Aeson import Data.JSON.QQ as QQ aesonQQ :: QuasiQuoter aesonQQ = QuasiQuoter { quoteExp = jsonExp, quotePat = const $ error "No quotePat defined for jsonQQ", quoteType = const $ error "No quoteType defined for jsonQQ", quoteDec = const $ error "No quoteDec defined for jsonQQ" } jsonExp :: String -> ExpQ jsonExp txt = case parsed' of Left err -> error $ "Error in aesonExp: " ++ show err Right val -> toExp val where parsed' = QQ.parsedJson txt ---- -- JSValue etc to ExpQ --------- toExp :: QQ.JsonValue -> ExpQ toExp (JsonString str) = [|String (T.pack str)|] toExp (JsonNull) = [|Null|] toExp (JsonObject objs) = [|object $jsList|] where jsList :: ExpQ jsList = ListE <$> mapM objs2list (objs) objs2list :: (HashKey, JsonValue) -> ExpQ objs2list (key, value) = do case key of HashStringKey k -> [|(T.pack k, $(toExp value))|] HashVarKey k -> [|(T.pack $(dyn k), $(toExp value))|] toExp (JsonArray arr) = [|Array $ V.fromList $(ListE <$> mapM toExp arr)|] toExp (JsonNumber n) = [|Number (fromRational $(return $ LitE $ RationalL (toRational n)))|] toExp (JsonBool b) = [|Bool b|] toExp (JsonCode e) = [|toJSON $(return e)|] aeson-qq-0.8.2/src/Data/JSON/0000755000000000000000000000000013120002374013634 5ustar0000000000000000aeson-qq-0.8.2/src/Data/JSON/QQ.hs0000644000000000000000000000726613120002374014524 0ustar0000000000000000module Data.JSON.QQ (JsonValue (..), HashKey (..), parsedJson) where import Control.Applicative import Language.Haskell.TH import Text.ParserCombinators.Parsec hiding (many, (<|>)) import Language.Haskell.Meta.Parse import qualified Data.Attoparsec.Text as A import Data.Scientific (Scientific) import qualified Data.Text as T parsedJson :: String -> Either ParseError JsonValue parsedJson = parse (jpValue <* eof) "txt" ------- -- Internal representation data JsonValue = JsonNull | JsonString String | JsonNumber Scientific | JsonObject [(HashKey,JsonValue)] | JsonArray [JsonValue] | JsonBool Bool | JsonCode Exp deriving (Eq, Show) data HashKey = HashVarKey String | HashStringKey String deriving (Eq, Show) type JsonParser = Parser JsonValue jpValue :: JsonParser jpValue = do spaces res <- jpBool <|> jpNull <|> jpString <|> jpObject <|> jpNumber <|> jpArray <|> jpCode spaces return res jpBool :: JsonParser jpBool = JsonBool <$> (string "true" *> pure True <|> string "false" *> pure False) jpCode :: JsonParser jpCode = JsonCode <$> (string "#{" *> parseExp') where parseExp' = do str <- many1 (noneOf "}") <* char '}' case (parseExp str) of Left l -> fail l Right r -> return r jpNull :: JsonParser jpNull = string "null" *> pure JsonNull jpString :: JsonParser jpString = between (char '"') (char '"') (option [""] $ many chars) >>= return . JsonString . concat -- do jpNumber :: JsonParser jpNumber = JsonNumber <$> do isMinus <- option "" (string "-") d <- many1 digit o <- option "" withDot e <- option "" withE convert (isMinus ++ d ++ o ++ e) where 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 convert :: Monad m => String -> m Scientific convert = either fail return . A.parseOnly (A.scientific <* A.endOfInput) . T.pack jpObject :: JsonParser jpObject = do list <- between (char '{') (char '}') (spaces *> 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 = HashStringKey <$> symbol quotedStringKey :: CharParser () HashKey quotedStringKey = HashStringKey <$> quotedString varKey :: CharParser () HashKey varKey = HashVarKey <$> (char '$' *> symbol) jpArray :: CharParser () JsonValue jpArray = JsonArray <$> between (char '[') (char ']') (spaces *> commaSep jpValue) ------- -- helpers for parser/grammar quotedString :: CharParser () String quotedString = concat <$> between (char '"') (char '"') (option [""] $ many chars) symbol :: CharParser () String symbol = many1 (noneOf "\\ \":;><${}") commaSep :: CharParser () a -> CharParser () [a] commaSep p = p `sepBy` (char ',') chars :: CharParser () String chars = do try (string "\\\"" *> pure "\"") <|> try (string "\\\\" *> pure "\\") <|> try (string "\\/" *> pure "/") <|> try (string "\\b" *> pure "\b") <|> try (string "\\f" *> pure "\f") <|> try (string "\\n" *> pure "\n") <|> try (string "\\r" *> pure "\r") <|> try (string "\\t" *> pure "\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]