2010-11-01 00:38:38 +00:00
|
|
|
-- | Miscellaneous general functions and Show, Eq, and Ord instances for PortID
|
2010-01-17 01:22:05 +00:00
|
|
|
|
2010-10-27 20:13:23 +00:00
|
|
|
{-# LANGUAGE StandaloneDeriving #-}
|
2010-01-17 01:22:05 +00:00
|
|
|
|
2010-06-21 15:06:20 +00:00
|
|
|
module Database.MongoDB.Internal.Util where
|
2010-01-17 01:22:05 +00:00
|
|
|
|
2010-06-15 03:14:40 +00:00
|
|
|
import Prelude hiding (length)
|
2010-12-20 02:08:53 +00:00
|
|
|
import Control.Applicative ((<$>))
|
2010-06-15 03:14:40 +00:00
|
|
|
import Network (PortID(..))
|
2010-06-21 15:06:20 +00:00
|
|
|
import Data.UString as U (cons, append)
|
2010-06-15 03:14:40 +00:00
|
|
|
import Data.Bits (Bits, (.|.))
|
|
|
|
import Data.Bson
|
2010-12-20 02:08:53 +00:00
|
|
|
import Data.ByteString.Lazy as S (ByteString, length, append, hGet)
|
|
|
|
import System.IO (Handle)
|
|
|
|
import System.IO.Error (mkIOError, eofErrorType)
|
|
|
|
import Control.Exception (assert)
|
2010-06-15 03:14:40 +00:00
|
|
|
|
|
|
|
deriving instance Show PortID
|
|
|
|
deriving instance Eq PortID
|
|
|
|
deriving instance Ord PortID
|
|
|
|
|
|
|
|
bitOr :: (Bits a) => [a] -> a
|
|
|
|
-- ^ bit-or all numbers together
|
|
|
|
bitOr = foldl (.|.) 0
|
|
|
|
|
|
|
|
(<.>) :: UString -> UString -> UString
|
|
|
|
-- ^ Concat first and second together with period in between. Eg. @\"hello\" \<.\> \"world\" = \"hello.world\"@
|
|
|
|
a <.> b = U.append a (cons '.' b)
|
|
|
|
|
|
|
|
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.
|
|
|
|
true1 k doc = case valueAt k doc of
|
|
|
|
Bool b -> b
|
|
|
|
Float n -> n == 1
|
|
|
|
Int32 n -> n == 1
|
|
|
|
Int64 n -> n == 1
|
|
|
|
_ -> error $ "expected " ++ show k ++ " to be Num or Bool in " ++ show doc
|
2010-12-20 02:08:53 +00:00
|
|
|
|
|
|
|
hGetN :: Handle -> Int -> IO ByteString
|
|
|
|
-- ^ Read N bytes from hande, blocking until all N bytes are read. If EOF is reached before N bytes then raise EOF exception.
|
|
|
|
hGetN h n = assert (n >= 0) $ do
|
|
|
|
bytes <- hGet h n
|
|
|
|
let x = fromEnum $ length bytes
|
|
|
|
if x >= n then return bytes
|
|
|
|
else if x == 0 then ioError (mkIOError eofErrorType "hGetN" (Just h) Nothing)
|
|
|
|
else S.append bytes <$> hGetN h (n - x)
|