-- | A BSON document is a JSON-like object with a standard binary encoding
-- defined at bsonspec.org. This implements version 1.0 of that spec.
--
-- Use the GHC language extension /OverloadedStrings/ to automatically convert
-- String literals to Text

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Data.Bson (
  -- * Document
  Document, (!?), look, lookup, valueAt, at, include, exclude, merge,
  -- * Field
  Field(..), (=:), (=?),
  Label,
  -- * Value
  Value(..), Val(..), fval, cast, typed, typeOfVal,
  -- * Special Bson value types
  Binary(..), Function(..), UUID(..), MD5(..), UserDefined(..),
  Regex(..), Javascript(..), Symbol(..), MongoStamp(..), MinMaxKey(..),
  -- ** ObjectId
  ObjectId(..), timestamp, genObjectId, showHexLen
) where

import Prelude hiding (fail, lookup)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
#if MIN_VERSION_base(4, 9, 0)
import Control.Monad.Fail (MonadFail(fail))
#endif
import Control.Monad (foldM)
import Data.Bits (shift, (.|.))
import Data.Int (Int32, Int64)
import Data.IORef (IORef, newIORef, atomicModifyIORef)
import Data.List (find, findIndex)
import Data.Maybe (maybeToList, mapMaybe, fromJust, fromMaybe)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime,
                              utcTimeToPOSIXSeconds, getPOSIXTime)
import Data.Time.Format ()  -- for Show and Read instances of UTCTime
import Data.Typeable hiding (cast)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric (readHex, showHex)
import System.IO.Unsafe (unsafePerformIO)
import Text.Read (Read(..))

import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as SC
import qualified Text.ParserCombinators.ReadP as R
import qualified Text.ParserCombinators.ReadPrec as R (lift, readS_to_Prec)

import Control.Monad.Identity (runIdentity)
import Network.BSD (getHostName)
import Data.Text (Text)

import qualified Data.Text as T
import qualified Crypto.Hash.MD5 as MD5

getProcessID :: IO Int
-- ^ Get the current process id.
getProcessID :: IO Int
getProcessID = IO Int
c_getpid

#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
foreign import ccall unsafe "_getpid"
   c_getpid :: IO Int
#else
foreign import ccall unsafe "getpid"
   c_getpid :: IO Int
#endif

roundTo :: (RealFrac a) => a -> a -> a
-- ^ Round second number to nearest multiple of first number. Eg: roundTo (1/1000) 0.12345 = 0.123
roundTo :: forall a. RealFrac a => a -> a -> a
roundTo a
mult a
n = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (a
n a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
mult) :: Integer) a -> a -> a
forall a. Num a => a -> a -> a
* a
mult

showHexLen :: (Show n, Integral n) => Int -> n -> ShowS
-- ^ showHex of n padded with leading zeros if necessary to fill d digits
showHexLen :: forall n. (Show n, Integral n) => Int -> n -> ShowS
showHexLen Int
d n
n = String -> ShowS
showString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- n -> Int
forall {a} {a}. (Integral a, Integral a) => a -> a
sigDigits n
n) Char
'0') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> ShowS
forall a. Integral a => a -> ShowS
showHex n
n  where
  sigDigits :: a -> a
sigDigits a
0 = a
1
  sigDigits a
n' = Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
16 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n' :: Double) a -> a -> a
forall a. Num a => a -> a -> a
+ a
1

-- * Document

type Document = [Field]
-- ^ A BSON document is a list of 'Field's

-- | Recursively lookup a nested field in a Document.
(!?) :: Val a => Document -> Label -> Maybe a
Document
doc !? :: forall a. Val a => Document -> Label -> Maybe a
!? Label
l = (Document -> Label -> Maybe Document)
-> Document -> [Label] -> Maybe Document
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((Label -> Document -> Maybe Document)
-> Document -> Label -> Maybe Document
forall a b c. (a -> b -> c) -> b -> a -> c
flip Label -> Document -> Maybe Document
forall v (m :: * -> *).
(Val v, MonadFail m) =>
Label -> Document -> m v
lookup) Document
doc ([Label] -> [Label]
forall a. HasCallStack => [a] -> [a]
init [Label]
chunks) Maybe Document -> (Document -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Label -> Document -> Maybe a
forall v (m :: * -> *).
(Val v, MonadFail m) =>
Label -> Document -> m v
lookup ([Label] -> Label
forall a. HasCallStack => [a] -> a
last [Label]
chunks)
  where chunks :: [Label]
chunks = (Char -> Bool) -> Label -> [Label]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Label
l

look :: (MonadFail m) => Label -> Document -> m Value
-- ^ Value of field in document, or fail (Nothing) if field not found
look :: forall (m :: * -> *). MonadFail m => Label -> Document -> m Value
look Label
k Document
doc = m Value -> (Field -> m Value) -> Maybe Field -> m Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Value
forall {a}. m a
notFound (Value -> m Value
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> (Field -> Value) -> Field -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Value
value) ((Field -> Bool) -> Document -> Maybe Field
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Label
k Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
==) (Label -> Bool) -> (Field -> Label) -> Field -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Label
label) Document
doc)
  where notFound :: m a
notFound = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Label -> String
forall a. Show a => a -> String
show Label
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Document -> String
forall a. Show a => a -> String
show Document
doc

lookup :: (Val v, MonadFail m) => Label -> Document -> m v
-- ^ Lookup value of field in document and cast to expected type. Fail (Nothing) if field not found or value not of expected type.
lookup :: forall v (m :: * -> *).
(Val v, MonadFail m) =>
Label -> Document -> m v
lookup Label
k Document
doc = Value -> m v
forall a (m :: * -> *). (Val a, MonadFail m) => Value -> m a
cast (Value -> m v) -> m Value -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Label -> Document -> m Value
forall (m :: * -> *). MonadFail m => Label -> Document -> m Value
look Label
k Document
doc

valueAt :: Label -> Document -> Value
-- ^ Value of field in document. Error if missing.
valueAt :: Label -> Document -> Value
valueAt Label
k = Maybe Value -> Value
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Value -> Value)
-> (Document -> Maybe Value) -> Document -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> Document -> Maybe Value
forall (m :: * -> *). MonadFail m => Label -> Document -> m Value
look Label
k

at :: (Val v) => Label -> Document -> v
-- ^ Typed value of field in document. Error if missing or wrong type.
at :: forall v. Val v => Label -> Document -> v
at Label
k Document
doc = v
result
  where
   result :: v
result = v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
err (Label -> Document -> Maybe v
forall v (m :: * -> *).
(Val v, MonadFail m) =>
Label -> Document -> m v
lookup Label
k Document
doc)
   err :: v
err = String -> v
forall a. HasCallStack => String -> a
error (String -> v) -> String -> v
forall a b. (a -> b) -> a -> b
$ String
"expected (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Label -> String
forall a. Show a => a -> String
show Label
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (v -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf v
result) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Document -> String
forall a. Show a => a -> String
show Document
doc

include :: [Label] -> Document -> Document
-- ^ Only include fields of document in label list
include :: [Label] -> Document -> Document
include [Label]
keys Document
doc = (Label -> Maybe Field) -> [Label] -> Document
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Label
k -> (Field -> Bool) -> Document -> Maybe Field
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Label
k Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
==) (Label -> Bool) -> (Field -> Label) -> Field -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Label
label) Document
doc) [Label]
keys

exclude :: [Label] -> Document -> Document
-- ^ Exclude fields from document in label list
exclude :: [Label] -> Document -> Document
exclude [Label]
keys = (Field -> Bool) -> Document -> Document
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Label
k := Value
_) -> Label -> [Label] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Label
k [Label]
keys)

merge :: Document -> Document -> Document
-- ^ Merge documents with preference given to first one when both have the same label. I.e. for every (k := v) in first argument, if k exists in second argument then replace its value with v, otherwise add (k := v) to second argument.
merge :: Document -> Document -> Document
merge Document
es Document
docInitial = (Document -> Field -> Document) -> Document -> Document -> Document
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Document -> Field -> Document
f Document
docInitial Document
es
  where f :: Document -> Field -> Document
