diff --git a/COPYING.txt b/COPYING.txt deleted file mode 100644 --- a/COPYING.txt +++ /dev/null @@ -1,14 +0,0 @@ - DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE - Version 2, December 2004 - - Copyright (C) 2010 Oscar Finnsson - - Everyone is permitted to copy and distribute verbatim or modified - copies of this license document, and changing it is allowed as long - as the name is changed. - - DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. You just DO WHAT THE FUCK YOU WANT TO. - diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (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. diff --git a/aeson-qq.cabal b/aeson-qq.cabal --- a/aeson-qq.cabal +++ b/aeson-qq.cabal @@ -1,34 +1,53 @@ -name: aeson-qq -version: 0.4.1 -synopsis: Json Quasiquatation for Haskell. - --- A longer description of the package. -description: - @aeson-qq@ provides json quasiquatation for Haskell. - . - This package expose the function @aesonQQ@ that compile time converts json code into a @Data.Aeson.Value@. - @aesonQQ@ got the signature - . - > aesonQQ :: QuasiQuoter. - . - Consult documentation in the module @Data.Aeson.QQ@. - -homepage: http://github.com/finnsson/aeson-qq -license: OtherLicense -license-file: COPYING.txt -author: Oscar Finnsson -maintainer: oscar.finnsson@gmail.com -category: JSON -build-type: Simple -cabal-version: >=1.6 +name: aeson-qq +version: 0.6.0 +synopsis: Json Quasiquatation for Haskell. +description: @aeson-qq@ provides json quasiquatation for Haskell. + . + This package expose the function @aesonQQ@ that compile time converts json code into a @Data.Aeson.Value@. + @aesonQQ@ got the signature + . + > aesonQQ :: QuasiQuoter. + . + Consult documentation in the module @Data.Aeson.QQ@. -library - hs-source-dirs: src - exposed-modules: Data.Aeson.QQ - build-depends: base >= 4.3 && < 5, aeson, parsec >= 2, json-qq == 0.4.1, template-haskell, haskell-src-meta >= 0.1.0 +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/finnsson/aeson-qq/ + type: git + location: https://github.com/zalora/aeson-qq/ +library + hs-source-dirs: + src + exposed-modules: + Data.Aeson.QQ + build-depends: + base >= 4.6 && < 5 + , text + , vector + , aeson >= 0.7 + , json-qq == 0.4.1 + , template-haskell + , haskell-src-meta >= 0.1.0 +test-suite spec + type: + exitcode-stdio-1.0 + ghc-options: + -Wall -Werror + hs-source-dirs: + test + main-is: + Spec.hs + build-depends: + base >= 4.6 && < 5 + , aeson-qq + , aeson + , hspec 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,115 +1,89 @@ -{-# OPTIONS_GHC -XTemplateHaskell -XQuasiQuotes -XUndecidableInstances #-} - --- | This package expose the function @aesonQQ@ that compile time converts json code into a @Data.Aeson.Value@. --- @aesonQQ@ got the signature --- --- > aesonQQ :: QuasiQuoter --- --- and is used like --- --- > myCode = [aesonQQ| {age: 23, name: "Pelle", likes: ["mac","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 = 34 :: Integer --- > name = "Pelle" --- --- where the function @toJSON@ will be called on @age@ and @name@ runtime. +{-# LANGUAGE TemplateHaskell #-} +-- | +-- This package expose the function `aesonQQ` that compile time converts json +-- code into a `Value`. @aesonQQ@ got the signature -- --- You can also insert Haskell code: +-- > aesonQQ :: QuasiQuoter -- --- > myCode = [aesonQQ| {age: <|age + 34 :: Integer|>, name: <|map toUpper name|>} |] --- > where age = 34 :: Integer --- > name = "Pelle" --- --- You can use a similar syntax if you want to insert a value of type Data.Aeson.Value like --- --- > myCode = [aesonQQ| {"age": <>} |] --- --- If you want to replace the name of the key in a hash you'll use the $-syntax: --- --- > foo = [aesonQQ| {$bar: 42} |] --- > bar = "age" --- - -module Data.Aeson.QQ ( - aesonQQ -) where +-- 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" +module Data.Aeson.QQ (aesonQQ) where import Language.Haskell.TH import Language.Haskell.TH.Quote -import Data.Data -import Data.Maybe +import Control.Applicative +import qualified Data.Vector as V +import qualified Data.Text as T +import Data.Aeson import Data.JSON.QQ as QQ -import Data.Aeson as A -import Data.Aeson.Generic - -import Data.Ratio -import Text.ParserCombinators.Parsec -import Text.ParserCombinators.Parsec.Error - -import Language.Haskell.Meta.Parse - aesonQQ :: QuasiQuoter -aesonQQ = QuasiQuoter { - quoteExp = jsonExp, - quotePat = \s -> error "No quotePat defined for jsonQQ", - quoteType = \s -> error "No quoteType defined for jsonQQ", - quoteDec = \s -> error "No quoteDec defined for jsonQQ" +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 + case parsed' of Left err -> error $ "Error in aesonExp: " ++ show err - Right val -> return $ toExp val + Right val -> toExp val where parsed' = QQ.parsedJson txt ---- -- JSValue etc to ExpQ --------- -toExp :: QQ.JsonValue -> Exp - -toExp (JsonString str) = - AppE (ConE $ mkName "Data.Aeson.Types.String") (packE (LitE (StringL $ str))) - -toExp (JsonNull) = ConE $ mkName "Data.Aeson.Types.Null" - -toExp (JsonObject objs) = - (AppE (VarE $ mkName "Data.Aeson.Types.object") (ListE $ jsList )) +toExp :: QQ.JsonValue -> ExpQ +toExp (JsonString str) = [|String (T.pack str)|] +toExp (JsonNull) = [|Null|] +toExp (JsonObject objs) = [|object $jsList|] where - jsList :: [Exp] -- [(String,JSValue)] - jsList = map objs2list (objs) - objs2list :: (HashKey,JsonValue) -> Exp - objs2list (HashStringKey k,v) = TupE [packE (LitE (StringL k)), toExp v] - objs2list (HashVarKey k,v) = TupE [packE (VarE $ mkName k), toExp v] - -toExp (JsonArray arr) = - AppE (ConE $ mkName "Data.Aeson.Types.Array") (AppE (VarE $ mkName "Data.Vector.fromList") (ListE $ map toExp arr)) - -toExp (JsonNumber b rat) = - AppE (ConE $ mkName "Data.Aeson.Types.Number") (AppE (ConE $ mkName "Data.Attoparsec.Number.D") (LitE (RationalL rat))) -toExp (JsonIdVar v) = - VarE $ mkName v - -toExp (JsonBool b) = - AppE (ConE $ mkName "Data.Aeson.Types.Bool") (ConE $ mkName (if b then "True" else "False")) + jsList :: ExpQ + jsList = ListE <$> mapM objs2list (objs) -toExp (JsonCode exp) = - AppE (VarE $ mkName "Data.Aeson.Generic.toJSON") exp + 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 _ rat) = [|Number (fromRational $(return $ LitE $ RationalL rat))|] +toExp (JsonIdVar v) = dyn v +toExp (JsonBool b) = [|Bool b|] +toExp (JsonCode e) = [|toJSON $(return e)|] -- Helpers -packE = AppE (VarE $ mkName "Data.Text.pack") - +packE :: Exp -> ExpQ +packE e = [|T.pack $(return e)|] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}