bson-generic 0.0.5.1 → 0.0.6

raw patch · 2 files changed

+77/−57 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• bson-generic.cabal +1/−1
• src/Data/Bson/Generic.hs +76/−56

@@ -1,5 +1,5 @@ Name:                bson-generic-Version:             0.0.5.1+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

@@ -91,6 +91,8 @@ ( ToBSON(..) , FromBSON(..) , ObjectKey(..)+, genericToBSON+, genericFromBSON , keyLabel , constructorLabel ) where@@ -108,26 +110,6 @@ constructorLabel :: Label constructorLabel = u "_co" -class GConstructorCount f where-    gconstructorCount :: f a -> Int--instance GConstructorCount V1 where-    gconstructorCount _ = 0--instance (GConstructorCount a) => GConstructorCount (D1 d a) where-    gconstructorCount (M1 x) = gconstructorCount x--instance (Constructor c) => GConstructorCount (C1 c a) where-    gconstructorCount c = 1--instance (GConstructorCount a, GConstructorCount b) => GConstructorCount (a :+: b) where-    gconstructorCount (_ :: (a :+: b) r) = gconstructorCount (undefined :: a r) +-                                           gconstructorCount (undefined :: b r)--constructorCount :: (Generic a, GConstructorCount (Rep a)) => a -> Int-constructorCount x = gconstructorCount $ from x-- ------------------------------------------------------------------------------  newtype ObjectKey = ObjectKey { unObjectKey :: Maybe ObjectId } deriving (Generic, Typeable, Show, Eq)@@ -147,92 +129,130 @@     toBSON :: a -> Document      default toBSON :: (Generic a, GConstructorCount (Rep a), GToBSON (Rep a)) => a -> Document-    toBSON a = genericToBSON (constructorCount a) (from a)+    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)++------------------------------------------------------------------------------+ class GToBSON f where-    genericToBSON :: Int -> f a -> Document+    gtoBSON :: (String -> Maybe String) -> Int -> f a -> Document  -- | Unit type -> Empty document instance GToBSON U1 where-    genericToBSON _ U1 = []+    gtoBSON _ _ U1 = []  -- | Sum of types instance (GToBSON a, GToBSON b) => GToBSON (a :*: b) where-    genericToBSON n (x :*: y) = genericToBSON n x ++ genericToBSON n y+    gtoBSON tr n (x :*: y) = gtoBSON tr n x ++ gtoBSON tr n y  -- | Product of types instance (GToBSON a, GToBSON b) => GToBSON (a :+: b) where-    genericToBSON n (L1 x) = genericToBSON n x-    genericToBSON n (R1 x) = genericToBSON n x+    gtoBSON tr n (L1 x) = gtoBSON tr n x+    gtoBSON tr n (R1 x) = gtoBSON tr n x  -- | Datatype information tag instance (GToBSON a) => GToBSON (D1 c a) where-    genericToBSON n (M1 x) = genericToBSON n x+    gtoBSON tr n (M1 x) = gtoBSON tr n x  -- | Constructor tag instance (GToBSON a, Constructor c) => GToBSON (C1 c a) where-    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 ]+    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 ]  -- | Selector tag instance (Val a, Selector s) => GToBSON (S1 s (K1 i a)) where-    genericToBSON _ s@(M1 (K1 x)) = [u (selName s) =: x]+    gtoBSON tr _ s@(M1 (K1 x)) = [sname =: x]+        where sname = u $ maybe (selName s) id (tr $ selName s)  -- | ObjectKey special treatment instance (Selector s) => GToBSON (S1 s (K1 i ObjectKey)) where-    genericToBSON _ (M1 (K1 (ObjectKey (Just key)))) = [ keyLabel =: key ]-    genericToBSON                              _ _ = []+    gtoBSON _ _ (M1 (K1 (ObjectKey (Just key)))) = [ keyLabel =: key ]+    gtoBSON                                _ _ _ = []  -- | Constants instance (ToBSON a) => GToBSON (K1 i a) where-    genericToBSON _ (K1 x) = toBSON x+    gtoBSON _ _ (K1 x) = toBSON x  ------------------------------------------------------------------------------  ------------------------------------------------------------------------------ -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-    genericFromBSON :: Int -> Document -> Maybe (f a)+    gfromBSON :: (String -> Maybe String) -> Int -> Document -> Maybe (f a)  instance GFromBSON U1 where-    genericFromBSON _ doc = Just U1+    gfromBSON _ _ doc = Just U1  instance (GFromBSON a, GFromBSON b) => GFromBSON (a :*: b) where-    genericFromBSON n doc = do-        x <- (genericFromBSON n doc)-        y <- (genericFromBSON n doc)+    gfromBSON tr n doc = do+        x <- (gfromBSON tr n doc)+        y <- (gfromBSON tr n doc)         return (x :*: y)  instance (GFromBSON a, GFromBSON b) => GFromBSON (a :+: b) where-    genericFromBSON n doc = left `mplus` right-        where left  = maybe Nothing (Just . L1) (genericFromBSON n doc)-              right = maybe Nothing (Just . R1) (genericFromBSON n doc)+    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)  instance (GFromBSON a, Constructor c) => GFromBSON (C1 c a) where-    genericFromBSON 0 doc = maybe Nothing (Just . M1) (genericFromBSON 0 doc)-    genericFromBSON 1 doc = maybe Nothing (Just . M1) (genericFromBSON 0 doc)-    genericFromBSON n doc = do+    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         cname <- BSON.lookup constructorLabel doc         if (cname == (conName (undefined :: M1 C c a r)))-           then maybe Nothing (Just . M1) (genericFromBSON n doc)+           then maybe Nothing (Just . M1) (gfromBSON tr n doc)            else Nothing  instance (GFromBSON a) => GFromBSON (M1 D c a) where-    genericFromBSON n doc = genericFromBSON n doc >>= return . M1+    gfromBSON tr n doc = gfromBSON tr n doc >>= return . M1  instance (Val a, Selector s) => GFromBSON (S1 s (K1 i a)) where-    genericFromBSON n doc = (BSON.lookup sname doc) >>= return . M1 . K1-        where sname = u . selName $ (undefined :: S1 s (K1 i a) r)+    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))  -- | ObjectKey special treatment instance (Selector s) => GFromBSON (S1 s (K1 i ObjectKey)) where-    genericFromBSON n doc = Just . M1 . K1 $ ObjectKey (BSON.lookup keyLabel doc)+    gfromBSON _ n doc = Just . M1 . K1 $ ObjectKey (BSON.lookup keyLabel doc)  ------------------------------------------------------------------------------++-- | Class for getting the number of constructors of type.+class GConstructorCount f where+    gconstructorCount :: f a -> Int++instance GConstructorCount V1 where+    gconstructorCount _ = 0++instance (GConstructorCount a) => GConstructorCount (D1 d a) where+    gconstructorCount (M1 x) = gconstructorCount x++instance (Constructor c) => GConstructorCount (C1 c a) where+    gconstructorCount c = 1++instance (GConstructorCount a, GConstructorCount b) => GConstructorCount (a :+: b) where+    gconstructorCount (_ :: (a :+: b) r) = gconstructorCount (undefined :: a r) ++                                           gconstructorCount (undefined :: b r)++constructorCount :: (Generic a, GConstructorCount (Rep a)) => a -> Int+constructorCount x = gconstructorCount $ from x