f Document
doc (Label
k := Value
v) = case (Field -> Bool) -> Document -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Label
k Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
==) (Label -> Bool) -> (Field -> Label) -> Field -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Label
label) Document
doc of
                          Maybe Int
Nothing -> Document
doc Document -> Document -> Document
forall a. [a] -> [a] -> [a]
++ [Label
k Label -> Value -> Field
:= Value
v]
                          Just Int
i -> let (Document
x, Field
_ : Document
y) = Int -> Document -> (Document, Document)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i Document
doc in Document
x Document -> Document -> Document
forall a. [a] -> [a] -> [a]
++ [Label
k Label -> Value -> Field
:= Value
v] Document -> Document -> Document
forall a. [a] -> [a] -> [a]
++ Document
y

-- * Field

infix 0 :=, =:, =?

data Field = (:=) {Field -> Label
label :: !Label, Field -> Value
value :: Value}  deriving (Typeable, Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
/= :: Field -> Field -> Bool
Eq, Eq Field
Eq Field =>
(Field -> Field -> Ordering)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Field)
-> (Field -> Field -> Field)
-> Ord Field
Field -> Field -> Bool
Field -> Field -> Ordering
Field -> Field -> Field
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Field -> Field -> Ordering
compare :: Field -> Field -> Ordering
$c< :: Field -> Field -> Bool
< :: Field -> Field -> Bool
$c<= :: Field -> Field -> Bool
<= :: Field -> Field -> Bool
$c> :: Field -> Field -> Bool
> :: Field -> Field -> Bool
$c>= :: Field -> Field -> Bool
>= :: Field -> Field -> Bool
$cmax :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
min :: Field -> Field -> Field
Ord)
-- ^ A BSON field is a named value, where the name (label) is a string and the value is a BSON 'Value'

(=:) :: (Val v) => Label -> v -> Field
-- ^ Field with given label and typed value
Label
k =: :: forall v. Val v => Label -> v -> Field
=: v
v = Label
k Label -> Value -> Field
:= v -> Value
forall a. Val a => a -> Value
val v
v

(=?) :: (Val a) => Label -> Maybe a -> Document
-- ^ If Just value then return one field document, otherwise return empty document
Label
k =? :: forall a. Val a => Label -> Maybe a -> Document
=? Maybe a
ma = Maybe Field -> Document
forall a. Maybe a -> [a]
maybeToList ((a -> Field) -> Maybe a -> Maybe Field
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Label
k Label -> a -> Field
forall v. Val v => Label -> v -> Field
=:) Maybe a
ma)

instance Show Field where
  showsPrec :: Int -> Field -> ShowS
showsPrec Int
d (Label
k := Value
v) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Label -> String
T.unpack Label
k) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
": " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Value -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
1 Value
v

type Label = Text
-- ^ The name of a BSON field

-- * Value

-- | A BSON value is one of the following types of values
data Value = Float Double
           | String Text
           | Doc Document
           | Array [Value]
           | Bin Binary
           | Fun Function
           | Uuid UUID
           | Md5 MD5
           | UserDef UserDefined
           | ObjId ObjectId
           | Bool Bool
           | UTC UTCTime
           | Null
           | RegEx Regex
           | JavaScr Javascript
           | Sym Symbol
           | Int32 Int32
           | Int64 Int64
           | Stamp MongoStamp
           | MinMax MinMaxKey
           deriving (Typeable, Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Eq Value
Eq Value =>
(Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Value -> Value -> Ordering
compare :: Value -> Value -> Ordering
$c< :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
>= :: Value -> Value -> Bool
$cmax :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
min :: Value -> Value -> Value
Ord)

instance Show Value where
  showsPrec :: Int -> Value -> ShowS
showsPrec Int
d = (forall a. Val a => a -> ShowS) -> Value -> ShowS
forall b. (forall a. Val a => a -> b) -> Value -> b
fval (Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d)

fval :: (forall a . (Val a) => a -> b) -> Value -> b
-- ^ Apply generic function to typed value
fval :: forall b. (forall a. Val a => a -> b) -> Value -> b
fval forall a. Val a => a -> b
f Value
v = case Value
v of
            Float Double
x   -> Double -> b
forall a. Val a => a -> b
f Double
x
            String Label
x  -> Label -> b
forall a. Val a => a -> b
f Label
x
            Doc Document
x     -> Document -> b
forall a. Val a => a -> b
f Document
x
            Array [Value]
x   -> [Value] -> b
forall a. Val a => a -> b
f [Value]
x
            Bin Binary
x     -> Binary -> b
forall a. Val a => a -> b
f Binary
x
            Fun Function
x     -> Function -> b
forall a. Val a => a -> b
f Function
x
            Uuid UUID
x    -> UUID -> b
forall a. Val a => a -> b
f UUID
x
            Md5 MD5
x     -> MD5 -> b
forall a. Val a => a -> b
f MD5
x
            UserDef UserDefined
x -> UserDefined -> b
forall a. Val a => a -> b
f UserDefined
x
            ObjId ObjectId
x   -> ObjectId -> b
forall a. Val a => a -> b
f ObjectId
x
            Bool Bool
x    -> Bool -> b
forall a. Val a => a -> b
f Bool
x
            UTC UTCTime
x     -> UTCTime -> b
forall a. Val a => a -> b
f UTCTime
x
            Value
Null      -> Maybe Value -> b
forall a. Val a => a -> b
f (Maybe Value
forall a. Maybe a
Nothing :: Maybe Value)
            RegEx Regex
x   -> Regex -> b
forall a. Val a => a -> b
f Regex
x
            JavaScr Javascript
x -> Javascript -> b
forall a. Val a => a -> b
f Javascript
x
            Sym Symbol
x     -> Symbol -> b
forall a. Val a => a -> b
f Symbol
x
            Int32 Int32
x   -> Int32 -> b
forall a. Val a => a -> b
f Int32
x
            Int64 Int64
x   -> Int64 -> b
forall a. Val a => a -> b
f Int64
x
            Stamp MongoStamp
x   -> MongoStamp -> b
forall a. Val a => a -> b
f MongoStamp
x
            MinMax MinMaxKey
x  -> MinMaxKey -> b
forall a. Val a => a -> b
f MinMaxKey
x

-- * Value conversion

cast :: (Val a, MonadFail m) => Value -> m a
-- ^ Convert Value to expected type, or fail (Nothing) if not of that type
cast :: forall a (m :: * -> *). (Val a, MonadFail m) => Value -> m a
cast Value
v = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
forall {a}. m a
notType a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
castingResult
  where
    castingResult :: Maybe a
castingResult = Value -> Maybe a
forall a. Val a => Value -> Maybe a
cast' Value
v
    unMaybe :: Maybe a -> a
    unMaybe :: forall a. Maybe a -> a
unMaybe = Maybe a -> a
forall a. HasCallStack => a
undefined
    notType :: m a
notType = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a -> TypeRep) -> a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Maybe a -> a
forall a. Maybe a -> a
unMaybe Maybe a
castingResult) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v

typed :: (Val a) => Value -> a
-- ^ Convert Value to expected type. Error if not that type.
typed :: forall a. Val a => Value -> a
typed = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (Value -> Maybe a) -> Value -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe a
forall a (m :: * -> *). (Val a, MonadFail m) => Value -> m a
cast

typeOfVal :: Value -> TypeRep
-- ^ Type of typed value
typeOfVal :: Value -> TypeRep
typeOfVal = (forall a. Val a => a -> TypeRep) -> Value -> TypeRep
forall b. (forall a. Val a => a -> b) -> Value -> b
fval a -> TypeRep
forall a. Typeable a => a -> TypeRep
forall a. Val a => a -> TypeRep
typeOf

-- ** conversion class

-- | Haskell types of this class correspond to BSON value types
class (Typeable a, Show a, Eq a) => Val a where
  val :: a -> Value
  valList :: [a] -> Value
  valList = [Value] -> Value
