bson-generic 0.0.6 → 0.0.7

raw patch · 2 files changed

+77/−95 lines, 2 filesdep +textdep ~basedep ~bsondep ~ghc-primPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: text

Dependency ranges changed: base, bson, ghc-prim

API changes (from Hackage documentation)

Files

• bson-generic.cabal +23/−30
• src/Data/Bson/Generic.hs +54/−65

@@ -1,35 +1,28 @@-Name:                bson-generic-Version:             0.0.6-Synopsis:            Generic functionality for BSON-Description:         This package offers easy conversion from and to BSON data type for most of user defined data types.-License:             BSD3-License-file:        LICENSE-Author:              Petr Pilař-Maintainer:          the.palmik+maintainer@gmail.com-Category:            Data+name:                bson-generic+version:             0.0.7+synopsis:            Generic functionality for BSON+description:         This package offers easy conversion from and to BSON data type for most of user defined data types.+                     The interface may change at will.+license:             BSD3+license-file:        LICENSE+author:              Petr Pilař+maintainer:          the.palmik+maintainer@gmail.com+category:            Data+build-type:          Simple+cabal-version:       >= 1.8+stability:           experimental -Build-type:          Simple+library+  hs-source-dirs: src -Cabal-version:       >= 1.6+  exposed-modules:+      Data.Bson.Generic -Source-repository head-  type:     git-  location: git://github.com:Palmik/bson-generic.git+  build-depends:+      base     == 4.5.*+    , bson     == 0.2.*+    , ghc-prim == 0.2.*+    , text     == 0.11.* -Library-  hs-source-dirs: src+  ghc-options: -O2 -  Exposed-modules:-    Data.Bson.Generic-  -  Build-depends:-    base        >= 4 && < 5,-    ghc-prim    >= 0.2,-    bson        >= 0.1.7 && < 0.2-  -  -- Modules not exported by this package.-  -- Other-modules:       -  -  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.-  -- Build-tools:         -  

