module Database.MongoDB.Internal.Util where
import Control.Applicative (Applicative(..), (<$>))
import Network (PortID(..))
import Data.UString as U (cons, append)
import Data.Bits (Bits, (.|.))
import Data.Bson
import Data.ByteString.Lazy as S (ByteString, length, append, hGet)
import System.IO (Handle)
import System.IO.Error (mkIOError, eofErrorType)
import Control.Exception (assert)
import Control.Monad.Error
import Control.Arrow (left)
import qualified Data.ByteString as BS (ByteString, unpack)
import Data.Word (Word8)
import Numeric (showHex)
import System.Random.Shuffle (shuffle')
import System.Random (newStdGen)
import Data.List as L (length)
deriving instance Show PortID
deriving instance Eq PortID
deriving instance Ord PortID
class (MonadIO m, Applicative m, Functor m) => MonadIO' m
instance (MonadIO m, Applicative m, Functor m) => MonadIO' m
shuffle :: [a] -> IO [a]
shuffle list = shuffle' list (L.length list) <$> newStdGen
loop :: (Functor m, Monad m) => m (Maybe a) -> m [a]
loop act = act >>= maybe (return []) (\a -> (a :) <$> loop act)
untilSuccess :: (MonadError e m, Error e) => (a -> m b) -> [a] -> m b
untilSuccess = untilSuccess' (strMsg "empty untilSuccess")
untilSuccess' :: (MonadError e m) => e -> (a -> m b) -> [a] -> m b
untilSuccess' e _ [] = throwError e
untilSuccess' _ f (x : xs) = catchError (f x) (\e -> untilSuccess' e f xs)
whenJust :: (Monad m) => Maybe a -> (a -> m ()) -> m ()
whenJust mVal act = maybe (return ()) act mVal
liftIOE :: (MonadIO m) => (e -> e') -> ErrorT e IO a -> ErrorT e' m a
liftIOE f = ErrorT . liftIO . fmap (left f) . runErrorT
runIOE :: ErrorT IOError IO a -> IO a
runIOE (ErrorT action) = action >>= either ioError return
updateAssocs :: (Eq k) => k -> v -> [(k, v)] -> [(k, v)]
updateAssocs key valu assocs = case back of [] -> (key, valu) : front; _ : back' -> front ++ (key, valu) : back'
where (front, back) = break ((key ==) . fst) assocs
bitOr :: (Bits a) => [a] -> a
bitOr = foldl (.|.) 0
(<.>) :: UString -> UString -> UString
a <.> b = U.append a (cons '.' b)
true1 :: Label -> Document -> 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
hGetN :: Handle -> Int -> IO ByteString
hGetN h n = assert (n >= 0) $ do
bytes <- hGet h n
let x = fromEnum $ S.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)
byteStringHex :: BS.ByteString -> String
byteStringHex = concatMap byteHex . BS.unpack
byteHex :: Word8 -> String
byteHex b = (if b < 16 then ('0' :) else id) (showHex b "")