Array ([Value] -> Value) -> ([a] -> [Value]) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value
forall a. Val a => a -> Value
val
  valMaybe :: Maybe a -> Value
  valMaybe = Value -> (a -> Value) -> Maybe a -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Null a -> Value
forall a. Val a => a -> Value
val
  cast' :: Value -> Maybe a
  cast'List :: Value -> Maybe [a]
  cast'List (Array [Value]
x) = (Value -> Maybe a) -> [Value] -> Maybe [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Maybe a
forall a (m :: * -> *). (Val a, MonadFail m) => Value -> m a
cast [Value]
x
  cast'List Value
_         = Maybe [a]
forall a. Maybe a
Nothing
  cast'Maybe :: Value -> Maybe (Maybe a)
  cast'Maybe Value
Null = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
  cast'Maybe Value
v    = (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Value -> Maybe a
forall a. Val a => Value -> Maybe a
cast' Value
v)

instance Val Double where
  val :: Double -> Value
val             = Double -> Value
Float
  cast' :: Value -> Maybe Double
cast' (Float Double
x) = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x
  cast' (Int32 Int32
x) = Double -> Maybe Double
forall a. a -> Maybe a
Just (Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  cast' (Int64 Int64
x) = Double -> Maybe Double
forall a. a -> Maybe a
Just (Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  cast' Value
_         = Maybe Double
forall a. Maybe a
Nothing

instance Val Float where
  val :: Float -> Value
val             = Double -> Value
Float (Double -> Value) -> (Float -> Double) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
  cast' :: Value -> Maybe Float
cast' (Float Double
x) = Float -> Maybe Float
forall a. a -> Maybe a
Just (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
  cast' (Int32 Int32
x) = Float -> Maybe Float
forall a. a -> Maybe a
Just (Int32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  cast' (Int64 Int64
x) = Float -> Maybe Float
forall a. a -> Maybe a
Just (Int64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  cast' Value
_         = Maybe Float
forall a. Maybe a
Nothing

instance Val Text where
  val :: Label -> Value
val                    = Label -> Value
String
  cast' :: Value -> Maybe Label
cast' (String Label
x)       = Label -> Maybe Label
forall a. a -> Maybe a
Just Label
x
  cast' (Sym (Symbol Label
x)) = Label -> Maybe Label
forall a. a -> Maybe a
Just Label
x
  cast' Value
_                = Maybe Label
forall a. Maybe a
Nothing

instance Val Char where
  val :: Char -> Value
val Char
x   = String -> Value
forall a. Val a => [a] -> Value
valList [Char
x]
  valList :: String -> Value
valList = Label -> Value
String (Label -> Value) -> (String -> Label) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Label
T.pack
  cast' :: Value -> Maybe Char
cast' Value
v = Value -> Maybe String
forall a. Val a => Value -> Maybe [a]
cast'List Value
v Maybe String -> (String -> Maybe Char) -> Maybe Char
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Char
forall {a}. [a] -> Maybe a
safeHead
    where safeHead :: [a] -> Maybe a
safeHead [a]
list = case [a]
list of
                           a
x:[a]
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
                           [a]
_   -> Maybe a
forall a. Maybe a
Nothing
  cast'List :: Value -> Maybe String
cast'List (String Label
x)       = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Label -> String
T.unpack Label
x
  cast'List (Sym (Symbol Label
x)) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Label -> String
T.unpack Label
x
  cast'List Value
_                = Maybe String
forall a. Maybe a
Nothing

instance Val Field where
  val :: Field -> Value
val Field
x   = Document -> Value
forall a. Val a => [a] -> Value
valList [Field
x]
  valList :: Document -> Value
valList = Document -> Value
Doc
  cast' :: Value -> Maybe Field
cast' Value
_ = Maybe Field
forall a. Maybe a
Nothing
  cast'List :: Value -> Maybe Document
cast'List Value
v = case Value
v of
                 Doc Document
x -> Document -> Maybe Document
forall a. a -> Maybe a
Just Document
x
                 Value
_     -> Maybe Document
forall a. Maybe a
Nothing

instance Val Value where
  val :: Value -> Value
val   = Value -> Value
forall a. a -> a
id
  cast' :: Value -> Maybe Value
cast' = Value -> Maybe Value
forall a. a -> Maybe a
Just

instance (Val a) => Val [a] where
  val :: [a] -> Value
val   = [a] -> Value
forall a. Val a => [a] -> Value
valList
  cast' :: Value -> Maybe [a]
cast' = Value -> Maybe [a]
forall a. Val a => Value -> Maybe [a]
cast'List

instance Val Binary where
  val :: Binary -> Value
val           = Binary -> Value
Bin
  cast' :: Value -> Maybe Binary
cast' (Bin Binary
x) = Binary -> Maybe Binary
forall a. a -> Maybe a
Just Binary
x
  cast' Value
_       = Maybe Binary
forall a. Maybe a
Nothing

instance Val Function where
  val :: Function -> Value
val           = Function -> Value
Fun
  cast' :: Value -> Maybe Function
cast' (Fun Function
x) = Function -> Maybe Function
forall a. a -> Maybe a
Just Function
x
  cast' Value
_       = Maybe Function
forall a. Maybe a
Nothing

instance Val UUID where
  val :: UUID -> Value
val            = UUID -> Value
Uuid
  cast' :: Value -> Maybe UUID
cast' (Uuid UUID
x) = UUID -> Maybe UUID
forall a. a -> Maybe a
Just UUID
x
  cast' Value
_         = Maybe UUID
forall a. Maybe a
Nothing

instance Val MD5 where
  val :: MD5 -> Value
val           = MD5 -> Value
Md5
  cast' :: Value -> Maybe MD5
cast' (Md5 MD5
x) = MD5 -> Maybe MD5
forall a. a -> Maybe a
Just MD5
x
  cast' Value
_       = Maybe MD5
forall a. Maybe a
Nothing

instance Val UserDefined where
  val :: UserDefined -> Value
val               = UserDefined -> Value
UserDef
  cast' :: Value -> Maybe UserDefined
cast' (UserDef UserDefined
x) = UserDefined -> Maybe UserDefined
forall a. a -> Maybe a
Just UserDefined
x
  cast' Value
_           = Maybe UserDefined
forall a. Maybe a
Nothing

instance Val ObjectId where
  val :: ObjectId -> Value
val             = ObjectId -> Value
ObjId
  cast' :: Value -> Maybe ObjectId
cast' (ObjId ObjectId
x) = ObjectId -> Maybe ObjectId
forall a. a -> Maybe a
Just ObjectId
x
  cast' Value
_         = Maybe ObjectId
forall a. Maybe a
Nothing

instance Val Bool where
  val :: Bool -> Value
val            = Bool -> Value
Bool
  cast' :: Value -> Maybe Bool
cast' (Bool Bool
x) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
x
  cast' Value
_        = Maybe Bool
forall a. Maybe a
Nothing

instance Val UTCTime where
  val :: UTCTime -> Value
val           = UTCTime -> Value
UTC
  cast' :: Value -> Maybe UTCTime
cast' (UTC UTCTime
x) = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
x
  cast' Value
_       = Maybe UTCTime
forall a. Maybe a
Nothing

instance Val POSIXTime where
  val :: POSIXTime -> Value
val           = UTCTime -> Value
UTC (UTCTime -> Value) -> (POSIXTime -> UTCTime) -> POSIXTime -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (POSIXTime -> POSIXTime) -> POSIXTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> POSIXTime -> POSIXTime
forall a. RealFrac a => a -> a -> a
roundTo (POSIXTime
1POSIXTime -> POSIXTime -> POSIXTime
forall a. Fractional a => a -> a -> a
/POSIXTime
1000)
  cast' :: Value -> Maybe POSIXTime
cast' (UTC UTCTime
x) = POSIXTime -> Maybe POSIXTime
forall a. a -> Maybe a
Just (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
x)
  cast' Value
