module Database.CouchDB.Conduit.View
(
couchView,
couchView',
rowValue
)
where
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.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 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')
couchView :: MonadCouch m =>
Path
-> Path
-> Path
-> HT.Query
-> 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'
return $ bsrc $= conduitCouchView
where
fullPath = mkPath [db, "_design", designDocName, "_view", viewName]
couchView' :: MonadCouch m =>
Path
-> Path
-> Path
-> HT.Query
-> Sink A.Object m a
-> 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
where
fullPath = mkPath [db, "_design", designDocName, "_view", viewName]
rowValue :: ResourceIO m => Conduit A.Object m A.Value
rowValue = CL.mapM (\v -> case M.lookup "value" v of
(Just o) -> return o
_ -> resourceThrow $ CouchInternalError $ BC8.pack
("View row does not contain value: " ++ show v))
conduitCouchView :: ResourceIO m => Conduit B.ByteString m A.Object
conduitCouchView = sequenceSink () $ \() -> do
b <- CA.sinkParser viewStart
if b then return $ StartConduit viewLoop
else return Stop
viewLoop :: ResourceIO m => Conduit B.ByteString m A.Object
viewLoop = sequenceSink False $ \isLast ->
if isLast then return Stop
else do
v <- CA.sinkParser (A.json <?> "json object")
vobj <- case v of
(A.Object o) -> return o
_ -> lift $ resourceThrow $
CouchInternalError "view entry is not an object"
res <- CA.sinkParser (commaOrClose <?> "comma or close")
case res of
Comma -> return $ Emit False [vobj]
CloseBracket -> return $ Emit True [vobj]
data CommaOrCloseBracket = Comma | CloseBracket
commaOrClose :: Parser CommaOrCloseBracket
commaOrClose = do
skipWhile (\c -> c /= 44 && c /= 93) <?>
"Checking for next comma"
w <- anyWord8
if w == 44 then return Comma else return CloseBracket
viewStart :: Parser Bool
viewStart = do
_ <- string "{"
_ <- option "" $ string "\"total_rows\":"
option () $ skipWhile (\x -> x >= 48 && x <= 57)
_ <- option "" $ string ",\"offset\":"
option () $ skipWhile (\x -> x >= 48 && x <= 57)
_ <- option "" $ string ","
_ <- string "\"rows\":["
(string "]}" >> return False) <|> return True