couchdb-conduit 0.9.0 → 0.10.0

raw patch · 6 files changed

+262/−244 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• couchdb-conduit.cabal +5/−3
• src/Database/CouchDB/Conduit/View.hs +23/−220
• src/Database/CouchDB/Conduit/View/Query.hs +196/−0
• test/Database/CouchDB/Conduit/Test/Query.hs +32/−0
• test/Database/CouchDB/Conduit/Test/View.hs +0/−17
• test/Main.hs +6/−4

@@ -1,5 +1,5 @@ name:           couchdb-conduit-version:        0.9.0
+version:        0.10.0
 cabal-version:  >= 1.8 build-type:     Simple stability:      Testing
@@ -54,7 +54,8 @@                     Database.CouchDB.Conduit.Generic,
                     Database.CouchDB.Conduit.Implicit,
                     Database.CouchDB.Conduit.LowLevel,
-                    Database.CouchDB.Conduit.View
+                    Database.CouchDB.Conduit.View,
+                    Database.CouchDB.Conduit.View.Query
   other-modules:    
                     Database.CouchDB.Conduit.Internal.Doc,
                     Database.CouchDB.Conduit.Internal.Parser,
@@ -98,5 +99,6 @@                    Database.CouchDB.Conduit.Test.Explicit,
                    Database.CouchDB.Conduit.Test.Generic,
                    Database.CouchDB.Conduit.Test.Util,
-                   Database.CouchDB.Conduit.Test.View
+                   Database.CouchDB.Conduit.Test.View,
+                   Database.CouchDB.Conduit.Test.Query
 

@@ -2,6 +2,10 @@ {-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, NoMonomorphismRestriction #-} 
 
 -- | Higher-level functions to interact with CouchDB views.
+--   
+--   To automate creation of CouchDB Query Options see
+--   "Database.CouchDB.Conduit.View.Query"
+--
 --   To manipulate views in design documents see 
 --   "Database.CouchDB.Conduit.Design"
 
@@ -14,54 +18,18 @@     couchViewPost,
     couchViewPost_,
     rowValue,
-
-    -- * View query parameters
-    -- $view_query #view_query#
-    viewQpUnit,
-    viewQp,
-    viewQpBS,
-    viewQpInt,
-    viewQpTrue,
-    viewQpFalse,
-    
-    -- ** Rows
-    -- $view_query_rows #view_query_rows#
-    viewQpDescending,
-    viewQpLimit,
-    viewQpSkip,
-    viewQpStartId,
-    viewQpEndId,
-
-    -- ** Map/Reduce
-    -- $view_query_reduce #view_query_reduce#
-    viewQpGroup,
-    viewQpGroupLevel,
-    viewQpReduceOff,
-    viewQpReduceOn,
-    
-    -- ** Keys
-    -- $view_query_keys #view_query_keys#
-    viewQpKey,
-    viewQpStartKey,
-    viewQpEndKey,
-    viewQpKeys,
-
-    -- ** Control
-    -- $view_query_control #view_query_control#
-    viewQpIncludeDocs,
-    viewQpInclusiveEnd
-)
- where
+    rowDoc,
+    rowField,
+) where
 
 import Control.Exception.Lifted (throw)
 
-import Data.Monoid (mconcat)
 import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Char8 as BS8
+import qualified Data.Text as T
 import qualified Data.HashMap.Lazy as M
-import qualified Data.HashMap.Strict as MS
 import qualified Data.Aeson as A
+import Data.String.Conversions (cs, (<>))
 import Data.Attoparsec
 
 import qualified Data.Vector.Generic as V