_       = Maybe POSIXTime
forall a. Maybe a
Nothing

instance (Val a) => Val (Maybe a) where
  val :: Maybe a -> Value
val   = Maybe a -> Value
forall a. Val a => Maybe a -> Value
valMaybe
  cast' :: Value -> Maybe (Maybe a)
cast' = Value -> Maybe (Maybe a)
forall a. Val a => Value -> Maybe (Maybe a)
cast'Maybe

instance Val Regex where
  val :: Regex -> Value
val             = Regex -> Value
RegEx
  cast' :: Value -> Maybe Regex
cast' (RegEx Regex
x) = Regex -> Maybe Regex
forall a. a -> Maybe a
Just Regex
x
  cast' Value
_         = Maybe Regex
forall a. Maybe a
Nothing

instance Val Javascript where
  val :: Javascript -> Value
val               = Javascript -> Value
JavaScr
  cast' :: Value -> Maybe Javascript
cast' (JavaScr Javascript
x) = Javascript -> Maybe Javascript
forall a. a -> Maybe a
Just Javascript
x
  cast' Value
_           = Maybe Javascript
forall a. Maybe a
Nothing

instance Val Symbol where
  val :: Symbol -> Value
val              = Symbol -> Value
Sym
  cast' :: Value -> Maybe Symbol
cast' (Sym Symbol
x)    = Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
x
  cast' (String Label
x) = Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just (Label -> Symbol
Symbol Label
x)
  cast' Value
_          = Maybe Symbol
forall a. Maybe a
Nothing

instance Val Int32 where
  val :: Int32 -> Value
val             = Int32 -> Value
Int32
  cast' :: Value -> Maybe Int32
cast' (Int32 Int32
x) = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
x
  cast' (Int64 Int64
x) = Int64 -> Maybe Int32
forall n m. (Integral n, Integral m, Bounded m) => n -> Maybe m
fitInt Int64
x
  cast' (Float Double
x) = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just (Double -> Int32
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
x)
  cast' Value
_         = Maybe Int32
forall a. Maybe a
Nothing

instance Val Int64 where
  val :: Int64 -> Value
val             = Int64 -> Value
Int64
  cast' :: Value -> Maybe Int64
cast' (Int64 Int64
x) = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
x
  cast' (Int32 Int32
x) = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  cast' (Float Double
x) = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Double -> Int64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
x)
  cast' Value
_         = Maybe Int64
forall a. Maybe a
Nothing

instance Val Int where
  val :: Int -> Value
val Int
n           = Value -> (Int32 -> Value) -> Maybe Int32 -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int64 -> Value
Int64 (Int64 -> Value) -> Int64 -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Int32 -> Value
Int32 (Int -> Maybe Int32
forall n m. (Integral n, Integral m, Bounded m) => n -> Maybe m
fitInt Int
n)
  cast' :: Value -> Maybe Int
cast' (Int32 Int32
x) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  cast' (Int64 Int64
x) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int64 -> Int
forall a. Enum a => a -> Int
fromEnum Int64
x)
  cast' (Float Double
x) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
x)
  cast' Value
_         = Maybe Int
forall a. Maybe a
Nothing

instance Val Integer where
  val :: Integer -> Value
val Integer
n           = Value -> (Int32 -> Value) -> Maybe Int32 -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value -> (Int64 -> Value) -> Maybe Int64 -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
forall {a}. a
err Int64 -> Value
Int64 (Maybe Int64 -> Value) -> Maybe Int64 -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Maybe Int64
forall n m. (Integral n, Integral m, Bounded m) => n -> Maybe m
fitInt Integer
n) Int32 -> Value
Int32 (Integer -> Maybe Int32
forall n m. (Integral n, Integral m, Bounded m) => n -> Maybe m
fitInt Integer
n)
    where err :: a
err = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is too large for Bson Int Value"
  cast' :: Value -> Maybe Integer
cast' (Int32 Int32
x) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
  cast' (Int64 Int64
x) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
  cast' (Float Double
x) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
x)
  cast' Value
_         = Maybe Integer
forall a. Maybe a
Nothing

instance Val MongoStamp where
  val :: MongoStamp -> Value
val             = MongoStamp -> Value
Stamp
  cast' :: Value -> Maybe MongoStamp
cast' (Stamp MongoStamp
x) = MongoStamp -> Maybe MongoStamp
forall a. a -> Maybe a
Just MongoStamp
x
  cast' Value
_         = Maybe MongoStamp
forall a. Maybe a
Nothing

instance Val MinMaxKey where
  val :: MinMaxKey -> Value
val              = MinMaxKey -> Value
MinMax
  cast' :: Value -> Maybe MinMaxKey
cast' (MinMax MinMaxKey
x) = MinMaxKey -> Maybe MinMaxKey
forall a. a -> Maybe a
Just MinMaxKey
x
  cast' Value
_          = Maybe MinMaxKey
forall a. Maybe a
Nothing

fitInt :: (Integral n, Integral m, Bounded m) => n -> Maybe m
-- ^ If number fits in type m then cast to m, otherwise Nothing
fitInt :: forall n m. (Integral n, Integral m, Bounded m) => n -> Maybe m
fitInt n
n =
  if m -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m
forall a. Bounded a => a
minBound m -> m -> m
forall a. a -> a -> a
`asTypeOf` m
result) n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
n Bool -> Bool -> Bool
&& n
n n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= m -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m
forall a. Bounded a => a
maxBound m -> m -> m
forall a. a -> a -> a
`asTypeOf` m
result)
  then m -> Maybe m
forall a. a -> Maybe a
Just m
result
  else Maybe m
forall a. Maybe a
Nothing
    where result :: m
result = n -> m
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
n

-- * Haskell types corresponding to special Bson value types

-- ** Binary types

newtype Binary = Binary S.ByteString  deriving (Typeable, Int -> Binary -> ShowS
[Binary] -> ShowS
Binary -> String
(Int -> Binary -> ShowS)
-> (Binary -> String) -> ([Binary] -> ShowS) -> Show Binary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Binary -> ShowS
showsPrec :: Int -> Binary -> ShowS
$cshow :: Binary -> String
show :: Binary -> String
$cshowList :: [Binary] -> ShowS
showList :: [Binary] -> ShowS
Show, ReadPrec [Binary]
ReadPrec Binary
Int -> ReadS Binary
ReadS [Binary]
(Int -> ReadS Binary)
-> ReadS [Binary]
-> ReadPrec Binary
-> ReadPrec [Binary]
-> Read Binary
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Binary
readsPrec :: Int -> ReadS Binary
$creadList :: ReadS [Binary]
readList :: ReadS [Binary]
$creadPrec :: ReadPrec Binary
readPrec :: ReadPrec Binary
$creadListPrec :: ReadPrec [Binary]
readListPrec :: ReadPrec [Binary]
Read, Binary -> Binary -> Bool
(Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool) -> Eq Binary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Binary -> Binary -> Bool
== :: Binary -> Binary -> Bool
$c/= :: Binary -> Binary -> Bool
/= :: Binary -> Binary -> Bool
Eq, Eq Binary
Eq Binary =>
(Binary -> Binary -> Ordering)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Bool)
-> (Binary -> Binary -> Binary)
-> (Binary -> Binary -> Binary)
-> Ord Binary
Binary -> Binary -> Bool
Binary -> Binary -> Ordering
Binary -> Binary -> Binary
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Binary -> Binary -> Ordering
compare :: Binary -> Binary -> Ordering
$c< :: Binary -> Binary -> Bool
< :: Binary -> Binary -> Bool
$c<= :: Binary -> Binary -> Bool
<= :: Binary -> Binary -> Bool
$c> :: Binary -> Binary -> Bool
> :: Binary -> Binary -> Bool
$c>= :: Binary -> Binary -> Bool
>= :: Binary -> Binary -> Bool
$cmax :: Binary -> Binary -> Binary
max :: Binary -> Binary -> Binary
$cmin :: Binary -> Binary -> Binary
min :: Binary -> Binary -> Binary
Ord)

