{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}

{- | A convenient wrapper around "Database.CouchDB.Enumerator" and "Data.Aeson.Generic"

The aeson library has the ability to encode and decode JSON using the generic
Data and Typeable classes via the "Data.Aeson.Generic" module.  It isn't too
hard to use 'AG.fromJSON' and 'AG.toJSON' combined with the functions in
"Database.CouchDB.Enumerator", except that in several cases Couch DB uses
system fields /_id/ and /_rev/ which present a small difficulty.

For example, Couch DB will return an object like the following

> {
>    "_id": "somedoc",
>    "_rev": "11-52b4f9b471de393fab82313b9d8571c1",
>    "foo": 3,
>    "bar": true
> }

Also, occasionally (not always) the /_rev/ field must be present in an object
that is sent to Couch DB during a PUT.

The short wrapper functions in this module take care of handling the /_id/
and /_rev/ fields separately from the encoding and decoding to the generic
data structure.

> import Data.Data (Data, Typeable)
> import Data.Bytestring (Bytestring)
> import Database.CouchDB.Enumerator hiding (couchGet, couchPut)
> import qualified Database.CouchDB.Enumerator.Generic as G
> 
> data Rec = Rec {
>     field1 :: Int
>   , field2 :: ByteString
> } deriving (Data, Typeable)
> 
> testCouch :: IO ()
> testCouch = runCouch "localhost" 5984 "test" $ do
>    -- Insert doc
>    rev1 <- G.couchPut "doc1" Nothing [] $ Rec 1 "foo"
>    -- Get doc 
>    G.CouchDoc p r doc1 <- G.couchGet "doc1" []
>    -- New revision
>    rev2 <- G.couchPut "doc1" (Just rev1) [] $ Rec 2 "bar"
-}

module Database.CouchDB.Enumerator.Generic (
    -- * Couch DB documents API for Generic
    CouchDoc(..),
    couchGet,
    couchPut,
    couchPut',
    -- * Couch DB views API for Generic
    consumeView,
    parseGeneric
) where

import Prelude hiding (catch)

import Control.Monad (mzero)
import Control.Exception.Lifted (catch, throw)
import Control.Applicative

import Data.Data (Data)
import Data.Aeson
import qualified Data.Aeson.Generic as AG

import Data.Enumerator (($=), ($$), Enumeratee, run_)
import qualified Data.Enumerator.List as EL (map, consume)

import qualified Network.HTTP.Types as HT

import Database.CouchDB.Enumerator hiding (couchGet, couchPut)
import qualified Database.CouchDB.Enumerator as CE (couchGet, couchPutRev)

-- | CouchDB document with path and revision.
data CouchDoc a = CouchDoc Path Revision a deriving (Show)

-- | Doc signature. Just for parsing.
data DocSig = DocSig String Revision

instance FromJSON DocSig where
    parseJSON (Object v) = DocSig <$>
        v .: "_id" <*>
        v .:? "_rev" .!= ""
    parseJSON _ = mzero

-- | Load a single object from couch DB.
couchGet :: (MonadCouch m, Data a) => 
        Path        -- ^ the dbname is prepended to this string to 
                    --   form the full path.
     -> HT.Query    -- ^ Query arguments.
     -> m (CouchDoc a)
couchGet p q = do
    res <- CE.couchGet p q
    case fromJSON $ Object res of
        Success (DocSig i r) -> return $ CouchDoc i r $ parseObjToGen res
        _ ->  throw $ CouchError Nothing "Error parse signature."

-- | Put an object in Couch DB, returning the new Revision. 
couchPut :: (MonadCouch m, Data a) =>
       Path             -- ^ the dbname is prepended to this string to 
                        --   form the full path.
    -> Revision         -- ^ Revision. Empty string for new documents.
    -> HT.Query         -- ^ Query arguments.
    -> a                -- ^ Data
    -> m Revision
couchPut p r q a = 
    CE.couchPutRev p r q $ AG.toJSON a
    
-- | Brute force version of 'couchPut'. Stores document regardless of presence
--   in database (catches 'couchRev' 'CouchError' /404/). 
--
--   This version is slower that 'couchPut' because it first tries to find the
--   document revision.  
--
--   Also, there are no guarantees that some other thread or
--   program updated the object (and thus generated a new revision) between loading
--   the existing revision and deleting the object.  If this occurs, an error will
--   still be thrown.
couchPut' :: (MonadCouch m, Data a) =>
       Path         -- ^ the dbname is prepended to this string to 
                    --   form the full path.
    -> HT.Query     -- ^ Query arguments.
    -> a            -- ^ Data
    -> m Revision    
couchPut' p q a = do
    rev1 <- catch (couchRev p) handler
    couchPut p rev1 q a
  where
    handler (CouchError (Just 404) _) = return ""
    handler e = throw e

-- | Strictly consumes all view result. Use this if all view data is 
--   mandatory and all errors must be handled.
consumeView :: (MonadCouch m, Data a) =>
       Path        -- ^ the dbname is prepended to this string to 
                   --   form the full path.
    -> HT.Query    -- ^ Query arguments.
    -> m [a]
consumeView p q = 
    run_ $ couchView p q $= extractViewValue $= parseGeneric $$ EL.consume

-- | Parse 'Object' from 'extractViewValue'.
parseGeneric :: (Monad m, Data a) => Enumeratee Object a m b    
parseGeneric = EL.map parseObjToGen

-- | Parse 'Value' to generic.
parseObjToGen :: Data a => Object -> a
parseObjToGen v = case AG.fromJSON $ Object v of
    Success s -> s
    _ -> throw $ CouchError Nothing "Error parse to Generic"