@@ -79,180 +47,6 @@ import Database.CouchDB.Conduit.Internal.Connection
 import Database.CouchDB.Conduit.LowLevel (couch, protect')
 
------------------------------------------------------------------------------
--- View query parameters
------------------------------------------------------------------------------
-
--- $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 following
--- functions. 
-
--- | Not query parameter. Returns empty 'MS.HashMap'. Aeson will convert 
---   this to @\{\}@ (JSON unit). This useful for @startkey@ and @endkey@.
-viewQpUnit :: MS.HashMap B.ByteString Bool
-viewQpUnit = MS.empty
-
--- | Make complex view query parameter.  
---
--- > viewQP "key" (["a", "b"] :: [String])
--- > ("key", Just "[\"a\",\"b\"]")
---
--- It't just convert lazy 'BL.ByteString' from 'A.encode' to strict 
--- 'B.ByteString'. For more efficient use specific functions. 
-viewQp :: A.ToJSON a =>
-       B.ByteString     -- ^ Query parameter name
-    -> a                -- ^ Parameter
-    -> HT.QueryItem
-viewQp n v = (n, Just $ mconcat . BL.toChunks . A.encode $ v)
-
--- | Make quoted 'B.ByteString' query parameter.
-viewQpBS :: B.ByteString -> B.ByteString -> HT.QueryItem
-viewQpBS n v = (n, Just $ "\"" `B.append` v `B.append` "\"")
-
--- | Make 'Int' query parameter.
-viewQpInt :: B.ByteString -> Int -> HT.QueryItem
-viewQpInt n v = (n, Just $ BS8.pack . show $ v)
-
--- | Make @...=true@ query parameter.
-viewQpTrue :: B.ByteString -> HT.QueryItem
-viewQpTrue n = (n, Just "true")
-
--- | Make @...=true@ query parameter.
-viewQpFalse :: B.ByteString -> HT.QueryItem
-viewQpFalse n = (n, Just "false")
-
--- $view_query_rows
--- Helpers for sorting and limiting rows. 
-
--- $view_query_reduce
--- Helpers for Map/Reduce. 
-
--- $view_query_keys
--- Helpers for quering by keys. 
-
--- $view_query_control
--- Helpers for view behaviour. 
-
----------------------------
--- Boolean query parameters
----------------------------
-
--- | Turn on descending sort of view results. 
---   Shorthand for @viewQpTrue \"descending\"@.
-viewQpDescending :: HT.QueryItem
-viewQpDescending = viewQpTrue "descending"
-
--- | Turn on grouping.
---   Shorthand for @viewQpTrue \"group\"@.
-viewQpGroup :: HT.QueryItem
-viewQpGroup = viewQpTrue "group"
-
--- | Turn on inclusion docs in view results.
---   Shorthand for @viewQpTrue \"include_docs\"@.
-viewQpIncludeDocs :: HT.QueryItem
-viewQpIncludeDocs = viewQpTrue "include_docs"
-
--- | Turn off inclusion @endkey@ in view results.
---   Shorthand for @viewQpFalse \"inclusive_end\"@.
-viewQpInclusiveEnd :: HT.QueryItem
-viewQpInclusiveEnd = viewQpFalse "inclusive_end"
-
--- | Force off reduce if a reduce function is defined.
---   Shorthand for @viewQpFalse \"reduce\"@.
-viewQpReduceOff :: HT.QueryItem
-viewQpReduceOff = viewQpFalse "reduce"
-
--- | Force on reduce if a reduce function is not defined.
---   Shorthand for @viewQpTrue \"reduce\"@.
-viewQpReduceOn :: HT.QueryItem
-viewQpReduceOn = viewQpTrue "reduce"
-
---------------
--- Pure string
---------------
-
--- | Document id to start with.
---   Shorthand for @viewQpBS \"startkey_docid\"@.
-viewQpStartId :: 
-       Path             -- ^ Document ID.
-    -> HT.QueryItem
-viewQpStartId = viewQpBS "startkey_docid"
-
--- | Last document id to include in the output.
---   Shorthand for @viewQpBS \"endkey_docid\"@.
-viewQpEndId :: 
-       Path             -- ^ Document ID.
-    -> HT.QueryItem
-viewQpEndId = viewQpBS "endkey_docid"
-
---------------
--- Numeric
---------------
-
--- | Limit view rows. 
---   Shorthand for @viewQpInt \"limit\"@.
-viewQpLimit :: 
-       Int              -- ^ Max number of rows.
-    -> HT.QueryItem
-viewQpLimit = viewQpInt "limit"
-
--- | Skip view rows. 
---   Shorthand for @viewQpInt \"skip\"@.
-viewQpSkip :: 
-       Int              -- ^ Number of rows to skip. 
-    -> HT.QueryItem
-viewQpSkip = viewQpInt "skip"
-
--- | Set grouping level. 
---   Shorthand for @viewQpInt \"group_level\"@.
-viewQpGroupLevel :: 
-       Int          -- ^ Grouping level. 
-    -> HT.QueryItem
-viewQpGroupLevel = viewQpInt "group_level"
-
---------------
--- Complex
---------------
-
--- | Make @key=...@ query parameter.
---   Shorthand for @viewQp \"key\"@.
-viewQpKey :: A.ToJSON a => 
-       a                -- ^ Key 
-    -> HT.QueryItem
-viewQpKey = viewQp "key"
-
--- | Row key to start with.
---   Shorthand for @viewQp "startkey"@
-viewQpStartKey :: A.ToJSON a =>
-       a                -- ^ Start Key value
-    -> HT.QueryItem
-viewQpStartKey = viewQp "startkey"
-
--- | Row key to end with.
---   Shorthand for @viewQp "endkey"@
-viewQpEndKey :: A.ToJSON a =>
-       a                -- ^ Start Key value
-    -> HT.QueryItem
-viewQpEndKey = viewQp "endkey"
-
-
--- | Make @keys=...@ query parameter. 
---   Shorthand for @viewQp \"keys\"@.
---
---   Use it only with 'couchView' and 'couchView''. For large sets of @keys@
---   use 'couchViewPost' and 'couchViewPost''
-viewQpKeys :: A.ToJSON a => 
-       a                -- ^ Keys. Must be list or cortege. 
-    -> HT.QueryItem
-viewQpKeys = viewQp "keys"
-
------------------------------------------------------------------------------
--- Running
------------------------------------------------------------------------------
-
 -- $run
 -- In contrast to the functions of access to documents that are loaded into 
 -- memory entirely. 'couchView' and 'couchView'' combines the incredible power 
@@ -317,7 +111,7 @@ -- 
 -- > runCouch def $ do
 -- >     src <- couchViewPost "mydb" "mydesign" "myview" 
--- >             [("group", Just "true")]
+-- >             (mkQuery [QPGroup])
 -- >             ["key1", "key2", "key3"]  -- >     src $$ CL.mapM_ (liftIO . print)
 couchViewPost :: (MonadCouch m, A.ToJSON a) =>
@@ -352,11 +146,20 @@ 
 -- | Conduit for extract \"value\" field from CouchDB view row.
 rowValue :: Monad m => Conduit A.Object m A.Value
-rowValue = CL.mapM (\v -> case M.lookup "value" v of
-            (Just o) -> return o
-            _ -> throw $ CouchInternalError $ BS8.pack
-                    ("View row does not contain value: " ++ show v))
+rowValue = rowField "value"
 
+-- | Conduit for extract \"doc\" field from CouchDB view row. 
+--   Use only with @include_docs=true@ query parameter.
+rowDoc :: Monad m => Conduit A.Object m A.Value
+rowDoc = rowField "doc"
+
+-- | Extract field from view row
+rowField :: Monad m => T.Text -> Conduit A.Object m A.Value
+rowField f = CL.mapM (\v -> case M.lookup f v of
+            (Just o) -> return o
+            _ -> throw $ CouchInternalError $ 
+                "View row does not contain \"" <> cs f <> "\": " <> cs (show v)
+            ) 
 -----------------------------------------------------------------------------
 -- Internal
 -----------------------------------------------------------------------------

@@ -0,0 +1,196 @@+{-# LANGUAGE OverloadedStrings, ExistentialQuantification #-} 
+
+-- | CouchDB View Query options.
+--
+--   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 'mkQuery'.
+ 
+module Database.CouchDB.Conduit.View.Query (
+    -- * Creating Query
+    CouchQP(..),
+    mkQuery,
+    
+    -- * Parameter helpers
+    qpUnit,
+    qpNull
+) where
+
+import qualified Data.ByteString as B
+import qualified Data.HashMap.Strict as MS
+import qualified Data.Aeson as A
+import Data.String.Conversions (cs, (<>))
+
+import qualified Network.HTTP.Types as HT
+
+import Database.CouchDB.Conduit.Internal.Connection (Path)
+
+-- | CouchDB Query options primitives.
+data CouchQP =
+      forall a . A.ToJSON a => QPComplex B.ByteString a
+        -- ^ Complex view query parameter.  
+        --
+        -- > couchQP [QPComplex "param" (["a", "b"] :: [String])]
+        -- > [("param", Just "[\"a\",\"b\"]")]
+        -- > ...?param=["a","b"]
+        -- > 
+        -- > couchQP [QPComplex "key" (("a", 1) :: (String, Int))]
+        -- > [("key", Just "[\"a\",0]")]
+        -- > ...?param=["a",0]
+        --
+        -- It't just convert lazy 'BL.ByteString' from 'A.encode' to strict 
+        -- 'B.ByteString'. For more efficient use specific functions. 
+    
+    | QPBS B.ByteString B.ByteString
+        -- ^ Quoted 'B.ByteString' query parameter.
+        --
+        -- > ...?param="value" 
+    
+    | QPInt B.ByteString Int
+        -- ^ 'Int' query parameter.
+        --
+        -- > ...?param=100 
+    
+    | QPBool B.ByteString Bool
+        -- ^ 'Bool' query parameter.
+        --
+        -- > ...?param=true
+    
+    | QPLimit Int
+        -- ^ Limit rows. Use @Zero (0)@ to omit.
+        --
+        -- > ...?limit=5 
+    
+    | QPSkip Int
+        -- ^ Skip rows. Use @Zero (0)@ to omit.
+        --
+        -- > ...?skip=10
+    
+    | QPStale Bool
+        -- ^ Stale view. On @True@ sets @stale@ parameter to @ok@, else 
+        --   sets it to @update_after@.
+        --    
+        -- > ...?stale=ok
+        -- > ...?stale=update_after
+    
+    | forall a . A.ToJSON a => QPKey a
+        -- ^ @key=...@ query parameter.
+        -- > key=...
+        
+    | forall a . A.ToJSON a => QPStartKey a
+        -- ^ Row key to start with. Becomes @endkey@ if @descending@ turned on. 
+        --   See 'couchQuery'. 
+        --
+        -- > ...?startkey=...
+        -- > ...?descending=true?endkey=...
+        
+    | forall a . A.ToJSON a => QPEndKey a
+        -- ^ Row key to start with. Becomes @startkey@ if @descending@ 
+        --   turned on. See 'couchQuery'. 
+        --
+        -- > ...?endkey=...
+        -- > ...?descending=true?startkey=...
+        
+    | forall a . A.ToJSON a => QPKeys a
+        -- ^ Row key to start with. Use only with 'couchView' and 
+        --   'couchView_'. For large sets of @keys@ use 'couchViewPost' and 
+        --   'couchViewPost_'
+        --
+        -- > ...?keys=...
+        
+    | QPGroup
+        -- ^ Turn on grouping.
+        --
+        -- > ...?group=true
+    | QPGroupLevel Int
+        -- ^ Set grouping level. Use @Zero (0)@ to omit.
+        --
+        -- > ...?group_level=2
+    | QPReduce Bool
+        -- ^ Control reduce.
+        --
+        -- > ...?reduce=true
+        -- > ...?reduce=false
+        
+    | QPIncludeDocs
+        -- ^ Turn on inclusion docs in view results.
+        --
+        -- > ...?include_docs=true
+        
+    | QPInclusiveEnd
+        -- ^ Turn off inclusion @endkey@ in view results.
+        --
+        -- > ...?inclusive_end=false
+
+    | QPUpdateSeq
+        -- ^ Response includes an update_seq value indicating which sequence 
+        --   id of the database the view reflects
+        --
+        -- > ...?update_seq=true
+        
+    | QPStartKeyDocId Path
+        -- ^ Document id to start with.
+        --
+        -- > ...?startkey_docid=...
+    | QPEndKeyDocId Path
+        -- ^ Document id to end with.
+        --
+        -- > ...?endkey_docid=...
+        
+-- | Make CouchDB query options.
+mkQuery :: 
+       Bool         -- ^ Descending sort order. On @True@ adds 
+                    --   @descending@ to query. Also swaps 
+                    --   @start_key@ and @end_key@ parameters            
+    -> [CouchQP]    -- ^ Query options.
+    -> HT.Query
+mkQuery desc = 
+    parseDesc desc . concatMap parseqp
+  where
+    parseDesc True = (("descending", Just "true"):)
+    parseDesc False = id
+    parseqp (QPComplex n v) = [(n, Just $ cs . A.encode $ v)]  
+    parseqp (QPBS n v) = [(n, Just $ "\"" <> v <> "\"")]  
+    parseqp (QPInt n v) = [(n, Just $ cs . show $ v)]  
+    parseqp (QPBool n True) = [(n, Just "true")]  
+    parseqp (QPBool n False) = [(n, Just "false")]  
+    parseqp (QPLimit v) = intZeroQp "limit" v  
+    parseqp (QPSkip v) = intZeroQp "skip" v
+    parseqp (QPStale True) = [("stale", Just "ok")]
+    parseqp (QPStale False) = [("stale", Just "update_after")]
+    parseqp (QPKey v) = parseqp $ QPComplex "key" v
+    parseqp (QPKeys v) = parseqp $ QPComplex "keys" v
+    parseqp (QPStartKey v) = parseqp $ QPComplex 
+            (descDep "startkey" "endkey") v
+    parseqp (QPEndKey v) = parseqp $ QPComplex 
+            (descDep "endkey" "startkey") v
+    parseqp QPGroup = boolqp "group" True  
+    parseqp (QPGroupLevel v) = intZeroQp "group_level" v  
+    parseqp (QPReduce v) = boolqp "reduce" v
+    parseqp QPIncludeDocs = boolqp "include_docs" True
+    parseqp QPInclusiveEnd = boolqp "inclusive_end" False
+    parseqp QPUpdateSeq = boolqp "update_seq" True
+    parseqp (QPStartKeyDocId v) = parseqp $ QPComplex "startkey_docid" v
+    parseqp (QPEndKeyDocId v) = parseqp $ QPComplex "endkey_docid" v
+    
+    -- | Boolean
+    boolqp n v = parseqp $ QPBool n v
+    -- | Ommitable int
+    intZeroQp _ 0 = []
+    intZeroQp n v = parseqp $ QPInt n v
+    -- | Descending dependent param
+    descDep a b = if desc then b else a
+
+
+
+-- | Returns empty 'MS.HashMap'. Aeson will convert 
+--   this to @\{\}@ (JSON unit). This useful for @startkey@ and @endkey@.
+--   
+-- > couchQuery [QPStartKey (1, 0), QPEndKey (1, {})]
+qpUnit :: MS.HashMap B.ByteString Bool
+qpUnit = MS.empty
+
+-- | Simply return 'A.Null'.
+qpNull :: A.Value
+qpNull = A.Null

@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-} 
+
+-- | Query tests
+
+module Database.CouchDB.Conduit.Test.Query (tests) where
+
+import Test.Framework (testGroup, mutuallyExclusive, Test)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit (Assertion, (@=?))
+
+import Control.Monad.IO.Class (liftIO)
+
+import Database.CouchDB.Conduit.View.Query
+
+tests :: Test
+tests = mutuallyExclusive $ testGroup "Generic" [
+    testCase "Descending" caseDescending
+    ]
+
+caseDescending :: Assertion    
+caseDescending = liftIO $ do
+    mkQuery False [QPInt "i" 0] @=? [("i", Just "0")]
+    mkQuery True [QPInt "i" 0] @=? 
+            [desc, ("i", Just "0")]
+    let swappable = [QPStartKey (0::Int), QPEndKey (1::Int)]
+    mkQuery False swappable @=? 
+            [("startkey", Just "0"), ("endkey", Just "1")]
+    mkQuery True swappable @=? 
+            [desc, ("endkey", Just "0"), ("startkey", Just "1")]
+  where
+    desc = ("descending", Just "true")
+

@@ -18,8 +18,6 @@ import Data.String.Conversions ((<>), cs)
 import qualified Data.Aeson as A
 import Data.Aeson ((.:), (.=))
-import qualified Data.HashMap.Strict as H
---import qualified Data.Aeson.Generic as AG
 import Data.Generics (Data, Typeable)
 import Data.Conduit
 import qualified Data.Conduit.List as CL
@@ -32,7 +30,6 @@ 
 tests :: Test
 tests = mutuallyExclusive $ testGroup "View" [
-    testCase "Params" caseMakeParams,
     testCase "Big values parsing" caseBigValues,
     testCase "With reduce" caseWithReduce,
     testCase "update_seq before rows" caseUpdateSeqTop,
@@ -51,20 +48,6 @@    
 instance A.ToJSON T where
    toJSON (T k i s) = A.object ["kind" .= k, "intV" .= i, "strV" .= s]
-
-caseMakeParams :: Assertion
-caseMakeParams = do
-    let numP = viewQpInt "numP" 1
-    let bsP = viewQpBS "bsP" "a"
-    let arrP = viewQp "arrP" (["a", "b", "c"] :: [B.ByteString])
-    let tupleP = viewQp "tupleP" (1 :: Int, H.empty :: H.HashMap String Int)
-    liftIO $ (
-            ("numP", Just "1"),
-            ("bsP", Just "\"a\""),
-            ("arrP", Just "[\"a\",\"b\",\"c\"]"),
-            ("tupleP", Just "[1,{}]")
-            ) 
-            @=? (numP, bsP, arrP, tupleP)
 
 caseBigValues :: Assertion
 caseBigValues = bracket_

@@ -7,12 +7,14 @@ import qualified Database.CouchDB.Conduit.Test.Explicit
 import qualified Database.CouchDB.Conduit.Test.Generic
 import qualified Database.CouchDB.Conduit.Test.View
+import qualified Database.CouchDB.Conduit.Test.Query
 
 main :: IO ()
 main = defaultMain [
-      Database.CouchDB.Conduit.Test.Base.tests
-    , Database.CouchDB.Conduit.Test.Explicit.tests
-    , Database.CouchDB.Conduit.Test.Generic.tests
-    , Database.CouchDB.Conduit.Test.View.tests
+--    Database.CouchDB.Conduit.Test.Base.tests,
+--    Database.CouchDB.Conduit.Test.Explicit.tests,
+--    Database.CouchDB.Conduit.Test.Generic.tests,
+--    Database.CouchDB.Conduit.Test.View.tests,
+    Database.CouchDB.Conduit.Test.Query.tests
     ]