newtype Function = Function S.ByteString  deriving (Typeable, Int -> Function -> ShowS
[Function] -> ShowS
Function -> String
(Int -> Function -> ShowS)
-> (Function -> String) -> ([Function] -> ShowS) -> Show Function
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Function -> ShowS
showsPrec :: Int -> Function -> ShowS
$cshow :: Function -> String
show :: Function -> String
$cshowList :: [Function] -> ShowS
showList :: [Function] -> ShowS
Show, ReadPrec [Function]
ReadPrec Function
Int -> ReadS Function
ReadS [Function]
(Int -> ReadS Function)
-> ReadS [Function]
-> ReadPrec Function
-> ReadPrec [Function]
-> Read Function
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Function
readsPrec :: Int -> ReadS Function
$creadList :: ReadS [Function]
readList :: ReadS [Function]
$creadPrec :: ReadPrec Function
readPrec :: ReadPrec Function
$creadListPrec :: ReadPrec [Function]
readListPrec :: ReadPrec [Function]
Read, Function -> Function -> Bool
(Function -> Function -> Bool)
-> (Function -> Function -> Bool) -> Eq Function
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Function -> Function -> Bool
== :: Function -> Function -> Bool
$c/= :: Function -> Function -> Bool
/= :: Function -> Function -> Bool
Eq, Eq Function
Eq Function =>
(Function -> Function -> Ordering)
-> (Function -> Function -> Bool)
-> (Function -> Function -> Bool)
-> (Function -> Function -> Bool)
-> (Function -> Function -> Bool)
-> (Function -> Function -> Function)
-> (Function -> Function -> Function)
-> Ord Function
Function -> Function -> Bool
Function -> Function -> Ordering
Function -> Function -> Function
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Function -> Function -> Ordering
compare :: Function -> Function -> Ordering
$c< :: Function -> Function -> Bool
< :: Function -> Function -> Bool
$c<= :: Function -> Function -> Bool
<= :: Function -> Function -> Bool
$c> :: Function -> Function -> Bool
> :: Function -> Function -> Bool
$c>= :: Function -> Function -> Bool
>= :: Function -> Function -> Bool
$cmax :: Function -> Function -> Function
max :: Function -> Function -> Function
$cmin :: Function -> Function -> Function
min :: Function -> Function -> Function
Ord)

newtype UUID = UUID S.ByteString  deriving (Typeable, Int -> UUID -> ShowS
[UUID] -> ShowS
UUID -> String
(Int -> UUID -> ShowS)
-> (UUID -> String) -> ([UUID] -> ShowS) -> Show UUID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UUID -> ShowS
showsPrec :: Int -> UUID -> ShowS
$cshow :: UUID -> String
show :: UUID -> String
$cshowList :: [UUID] -> ShowS
showList :: [UUID] -> ShowS
Show, ReadPrec [UUID]
ReadPrec UUID
Int -> ReadS UUID
ReadS [UUID]
(Int -> ReadS UUID)
-> ReadS [UUID] -> ReadPrec UUID -> ReadPrec [UUID] -> Read UUID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UUID
readsPrec :: Int -> ReadS UUID
$creadList :: ReadS [UUID]
readList :: ReadS [UUID]
$creadPrec :: ReadPrec UUID
readPrec :: ReadPrec UUID
$creadListPrec :: ReadPrec [UUID]
readListPrec :: ReadPrec [UUID]
Read, UUID -> UUID -> Bool
(UUID -> UUID -> Bool) -> (UUID -> UUID -> Bool) -> Eq UUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
/= :: UUID -> UUID -> Bool
Eq, Eq UUID
Eq UUID =>
(UUID -> UUID -> Ordering)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> UUID)
-> (UUID -> UUID -> UUID)
-> Ord UUID
UUID -> UUID -> Bool
UUID -> UUID -> Ordering
UUID -> UUID -> UUID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UUID -> UUID -> Ordering
compare :: UUID -> UUID -> Ordering
$c< :: UUID -> UUID -> Bool
< :: UUID -> UUID -> Bool
$c<= :: UUID -> UUID -> Bool
<= :: UUID -> UUID -> Bool
$c> :: UUID -> UUID -> Bool
> :: UUID -> UUID -> Bool
$c>= :: UUID -> UUID -> Bool
>= :: UUID -> UUID -> Bool
$cmax :: UUID -> UUID -> UUID
max :: UUID -> UUID -> UUID
$cmin :: UUID -> UUID -> UUID
min :: UUID -> UUID -> UUID
Ord)

newtype MD5 = MD5 S.ByteString  deriving (Typeable, Int -> MD5 -> ShowS
[MD5] -> ShowS
MD5 -> String
(Int -> MD5 -> ShowS)
-> (MD5 -> String) -> ([MD5] -> ShowS) -> Show MD5
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MD5 -> ShowS
showsPrec :: Int -> MD5 -> ShowS
$cshow :: MD5 -> String
show :: MD5 -> String
$cshowList :: [MD5] -> ShowS
showList :: [MD5] -> ShowS
Show, ReadPrec [MD5]
ReadPrec MD5
Int -> ReadS MD5
ReadS [MD5]
(Int -> ReadS MD5)
-> ReadS [MD5] -> ReadPrec MD5 -> ReadPrec [MD5] -> Read MD5
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MD5
readsPrec :: Int -> ReadS MD5
$creadList :: ReadS [MD5]
readList :: ReadS [MD5]
$creadPrec :: ReadPrec MD5
readPrec :: ReadPrec MD5
$creadListPrec :: ReadPrec [MD5]
readListPrec :: ReadPrec [MD5]
Read, MD5 -> MD5 -> Bool
(MD5 -> MD5 -> Bool) -> (MD5 -> MD5 -> Bool) -> Eq MD5
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MD5 -> MD5 -> Bool
== :: MD5 -> MD5 -> Bool
$c/= :: MD5 -> MD5 -> Bool
/= :: MD5 -> MD5 -> Bool
Eq, Eq MD5
Eq MD5 =>
(MD5 -> MD5 -> Ordering)
-> (MD5 -> MD5 -> Bool)
-> (MD5 -> MD5 -> Bool)
-> (MD5 -> MD5 -> Bool)
-> (MD5 -> MD5 -> Bool)
-> (MD5 -> MD5 -> MD5)
-> (MD5 -> MD5 -> MD5)
-> Ord MD5
MD5 -> MD5 -> Bool
MD5 -> MD5 -> Ordering
MD5 -> MD5 -> MD5
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MD5 -> MD5 -> Ordering
compare :: MD5 -> MD5 -> Ordering
$c< :: MD5 -> MD5 -> Bool
< :: MD5 -> MD5 -> Bool
$c<= :: MD5 -> MD5 -> Bool
<= :: MD5 -> MD5 -> Bool
$c> :: MD5 -> MD5 -> Bool
> :: MD5 -> MD5 -> Bool
$c>= :: MD5 -> MD5 -> Bool
>= :: MD5 -> MD5 -> Bool
$cmax :: MD5 -> MD5 -> MD5
max :: MD5 -> MD5 -> MD5
$cmin :: MD5 -> MD5 -> MD5
min :: MD5 -> MD5 -> MD5
Ord)

