packages feed

aeson-value-qq (empty) → 1.0.0

raw patch · 10 files changed

+602/−0 lines, 10 filesdep +aesondep +aeson-value-qqdep +attoparsec

Dependencies added: aeson, aeson-value-qq, attoparsec, attoparsec-aeson, base, bytestring, ghc-hs-meta, hspec, scientific, template-haskell, text, unordered-containers, vector

Files

+ CHANGELOG.markdown view
@@ -0,0 +1,5 @@+1.0.0+=====++  * Initial release.+
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright Matvey Aksenov (c) 2026++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE..+
+ README.markdown view
@@ -0,0 +1,61 @@+aeson-value-qq provides a `QuasiQuoter` that creates aeson `Value`s using JSON-like syntax.  +It's a sister package of [aeson-match-qq][0]++[aeson-qq][1] is a very similar package. The main differences (as far as I can say) are:++  - we use aeson-attoparsec's parsers (specifically, `jstring` and `scientific`) where possible++  - we don't support variable object keys (that is, the `{$key: 42}` notation); I'm not exactly opposed to that feature but I don't really like how it looks and never had the need for it. It would also require adding `FromJSONKey` support and I would then have to support it in aeson-match-qq as well; in the end it's just too much work, man.++  - we use [ghc-hs-meta][2] instead of [haskell-src-meta][3] to parse Haskell expressions++## Syntax++Copy-pasting JSON should always work (assuming infinite RAM).  +Besides that, there are syntax extensions such as:++### Bare keys++It's often possible to omit quotes around keys that include neither whitespace  +nor characters used as part of JSON syntax:++```+[qq|+  { foo: 4+  , snake-case: "hello"+  }+|]+```++The bare-keys support is best-effort, so if your keys are *weird*, err on the side of quoting them.++### Comments++If for some reason you'd like to document what you're doing, you can add comments:++```+[qq|+  # .foo works better when it's 7 not 4+  { foo: 7+  }+|]+```++### Interpolation++We use ghc-hs-meta to parse Haskell inside `#{...}` syntax.++```+[qq|+  { foo: #{4 + 7}+  }+|]+```++Note that `#{...}` uses the Haskell language extensions enabled in the current module.+++[0]: https://github.com/supki/aeson-match-qq+[1]: https://hackage.haskell.org/package/aeson-qq+[2]: https://hackage.haskell.org/package/ghc-hs-meta+[3]: https://hackage.haskell.org/package/haskell-src-meta
+ aeson-value-qq.cabal view
@@ -0,0 +1,76 @@+cabal-version: 1.18++-- This file has been generated from package.yaml by hpack version 0.38.1.+--+-- see: https://github.com/sol/hpack++name:           aeson-value-qq+version:        1.0.0+synopsis:       QuasiQuoter for Aeson.Value+description:    See README.markdown+homepage:       https://github.com/supki/aeson-value-qq#readme+bug-reports:    https://github.com/supki/aeson-value-qq/issues+author:         Matvey Aksenov+maintainer:     matvey.aksenov@gmail.com+copyright:      2026 Matvey Aksenov+license:        BSD2+license-file:   LICENSE+build-type:     Simple+tested-with:+    GHC==9.8.4+extra-doc-files:+    README.markdown+    CHANGELOG.markdown++source-repository head+  type: git+  location: https://github.com/supki/aeson-value-qq++library+  exposed-modules:+      Aeson.Value.QQ+      Aeson.Value.QQ.Internal.Parse+      Aeson.Value.QQ.Internal.Quote+      Aeson.Value.QQ.Internal.Value+  other-modules:+      Paths_aeson_value_qq+  hs-source-dirs:+      src+  default-extensions:+      ImportQualifiedPost+      NoFieldSelectors+      OverloadedStrings+  ghc-options: -funbox-strict-fields -Wall -Wno-incomplete-uni-patterns+  build-depends:+      aeson+    , attoparsec+    , attoparsec-aeson+    , base >=4.7 && <5+    , bytestring+    , ghc-hs-meta+    , scientific+    , template-haskell+    , text+    , unordered-containers+    , vector+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Aeson.Value.QQ.Internal.ParseSpec+      Paths_aeson_value_qq+  hs-source-dirs:+      test+  default-extensions:+      ImportQualifiedPost+      NoFieldSelectors+      OverloadedStrings+  ghc-options: -freduction-depth=0 -Wall -Wno-incomplete-uni-patterns -threaded -with-rtsopts=-N+  build-depends:+      aeson+    , aeson-value-qq+    , base >=4.7 && <5+    , hspec+  default-language: Haskell2010
+ src/Aeson/Value/QQ.hs view
@@ -0,0 +1,43 @@+module Aeson.Value.QQ+  ( qq+  ) where++import Control.Monad (filterM)+import Data.String (fromString)+import Data.Text.Encoding qualified as Text+import Language.Haskell.TH (Q, Exp)+import Language.Haskell.TH.Quote (QuasiQuoter(..))+import Language.Haskell.TH.Syntax (Extension, isExtEnabled)++import Aeson.Value.QQ.Internal.Parse (parse)+import Aeson.Value.QQ.Internal.Quote (quote)+++qq :: QuasiQuoter+qq =+  fromQuoteExp valueExp++fromQuoteExp :: (String -> Q Exp) -> QuasiQuoter+fromQuoteExp f = QuasiQuoter+  { quoteExp =+      f+  , quotePat =+      \_pat -> error "Aeson.Value.QQ.qq: no quotePat"+  , quoteType =+      \_type -> error "Aeson.Value.QQ.qq: no quoteType"+  , quoteDec =+      \_dec -> error "Aeson.Value.QQ.qq: no quoteDec"+  }++valueExp :: String -> Q Exp+valueExp str = do+  exts <- reifyEnabledExtensions+  case parse exts (Text.encodeUtf8 (fromString str)) of+    Left err ->+      error ("Aeson.Value.QQ.qq: " <> err)+    Right parsed ->+      quote parsed++reifyEnabledExtensions :: Q [Extension]+reifyEnabledExtensions =+  filterM isExtEnabled [minBound .. maxBound]
+ src/Aeson/Value/QQ/Internal/Parse.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE PatternSynonyms #-}+module Aeson.Value.QQ.Internal.Parse+  ( parse+  ) where++import Control.Applicative ((<|>))+import Data.Aeson.Parser qualified as Aeson+import Data.Attoparsec.ByteString qualified as Atto+import Data.ByteString qualified as ByteString+-- cannot use .Text here due to .Aeson parsers being tied to .ByteString+import Data.ByteString (ByteString)+import Data.Char qualified as Char+import Data.HashMap.Strict qualified as HashMap+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Vector qualified as Vector+import Data.Word (Word8)+import "ghc-hs-meta" Language.Haskell.Meta.Parse (parseExpWithExts)+import Language.Haskell.TH.Syntax qualified as Haskell (Extension)+import Prelude hiding (any, exp, null)+import Text.Printf (printf)++import Aeson.Value.QQ.Internal.Value (Json(..))+++-- | An 'attoparsec' parser for 'Json'.+--+-- /Note:/ consumes spaces before and after the matcher.+parse :: [Haskell.Extension] -> ByteString -> Either String Json+parse exts =+  Atto.parseOnly (value exts <* eof)++value :: [Haskell.Extension] -> Atto.Parser Json+value exts =+  between spaces spaces $ do+    b <- Atto.peekWord8'+    case b of+      NP ->+        null+      FP ->+        false+      TP ->+        true+      DoubleQuoteP ->+        string+      OpenSquareBracketP ->+        array exts+      OpenCurlyBracketP ->+        object exts+      HashP ->+        haskellExp exts+      _ | startOfNumber b ->+          number+        | otherwise ->+          fail ("a value cannot start with " ++ show b)+ where+  startOfNumber b =+    b >= ZeroP && b <= NineP || b == MinusP+  between a b p =+    a *> p <* b++null :: Atto.Parser Json+null =+  Null <$ Atto.string "null"++false :: Atto.Parser Json+false =+  Bool False <$ Atto.string "false"++true :: Atto.Parser Json+true =+  Bool True <$ Atto.string "true"++number :: Atto.Parser Json+number =+  fmap Number Aeson.scientific++string :: Atto.Parser Json+string =+  fmap String Aeson.jstring++array :: [Haskell.Extension] -> Atto.Parser Json+array exts = do+  _ <- Atto.word8 OpenSquareBracketP+  spaces+  b <- Atto.peekWord8'+  case b of+    CloseSquareBracketP -> do+      _ <- Atto.word8 CloseSquareBracketP+      pure (Array Vector.empty)+    _ -> do+      loop [] 0+ where+  loop acc !n = do+    spaces+    val <- value exts+    sep <- Atto.satisfy (\w -> w == CommaP || w == CloseSquareBracketP) Atto.<?> "',' or ']'"+    case sep of+      CommaP ->+        loop (val : acc) (n + 1)+      CloseSquareBracketP ->+        pure (Array (Vector.fromListN (n + 1) (reverse (val : acc))))+      _ ->+        error "impossible"++object :: [Haskell.Extension] -> Atto.Parser Json+object exts = do+  _ <- Atto.word8 OpenCurlyBracketP+  spaces+  b <- Atto.peekWord8'+  case b of+    CloseCurlyBracketP -> do+      _ <- Atto.word8 CloseCurlyBracketP+      pure (Object HashMap.empty)+    _ ->+      loop []+ where+  loop acc = do+    spaces+    k <- key+    spaces+    _ <- Atto.word8 ColonP+    val <- value exts+    sep <- Atto.satisfy (\w -> w == CommaP || w == CloseCurlyBracketP) Atto.<?> "',' or '}'"+    case sep of+      CommaP ->+        loop ((k, val) : acc)+      CloseCurlyBracketP ->+        pure (Object (HashMap.fromList ((k, val) : acc)))+      _ ->+        error "impossible"++key :: Atto.Parser Text+key =+  Aeson.jstring <|> bareKey++bareKey :: Atto.Parser Text+bareKey =+  fmap+    (Text.decodeUtf8 . ByteString.pack)+    (Atto.many1+      (Atto.satisfy+        (p . Char.chr . fromIntegral)))+ where+  p c =+    not (Char.isSpace c || c `elem` ("\\\":;><${}[],#" :: String))++haskellExp :: [Haskell.Extension] -> Atto.Parser Json+haskellExp exts =+  fmap Ext (Atto.string "#{" *> go)+ where+  go = do+    str <- Atto.takeWhile1 (/= CloseCurlyBracketP) <* Atto.word8 CloseCurlyBracketP+    case parseExpWithExts exts (Text.unpack (Text.decodeUtf8 str)) of+      Left (line, col, err) ->+        fail (printf "%d:%d: %s" line col err)+      Right exp ->+        pure exp++eof :: Atto.Parser ()+eof =+  Atto.endOfInput Atto.<?> "trailing garbage after a Matcher value"++spaces :: Atto.Parser ()+spaces =+  comment <|> whitespace <|> pure ()+ where+  comment = do+    _ <- Atto.word8 HashP+    b0 <- Atto.peekWord8+    case b0 of+      Just OpenCurlyBracketP ->+        -- it's possible to rewrite this with Atto.lookAhead,+        -- but I like this version better+        fail "not a comment"+      _ -> do+        Atto.skipWhile (/= NewLineP)+        spaces+  whitespace = do+    _ <- skipWhile1 (\b -> b == SpaceP || b == NewLineP || b == CRP || b == TabP)+    spaces++skipWhile1 :: (Word8 -> Bool) -> Atto.Parser ()+skipWhile1 p = do+  _ <- Atto.satisfy p+  Atto.skipWhile p++pattern NP, FP, TP, DoubleQuoteP, CommaP, HashP :: Word8+pattern NP = 110 -- 'n'+pattern FP = 102 -- 'f'+pattern TP = 116 -- 't'+pattern DoubleQuoteP = 34 -- '"'+pattern CommaP = 44 -- ','+pattern HashP = 35 -- '#'++pattern OpenSquareBracketP, CloseSquareBracketP :: Word8+pattern OpenSquareBracketP = 91 -- '['+pattern CloseSquareBracketP = 93 -- ']'++pattern OpenCurlyBracketP, CloseCurlyBracketP, ColonP :: Word8+pattern OpenCurlyBracketP = 123 -- '{'+pattern CloseCurlyBracketP = 125 -- '}'++pattern ColonP = 58 -- ':'++pattern ZeroP, NineP, MinusP :: Word8+pattern ZeroP = 48 -- '0'+pattern NineP = 57 -- '9'+pattern MinusP = 45 -- '-'++pattern SpaceP, NewLineP, CRP, TabP :: Word8+pattern SpaceP = 0x20+pattern NewLineP = 0x0a+pattern CRP = 0x0d+pattern TabP = 0x09
+ src/Aeson/Value/QQ/Internal/Quote.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskell #-}+module Aeson.Value.QQ.Internal.Quote where++import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as Aeson.KeyMap+import Data.HashMap.Strict qualified as HashMap+import Data.Vector qualified as Vector+import Data.Text qualified as Text+import Language.Haskell.TH (Q, Exp(..), Lit(..))++import Aeson.Value.QQ.Internal.Value (Json(..))+++quote :: Json -> Q Exp+quote = \case+  Null ->+    [| Aeson.Null |]+  Bool b ->+    [| Aeson.Bool b |]+  Number n ->+    [| Aeson.Number n |]+  String str ->+    [| Aeson.String str |]+  Array values -> do+    let+      quoted =+        fmap ListE (traverse quote (Vector.toList values))+    [| Aeson.Array (Vector.fromList $quoted) |]+  Object values -> do+    let+      quoted = do+        fmap (toExp . HashMap.toList) (traverse quote values)+      toExp =+        ListE . map (\(k, v) -> tup2 (LitE (StringL (Text.unpack k)), v))+      tup2 (a, b) =+        TupE [Just a, Just b]+    [| Aeson.Object (Aeson.KeyMap.fromHashMapText (HashMap.fromList $quoted)) |]+  Ext ext ->+    [| Aeson.toJSON $(pure ext) |]
+ src/Aeson/Value/QQ/Internal/Value.hs view
@@ -0,0 +1,19 @@+module Aeson.Value.QQ.Internal.Value+  ( Json(..)+  ) where++import Data.HashMap.Strict (HashMap)+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Vector (Vector)+import Language.Haskell.TH (Exp)+++data Json+  = Null+  | Bool Bool+  | Number Scientific+  | String Text+  | Array (Vector Json)+  | Object (HashMap Text Json)+  | Ext Exp
+ test/Aeson/Value/QQ/Internal/ParseSpec.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+module Aeson.Value.QQ.Internal.ParseSpec (spec) where++import Data.Aeson qualified as Aeson+import Test.Hspec++import Aeson.Value.QQ+++spec :: Spec+spec = do+  it "specs" $ do+    [qq| null |] `shouldBe` Aeson.Null++    [qq| false |] `shouldBe` Aeson.Bool False+    [qq| true |] `shouldBe` Aeson.Bool True++    [qq| 4 |] `shouldBe` Aeson.Number 4+    [qq| -7 |] `shouldBe` Aeson.Number (-7)+    [qq| 4.2 |] `shouldBe` Aeson.Number 4.2+++    [qq| [] |] `shouldBe`+      Aeson.Array []+    [qq| [1, 2, 3] |] `shouldBe`+      Aeson.Array [Aeson.Number 1, Aeson.Number 2, Aeson.Number 3]+    [qq|+      [ 1+      , 2+      , 3+      ]+    |] `shouldBe`+      Aeson.Array+        [ Aeson.Number 1+        , Aeson.Number 2+        , Aeson.Number 3+        ]++    [qq| {} |] `shouldBe`+      Aeson.Object []+    [qq| {foo: 4} |] `shouldBe`+      Aeson.Object [("foo", Aeson.Number 4)]+    [qq| {foo: 4, "bar-baz": 7} |] `shouldBe`+      Aeson.Object [("foo", Aeson.Number 4), ("bar-baz", Aeson.Number 7)]+    [qq|+      { foo: 4+      , "bar": 7+      }+    |] `shouldBe`+      Aeson.Object+        [ ("foo", Aeson.Number 4)+        , ("bar", Aeson.Number 7)+        ]++    [qq| {foo: #{4 + 7 :: Int}} |] `shouldBe`+      Aeson.Object [("foo", Aeson.Number 11)]++  it "comments" $ do+    [qq|+      [ 1+      # , 2+      , 3+      ]+    |] `shouldBe`+      Aeson.Array [Aeson.Number 1, Aeson.Number 3]+    [qq|+      [ 1 # one+      , 2 # two+      , 3 # three+      ]+    |] `shouldBe`+      Aeson.Array [Aeson.Number 1, Aeson.Number 2, Aeson.Number 3]+    [qq|+      # it's an object!+      { foo: 4+      , bar: 7+      }+    |] `shouldBe`+      Aeson.Object [("foo", Aeson.Number 4), ("bar", Aeson.Number 7)]+    [qq|+      # multiline+      # comment+      { foo: 4+      # in the middle of+      # object definition+      , bar: 7+      }+      # and at the end+      # too+    |] `shouldBe`+      Aeson.Object [("foo", Aeson.Number 4), ("bar", Aeson.Number 7)]++  it "unicode" $+    [qq| "бусифікація" |] `shouldBe` Aeson.String "бусифікація"++  it "overloaded-record-dot" $ do+    let+      foo = Foo 4+    -- note that for this to work -XOverloadedRecordDot+    -- needs to be enabled in the current module+    [qq|+      #{foo.bar}+    |] `shouldBe` Aeson.Number 4+++data Foo = Foo { bar :: Int }
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+