aeson-qq-0.8.1/0000755000000000000000000000000012562614257011444 5ustar0000000000000000aeson-qq-0.8.1/LICENSE0000644000000000000000000000212512562614257012451 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.1/aeson-qq.cabal0000644000000000000000000000331612562614257014157 0ustar0000000000000000name: aeson-qq version: 0.8.1 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: http://github.com/zalora/aeson-qq license: MIT license-file: LICENSE author: Oscar Finnsson maintainer: Simon Hengel category: JSON build-type: Simple cabal-version: >= 1.8 source-repository head type: git location: https://github.com/zalora/aeson-qq/ library ghc-options: -Wall hs-source-dirs: src exposed-modules: Data.Aeson.QQ other-modules: Data.JSON.QQ 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: Person Data.Aeson.QQSpec build-depends: base >= 4.5 && < 5 , base-compat , text , attoparsec , scientific , vector , aeson , parsec , template-haskell , haskell-src-meta , aeson , hspec -- Neded for GHC 7.4.* , ghc-prim aeson-qq-0.8.1/Setup.hs0000644000000000000000000000005612562614257013101 0ustar0000000000000000import Distribution.Simple main = defaultMain aeson-qq-0.8.1/test/0000755000000000000000000000000012562614257012423 5ustar0000000000000000aeson-qq-0.8.1/test/Person.hs0000644000000000000000000000035612562614257014231 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.1/test/Spec.hs0000644000000000000000000000005412562614257013650 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} aeson-qq-0.8.1/test/Data/0000755000000000000000000000000012562614257013274 5ustar0000000000000000aeson-qq-0.8.1/test/Data/Aeson/0000755000000000000000000000000012562614257014341 5ustar0000000000000000aeson-qq-0.8.1/test/Data/Aeson/QQSpec.hs0000644000000000000000000000405112562614257016031 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.1/src/0000755000000000000000000000000012562614257012233 5ustar0000000000000000aeson-qq-0.8.1/src/Data/0000755000000000000000000000000012562614257013104 5ustar0000000000000000aeson-qq-0.8.1/src/Data/Aeson/0000755000000000000000000000000012562614257014151 5ustar0000000000000000aeson-qq-0.8.1/src/Data/Aeson/QQ.hs0000644000000000000000000000303212562614257015024 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.1/src/Data/JSON/0000755000000000000000000000000012562614257013655 5ustar0000000000000000aeson-qq-0.8.1/src/Data/JSON/QQ.hs0000644000000000000000000000726612562614257014545 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]