Merge pull request #8 from dicefm/example

Add a basic find example

Author: SimonRichardson

examples/Examples/Data/Event.purs

@@ -0,0 +1,37 @@
+module Data.Event where
+
+import Data.Argonaut ((~>), (:=), (.?), jsonEmptyObject, printJson)
+import Data.Argonaut.Core (Json(), JString(), toString)
+import Data.Argonaut.Encode (EncodeJson, encodeJson)
+import Data.Argonaut.Decode (DecodeJson, decodeJson)
+import Data.Date
+import Data.Either
+import Data.Maybe (Maybe(..), maybe)
+import Data.Traversable (traverse)
+
+import Debug.Trace
+
+newtype Event = Event
+  { name :: Maybe String
+  , date :: Maybe Date
+  }
+
+instance decodeJsonEvent :: DecodeJson Event where
+  decodeJson json = do
+    obj  <- decodeJson json
+    name <- obj .? "name"
+    pure $ Event
+      { name : name
+      , date : Nothing
+      }
+
+instance encodeJsonEvent :: EncodeJson Event where
+  encodeJson (Event e)
+    = "name" := e.name
+    ~> jsonEmptyObject
+
+instance showEvent :: Show Event where
+  show (Event e) = "Event " ++
+    "{ name: " ++ show e.name ++
+    "}"
+  

examples/Examples/Database/Mongo/Example.purs

@@ -0,0 +1,52 @@
+module Examples.Database.Mongo.Example where
+
+import Database.Mongo.Mongo
+import Database.Mongo.ConnectionInfo
+import Database.Mongo.Bson.BsonValue
+
+import Control.Monad.Aff
+import Control.Monad.Eff
+import Control.Monad.Eff.Class
+import Control.Monad.Eff.Exception
+
+import Data.Argonaut (printJson)
+import Data.Argonaut.Core (Json(..))
+import Data.Argonaut.Decode (DecodeJson, decodeJson)
+import Data.Either
+import Data.Event
+import Data.Maybe
+import Data.String.Regex
+
+import Debug.Trace
+
+foreign import traceAny
+  """
+  function traceAny(a){
+    return function () {
+      console.log(a);
+      return {};
+    };
+  }
+  """ :: forall e a. a -> Eff (trace :: Trace | e) Unit
+
+main = launchAff $ do
+  
+  Right database <- attempt $ connect $ defaultOptions { db = Just "test" }
+  col <- collection "events" database
+  cur <- find [ 
+                "$or" := [ "name" := (regex "Amazing" noFlags)
+                         , "name" := (regex "Wow!" noFlags)
+                         ]
+              ] [] col
+  res <- collect cur
+
+  liftEff $ case decodeEvents res of
+    Left err -> traceAny err
+    Right x -> traceAny x
+  
+  close database
+
+
+  where
+    decodeEvents :: Json -> (Either String [Event])
+    decodeEvents = decodeJson

src/Database/Mongo/Mongo.purs

@@ -26,11 +26,17 @@ type AffDatabase e = Aff (db :: DB | e) Database
 type AffCollection e = Aff (db :: DB | e) Collection
 type AffCursor e = Aff (db :: DB | e) Cursor 
 type AffResult e = Aff (db :: DB | e) Json
+type AffUnit e = Aff (db :: DB | e) Unit
 
 -- | Makes a connection to the database.
 connect :: forall e. ConnectionInfo -> AffDatabase e
 connect = makeAff' <<< connect'
 
+-- | Close the connection to the database
+close :: forall e. Database -> AffUnit e
+close = makeAff' <<< close'
+
+
 -- | Get the collection
 collection :: forall e. String -> Database -> AffCollection e
 collection a b = makeAff' (collection' a b)
@@ -59,6 +65,13 @@ connect' :: forall e
   -> (Eff (db :: DB | e) (Canceler (db :: DB | e)))
 connect' info eb cb = runFn4 _connect (dialUri info) ignoreCancel eb cb
 
+close' :: forall e
+  .  Database
+  -> (Error -> Eff (db :: DB | e) Unit)
+  -> (Unit -> Eff (db :: DB | e) Unit)
+  -> (Eff (db :: DB | e) (Canceler (db :: DB | e)))
+close' database eb cb = runFn4 _close database ignoreCancel eb cb
+
 collection' :: forall e
   .  String
   -> Database
@@ -120,6 +133,21 @@ foreign import _connect
                    (Database -> Eff (db :: DB | e) Unit)
                    (Eff (db :: DB | e) (Canceler (db :: DB | e)))
 
+foreign import _close
+  """
+  function _close(db, canceler, errback, callback) {
+    db.close(function(err, x) {
+      (err ? errback(err) : callback(x))();
+    });
+    return canceler({});
+  }
+  """ :: forall e. Fn4 
+                   Database
+                   (Unit -> Canceler (db :: DB | e))
+                   (Error -> Eff (db :: DB | e) Unit)
+                   (Unit -> Eff (db :: DB | e) Unit)
+                   (Eff (db :: DB | e) (Canceler (db :: DB | e)))                   
+
 foreign import _collection
   """
   function _collection(name, db, canceler, errback, callback) {
@@ -212,7 +240,7 @@ foreign import _ignoreCancel
   """
   function _ignoreCancel(any, cancelError, errback, callback) {
     return function() {
-        callback(false);
+        return callback(false)();
     };
   }
   """ :: forall e a. Fn4