packages feed

text-json-qq (empty) → 0.1

raw patch · 4 files changed

+338/−0 lines, 4 filesdep +basedep +jsondep +parsecsetup-changed

Dependencies added: base, json, parsec, template-haskell

Files

+ COPYING.txt view
@@ -0,0 +1,14 @@+            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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Text/JSON/QQ.hs view
@@ -0,0 +1,248 @@+{-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell -XQuasiQuotes #-}++-- | This package expose the function @jsonQQ@ that compile time converts json code into a @Text.JSON.JSValue@.+--    @jsonQQ@ got the signature+--    +--    > jsonQQ :: QuasiQuoter+--    +--    and is used like+--    +--    > myCode = [$jsonQQ| {age: 23, name: "Pelle", likes: ["mac","Haskell"] } |]+--    +--    where it is important that+--    +--    * you got no space in @[$jsonQQ|@ and+--    +--    * no additional code after @|]@.+--    +--    The quasiquatation can also bind to variables like+--    +--    > myCode = [$jsonQQ | {age: <<age>>, name: <<name>>} |]+--    > where age = 34 :: Integer+--    >       name = "Pelle"+--    +--    where a function  @toJsonOrId@ (that is also exported by @Text.JSON.QQ@) will be called on @age@ and @name@ runtime.++module Text.JSON.QQ (+  jsonQQ,+  ToJsonOrId (..)+) where++import Language.Haskell.TH+import Language.Haskell.TH.Quote+-- import Language.Haskell.Meta.Parse++import Data.Data+import Data.Maybe++import Text.JSON+import Text.JSON.Generic++import Data.Ratio+-- import Parsec+import Text.ParserCombinators.Parsec+-- import qualified Data.ByteString.Lazy as L+-- import Codec.Binary.UTF8.String (decode)+import Text.ParserCombinators.Parsec.Error++jsonQQ :: QuasiQuoter+jsonQQ = QuasiQuoter jsonExp jsonPat+++jsonExp :: String -> ExpQ+jsonExp txt =+  case parsed' of +    Left err -> error $ "Error in jsonExp: " ++ show err+    Right val -> return $ toExp val -- test -- dataToExpQ undefined test -- [| test |] -- [| toJSObject [("a","b")] |] --+  where+    parsed' = parse jpValue "txt" txt+    -- test = JSObject $ toJSObject [("a",JSNull)]++jsonPat :: String -> PatQ+jsonPat s = undefined+++----+-- JSValue etc to ExpQ+---------++class ToExp a where+  toExp :: a -> Exp++instance ToExp JsonValue where+  toExp (JsonString str) = +    AppE (ConE $ mkName "Text.JSON.Types.JSString") (AppE (VarE $ mkName "Text.JSON.Types.toJSString") (LitE (StringL $ str)))++  toExp (JsonNull) = ConE $ mkName "Text.JSON.Types.JSNull"++  toExp (JsonObject objs) = +    AppE (ConE $ mkName "Text.JSON.Types.JSObject") (AppE (VarE $ mkName "Text.JSON.Types.toJSObject") (ListE $ jsList ))+    where+      jsList :: [Exp] -- [(String,JSValue)]+      jsList = map objs2list (objs)+      objs2list :: (String,JsonValue) -> Exp+      objs2list (k,v) = TupE [LitE (StringL k), toExp v]++  toExp (JsonArray arr) =+    AppE (ConE $ mkName "Text.JSON.Types.JSArray") (ListE $ map toExp arr)++  toExp (JsonNumber b rat) =+    AppE (AppE (ConE $ mkName "Text.JSON.Types.JSRational") (ConE $ mkName (if b then "True" else "False"))) (InfixE (Just (LitE (IntegerL $ numerator rat))) (VarE $ mkName "Data.Ratio.%") (Just (LitE (IntegerL $ denominator rat))))+    +  toExp (JsonVar v) =+    AppE (VarE $ mkName "Text.JSON.QQ.toJsonOrId") (VarE $ mkName v)++  toExp (JsonBool b) =+    AppE (ConE $ mkName "Text.JSON.Types.JSBool") (ConE $ mkName (if b then "True" else "False"))++class ToJsonOrId a where+  toJsonOrId :: a -> JSValue++instance ToJsonOrId JSValue where+  toJsonOrId = id++instance ToJsonOrId String where+  toJsonOrId txt = Text.JSON.JSString $ Text.JSON.toJSString txt++instance ToJsonOrId Integer where+  toJsonOrId int = Text.JSON.JSRational True (int % 1)++-------+-- Internal representation++data JsonValue =+  JsonNull+  | JsonString String+  | JsonNumber Bool Rational+  | JsonObject [(String,JsonValue)]+  | JsonArray [JsonValue]+  | JsonVar String+  | JsonBool Bool++------+-- Grammar+-- jp = json parsec+-----++data QQJsCode =+  QQjs JSValue+  | QQcode String++jpValue :: CharParser st JsonValue+jpValue = do+  spaces+  res <- jpTrue <|> jpFalse <|> try jpVar <|> jpNull <|> jpString <|> jpObject <|> try jpNumber  <|> jpArray+  spaces+  return res++jpTrue :: CharParser st JsonValue+jpTrue = do+  string "true"+  return $ JsonBool True++jpFalse :: CharParser st JsonValue+jpFalse = do+  string "false"+  return $ JsonBool False++jpVar :: CharParser st JsonValue+jpVar = do+  string "<<"+  sym <- symbol+  string ">>"+  return $ JsonVar sym++jpNull :: CharParser st JsonValue+jpNull = do+  string "null"+  return $ JsonNull++jpString :: CharParser st JsonValue +jpString = do+  char '"'+  sym <- try $ option [""] $ many chars+  char '"'+  return $ JsonString $ concat sym ++jpNumber :: CharParser st JsonValue +jpNumber = do+  isMinus <- optionMaybe (char '-')+  val <- float+  return $ JsonNumber (not $ isJust isMinus) (toRational val)++jpObject :: CharParser st JsonValue+jpObject = do+  char '{'+  spaces+  list <- commaSep jpHash+  spaces+  char '}'+  return $ JsonObject $ list+  where+    jpHash :: CharParser st (String,JsonValue)+    jpHash = do+      spaces+      name <- symbol+      spaces+      char ':'+      spaces+      value <- jpValue+      spaces+      return (name,value)++jpArray :: CharParser st JsonValue+jpArray = do+  char '['+  spaces+  list <- commaSep jpValue+  spaces+  char ']'+  return $ JsonArray list++-------+-- helpers for parser/grammar++float :: CharParser st Double +float = do+  d <- many1 digit+  o <- option "" withDot+  e <- option "" withE+  return $ (read $ 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++symbol :: CharParser st String+symbol = many1 (noneOf "\\ \":;><") -- alphaNum -- should be replaced!++commaSep p  = p `sepBy` (char ',')++chars :: CharParser st 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 st String+unicodeChars = do+  u <- string "\\u"+  d1 <- hexDigit+  d2 <- hexDigit+  d3 <- hexDigit+  d4 <- hexDigit+  return $ u ++ [d1] ++ [d2] ++ [d3] ++ [d4]
+ text-json-qq.cabal view
@@ -0,0 +1,74 @@+-- text-json-qq.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                text-json-qq++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.1++-- A short (one-line) description of the package.+Synopsis:            Json Quasiquatation for Haskell.++-- A longer description of the package.+Description:  +    @text-json-qq@ provides json quasiquatation for Haskell.+    .+    This package expose the function @jsonQQ@ that compile time converts json code into a @Text.JSON.JSValue@.+    @jsonQQ@ got the signature+    .+    > jsonQQ :: QuasiQuoter.+    .+    Consult documentation in the module @Text.JSON.QQ@.++++-- URL for the project homepage or repository.+Homepage:            http://github.com/finnsson/text-json-qq++-- The license under which the package is released.+License:             OtherLicense++-- The file containing the license text.+License-file:        COPYING.txt++-- The package author(s).+Author:              Oscar Finnsson++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          oscar.finnsson@gmail.com++-- A copyright notice.+-- Copyright:           ++Category:            Text++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.2++build-depends: base >= 4.2 && < 5, json, parsec >= 2 && < 3, template-haskell++hs-source-dirs: src++-- Library+  -- Modules exported by the library.+exposed-modules: Text.JSON.QQ+  +  -- Packages needed in order to build this package.+  -- build-depends:       base >= 4 < 5, json+  +  -- Modules not exported by this package.+  -- Other-modules:       +  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +