diff --git a/aeson-qq.cabal b/aeson-qq.cabal --- a/aeson-qq.cabal +++ b/aeson-qq.cabal @@ -1,14 +1,16 @@ name: aeson-qq -version: 0.6.1 -synopsis: Json Quasiquatation for Haskell. -description: @aeson-qq@ provides json quasiquatation for Haskell. +version: 0.7.0 +synopsis: JSON quasiquoter for Haskell +description: @aeson-qq@ provides a JSON quasiquoter for Haskell. . - This package expose the function @aesonQQ@ that compile time converts json code into a @Data.Aeson.Value@. - @aesonQQ@ got the signature + 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. + >aesonQQ :: QuasiQuoter . - Consult documentation in the module @Data.Aeson.QQ@. + Consult the @README@ for documentation: + homepage: http://github.com/zalora/aeson-qq license: MIT @@ -24,6 +26,8 @@ location: https://github.com/zalora/aeson-qq/ library + ghc-options: + -Wall hs-source-dirs: src exposed-modules: @@ -43,7 +47,7 @@ type: exitcode-stdio-1.0 ghc-options: - -Wall -Werror + -Wall hs-source-dirs: test main-is: diff --git a/src/Data/Aeson/QQ.hs b/src/Data/Aeson/QQ.hs --- a/src/Data/Aeson/QQ.hs +++ b/src/Data/Aeson/QQ.hs @@ -1,38 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} --- | --- This package expose the function `aesonQQ` that compile time converts json --- code into a `Value`. @aesonQQ@ got the signature --- --- > aesonQQ :: QuasiQuoter --- --- and is used like --- --- > myCode = [aesonQQ| {age: 23, name: "John", likes: ["linux", "Haskell"]} |] --- --- where it is important that --- --- * you got no space in @[aesonQQ|@ and --- --- * no additional code after @|]@. --- --- The quasiquatation can also bind to variables like --- --- > myCode = [aesonQQ| {age: <|age|>, name: <|name|>} |] --- > where age = 23 :: Integer --- > name = "John" --- --- where the function `toJSON` will be called on @age@ and @name@ at runtime. --- --- You can also insert Haskell code: --- --- > myCode = [aesonQQ| {age: <|succ age|>, name: <|map toUpper name|>} |] --- > where age = 23 :: Integer --- > name = "John" --- --- If you want to replace the name of the key in a hash you'll use the $-syntax: --- --- > foo = [aesonQQ| {$bar: 42} |] --- > bar = "age" +-- | Have a loot at the for +-- documentation. module Data.Aeson.QQ (aesonQQ) where import Language.Haskell.TH @@ -80,7 +48,6 @@ HashVarKey k -> [|(T.pack $(dyn k), $(toExp value))|] toExp (JsonArray arr) = [|Array $ V.fromList $(ListE <$> mapM toExp arr)|] toExp (JsonNumber _ rat) = [|Number (fromRational $(return $ LitE $ RationalL rat))|] -toExp (JsonIdVar v) = dyn v toExp (JsonBool b) = [|Bool b|] toExp (JsonCode e) = [|toJSON $(return e)|] diff --git a/src/Data/JSON/QQ.hs b/src/Data/JSON/QQ.hs --- a/src/Data/JSON/QQ.hs +++ b/src/Data/JSON/QQ.hs @@ -1,17 +1,6 @@ -{-# 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 -module Data.JSON.QQ ( - JsonValue (..), - HashKey (..), - parsedJson -) where +import Control.Applicative import Language.Haskell.TH import Language.Haskell.TH.Quote @@ -20,7 +9,7 @@ import Data.Maybe import Data.Ratio -import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec hiding (many, (<|>)) import Text.ParserCombinators.Parsec.Error import Language.Haskell.Meta.Parse @@ -37,7 +26,6 @@ | JsonNumber Bool Rational | JsonObject [(HashKey,JsonValue)] | JsonArray [JsonValue] - | JsonIdVar String | JsonBool Bool | JsonCode Exp @@ -45,63 +33,29 @@ 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 +jpValue :: JsonParser +jpValue = do spaces - res <- jpTrue <|> jpFalse <|> try jpIdVar <|> jpNull <|> jpString <|> jpObject <|> jpNumber <|> jpArray <|> jpCode + res <- jpBool <|> 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 +jpBool :: JsonParser +jpBool = JsonBool <$> (string "true" *> pure True <|> string "false" *> pure False) jpCode :: JsonParser -jpCode = do - string "<|" - parseExp' >>>= JsonCode +jpCode = JsonCode <$> (string "#{" *> parseExp') where parseExp' = do - str <- untilString + str <- many1 (noneOf "}") <* char '}' 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 +jpNull = string "null" *> pure JsonNull jpString :: JsonParser jpString = between (char '"') (char '"') (option [""] $ many chars) >>= return . JsonString . concat -- do @@ -128,10 +82,10 @@ return (name,value) symbolKey :: CharParser () HashKey -symbolKey = symbol >>>= HashStringKey +symbolKey = HashStringKey <$> symbol quotedStringKey :: CharParser () HashKey -quotedStringKey = quotedString >>>= HashStringKey +quotedStringKey = HashStringKey <$> quotedString varKey :: CharParser () HashKey varKey = do @@ -140,24 +94,11 @@ return $ HashVarKey sym jpArray :: CharParser () JsonValue -jpArray = between (char '[') (char ']') (commaSep jpValue) >>>= JsonArray +jpArray = JsonArray <$> between (char '[') (char ']') (commaSep jpValue) ------- -- 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 '-') @@ -178,7 +119,7 @@ return $ o:d quotedString :: CharParser () String -quotedString = between (char '"') (char '"') (option [""] $ many chars) >>>= concat +quotedString = concat <$> between (char '"') (char '"') (option [""] $ many chars) symbol :: CharParser () String symbol = many1 (noneOf "\\ \":;><$") diff --git a/test/Data/Aeson/QQSpec.hs b/test/Data/Aeson/QQSpec.hs --- a/test/Data/Aeson/QQSpec.hs +++ b/test/Data/Aeson/QQSpec.hs @@ -37,7 +37,7 @@ it "can interpolate JSON values" $ do let x = object [("foo", Number 23)] - [aesonQQ|[null, <|x|>]|] `shouldBe` toJSON [Null, x] + [aesonQQ|[null, #{x}]|] `shouldBe` toJSON [Null, x] it "can interpolate field names" $ do let foo = "zoo" @@ -45,21 +45,21 @@ it "can interpolate numbers" $ do let x = 23 :: Int - [aesonQQ|[null, {foo: <|x|>}]|] `shouldBe` toJSON [Null, object [("foo", Number 23)]] + [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")] + [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)] + [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)] + [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")] + [aesonQQ|{name: #{map toUpper name}}|] `shouldBe` object [("name", "JOE")]