module Database.CouchDB.ViewServer.Reduce
(
ReduceSignature
, ViewReduce
, module Database.CouchDB.ViewServer.Parse
, logMsg
, ReduceOutput
, ReduceFunc
, toReduceFunc
, reduceFuncInterpreter
, execReduceFunc
) where
import Data.Maybe
import Data.Typeable
import Data.Aeson (toJSON, ToJSON)
import Data.Aeson.Types (Value(..), Object, Parser, parseMaybe)
import Control.Applicative
import Control.Monad.Trans.Writer (WriterT, tell, runWriterT)
import qualified Language.Haskell.Interpreter as H
import Database.CouchDB.ViewServer.Internal
import Database.CouchDB.ViewServer.Parse
type ReduceOutput = (Value, [LogMessage])
type ViewReduceT m a = WriterT [LogMessage] m a
type ViewReduce a = ViewReduceT Parser a
type ReduceSignature a = [Value] -> [Value] -> Bool -> ViewReduce a
newtype ReduceFunc = ReduceFunc { runReduceFunc :: ReduceSignature Value }
deriving (Typeable)
toReduceFunc :: ToJSON a => ReduceSignature a -> ReduceFunc
toReduceFunc f = ReduceFunc $ \k v r -> toJSON <$> f k v r
reduceFuncInterpreter :: [H.OptionVal H.Interpreter] -> [(H.ModuleName, Maybe String)] -> String -> H.Interpreter ReduceFunc
reduceFuncInterpreter opts mods source = do
H.set opts
H.setImportsQ $ mods ++ [("Database.CouchDB.ViewServer.Reduce", Nothing)]
H.interpret ("toReduceFunc " ++ H.parens source) (H.as :: ReduceFunc)
execReduceFunc :: ReduceFunc -> [Value] -> [Value] -> Bool -> ReduceOutput
execReduceFunc reduceFunc keys values rereduce = fromMaybe (Null, []) $ parseMaybe runWriterT (runReduceFunc reduceFunc keys values rereduce)
logMsg :: String -> ViewReduce ()
logMsg msg = tell [LogMessage msg]