newtype UserDefined = UserDefined S.ByteString  deriving (Typeable, Int -> UserDefined -> ShowS
[UserDefined] -> ShowS
UserDefined -> String
(Int -> UserDefined -> ShowS)
-> (UserDefined -> String)
-> ([UserDefined] -> ShowS)
-> Show UserDefined
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserDefined -> ShowS
showsPrec :: Int -> UserDefined -> ShowS
$cshow :: UserDefined -> String
show :: UserDefined -> String
$cshowList :: [UserDefined] -> ShowS
showList :: [UserDefined] -> ShowS
Show, ReadPrec [UserDefined]
ReadPrec UserDefined
Int -> ReadS UserDefined
ReadS [UserDefined]
(Int -> ReadS UserDefined)
-> ReadS [UserDefined]
-> ReadPrec UserDefined
-> ReadPrec [UserDefined]
-> Read UserDefined
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UserDefined
readsPrec :: Int -> ReadS UserDefined
$creadList :: ReadS [UserDefined]
readList :: ReadS [UserDefined]
$creadPrec :: ReadPrec UserDefined
readPrec :: ReadPrec UserDefined
$creadListPrec :: ReadPrec [UserDefined]
readListPrec :: ReadPrec [UserDefined]
Read, UserDefined -> UserDefined -> Bool
(UserDefined -> UserDefined -> Bool)
-> (UserDefined -> UserDefined -> Bool) -> Eq UserDefined
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserDefined -> UserDefined -> Bool
== :: UserDefined -> UserDefined -> Bool
$c/= :: UserDefined -> UserDefined -> Bool
/= :: UserDefined -> UserDefined -> Bool
Eq, Eq UserDefined
Eq UserDefined =>
(UserDefined -> UserDefined -> Ordering)
-> (UserDefined -> UserDefined -> Bool)
-> (UserDefined -> UserDefined -> Bool)
-> (UserDefined -> UserDefined -> Bool)
-> (UserDefined -> UserDefined -> Bool)
-> (UserDefined -> UserDefined -> UserDefined)
-> (UserDefined -> UserDefined -> UserDefined)
-> Ord UserDefined
UserDefined -> UserDefined -> Bool
UserDefined -> UserDefined -> Ordering
UserDefined -> UserDefined -> UserDefined
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UserDefined -> UserDefined -> Ordering
compare :: UserDefined -> UserDefined -> Ordering
$c< :: UserDefined -> UserDefined -> Bool
< :: UserDefined -> UserDefined -> Bool
$c<= :: UserDefined -> UserDefined -> Bool
<= :: UserDefined -> UserDefined -> Bool
$c> :: UserDefined -> UserDefined -> Bool
> :: UserDefined -> UserDefined -> Bool
$c>= :: UserDefined -> UserDefined -> Bool
>= :: UserDefined -> UserDefined -> Bool
$cmax :: UserDefined -> UserDefined -> UserDefined
max :: UserDefined -> UserDefined -> UserDefined
$cmin :: UserDefined -> UserDefined -> UserDefined
min :: UserDefined -> UserDefined -> UserDefined
Ord)

-- ** Regex

data Regex = Regex Text Text  deriving (Typeable, Int -> Regex -> ShowS
[Regex] -> ShowS
Regex -> String
(Int -> Regex -> ShowS)
-> (Regex -> String) -> ([Regex] -> ShowS) -> Show Regex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Regex -> ShowS
showsPrec :: Int -> Regex -> ShowS
$cshow :: Regex -> String
show :: Regex -> String
$cshowList :: [Regex] -> ShowS
showList :: [Regex] -> ShowS
Show, ReadPrec [Regex]
ReadPrec Regex
Int -> ReadS Regex
ReadS [Regex]
(Int -> ReadS Regex)
-> ReadS [Regex]
-> ReadPrec Regex
-> ReadPrec [Regex]
-> Read Regex
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Regex
readsPrec :: Int -> ReadS Regex
$creadList :: ReadS [Regex]
readList :: ReadS [Regex]
$creadPrec :: ReadPrec Regex
readPrec :: ReadPrec Regex
$creadListPrec :: ReadPrec [Regex]
readListPrec :: ReadPrec [Regex]
Read, Regex -> Regex -> Bool
(Regex -> Regex -> Bool) -> (Regex -> Regex -> Bool) -> Eq Regex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Regex -> Regex -> Bool
== :: Regex -> Regex -> Bool
$c/= :: Regex -> Regex -> Bool
/= :: Regex -> Regex -> Bool
Eq, Eq Regex
Eq Regex =>
(Regex -> Regex -> Ordering)
-> (Regex -> Regex -> Bool)
-> (Regex -> Regex -> Bool)
-> (Regex -> Regex -> Bool)
-> (Regex -> Regex -> Bool)
-> (Regex -> Regex -> Regex)
-> (Regex -> Regex -> Regex)
-> Ord Regex
Regex -> Regex -> Bool
Regex -> Regex -> Ordering
Regex -> Regex -> Regex
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Regex -> Regex -> Ordering
compare :: Regex -> Regex -> Ordering
$c< :: Regex -> Regex -> Bool
< :: Regex -> Regex -> Bool
$c<= :: Regex -> Regex -> Bool
<= :: Regex -> Regex -> Bool
$c> :: Regex -> Regex -> Bool
> :: Regex -> Regex -> Bool
$c>= :: Regex -> Regex -> Bool
>= :: Regex -> Regex -> Bool
$cmax :: Regex -> Regex -> Regex
max :: Regex -> Regex -> Regex
$cmin :: Regex -> Regex -> Regex
min :: Regex -> Regex -> Regex
Ord)
-- ^ The first string is the regex pattern, the second is the regex options string. Options are identified by characters, which must be listed in alphabetical order. Valid options are *i* for case insensitive matching, *m* for multiline matching, *x* for verbose mode, *l* to make \\w, \\W, etc. locale dependent, *s* for dotall mode (\".\" matches everything), and *u* to make \\w, \\W, etc. match unicode.

-- ** Javascript

data Javascript = Javascript Document Text deriving (Typeable, Int -> Javascript -> ShowS
[Javascript] -> ShowS
Javascript -> String
(Int -> Javascript -> ShowS)
-> (Javascript -> String)
-> ([Javascript] -> ShowS)
-> Show Javascript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Javascript -> ShowS
showsPrec :: Int -> Javascript -> ShowS
$cshow :: Javascript -> String
show :: Javascript -> String
$cshowList :: [Javascript] -> ShowS
showList :: [Javascript] -> ShowS
Show, Javascript -> Javascript -> Bool
(Javascript -> Javascript -> Bool)
-> (Javascript -> Javascript -> Bool) -> Eq Javascript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Javascript -> Javascript -> Bool
== :: Javascript -> Javascript -> Bool
$c/= :: Javascript -> Javascript -> Bool
/= :: Javascript -> Javascript -> Bool
Eq, Eq Javascript
Eq Javascript =>
(Javascript -> Javascript -> Ordering)
-> (Javascript -> Javascript -> Bool)
-> (Javascript -> Javascript -> Bool)
-> (Javascript -> Javascript -> Bool)
-> (Javascript -> Javascript -> Bool)
-> (Javascript -> Javascript -> Javascript)
-> (Javascript -> Javascript -> Javascript)
-> Ord Javascript
Javascript -> Javascript -> Bool
Javascript -> Javascript -> Ordering
Javascript -> Javascript -> Javascript
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Javascript -> Javascript -> Ordering
compare :: Javascript -> Javascript -> Ordering
$c< :: Javascript -> Javascript -> Bool
< :: Javascript -> Javascript -> Bool
$c<= :: Javascript -> Javascript -> Bool
<= :: Javascript -> Javascript -> Bool
$c> :: Javascript -> Javascript -> Bool
> :: Javascript -> Javascript -> Bool
$c>= :: Javascript -> Javascript -> Bool
>= :: Javascript -> Javascript -> Bool
$cmax :: Javascript -> Javascript -> Javascript
max :: Javascript -> Javascript -> Javascript
$cmin :: Javascript -> Javascript -> Javascript
min :: Javascript -> Javascript -> Javascript
Ord)
-- ^ Javascript code with possibly empty environment mapping variables to values that the code may reference

-- ** Symbol

newtype Symbol = Symbol Text  deriving (Typeable, Int -> Symbol -> ShowS
[Symbol] -> ShowS
Symbol -> String
(Int -> Symbol -> ShowS)
-> (Symbol -> String) -> ([Symbol] -> ShowS) -> Show Symbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Symbol -> ShowS
showsPrec :: Int -> Symbol -> ShowS
$cshow :: Symbol -> String
show :: Symbol -> String
$cshowList :: [Symbol] -> ShowS
showList :: [Symbol] -> ShowS
Show, ReadPrec [Symbol]
ReadPrec Symbol
Int -> ReadS Symbol
ReadS [Symbol]
(Int -> ReadS Symbol)
-> ReadS [Symbol]
-> ReadPrec Symbol
-> ReadPrec [Symbol]
-> Read Symbol
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Symbol
readsPrec :: Int -> ReadS Symbol
$creadList :: ReadS [Symbol]
readList :: ReadS [Symbol]
$creadPrec :: ReadPrec Symbol
readPrec :: ReadPrec Symbol
$creadListPrec :: ReadPrec [Symbol]
readListPrec :: ReadPrec [Symbol]
Read, Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
/= :: Symbol -> Symbol -> Bool
Eq, Eq Symbol
Eq Symbol =>
(Symbol -> Symbol -> Ordering)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Symbol)
-> (Symbol -> Symbol -> Symbol)
-> Ord Symbol
Symbol -> Symbol -> Bool
Symbol -> Symbol -> Ordering
Symbol -> Symbol -> Symbol
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Symbol -> Symbol -> Ordering
compare :: Symbol -> Symbol -> Ordering
$c< :: Symbol -> Symbol -> Bool
< :: Symbol -> Symbol -> Bool
$c<= :: Symbol -> Symbol -> Bool
<= :: Symbol -> Symbol -> Bool
$c> :: Symbol -> Symbol -> Bool
> :: Symbol -> Symbol -> Bool
$c>= :: Symbol -> Symbol -> Bool
>= :: Symbol -> Symbol -> Bool
$cmax :: Symbol -> Symbol -> Symbol
max :: Symbol -> Symbol -> Symbol
$cmin :: Symbol -> Symbol -> Symbol
min :: Symbol -> Symbol -> Symbol
Ord)

