packages feed

record-aeson (empty) → 0.1.0.0

raw patch · 6 files changed

+228/−0 lines, 6 filesdep +aesondep +basedep +base-preludesetup-changed

Dependencies added: aeson, base, base-prelude, hspec, record, record-aeson, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2015, Nikita Volkov++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hspec/Main.hs view
@@ -0,0 +1,16 @@+module Main where++import BasePrelude+import Test.Hspec++import Record+import Record.Aeson+import Data.Aeson+++main =+  hspec $ do+    it "Encoding" $ do+      shouldBe+        (encode (toJSON ([r| { a = 'a', b = { c = 'c', d = 'd' } } |]))) +        "{\"a\":\"a\",\"b\":{\"d\":\"d\",\"c\":\"c\"}}"
+ library/Record/Aeson.hs view
@@ -0,0 +1,91 @@+-- |+-- This module exports instances of 'ToJSON' for all record types.+module Record.Aeson where++import BasePrelude+import Record.Types+import Record.Lens+import Data.Aeson.Types+import GHC.TypeLits+import Language.Haskell.TH+import Record.Aeson.TH+++-- +-- Produce something in the spirit of the following:+-- +-- instance (KnownSymbol n1, KnownSymbol n2, ToJSON v1, ToJSON v2) => ToJSON (Record2 n1 v1 n2 v2) where+--   toJSON x =+--     object pairs+--     where+--       pairs =+--         [+--           (undefined :: FieldName n1) & \n -> (fromString (symbolVal n), toJSON (view (fieldLens n) x)),+--           (undefined :: FieldName n2) & \n -> (fromString (symbolVal n), toJSON (view (fieldLens n) x))+--         ]+return $ do+  arity <- [1 .. 24]+  return $+    let+      recordName =+        mkName $ showString "Record" $ show arity+      arityNumbers =+        enumFromTo 1 arity+      fieldNameVarNames =+        mkName . showString "n" . show <$> arityNumbers+      valueVarNames =+        mkName . showString "v" . show <$> arityNumbers+      instanceDec =+        InstanceD constraints headType decs+        where+          constraints =+            knownSymbolConstraints <> toJSONConstraints+            where+              knownSymbolConstraints =+                do+                  varName <- fieldNameVarNames+                  return $ mkClassP ''KnownSymbol [(VarT varName)]+              toJSONConstraints =+                do+                  varName <- valueVarNames+                  return $ mkClassP ''ToJSON [(VarT varName)]+          headType =+            AppT (ConT ''ToJSON) $+            foldl' AppT (ConT recordName) $+            map VarT $+            interlace fieldNameVarNames valueVarNames+            where+              interlace a b = join (zipWith (\a b -> [a, b]) a b)+          decs =+            [toJSONDec]+            where+              toJSONDec =+                FunD 'toJSON [clause]+                where+                  clause =+                    Clause [pat] body []+                    where+                      pat =+                        ConP recordName varPats+                        where+                          varPats =+                            map VarP valueVarNames+                      body =+                        NormalB exp+                        where+                          exp =+                            AppE (VarE 'object) $ ListE $ do+                              (valueVarName, fieldNameVarName) <- zip valueVarNames fieldNameVarNames+                              let+                                labelExp =+                                  AppE (VarE 'fromString) $+                                  AppE (VarE 'symbolVal) $+                                  SigE (VarE 'undefined) $+                                  AppT (ConT ''FieldName) $+                                  VarT fieldNameVarName+                                valueExp =+                                  AppE (VarE 'toJSON) $+                                  VarE valueVarName+                              return $ TupE $ [labelExp, valueExp]+      in instanceDec+
+ library/Record/Aeson/TH.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE CPP #-}+module Record.Aeson.TH where++import BasePrelude+import Record.Types+import Record.Lens+import Language.Haskell.TH+import Data.Aeson.Types+import GHC.TypeLits+++-- |+-- Compatibility with the 'ClassP' constructor,+-- which was thrown away in 2.10.+#if MIN_VERSION_template_haskell(2,10,0)+mkClassP :: Name -> [Type] -> Type+mkClassP a b =+  foldl' AppT (ConT a) b+#else+mkClassP :: Name -> [Type] -> Pred+mkClassP =+  ClassP+#endif
+ record-aeson.cabal view
@@ -0,0 +1,74 @@+name:+  record-aeson+version:+  0.1.0.0+synopsis:+  Instances of "aeson" classes for the "record" types+category:+  Data, JSON, Record+homepage:+  https://github.com/nikita-volkov/record-aeson+bug-reports:+  https://github.com/nikita-volkov/record-aeson/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2015, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/record-aeson.git+++library+  hs-source-dirs:+    library+  other-modules:+    Record.Aeson.TH+  exposed-modules:+    Record.Aeson+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators+  default-language:+    Haskell2010+  build-depends:+    template-haskell == 2.*,+    aeson == 0.8.*,+    record == 0.3.*,+    base-prelude >= 0.1.19 && < 0.2,+    base >= 4.7 && < 5+++test-suite hspec+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    hspec+  main-is:+    Main.hs+  ghc-options:+    -threaded+    "-with-rtsopts=-N"+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    hspec == 2.1.*,+    record,+    record-aeson,+    aeson,+    base-prelude