persistent-mongoDB 0.6.2 → 0.6.3

raw patch · 2 files changed

+41/−2 lines, 2 filesdep +data-objectdep +neitherdep ~persistentPVP ok

version bump matches the API change (PVP)

Dependencies added: data-object, neither

Dependency ranges changed: persistent

API changes (from Hackage documentation)

Files

• Database/Persist/MongoDB.hs +37/−0
• persistent-mongoDB.cabal +4/−2

@@ -4,6 +4,8 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE PackageImports, RankNTypes #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Persist.MongoDB     ( withMongoDBConn@@ -19,6 +21,7 @@     , (DB.=:)     , ConnectionPool     , module Database.Persist+    , MongoConf (..)     ) where  import Database.Persist@@ -41,6 +44,8 @@ import qualified System.IO.Pool as Pool import Web.PathPieces (SinglePiece (..)) import Control.Monad.IO.Control (MonadControlIO)+import Data.Object+import Data.Neither (MEither (..), meither)  #ifdef DEBUG import FileLocation (debug)@@ -440,3 +445,35 @@ dummyFromUnique _ = error "dummyFromUnique" dummyFromFilts :: [Filter v] -> v dummyFromFilts _ = error "dummyFromFilts"++-- | Information required to connect to a mongo database+data MongoConf = MongoConf+    { mgDatabase :: String+    , mgHost     :: String+    , mgPoolSize :: Int+    }++instance PersistConfig MongoConf where+    type PersistConfigBackend MongoConf = DB.Action+    type PersistConfigPool MongoConf = ConnectionPool+    withPool (MongoConf db host poolsize) = withMongoDBPool (u db) host poolsize+    runPool _ = runMongoDBConn (DB.ConfirmWrites [u"j" DB.=: True])+    loadConfig e' = meither Left Right $ do+        e <- go $ fromMapping e'+        db <- go $ lookupScalar "database" e+        host <- go $ lookupScalar "host" e+        pool' <- go $ lookupScalar "poolsize" e+        pool <- safeRead "poolsize" pool'++        return $ MongoConf (T.unpack db) (T.unpack host) pool+      where+        go :: MEither ObjectExtractError a -> MEither String a+        go (MLeft e) = MLeft $ show e+        go (MRight a) = MRight a++safeRead :: String -> T.Text -> MEither String Int+safeRead name t = case reads s of+    (i, _):_ -> MRight i+    []       -> MLeft $ concat ["Invalid value for ", name, ": ", s]+  where+    s = T.unpack t

@@ -1,5 +1,5 @@ name:            persistent-mongoDB-version:         0.6.2+version:         0.6.3 license:         BSD3 license-file:    LICENSE author:          Greg Weber <greg@gregweber.info>@@ -14,7 +14,7 @@  library     build-depends:   base               >= 4 && < 5-                   , persistent         >= 0.6.0 && < 0.7.0+                   , persistent         >= 0.6.3 && < 0.7.0                    , template-haskell   >= 2.4     && < 2.7                    , text               >= 0.8     && < 0.12                    , transformers       >= 0.2.1   && < 0.3@@ -28,6 +28,8 @@                    , cereal             >= 0.3.0.0                    , path-pieces        >= 0.0     && < 0.1                    , monad-control      >= 0.2     && < 0.3+                   , data-object        >= 0.3     && < 0.4+                   , neither            >= 0.3     && < 0.4      exposed-modules: Database.Persist.MongoDB     ghc-options:     -Wall