-- ** MongoStamp

newtype MongoStamp = MongoStamp Int64  deriving (Typeable, Int -> MongoStamp -> ShowS
[MongoStamp] -> ShowS
MongoStamp -> String
(Int -> MongoStamp -> ShowS)
-> (MongoStamp -> String)
-> ([MongoStamp] -> ShowS)
-> Show MongoStamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MongoStamp -> ShowS
showsPrec :: Int -> MongoStamp -> ShowS
$cshow :: MongoStamp -> String
show :: MongoStamp -> String
$cshowList :: [MongoStamp] -> ShowS
showList :: [MongoStamp] -> ShowS
Show, ReadPrec [MongoStamp]
ReadPrec MongoStamp
Int -> ReadS MongoStamp
ReadS [MongoStamp]
(Int -> ReadS MongoStamp)
-> ReadS [MongoStamp]
-> ReadPrec MongoStamp
-> ReadPrec [MongoStamp]
-> Read MongoStamp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MongoStamp
readsPrec :: Int -> ReadS MongoStamp
$creadList :: ReadS [MongoStamp]
readList :: ReadS [MongoStamp]
$creadPrec :: ReadPrec MongoStamp
readPrec :: ReadPrec MongoStamp
$creadListPrec :: ReadPrec [MongoStamp]
readListPrec :: ReadPrec [MongoStamp]
Read, MongoStamp -> MongoStamp -> Bool
(MongoStamp -> MongoStamp -> Bool)
-> (MongoStamp -> MongoStamp -> Bool) -> Eq MongoStamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MongoStamp -> MongoStamp -> Bool
== :: MongoStamp -> MongoStamp -> Bool
$c/= :: MongoStamp -> MongoStamp -> Bool
/= :: MongoStamp -> MongoStamp -> Bool
Eq, Eq MongoStamp
Eq MongoStamp =>
(MongoStamp -> MongoStamp -> Ordering)
-> (MongoStamp -> MongoStamp -> Bool)
-> (MongoStamp -> MongoStamp -> Bool)
-> (MongoStamp -> MongoStamp -> Bool)
-> (MongoStamp -> MongoStamp -> Bool)
-> (MongoStamp -> MongoStamp -> MongoStamp)
-> (MongoStamp -> MongoStamp -> MongoStamp)
-> Ord MongoStamp
MongoStamp -> MongoStamp -> Bool
MongoStamp -> MongoStamp -> Ordering
MongoStamp -> MongoStamp -> MongoStamp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MongoStamp -> MongoStamp -> Ordering
compare :: MongoStamp -> MongoStamp -> Ordering
$c< :: MongoStamp -> MongoStamp -> Bool
< :: MongoStamp -> MongoStamp -> Bool
$c<= :: MongoStamp -> MongoStamp -> Bool
<= :: MongoStamp -> MongoStamp -> Bool
$c> :: MongoStamp -> MongoStamp -> Bool
> :: MongoStamp -> MongoStamp -> Bool
$c>= :: MongoStamp -> MongoStamp -> Bool
>= :: MongoStamp -> MongoStamp -> Bool
$cmax :: MongoStamp -> MongoStamp -> MongoStamp
max :: MongoStamp -> MongoStamp -> MongoStamp
$cmin :: MongoStamp -> MongoStamp -> MongoStamp
min :: MongoStamp -> MongoStamp -> MongoStamp
Ord)

-- ** MinMax

data MinMaxKey = MinKey | MaxKey  deriving (Typeable, Int -> MinMaxKey -> ShowS
[MinMaxKey] -> ShowS
MinMaxKey -> String
(Int -> MinMaxKey -> ShowS)
-> (MinMaxKey -> String)
-> ([MinMaxKey] -> ShowS)
-> Show MinMaxKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MinMaxKey -> ShowS
showsPrec :: Int -> MinMaxKey -> ShowS
$cshow :: MinMaxKey -> String
show :: MinMaxKey -> String
$cshowList :: [MinMaxKey] -> ShowS
showList :: [MinMaxKey] -> ShowS
Show, ReadPrec [MinMaxKey]
ReadPrec MinMaxKey
Int -> ReadS MinMaxKey
ReadS [MinMaxKey]
(Int -> ReadS MinMaxKey)
-> ReadS [MinMaxKey]
-> ReadPrec MinMaxKey
-> ReadPrec [MinMaxKey]
-> Read MinMaxKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MinMaxKey
readsPrec :: Int -> ReadS MinMaxKey
$creadList :: ReadS [MinMaxKey]
readList :: ReadS [MinMaxKey]
$creadPrec :: ReadPrec MinMaxKey
readPrec :: ReadPrec MinMaxKey
$creadListPrec :: ReadPrec [MinMaxKey]
readListPrec :: ReadPrec [MinMaxKey]
Read, MinMaxKey -> MinMaxKey -> Bool
(MinMaxKey -> MinMaxKey -> Bool)
-> (MinMaxKey -> MinMaxKey -> Bool) -> Eq MinMaxKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MinMaxKey -> MinMaxKey -> Bool
== :: MinMaxKey -> MinMaxKey -> Bool
$c/= :: MinMaxKey -> MinMaxKey -> Bool
/= :: MinMaxKey -> MinMaxKey -> Bool
Eq, Eq MinMaxKey
Eq MinMaxKey =>
(MinMaxKey -> MinMaxKey -> Ordering)
-> (MinMaxKey -> MinMaxKey -> Bool)
-> (MinMaxKey -> MinMaxKey -> Bool)
-> (MinMaxKey -> MinMaxKey -> Bool)
-> (MinMaxKey -> MinMaxKey -> Bool)
-> (MinMaxKey -> MinMaxKey -> MinMaxKey)
-> (MinMaxKey -> MinMaxKey -> MinMaxKey)
-> Ord MinMaxKey
MinMaxKey -> MinMaxKey -> Bool
MinMaxKey -> MinMaxKey -> Ordering
MinMaxKey -> MinMaxKey -> MinMaxKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MinMaxKey -> MinMaxKey -> Ordering
compare :: MinMaxKey -> MinMaxKey -> Ordering
$c< :: MinMaxKey -> MinMaxKey -> Bool
< :: MinMaxKey -> MinMaxKey -> Bool
$c<= :: MinMaxKey -> MinMaxKey -> Bool
<= :: MinMaxKey -> MinMaxKey -> Bool
$c> :: MinMaxKey -> MinMaxKey -> Bool
> :: MinMaxKey -> MinMaxKey -> Bool
$c>= :: MinMaxKey -> MinMaxKey -> Bool
>= :: MinMaxKey -> MinMaxKey -> Bool
$cmax :: MinMaxKey -> MinMaxKey -> MinMaxKey
max :: MinMaxKey -> MinMaxKey -> MinMaxKey
$cmin :: MinMaxKey -> MinMaxKey -> MinMaxKey
min :: MinMaxKey -> MinMaxKey -> MinMaxKey
Ord)

