mongo 6: fix issue on collections with '.'
Collection names are allowed to have a '.' in their name, db names aren't (see https://www.mongodb.com/docs/manual/reference/limits/#naming-restrictions) This codes changes the logic to extract the collection name form a FullConnecton string by stripping until the first dot, and provides a test case.
This commit is contained in:
parent
995087e9a0
commit
51358d13c4
3 changed files with 14 additions and 3 deletions
|
@ -92,6 +92,9 @@ bitOr = foldl (.|.) 0
|
||||||
-- ^ Concat first and second together with period in between. Eg. @\"hello\" \<.\> \"world\" = \"hello.world\"@
|
-- ^ Concat first and second together with period in between. Eg. @\"hello\" \<.\> \"world\" = \"hello.world\"@
|
||||||
a <.> b = T.append a (T.cons '.' b)
|
a <.> b = T.append a (T.cons '.' b)
|
||||||
|
|
||||||
|
splitDot :: Text -> (Text, Text)
|
||||||
|
splitDot t = let (pre, post) = T.break (== '.') t in (pre, T.drop 1 post)
|
||||||
|
|
||||||
true1 :: Label -> Document -> Bool
|
true1 :: Label -> Document -> Bool
|
||||||
-- ^ Is field's value a 1 or True (MongoDB use both Int and Bools for truth values). Error if field not in document or field not a Num or Bool.
|
-- ^ Is field's value a 1 or True (MongoDB use both Int and Bools for truth values). Error if field not in document or field not a Num or Bool.
|
||||||
true1 k doc = case valueAt k doc of
|
true1 k doc = case valueAt k doc of
|
||||||
|
|
|
@ -133,7 +133,7 @@ import Database.MongoDB.Internal.Protocol
|
||||||
)
|
)
|
||||||
import Control.Monad.Trans.Except
|
import Control.Monad.Trans.Except
|
||||||
import qualified Database.MongoDB.Internal.Protocol as P
|
import qualified Database.MongoDB.Internal.Protocol as P
|
||||||
import Database.MongoDB.Internal.Util (liftIOE, loop, true1, (<.>))
|
import Database.MongoDB.Internal.Util (liftIOE, loop, true1, (<.>), splitDot)
|
||||||
import System.Mem.Weak (Weak)
|
import System.Mem.Weak (Weak)
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
import Prelude hiding (lookup)
|
import Prelude hiding (lookup)
|
||||||
|
@ -1273,7 +1273,7 @@ find q@Query{selection, batchSize} = do
|
||||||
let newQr =
|
let newQr =
|
||||||
case fst qr of
|
case fst qr of
|
||||||
Req qry ->
|
Req qry ->
|
||||||
let coll = last $ T.splitOn "." (qFullCollection qry)
|
let (_db, coll) = splitDot (qFullCollection qry)
|
||||||
in (Req $ qry {qSelector = merge (qSelector qry) [ "find" =: coll ]}, snd qr)
|
in (Req $ qry {qSelector = merge (qSelector qry) [ "find" =: coll ]}, snd qr)
|
||||||
-- queryRequestOpMsg only returns Cmd types constructed via Req
|
-- queryRequestOpMsg only returns Cmd types constructed via Req
|
||||||
_ -> error "impossible"
|
_ -> error "impossible"
|
||||||
|
@ -1333,7 +1333,7 @@ findOne q = do
|
||||||
let newQr =
|
let newQr =
|
||||||
case fst qr of
|
case fst qr of
|
||||||
Req qry ->
|
Req qry ->
|
||||||
let coll = last $ T.splitOn "." (qFullCollection qry)
|
let (_db, coll) = splitDot (qFullCollection qry)
|
||||||
-- We have to understand whether findOne is called as
|
-- We have to understand whether findOne is called as
|
||||||
-- command directly. This is necessary since findOne is used via
|
-- command directly. This is necessary since findOne is used via
|
||||||
-- runCommand as a vehicle to execute any type of commands and notices.
|
-- runCommand as a vehicle to execute any type of commands and notices.
|
||||||
|
|
|
@ -76,6 +76,14 @@ spec = around withCleanDatabase $ do
|
||||||
db thisDatabase `shouldReturn` testDBName
|
db thisDatabase `shouldReturn` testDBName
|
||||||
db (useDb anotherDBName thisDatabase) `shouldReturn` anotherDBName
|
db (useDb anotherDBName thisDatabase) `shouldReturn` anotherDBName
|
||||||
|
|
||||||
|
describe "collectionWithDot" $ do
|
||||||
|
it "uses a collection with dots in the name" $ do
|
||||||
|
let coll = "collection.with.dot"
|
||||||
|
_id <- db $ insert coll ["name" =: "jack", "color" =: "blue"]
|
||||||
|
Just doc <- db $ findOne (select ["name" =: "jack"] coll)
|
||||||
|
doc !? "color" `shouldBe` (Just "blue")
|
||||||
|
|
||||||
|
|
||||||
describe "insert" $ do
|
describe "insert" $ do
|
||||||
it "inserts a document to the collection and returns its _id" $ do
|
it "inserts a document to the collection and returns its _id" $ do
|
||||||
_id <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
|
_id <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
|
||||||
|
|
Loading…
Reference in a new issue