json-qq (empty) → 0.4.0

raw patch · 4 files changed

+256/−0 lines, 4 filesdep +basedep +haskell-src-metadep +parsecsetup-changed

Dependencies added: base, haskell-src-meta, parsec, template-haskell

Files

COPYING.txt +14/−0
Setup.hs +2/−0
json-qq.cabal +32/−0
src/Data/JSON/QQ.hs +208/−0

+ COPYING.txt view

@@ -0,0 +1,14 @@+            DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+                    Version 2, December 2004++ Copyright (C) 2011 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

+ json-qq.cabal view

@@ -0,0 +1,32 @@+name:                json-qq+version:             0.4.0+synopsis:            Json Quasiquatation library for Haskell.++-- A longer description of the package.+description:  +    JSON quasiquatation library for Haskell.+    .+    This package only expose functionality so quasiquoters for different JSON-libraries can+    more easily be constructed.+    .+    See @text-json-qq@ and @aeson-qq@ for libraries that are based on json-qq.++homepage:            http://github.com/finnsson/json-qq+license:             OtherLicense+license-file:        COPYING.txt+author:              Oscar Finnsson+maintainer:          oscar.finnsson@gmail.com+category:            JSON+build-type:          Simple+cabal-version:       >=1.6++library+  hs-source-dirs: src+  exposed-modules: Data.JSON.QQ+  build-depends: base >= 4.3 && < 5, parsec >= 2 && < 3, template-haskell, haskell-src-meta >= 0.1.0++source-repository head+  type:     git+  location: https://github.com/finnsson/json-qq/++

+ src/Data/JSON/QQ.hs view

@@ -0,0 +1,208 @@+{-# OPTIONS_GHC -XTemplateHaskell -XQuasiQuotes -XUndecidableInstances #-}++-- | This package expose the parser @sonParser@.+--+-- 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++import Language.Haskell.TH+import Language.Haskell.TH.Quote++import Data.Data+import Data.Maybe++import Data.Ratio+import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Error++import Language.Haskell.Meta.Parse++parsedJson :: String -> Either ParseError JsonValue+parsedJson txt = parse jpValue "txt" txt++-------+-- Internal representation++data JsonValue =+  JsonNull+  | JsonString String+  | JsonNumber Bool Rational+  | JsonObject [(HashKey,JsonValue)]+  | JsonArray [JsonValue]+  | JsonIdVar String+  | JsonBool Bool+  | JsonCode Exp++data HashKey =+  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+  spaces+  res <- jpTrue <|> jpFalse <|> try jpIdVar <|> 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++jpCode :: JsonParser+jpCode = do+  string "<|"+  parseExp' >>>= JsonCode+  where+    parseExp' = do+      str <- untilString+      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++jpString :: JsonParser +jpString = between (char '"') (char '"') (option [""] $ many chars) >>= return . JsonString . concat -- do++jpNumber :: JsonParser +jpNumber = do+  val <- float+  return $ JsonNumber False (toRational val)++jpObject :: JsonParser+jpObject = do+  list <- between (char '{') (char '}') (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 = symbol >>>= HashStringKey++quotedStringKey :: CharParser () HashKey+quotedStringKey = quotedString >>>= HashStringKey++varKey :: CharParser () HashKey+varKey = do+  char '$'+  sym <- symbol+  return $ HashVarKey sym++jpArray :: CharParser () JsonValue+jpArray = between (char '[') (char ']') (commaSep jpValue) >>>= JsonArray++-------+-- 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 '-')+  d <- many1 digit+  o <- option "" withDot+  e <- option "" withE+  return $ (read $ isMinus : 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++quotedString :: CharParser () String+quotedString = between (char '"') (char '"') (option [""] $ many chars) >>>= concat++symbol :: CharParser () String+symbol = many1 (noneOf "\\ \":;><$")++commaSep p  = p `sepBy` (char ',')++chars :: CharParser () 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 () String+unicodeChars = do+  u <- string "\\u"+  d1 <- hexDigit+  d2 <- hexDigit+  d3 <- hexDigit+  d4 <- hexDigit+  return $ u ++ [d1] ++ [d2] ++ [d3] ++ [d4]