-- ** ObjectId

data ObjectId = Oid {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word64  deriving (Typeable, ObjectId -> ObjectId -> Bool
(ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool) -> Eq ObjectId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectId -> ObjectId -> Bool
== :: ObjectId -> ObjectId -> Bool
$c/= :: ObjectId -> ObjectId -> Bool
/= :: ObjectId -> ObjectId -> Bool
Eq, Eq ObjectId
Eq ObjectId =>
(ObjectId -> ObjectId -> Ordering)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> Bool)
-> (ObjectId -> ObjectId -> ObjectId)
-> (ObjectId -> ObjectId -> ObjectId)
-> Ord ObjectId
ObjectId -> ObjectId -> Bool
ObjectId -> ObjectId -> Ordering
ObjectId -> ObjectId -> ObjectId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ObjectId -> ObjectId -> Ordering
compare :: ObjectId -> ObjectId -> Ordering
$c< :: ObjectId -> ObjectId -> Bool
< :: ObjectId -> ObjectId -> Bool
$c<= :: ObjectId -> ObjectId -> Bool
<= :: ObjectId -> ObjectId -> Bool
$c> :: ObjectId -> ObjectId -> Bool
> :: ObjectId -> ObjectId -> Bool
$c>= :: ObjectId -> ObjectId -> Bool
>= :: ObjectId -> ObjectId -> Bool
$cmax :: ObjectId -> ObjectId -> ObjectId
max :: ObjectId -> ObjectId -> ObjectId
$cmin :: ObjectId -> ObjectId -> ObjectId
min :: ObjectId -> ObjectId -> ObjectId
Ord)
-- ^ A BSON ObjectID is a 12-byte value consisting of a 4-byte timestamp (seconds since epoch), a 3-byte machine id, a 2-byte process id, and a 3-byte counter. Note that the timestamp and counter fields must be stored big endian unlike the rest of BSON. This is because they are compared byte-by-byte and we want to ensure a mostly increasing order.

instance Show ObjectId where
  showsPrec :: Int -> ObjectId -> ShowS
showsPrec Int
_ (Oid Word24
x Word64
y) = Int -> Word24 -> ShowS
forall n. (Show n, Integral n) => Int -> n -> ShowS
showHexLen Int
8 Word24
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64 -> ShowS
forall n. (Show n, Integral n) => Int -> n -> ShowS
showHexLen Int
16 Word64
y

instance Read ObjectId where
  readPrec :: ReadPrec ObjectId
readPrec = do
    [(Word24
x, String
"")] <- ReadS Word24
forall a. (Eq a, Num a) => ReadS a
readHex ReadS Word24 -> ReadPrec String -> ReadPrec [(Word24, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP String -> ReadPrec String
forall a. ReadP a -> ReadPrec a
R.lift (Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
R.count Int
8 ReadP Char
R.get)
    Word64
y <- (Int -> ReadS Word64) -> ReadPrec Word64
forall a. (Int -> ReadS a) -> ReadPrec a
R.readS_to_Prec ((Int -> ReadS Word64) -> ReadPrec Word64)
-> (Int -> ReadS Word64) -> ReadPrec Word64
forall a b. (a -> b) -> a -> b
$ ReadS Word64 -> Int -> ReadS Word64
forall a b. a -> b -> a
const ReadS Word64
forall a. (Eq a, Num a) => ReadS a
readHex
    ObjectId -> ReadPrec ObjectId
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word24 -> Word64 -> ObjectId
Oid Word24
x Word64
y)

timestamp :: ObjectId -> UTCTime
-- ^ Time when objectId was created
timestamp :: ObjectId -> UTCTime
timestamp (Oid Word24
time Word64
_) = POSIXTime -> UTCTime
posixSecondsToUTCTime (Word24 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word24
time)

genObjectId :: IO ObjectId
-- ^ Create a fresh ObjectId
genObjectId :: IO ObjectId
genObjectId = do
  Word24
time <- POSIXTime -> Word24
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (POSIXTime -> Word24) -> IO POSIXTime -> IO Word24
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
getPOSIXTime
  Word16
pid <- Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> IO Int -> IO Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int
getProcessID
  Word24
inc <- IO Word24
nextCount
  ObjectId -> IO ObjectId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjectId -> IO ObjectId) -> ObjectId -> IO ObjectId
forall a b. (a -> b) -> a -> b
$ Word24 -> Word64 -> ObjectId
Oid Word24
time (Word24 -> Word16 -> Word24 -> Word64
composite Word24
machineId Word16
pid Word24
inc)
 where
  machineId :: Word24
  machineId :: Word24
machineId = IO Word24 -> Word24
forall a. IO a -> a
unsafePerformIO ([Word8] -> Word24
makeWord24 ([Word8] -> Word24) -> (String -> [Word8]) -> String -> Word24
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
S.unpack (ByteString -> [Word8])
-> (String -> ByteString) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
S.take Int
3 (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
MD5.hash (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
SC.pack (String -> Word24) -> IO String -> IO Word24
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHostName)
  {-# NOINLINE machineId #-}
  counter :: IORef Word24
  counter :: IORef Word24
counter = IO (IORef Word24) -> IORef Word24
forall a. IO a -> a
unsafePerformIO (Word24 -> IO (IORef Word24)
forall a. a -> IO (IORef a)
newIORef Word24
0)
  {-# NOINLINE counter #-}
  nextCount :: IO Word24
  nextCount :: IO Word24
nextCount = IORef Word24 -> (Word24 -> (Word24, Word24)) -> IO Word24
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Word24
counter ((Word24 -> (Word24, Word24)) -> IO Word24)
-> (Word24 -> (Word24, Word24)) -> IO Word24
forall a b. (a -> b) -> a -> b
$ \Word24
n -> (Word24 -> Word24
wrap24 (Word24
n Word24 -> Word24 -> Word24
forall a. Num a => a -> a -> a
+ Word24
1), Word24
n)

composite :: Word24 -> Word16 -> Word24 -> Word64
composite :: Word24 -> Word16 -> Word24 -> Word64
composite Word24
mid Word16
pid Word24
inc = Word24 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word24
mid Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shift` Int
40 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
pid Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shift` Int
24 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word24 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word24
inc

type Word24 = Word32
-- ^ low 3 bytes only, high byte must be zero

wrap24 :: Word24 -> Word24
wrap24 :: Word24 -> Word24
wrap24 Word24
n = Word24
n Word24 -> Word24 -> Word24
forall a. Integral a => a -> a -> a
`mod` Word24
0x1000000

makeWord24 :: [Word8] -> Word24
-- ^ Put last 3 bytes into a Word24. Expected to be called on very short list
makeWord24 :: [Word8] -> Word24
makeWord24 = (Word24 -> Word8 -> Word24) -> Word24 -> [Word8] -> Word24
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Word24
a Word8
b -> Word24
a Word24 -> Int -> Word24
forall a. Bits a => a -> Int -> a
`shift` Int
8 Word24 -> Word24 -> Word24
forall a. Bits a => a -> a -> a
.|. Word8 -> Word24
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word24
0

{- Authors: Tony Hannan <tony@10gen.com>
   Copyright 2010 10gen Inc.
   Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0. Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. -}