couch-hs 0.1.2 → 0.1.3

raw patch · 3 files changed

+23/−17 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• couch-hs.cabal +1/−1
• source/Database/CouchDB/ViewServer.hs +5/−4
• source/Database/CouchDB/ViewServer/Main/Server.hs +17/−12

@@ -1,5 +1,5 @@ name: couch-hs-version: 0.1.2+version: 0.1.3 cabal-version: >= 1.6 build-type: Simple license: PublicDomain

@@ -158,8 +158,8 @@     >\doc -> let net credits shares = let debts = shareAmounts (sumMap credits) (sumMap shares) shares     >                                 in  M.unionWith (+) credits debts     >-    >            sumMap = M.fold (+) 0     >            shareAmounts totCredit totShares = M.map (\shares -> -(shares / totShares) * totCredit)+    >            sumMap = M.fold (+) 0     >     >        in  do date <- doc .: "date" :: ViewMap T.Text     >               what <- doc .:? "what" :: ViewMap (Maybe T.Text) -- Optional field@@ -170,9 +170,10 @@     >     >               emit date $ object ["net" .= net credits shares, "what" .= what] -    >\_ values _ -> do objects <- parseJSONList values :: ViewReduce [J.Object]-    >                  nets <- mapM (.: "net") objects :: ViewReduce [M.Map T.Text Double]-    >                  return $ L.foldl' (M.unionWith (+)) M.empty nets+    >\_ values rereduce -> L.foldl' (M.unionWith (+)) M.empty <$>+    >    case rereduce of+    >        False -> mapM (.: "net") =<< parseJSONList values :: ViewReduce [(M.Map T.Text Double)]+    >        True  -> parseJSONList values :: ViewReduce [(M.Map T.Text Double)]      Map results: 

@@ -36,23 +36,25 @@   data ServerState = ServerState- { stateMapFuncs :: [MapFunc]+ { stateContext :: Context+ , stateMapFuncs :: [MapFunc]  , stateReduceFuncs :: [(Text, ReduceFunc)]  } -initialServerState = ServerState- { stateMapFuncs = []+initialServerState context = ServerState+ { stateContext = context+ , stateMapFuncs = []  , stateReduceFuncs = []  } -type LineProcessor a = StateT ServerState (ReaderT Context IO) a+type LineProcessor a = StateT ServerState IO a  type ResponseValue = J.Value   runServer :: Context -> IO ExitCode runServer context = do hSetBuffering stdout LineBuffering-                       runReaderT (evalStateT processLines initialServerState) context+                       evalStateT processLines $ initialServerState context                        return ExitSuccess  @@ -79,7 +81,7 @@ {- Log the input line to a file, if requested in the command-line arguments. -} logInputLine :: B.ByteString -> LineProcessor () logInputLine line = do-    commandLog <- askInputLog+    commandLog <- getInputLog     case commandLog of         Just handle -> liftIO $ B.hPutStrLn handle line         Nothing     -> return ()@@ -115,7 +117,7 @@  processAddFun :: Text -> LineProcessor ResponseValue processAddFun code = do-    mapInterpreter <- askMapFuncInterpreter+    mapInterpreter <- getMapFuncInterpreter     eitherFunc <- liftIO $ H.runInterpreter $ mapInterpreter (B.unpack $ T.E.encodeUtf8 code)     case eitherFunc of         Left err   -> return $ compileErrorValue $ "Map: " ++ show err@@ -159,7 +161,7 @@ -} eitherReduceFuncs :: [Text] -> LineProcessor (Either String [ReduceFunc]) eitherReduceFuncs codes = do-    reduceInterpreter <- askReduceFuncInterpreter+    reduceInterpreter <- getReduceFuncInterpreter     eitherFuncs <- mapM getReduceFunc codes     let errors = lefts eitherFuncs     if null errors@@ -177,7 +179,7 @@  loadReduceFunc :: Text -> LineProcessor (Either H.InterpreterError ReduceFunc) loadReduceFunc code = do-    interpreter <- askReduceFuncInterpreter+    interpreter <- getReduceFuncInterpreter     eitherFunc <- liftIO $ H.runInterpreter $ interpreter (B.unpack $ T.E.encodeUtf8 code)     case eitherFunc of         Left _     -> return eitherFunc@@ -192,9 +194,12 @@ {-     Monad transformer wrappers. -}-askMapFuncInterpreter = ctxMapFuncInterpreter <$> lift ask-askReduceFuncInterpreter = ctxReduceFuncInterpreter <$> lift ask-askInputLog = ctxInputLog <$> lift ask+getMapFuncInterpreter = ctxMapFuncInterpreter <$> getContext+getReduceFuncInterpreter = ctxReduceFuncInterpreter <$> getContext+getInputLog = ctxInputLog <$> getContext++getContext :: LineProcessor Context+getContext = stateContext <$> get  getMapFuncs :: LineProcessor [MapFunc] getMapFuncs = stateMapFuncs <$> get