pipes-mongodb (empty) → 0.1.0.0

raw patch · 5 files changed

+136/−0 lines, 5 filesdep +basedep +monad-controldep +mongoDBsetup-changed

Dependencies added: base, monad-control, mongoDB, pipes, text

Files

LICENSE +20/−0
Pipes/MongoDB.hs +34/−0
Setup.hs +2/−0
pipes-mongodb.cabal +35/−0
test/Test.hs +45/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2015 William Casarin++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.

+ Pipes/MongoDB.hs view

@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleContexts #-}++module Pipes.MongoDB (+  fromCursor+, action+, find+, runMR+) where++import Control.Monad.Trans.Control (MonadBaseControl)+import Database.MongoDB (Document)+import Database.MongoDB.Query (Action, Cursor, Query, MapReduce, nextBatch)+import Pipes (Producer, MonadIO, lift, each)+import qualified Database.MongoDB.Query as Q++fromCursor :: (MonadIO m, MonadBaseControl IO m)+           => Cursor -> Producer Document (Action m) ()+fromCursor c = do+  docs <- lift (nextBatch c)+  case docs of+    [] -> return ()+    xs -> each xs >> fromCursor c++action :: (MonadBaseControl IO m, MonadIO m)+       => Action m Cursor -> Producer Document (Action m) ()+action f = lift f >>= fromCursor++find :: (MonadIO m, MonadBaseControl IO m)+     => Query -> Producer Document (Action m) ()+find = action . Q.find++runMR :: (MonadIO m, MonadBaseControl IO m)+     => MapReduce -> Producer Document (Action m) ()+runMR = action . Q.runMR

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ pipes-mongodb.cabal view

@@ -0,0 +1,35 @@+name:                pipes-mongodb+version:             0.1.0.0+synopsis:            Stream results from MongoDB+description:         Stream results from MongoDB++homepage:            http://github.com/jb55/pipes-mongodb+license:             MIT+license-file:        LICENSE+author:              William Casarin+maintainer:          bill@casarin.me++category:            Database+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type: git+  location: https://github.com/jb55/pipes-mongodb++library+  exposed-modules: Pipes.MongoDB+  default-language: Haskell98+  build-depends: base >=4.5 && < 5+               , mongoDB+               , monad-control+               , pipes++Test-Suite test-pipes-mongodb+    type:       exitcode-stdio-1.0+    main-is:    test/Test.hs+    build-depends: base+                 , text+                 , mongoDB+                 , monad-control+                 , pipes

+ test/Test.hs view

@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}++module Main where++import Pipes.MongoDB as MP+import Pipes+import Data.Text+import Database.MongoDB+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad ((>=>))++import qualified Pipes.Prelude as P++runAction :: Action IO a -> IO a+runAction a = do+  pipe <- connect (host "127.0.0.1")+  access pipe master "pipes-mongodb-example" a++main :: IO ()+main = runAction tasks++cities :: Producer (Maybe Text) (Action IO) ()+cities = MP.find (select [] "team")+     >-> P.map (look "home" >=> cast >=> look "city" >=> cast)++tasks :: Action IO ()+tasks = do+  clearTeams+  insertTeams+  -- pipes stuff+  runEffect (cities >-> P.print)++clearTeams :: MonadIO m => Action m ()+clearTeams = delete (select [] "team")++t :: Text -> Text+t v = v++insertTeams :: MonadIO m => Action m [Value]+insertTeams = insertMany "team" [+   ["name" =: t "Yankees", "home" =: ["city" =: t "New York", "state" =: t "NY"], "league" =: t "American"],+   ["name" =: t "Mets", "home" =: ["city" =: t "New York", "state" =: t "NY"], "league" =: t "National"],+   ["name" =: t "Phillies", "home" =: ["city" =: t "Philadelphia", t "state" =: t "PA"], "league" =: t "National"],+   ["name" =: t "Red Sox", "home" =: ["city" =: t "Boston", "state" =: t "MA"], "league" =: t "American"] ]