Browse files

implement all changes in changelog

Signed-off-by: Alexander Dorofeev <aka.spin@gmail.com>
  • Loading branch information...
1 parent a83018c commit 6c16f4f2365c3560dd3cbdf793d3cef5d9066d3c @akaspin committed Mar 9, 2012
View
2 ChangeLog
@@ -1,4 +1,4 @@
- In Work, Version 0.6.0 (Stable) * Remove `couchPutView_` (In Work). * Update deps constraints. 15.02.2012, Version 0.5.3 (Stable) * Fix views with "update_seq" 04.02.2012, Version 0.5.1 (Stable) * Docs. * Quote query parameter helper. 03.02.2012, Version 0.5.0 (Stable) * Expose parser-independent methods in main module. * Expose Implicit methods. * Remove ambiguous database parameter from connection. * Add unambiguous database parameter in all methods. 03.02.2012, Version 0.4.2 * Update dependencies contraints. 24.01.2012, Version 0.4.1 * `couchSecureDB` lost db argument. 24.01.2012, Version 0.4.0 * Detailed error type. * Throw exception on `304`. * Database API lost db argument. * `couchViewPut*` -> `couchPutView` 22.01.2012, Version 0.3.0.1 * Constraints in cabal 19.01.2012, Version 0.3.0.0 * Fix for new http-conduit types 16.01.2012, Version 0.2.1.1 * Fixes for couchViewPut and couchSecureDB. 16.01.2012, Version 0.2.1 * Secure DB. 16.01.2012, Version 0.2.0.1 * Avoid escaping path in couch' 16.01.2012, Version 0.2.0 * Low-lewel API * "Don't care" versions of couchPut. * Brain-free couchRev'. * All database methods ignores DB in connection. * couchPutDB' renamed to couchPutDB_. * Database replication. 14.01.2012, Version 0.1.3.0 * Safe version of couchViewPut 14.01.2012, Version 0.1.2.0 * Authentification 11.01.2012, Version 0.1.1.0
+ 09.03.2012, Version 0.6.0 (Stable) * Remove `couchPutView_` * Rename `couchPutView'` to `couchPutView` * `couchViewPost` and `couchViewPost'` * Remove `quoteQueryParam` * `mkParam` * Update deps constraints 15.02.2012, Version 0.5.3 (Stable) * Fix views with "update_seq" 04.02.2012, Version 0.5.1 (Stable) * Docs. * Quote query parameter helper. 03.02.2012, Version 0.5.0 (Stable) * Expose parser-independent methods in main module. * Expose Implicit methods. * Remove ambiguous database parameter from connection. * Add unambiguous database parameter in all methods. 03.02.2012, Version 0.4.2 * Update dependencies contraints. 24.01.2012, Version 0.4.1 * `couchSecureDB` lost db argument. 24.01.2012, Version 0.4.0 * Detailed error type. * Throw exception on `304`. * Database API lost db argument. * `couchViewPut*` -> `couchPutView` 22.01.2012, Version 0.3.0.1 * Constraints in cabal 19.01.2012, Version 0.3.0.0 * Fix for new http-conduit types 16.01.2012, Version 0.2.1.1 * Fixes for couchViewPut and couchSecureDB. 16.01.2012, Version 0.2.1 * Secure DB. 16.01.2012, Version 0.2.0.1 * Avoid escaping path in couch' 16.01.2012, Version 0.2.0 * Low-lewel API * "Don't care" versions of couchPut. * Brain-free couchRev'. * All database methods ignores DB in connection. * couchPutDB' renamed to couchPutDB_. * Database replication. 14.01.2012, Version 0.1.3.0 * Safe version of couchViewPut 14.01.2012, Version 0.1.2.0 * Authentification 11.01.2012, Version 0.1.1.0
* API Changes. `couchViewPut` moved to Database.CouchDB.Design and lost
language argument.
* Tests. 10.01.2012, Version 0.1.0.1
View
9 src/Database/CouchDB/Conduit.hs
@@ -43,13 +43,10 @@ module Database.CouchDB.Conduit (
-- * "Database.CouchDB.Conduit.Generic" Generic JSON methods
couchRev,
couchRev',
- couchDelete,
+ couchDelete
- -- * Utility
- quoteQueryParam
) where
-import Data.ByteString (ByteString, append)
import Data.Conduit (ResourceT)
import Database.CouchDB.Conduit.Internal.Connection
import qualified Database.CouchDB.Conduit.Internal.Doc as D
@@ -76,7 +73,3 @@ couchDelete :: MonadCouch m =>
-> Revision -- ^ Revision
-> ResourceT m ()
couchDelete db p = D.couchDelete (mkPath [db, p])
-
--- | Simple query param quotation.
-quoteQueryParam :: ByteString -> ByteString
-quoteQueryParam a = "\"" `append` a `append` "\""
View
66 src/Database/CouchDB/Conduit/Design.hs
@@ -4,66 +4,38 @@
-- convenient for bootstrapping and testing.
module Database.CouchDB.Conduit.Design (
- couchPutView_,
- couchPutView'
+ couchPutView
) where
import Prelude hiding (catch)
-import Control.Exception.Lifted (catch)
+import Control.Monad (void)
+import Control.Exception.Lifted (catch)
-import Data.Conduit (ResourceT)
+import Data.Conduit (ResourceT)
-import qualified Data.ByteString as B
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import qualified Data.HashMap.Lazy as M
-import qualified Data.Aeson as A
-import qualified Data.Aeson.Types as AT
+import qualified Data.ByteString as B
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.HashMap.Lazy as M
+import qualified Data.Aeson as A
+import qualified Data.Aeson.Types as AT
import Database.CouchDB.Conduit.Internal.Connection
(MonadCouch, CouchError, Path, mkPath, Revision)
-import Database.CouchDB.Conduit.Internal.Doc (couchGetWith,
- couchPutWith_, couchPutWith')
+import Database.CouchDB.Conduit.Internal.Doc (couchGetWith, couchPutWith')
--- | Put view in design document if it not exists. If design document does
--- not exist, it will be created.
-couchPutView_ :: MonadCouch m =>
+-- | Put view to design document. If design document does not exist,
+-- it will be created.
+couchPutView :: MonadCouch m =>
Path -- ^ Database
-> Path -- ^ Design document
-> Path -- ^ View name
-> B.ByteString -- ^ Map function
-> Maybe B.ByteString -- ^ Reduce function
- -> ResourceT m Revision
-couchPutView_ = couchViewPutInt True
-
--- | Brute-force version of 'couchViewPut''. Put view in design document.
--- If design document does not exist, it will be created.
-couchPutView' :: MonadCouch m =>
- Path -- ^ Database
- -> Path -- ^ Design document
- -> Path -- ^ View name
- -> B.ByteString -- ^ Map function
- -> Maybe B.ByteString -- ^ Reduce function
- -> ResourceT m Revision
-couchPutView' = couchViewPutInt False
-
------------------------------------------------------------------------------
--- Internal
------------------------------------------------------------------------------
-
-couchViewPutInt :: MonadCouch m =>
- Bool -- ^ Care flag
- -> Path -- ^ Database
- -> Path -- ^ Design document
- -> Path -- ^ View name
- -> B.ByteString -- ^ Map function
- -> Maybe B.ByteString -- ^ Reduce function
- -> ResourceT m Revision
-couchViewPutInt prot db designName viewName mapF reduceF = do
- -- Get design or empty object
+ -> ResourceT m ()
+couchPutView db designName viewName mapF reduceF = do
(_, A.Object d) <- getDesignDoc path
- if prot then couchPutWith_ A.encode path [] $ inferViews (purge_ d)
- else couchPutWith' A.encode path [] $ inferViews (purge_ d)
+ void $ couchPutWith' A.encode path [] $ inferViews (purge_ d)
where
path = designDocPath db designName
inferViews d = A.Object $ M.insert "views" (addView d) d
@@ -75,6 +47,10 @@ couchViewPutInt prot db designName viewName mapF reduceF = do
constructView m (Just r) = A.object ["map" A..= m, "reduce" A..= r]
constructView m Nothing = A.object ["map" A..= m]
+-----------------------------------------------------------------------------
+-- Internal
+-----------------------------------------------------------------------------
+
getDesignDoc :: MonadCouch m =>
Path
-> ResourceT m (Revision, AT.Value)
View
146 src/Database/CouchDB/Conduit/View.hs
@@ -6,36 +6,66 @@
-- "Database.CouchDB.Conduit.Design"
module Database.CouchDB.Conduit.View
-(
+(
-- * Acccessing views #run#
-- $run
couchView,
couchView',
- rowValue
+ couchViewPost,
+ couchViewPost',
+ rowValue,
+
+ -- * View query parameters
+ -- $view_query #view_query#
+ mkParam
)
where
-import Control.Monad.Trans.Class (lift)
-import Control.Applicative ((<|>))
+import Control.Monad.Trans.Class (lift)
+import Control.Applicative ((<|>))
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as BC8
-import qualified Data.HashMap.Lazy as M
-import qualified Data.Aeson as A
-import Data.Attoparsec
+import Data.Monoid (mconcat)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Char8 as BC8
+import qualified Data.HashMap.Lazy as M
+import qualified Data.Aeson as A
+import Data.Attoparsec
-import Data.Conduit (ResourceIO, ResourceT,
+import Data.Conduit (ResourceIO, ResourceT,
Source, Conduit, Sink, ($$), ($=),
sequenceSink, SequencedSinkResponse(..),
resourceThrow )
-import qualified Data.Conduit.List as CL
-import qualified Data.Conduit.Attoparsec as CA
+import qualified Data.Conduit.List as CL
+import qualified Data.Conduit.Attoparsec as CA
+
+import qualified Network.HTTP.Conduit as H
+import qualified Network.HTTP.Types as HT
+
+import Database.CouchDB.Conduit.Internal.Connection
+import Database.CouchDB.Conduit.LowLevel (couch, protect')
+
+-----------------------------------------------------------------------------
+-- View query parameters
+-----------------------------------------------------------------------------
-import qualified Network.HTTP.Conduit as H
-import qualified Network.HTTP.Types as HT
+-- $view_query
+-- For details see
+-- <http://wiki.apache.org/couchdb/HTTP_view_API#Querying_Options>. Note,
+-- because all options must be a proper URL encoded JSON, construction of
+-- complex parameters can be very tedious. To simplify this, use 'mkParam'.
-import Database.CouchDB.Conduit.Internal.Connection
-import Database.CouchDB.Conduit.LowLevel (couch, protect')
+-- | Encode query parameter to 'B.ByteString'.
+--
+-- > mkParam (["a", "b"] :: [String])
+-- > "[\"a\",\"b\"]"
+--
+-- It't just convert lazy 'BL.ByteString' from 'A.encode' to strict
+-- 'B.ByteString'
+mkParam :: A.ToJSON a =>
+ a -- ^ Parameter
+ -> B.ByteString
+mkParam = mconcat . BL.toChunks . A.encode
-----------------------------------------------------------------------------
-- Running
@@ -69,38 +99,74 @@ couchView :: MonadCouch m =>
Path -- ^ Database
-> Path -- ^ Design document
-> Path -- ^ View name
- -> HT.Query -- ^ Query parameters
+ -> HT.Query -- ^ Query parameters
-> ResourceT m (Source m A.Object)
-couchView db designDocName viewName q = do
- H.Response _ _ bsrc <- couch HT.methodGet fullPath [] q
- (H.RequestBodyBS B.empty) protect'
+couchView db design view q = do
+ H.Response _ _ bsrc <- couch HT.methodGet
+ (viewPath db design view)
+ [] q
+ (H.RequestBodyBS B.empty) protect'
return $ bsrc $= conduitCouchView
- where
- fullPath = mkPath [db, "_design", designDocName, "_view", viewName]
-- | Brain-free version of 'couchView'. Takes 'Sink' to consume response.
---
--- > runCouch def $ do
+--
+-- > runCouch def $ do
-- >
--- > -- Print all upon receipt.
--- > couchView' "mydb" "mydesign" "myview" [] $ CL.mapM_ (liftIO . print)
+-- > -- Print all upon receipt.
+-- > couchView' "mydb" "mydesign" "myview" [] $ CL.mapM_ (liftIO . print)
-- >
-- > -- ... Or extract row value and consume
-- > res <- couchView' "mydb" "mydesign" "myview" [] $
-- > rowValue =$ CL.consume
-couchView' :: MonadCouch m =>
- Path -- ^ Database
+couchView' :: MonadCouch m =>
+ Path -- ^ Database
-> Path -- ^ Design document
- -> Path -- ^ View name
+ -> Path -- ^ View name
-> HT.Query -- ^ Query parameters
- -> Sink A.Object m a -- ^ Sink for handle view rows.
+ -> Sink A.Object m a -- ^ Sink for handle view rows.
-> ResourceT m a
-couchView' db designDocName viewName q sink = do
- H.Response _ _ bsrc <- couch HT.methodGet fullPath [] q
- (H.RequestBodyBS B.empty) protect'
- bsrc $= conduitCouchView $$ sink
+couchView' db design view q sink = do
+ raw <- couchView db design view q
+ raw $$ sink
+
+-- | Run CouchDB view in manner like 'H.http' using @POST@ (since CouchDB 0.9).
+-- It's convenient in case that @keys@ paremeter too big for @GET@ query
+-- string. Other query parameters used as usual.
+--
+-- > runCouch def $ do
+-- > src <- couchViewPost "mydb" "mydesign" "myview"
+-- > [("group", Just "true")]
+-- > ["key1", "key2", "key3"]
+-- > src $$ CL.mapM_ (liftIO . print)
+couchViewPost :: (MonadCouch m, A.ToJSON a) =>
+ Path -- ^ Database
+ -> Path -- ^ Design document
+ -> Path -- ^ View name
+ -> HT.Query -- ^ Query parameters
+ -> a -- ^ View @keys@. Must be list or cortege.
+ -> ResourceT m (Source m A.Object)
+couchViewPost db design view q ks = do
+ H.Response _ _ bsrc <- couch HT.methodPost
+ (viewPath db design view)
+ []
+ q
+ (H.RequestBodyLBS mkPost) protect'
+ return $ bsrc $= conduitCouchView
where
- fullPath = mkPath [db, "_design", designDocName, "_view", viewName]
+ mkPost = A.encode $ A.object ["keys" A..= ks]
+
+-- | Brain-free version of 'couchViewPost'. Takes 'Sink' to consume response.
+couchViewPost' :: (MonadCouch m, A.ToJSON a) =>
+ Path -- ^ Database
+ -> Path -- ^ Design document
+ -> Path -- ^ View name
+ -> HT.Query -- ^ Query parameters
+ -> a -- ^ View @keys@. Must be list or cortege.
+ -> Sink A.Object m a -- ^ Sink for handle view rows.
+ -> ResourceT m a
+couchViewPost' db design view q ks sink = do
+ raw <- couchViewPost db design view q ks
+ raw $$ sink
-- | Conduit for extract \"value\" field from CouchDB view row.
rowValue :: ResourceIO m => Conduit A.Object m A.Value
@@ -110,7 +176,15 @@ rowValue = CL.mapM (\v -> case M.lookup "value" v of
("View row does not contain value: " ++ show v))
-----------------------------------------------------------------------------
--- Internal Parser conduit
+-- Internal
+-----------------------------------------------------------------------------
+
+-- | Make full view path
+viewPath :: Path -> Path -> Path -> Path
+viewPath db design view = mkPath [db, "_design", design, "_view", view]
+
+-----------------------------------------------------------------------------
+-- Internal view parser
-----------------------------------------------------------------------------
conduitCouchView :: ResourceIO m => Conduit B.ByteString m A.Object
View
33 test/Database/CouchDB/Conduit/Test/View.hs
@@ -7,7 +7,7 @@ module Database.CouchDB.Conduit.Test.View where
import Test.Framework (testGroup, mutuallyExclusive, Test)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (Assertion, (@=?))
-import Database.CouchDB.Conduit.Test.Util (setupDB, tearDB, conn)
+import Database.CouchDB.Conduit.Test.Util (tearDB, conn)
--import Control.Monad.Trans.Class (lift)
import Control.Exception.Lifted (bracket_)
@@ -31,7 +31,7 @@ import Database.CouchDB.Conduit.Design
tests :: Test
tests = mutuallyExclusive $ testGroup "View" [
- testCase "Create" caseCreateView,
+ testCase "Params" caseMakeParams,
testCase "Big values parsing" caseBigValues,
testCase "With reduce" caseWithReduce,
testCase "update_seq before rows" caseUpdateSeqTop,
@@ -51,22 +51,18 @@ instance A.FromJSON T where
instance A.ToJSON T where
toJSON (T k i s) = A.object ["kind" .= k, "intV" .= i, "strV" .= s]
-caseCreateView :: Assertion
-caseCreateView = bracket_
- (setupDB db)
- (tearDB db) $ runCouch conn $ do
- rev <- couchPutView' db "mydesign" "myview"
- "function(doc){emit(null, doc);}" Nothing
- rev' <- couchRev db "_design/mydesign"
- liftIO $ rev @=? rev'
- where
- db = "cdbc_test_view_create"
+caseMakeParams :: Assertion
+caseMakeParams = do
+ let numP = mkParam (1 :: Int)
+ let bsP = mkParam ("a" :: B.ByteString)
+ let arrP = mkParam (["a", "b", "c"] :: [B.ByteString])
+ liftIO $ ("1","\"a\"","[\"a\",\"b\",\"c\"]") @=? (numP, bsP, arrP)
caseBigValues :: Assertion
caseBigValues = bracket_
(runCouch conn $ do
couchPutDB_ db
- _ <- couchPutView' db "mydesign" "myview"
+ couchPutView db "mydesign" "myview"
"function(doc){emit(doc.intV, doc);}" Nothing
mapM_ (\n -> CCG.couchPut' db (docName n) [] $ doc n) [1..20]
)
@@ -84,7 +80,7 @@ caseWithReduce :: Assertion
caseWithReduce = bracket_
(runCouch conn $ do
couchPutDB_ db
- _ <- couchPutView' db "mydesign" "myview"
+ couchPutView db "mydesign" "myview"
"function(doc){emit(doc.intV, doc.intV);}"
$ Just "function(keys, values){return sum(values);}"
mapM_ (\n -> CCG.couchPut' db (docName n) [] $ doc n) [1..20])
@@ -100,7 +96,7 @@ caseUpdateSeqTop :: Assertion
caseUpdateSeqTop = bracket_
(runCouch conn $ do
couchPutDB_ db
- _ <- couchPutView' db "mydesign" "myview"
+ couchPutView db "mydesign" "myview"
"function(doc){emit(doc.intV, doc.intV);}" Nothing
mapM_ (\n -> CCG.couchPut' db (docName n) [] $ doc n) [1..20])
(tearDB db) $ runCouch conn $ do
@@ -116,18 +112,15 @@ caseUpdateSeqAfter :: Assertion
caseUpdateSeqAfter = bracket_
(runCouch conn $ do
couchPutDB_ db
- _ <- couchPutView' db "mydesign" "myview"
+ couchPutView db "mydesign" "myview"
"function(doc){emit([doc.intV,doc.intV], doc.intV);}" Nothing
mapM_ (\n -> CCG.couchPut' db (docName n) [] $ doc n) [1..20])
(tearDB db) $ runCouch conn $ do
res <- couchView' db "mydesign" "myview"
[("keys",Just "[[0,0]]")] $
(rowValue =$= CCG.toType) =$ CL.consume
liftIO $ res @=? ([] :: [ReducedView])
- res' <- couchView' db "mydesign" "myview"
- [] $
- (rowValue) =$ CL.consume
- liftIO $ print (res')
+
where
db = "cdbc_test_view_after"

0 comments on commit 6c16f4f

Please sign in to comment.