@@ -91,24 +91,27 @@ ( ToBSON(..) , FromBSON(..) , ObjectKey(..)-, genericToBSON-, genericFromBSON , keyLabel , constructorLabel ) where +------------------------------------------------------------------------------ import           GHC.Generics-import qualified Data.Bson as BSON (lookup)+------------------------------------------------------------------------------+import           Control.Applicative+import           Control.Monad+------------------------------------------------------------------------------+import qualified Data.Bson     as BSON (lookup) import           Data.Bson-import           Data.UString (u)+import qualified Data.Text     as TS   (pack) import           Data.Typeable-import           Control.Monad+------------------------------------------------------------------------------  keyLabel :: Label-keyLabel = u "_id"+keyLabel = TS.pack "_id"  constructorLabel :: Label-constructorLabel = u "_co"+constructorLabel = TS.pack "_co"  ------------------------------------------------------------------------------ @@ -124,120 +127,106 @@     cast' _       = Nothing  ------------------------------------------------------------------------------+-- TO BSON  class ToBSON a where     toBSON :: a -> Document      default toBSON :: (Generic a, GConstructorCount (Rep a), GToBSON (Rep a)) => a -> Document-    toBSON val = genericToBSON (const Nothing) val--class FromBSON a where-    fromBSON :: Document -> Maybe a--    default fromBSON :: (Generic a, GConstructorCount (Rep a), GFromBSON (Rep a)) => Document -> Maybe a-    fromBSON doc = genericFromBSON (const Nothing) doc----------------------------------------------------------------------------------genericToBSON :: (Generic a, GConstructorCount (Rep a), GToBSON (Rep a))-              => (String -> Maybe String) -- ^ Function that takes a string (selector name) and returns Just transformed name or Nothing.-              -> a                        -- ^ The value you want to conver to BSON Document.-              -> Document                 -- ^ The resulting document.-genericToBSON tr val = gtoBSON tr (constructorCount val) (from val)--genericFromBSON :: forall a . (Generic a, GConstructorCount (Rep a), GFromBSON (Rep a))-                => (String -> Maybe String) -- ^ Function that takes a string (selector name) and returns Just transformed name or Nothing.-                -> Document                 -- ^ Document.-                -> Maybe a                  -- ^ Just the value or Nothing.-genericFromBSON tr doc = maybe Nothing (Just . to) (gfromBSON tr (constructorCount (undefined :: a)) doc)--------------------------------------------------------------------------------+    toBSON a = genericToBSON (constructorCount a) (from a)  class GToBSON f where-    gtoBSON :: (String -> Maybe String) -> Int -> f a -> Document+    genericToBSON :: Int -> f a -> Document  -- | Unit type -> Empty document instance GToBSON U1 where-    gtoBSON _ _ U1 = []+    genericToBSON _ U1 = []  -- | Sum of types instance (GToBSON a, GToBSON b) => GToBSON (a :*: b) where-    gtoBSON tr n (x :*: y) = gtoBSON tr n x ++ gtoBSON tr n y+    genericToBSON n (x :*: y) = genericToBSON n x ++ genericToBSON n y  -- | Product of types instance (GToBSON a, GToBSON b) => GToBSON (a :+: b) where-    gtoBSON tr n (L1 x) = gtoBSON tr n x-    gtoBSON tr n (R1 x) = gtoBSON tr n x+    genericToBSON n (L1 x) = genericToBSON n x+    genericToBSON n (R1 x) = genericToBSON n x  -- | Datatype information tag instance (GToBSON a) => GToBSON (D1 c a) where-    gtoBSON tr n (M1 x) = gtoBSON tr n x+    genericToBSON n (M1 x) = genericToBSON n x  -- | Constructor tag instance (GToBSON a, Constructor c) => GToBSON (C1 c a) where-    gtoBSON tr 0 (M1 x) = gtoBSON tr 0 x-    gtoBSON tr 1 (M1 x) = gtoBSON tr 1 x-    gtoBSON tr n c@(M1 x) = gtoBSON tr n x ++ [ constructorLabel =: conName c ]+    genericToBSON 0 (M1 x) = genericToBSON 0 x+    genericToBSON 1 (M1 x) = genericToBSON 1 x+    genericToBSON n c@(M1 x) = genericToBSON n x ++ [ constructorLabel =: conName c ]  -- | Selector tag instance (Val a, Selector s) => GToBSON (S1 s (K1 i a)) where-    gtoBSON tr _ s@(M1 (K1 x)) = [sname =: x]-        where sname = u $ maybe (selName s) id (tr $ selName s)+    genericToBSON _ s@(M1 (K1 x)) = [TS.pack (selName s) =: x]  -- | ObjectKey special treatment instance (Selector s) => GToBSON (S1 s (K1 i ObjectKey)) where-    gtoBSON _ _ (M1 (K1 (ObjectKey (Just key)))) = [ keyLabel =: key ]-    gtoBSON                                _ _ _ = []+    genericToBSON _ (M1 (K1 (ObjectKey (Just key)))) = [ keyLabel =: key ]+    genericToBSON                              _ _ = []  -- | Constants instance (ToBSON a) => GToBSON (K1 i a) where-    gtoBSON _ _ (K1 x) = toBSON x+    genericToBSON _ (K1 x) = toBSON x  ------------------------------------------------------------------------------  ------------------------------------------------------------------------------+-- FROM BSON +class FromBSON a where+    fromBSON :: Document -> Maybe a++    default fromBSON :: (Generic a, GConstructorCount (Rep a), GFromBSON (Rep a)) => Document -> Maybe a+    fromBSON doc = maybe Nothing (Just . to) (genericFromBSON (constructorCount (undefined :: a)) doc)+ class GFromBSON f where-    gfromBSON :: (String -> Maybe String) -> Int -> Document -> Maybe (f a)+    genericFromBSON :: Int -> Document -> Maybe (f a)  instance GFromBSON U1 where-    gfromBSON _ _ doc = Just U1+    genericFromBSON _ _ = Just U1  instance (GFromBSON a, GFromBSON b) => GFromBSON (a :*: b) where-    gfromBSON tr n doc = do-        x <- (gfromBSON tr n doc)-        y <- (gfromBSON tr n doc)-        return (x :*: y)+    genericFromBSON n doc = do+        x <- genericFromBSON n doc+        y <- genericFromBSON n doc+        return $ x :*: y  instance (GFromBSON a, GFromBSON b) => GFromBSON (a :+: b) where-    gfromBSON tr n doc = left `mplus` right-        where left  = maybe Nothing (Just . L1) (gfromBSON tr n doc)-              right = maybe Nothing (Just . R1) (gfromBSON tr n doc)+    genericFromBSON n doc = left `mplus` right+        where+          left  = L1 <$> genericFromBSON n doc+          right = R1 <$> genericFromBSON n doc  instance (GFromBSON a, Constructor c) => GFromBSON (C1 c a) where-    gfromBSON tr 0 doc = maybe Nothing (Just . M1) (gfromBSON tr 0 doc)-    gfromBSON tr 1 doc = maybe Nothing (Just . M1) (gfromBSON tr 0 doc)-    gfromBSON tr n doc = do+    genericFromBSON 0 doc = M1 <$> genericFromBSON 0 doc+    genericFromBSON 1 doc = M1 <$> genericFromBSON 0 doc+    genericFromBSON n doc = do         cname <- BSON.lookup constructorLabel doc-        if (cname == (conName (undefined :: M1 C c a r)))-           then maybe Nothing (Just . M1) (gfromBSON tr n doc)+        if cname == conName (undefined :: M1 C c a r)+           then M1 <$> genericFromBSON n doc            else Nothing  instance (GFromBSON a) => GFromBSON (M1 D c a) where-    gfromBSON tr n doc = gfromBSON tr n doc >>= return . M1+    genericFromBSON n doc = M1 <$> genericFromBSON n doc  instance (Val a, Selector s) => GFromBSON (S1 s (K1 i a)) where-    gfromBSON tr n doc = (BSON.lookup sname doc) >>= return . M1 . K1-        where sname = u . maybe orig id $ tr orig-              orig  = (selName $ (undefined :: S1 s (K1 i a) r))+    genericFromBSON _ doc = M1 . K1 <$> BSON.lookup sname doc+        where+          sname = TS.pack . selName $ (undefined :: S1 s (K1 i a) r)  -- | ObjectKey special treatment instance (Selector s) => GFromBSON (S1 s (K1 i ObjectKey)) where-    gfromBSON _ n doc = Just . M1 . K1 $ ObjectKey (BSON.lookup keyLabel doc)+    genericFromBSON _ doc = Just . M1 . K1 $ ObjectKey (BSON.lookup keyLabel doc)  ------------------------------------------------------------------------------+-- CONVENIENCE --- | Class for getting the number of constructors of type. class GConstructorCount f where     gconstructorCount :: f a -> Int @@ -248,7 +237,7 @@     gconstructorCount (M1 x) = gconstructorCount x  instance (Constructor c) => GConstructorCount (C1 c a) where-    gconstructorCount c = 1+    gconstructorCount _ = 1  instance (GConstructorCount a, GConstructorCount b) => GConstructorCount (a :+: b) where     gconstructorCount (_ :: (a :+: b) r) = gconstructorCount (undefined :: a r) +