Permalink
Browse files

Merge pull request #2 from Palmik/master.

Utility functions
  • Loading branch information...
2 parents 65027f1 + 9a24e7d commit 0732237ccd1ecfd1774c1d6781b8f30f6ef5df13 @ozataman committed May 2, 2011
Showing with 66 additions and 0 deletions.
  1. +66 −0 src/Snap/Extension/DB/MongoDB/Generics.hs
View
66 src/Snap/Extension/DB/MongoDB/Generics.hs
@@ -19,6 +19,24 @@ module Snap.Extension.DB.MongoDB.Generics
toDoc
, fromDoc
+ -- * Utilities
+, fromDocList
+, toDocList
+--
+, insertADT
+, insertADT_
+, insertManyADT
+, insertManyADT_
+--
+, saveADT
+, replaceADT
+, repsertADT
+--
+, restADT
+, nextNADT
+, nextADT
+, groupADT
+
-- * Useful Types
, RecKey(..)
, Optional(..)
@@ -36,7 +54,9 @@ where
import Control.Applicative
import Control.Monad
+import Data.Maybe
+import Database.MongoDB hiding (Selector)
import Data.Bson
import Data.Typeable
import Data.Monoid hiding (Product)
@@ -203,7 +223,53 @@ instance (FromDoc f, FromDoc g) => FromDoc (f :*: g) where
fromDoc :: (Regular a, FromDoc (PF a)) => Document -> Maybe a
fromDoc d = fromDocPF d >>= return . to
+------------------------------------------------------------------------------
+-- | Utilities -- functions for your convenience
+
+fromDocList :: (Regular a, FromDoc (PF a)) => [Document] -> [a]
+fromDocList = catMaybes . map fromDoc
+
+toDocList :: (Regular a, ToDoc (PF a)) => [a] -> [Document]
+toDocList = map toDoc
+
+-- Insert
+
+insertADT :: (Regular a, ToDoc (PF a), DbAccess m) => Collection -> a -> m Value
+insertADT c = insert c . toDoc
+
+insertADT_ :: (Regular a, ToDoc (PF a), DbAccess m) => Collection -> a -> m ()
+insertADT_ c adt = insertADT c adt >> return ()
+
+insertManyADT :: (Regular a, ToDoc (PF a), DbAccess m) => Collection -> [a] -> m [Value]
+insertManyADT c = insertMany c . map toDoc
+
+insertManyADT_ :: (Regular a, ToDoc (PF a), DbAccess m) => Collection -> [a] -> m ()
+insertManyADT_ c adts = insertManyADT c adts >> return ()
+
+-- Update
+
+saveADT :: (Regular a, ToDoc (PF a), DbAccess m) => Collection -> a -> m ()
+saveADT c adt = save c $ toDoc adt
+
+replaceADT :: (Regular a, ToDoc (PF a), DbAccess m) => Selection -> a -> m () -- perhaps replaceWithADT would be better?
+replaceADT s adt = replace s $ toDoc adt
+
+repsertADT :: (Regular a, ToDoc (PF a), DbAccess m) => Selection -> a -> m () -- perhaps repsertWithADT would be better?
+repsertADT s adt = repsert s $ toDoc adt
+
+--
+
+restADT :: (Regular a, FromDoc (PF a), DbAccess m) => Cursor -> m [a]
+restADT c = rest c >>= return . fromDocList
+
+nextNADT :: (Regular a, FromDoc (PF a), DbAccess m) => Int -> Cursor -> m [a]
+nextNADT n c = nextN n c >>= return . fromDocList
+
+nextADT :: (Regular a, FromDoc (PF a), DbAccess m) => Cursor -> m (Maybe a)
+nextADT c = next c >>= return . (maybe Nothing fromDoc)
+groupADT :: (Regular a, FromDoc (PF a), DbAccess m) => Group -> m [a]
+groupADT g = group g >>= return . fromDocList
------------------------------------------------------------------------------

0 comments on commit 0732237

Please sign in to comment.