-- | Subspaces allow you to easily attach a common prefix to tuple-encoded keys
-- (See "FoundationDB.Layer.Tuple") so that you can perform range reads and
-- deletes over a set of related keys.
--
-- The subspace layer is one of the standard layers supported by all
-- language bindings. See
-- <https://apple.github.io/foundationdb/developer-guide.html#subspaces the official documentation>
-- for more information.
module FoundationDB.Layer.Subspace
  ( -- * Creating subspaces
    Subspace (..),
    subspace,
    prefixedSubspace,

    -- * Using subspaces
    extend,
    pack,
    unpack,
    contains,
    subspaceRangeQuery,
    getLast,
    subspaceKey,
  )
where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Sequence (Seq (Empty, (:<|)))
import FoundationDB
import FoundationDB.Layer.Tuple

-- | Represents a subspace of 'Tuple' keys. A subspace is just a common prefix
-- for a set of tuples.
newtype Subspace = Subspace {Subspace -> ByteString
rawPrefix :: ByteString}
  deriving (Int -> Subspace -> ShowS
[Subspace] -> ShowS
Subspace -> String
(Int -> Subspace -> ShowS)
-> (Subspace -> String) -> ([Subspace] -> ShowS) -> Show Subspace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subspace] -> ShowS
$cshowList :: [Subspace] -> ShowS
show :: Subspace -> String
$cshow :: Subspace -> String
showsPrec :: Int -> Subspace -> ShowS
$cshowsPrec :: Int -> Subspace -> ShowS
Show, Subspace -> Subspace -> Bool
(Subspace -> Subspace -> Bool)
-> (Subspace -> Subspace -> Bool) -> Eq Subspace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subspace -> Subspace -> Bool
$c/= :: Subspace -> Subspace -> Bool
== :: Subspace -> Subspace -> Bool
$c== :: Subspace -> Subspace -> Bool
Eq, Eq Subspace
Eq Subspace
-> (Subspace -> Subspace -> Ordering)
-> (Subspace -> Subspace -> Bool)
-> (Subspace -> Subspace -> Bool)
-> (Subspace -> Subspace -> Bool)
-> (Subspace -> Subspace -> Bool)
-> (Subspace -> Subspace -> Subspace)
-> (Subspace -> Subspace -> Subspace)
-> Ord Subspace
Subspace -> Subspace -> Bool
Subspace -> Subspace -> Ordering
Subspace -> Subspace -> Subspace
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
min :: Subspace -> Subspace -> Subspace
$cmin :: Subspace -> Subspace -> Subspace
max :: Subspace -> Subspace -> Subspace
$cmax :: Subspace -> Subspace -> Subspace
>= :: Subspace -> Subspace -> Bool
$c>= :: Subspace -> Subspace -> Bool
> :: Subspace -> Subspace -> Bool
$c> :: Subspace -> Subspace -> Bool
<= :: Subspace -> Subspace -> Bool
$c<= :: Subspace -> Subspace -> Bool
< :: Subspace -> Subspace -> Bool
$c< :: Subspace -> Subspace -> Bool
compare :: Subspace -> Subspace -> Ordering
$ccompare :: Subspace -> Subspace -> Ordering
$cp1Ord :: Eq Subspace
Ord)

-- | Create a subspace from a tuple.
subspace ::
  -- | Tuple with which to prefix the subspace. May not contain
  -- incomplete version stamps.
  [Elem] ->
  Subspace
subspace :: [Elem] -> Subspace
subspace [Elem]
es = ByteString -> Subspace
Subspace ([Elem] -> ByteString
forall (t :: * -> *). Traversable t => t Elem -> ByteString
encodeTupleElems [Elem]
es)

-- | Create a subspace from a raw bytestring prefix and a tuple.
prefixedSubspace ::
  -- | prefix
  ByteString ->
  [Elem] ->
  Subspace
prefixedSubspace :: ByteString -> [Elem] -> Subspace
prefixedSubspace ByteString
prefix [Elem]
tuple = ByteString -> Subspace
Subspace (ByteString -> [Elem] -> ByteString
forall (t :: * -> *).
Traversable t =>
ByteString -> t Elem -> ByteString
encodeTupleElemsWPrefix ByteString
prefix [Elem]
tuple)

-- | Returns the bytestring prefix of the subspace. Equivalent to 'rawPrefix'.
-- This function is provided for consistency with other language bindings.
subspaceKey :: Subspace -> ByteString
subspaceKey :: Subspace -> ByteString
subspaceKey = Subspace -> ByteString
rawPrefix

-- | Create a subsubspace by extending the prefix of a subspace by the
-- given tuple.
extend ::
  Subspace ->
  [Elem] ->
  Subspace
extend :: Subspace -> [Elem] -> Subspace
extend (Subspace ByteString
prfx) =
  ByteString -> [Elem] -> Subspace
prefixedSubspace ByteString
prfx

-- | Encode a tuple prefixed with a subspace.
pack :: Subspace -> [Elem] -> ByteString
pack :: Subspace -> [Elem] -> ByteString
pack Subspace
sub = ByteString -> [Elem] -> ByteString
forall (t :: * -> *).
Traversable t =>
ByteString -> t Elem -> ByteString
encodeTupleElemsWPrefix (Subspace -> ByteString
rawPrefix Subspace
sub)

-- | Decode a tuple that was encoded by 'pack'.
unpack :: Subspace -> ByteString -> Either String [Elem]
unpack :: Subspace -> ByteString -> Either String [Elem]
unpack Subspace
sub = ByteString -> ByteString -> Either String [Elem]
decodeTupleElemsWPrefix (Subspace -> ByteString
rawPrefix Subspace
sub)

-- | Returns 'True' iff the subspace contains the given key.
contains ::
  Subspace ->
  -- | encoded key
  ByteString ->
  Bool
contains :: Subspace -> ByteString -> Bool
contains Subspace
sub = ByteString -> ByteString -> Bool
BS.isPrefixOf (Subspace -> ByteString
rawPrefix Subspace
sub)

-- | Construct a range query that covers an entire subspace.
subspaceRangeQuery :: Subspace -> RangeQuery
subspaceRangeQuery :: Subspace -> RangeQuery
subspaceRangeQuery Subspace
s =
  RangeQuery :: KeySelector -> KeySelector -> Maybe Int -> Bool -> RangeQuery
RangeQuery
    { rangeBegin :: KeySelector
rangeBegin = ByteString -> KeySelector
FirstGreaterOrEq (ByteString
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
BS.pack [Word8
0x00]),
      rangeEnd :: KeySelector
rangeEnd = ByteString -> KeySelector
FirstGreaterOrEq (ByteString
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
BS.pack [Word8
0xff]),
      rangeLimit :: Maybe Int
rangeLimit = Maybe Int
forall a. Maybe a
Nothing,
      rangeReverse :: Bool
rangeReverse = Bool
False
    }
  where
    k :: ByteString
k = Subspace -> [Elem] -> ByteString
pack Subspace
s []

-- | Get the last key,value pair in the subspace, if it exists.
getLast :: Subspace -> Transaction (Maybe (ByteString, ByteString))
getLast :: Subspace -> Transaction (Maybe (ByteString, ByteString))
getLast Subspace
sub = do
  Future RangeResult
rr <-
    RangeQuery -> Transaction (Future RangeResult)
getRange
      (Subspace -> RangeQuery
subspaceRangeQuery Subspace
sub)
        { rangeLimit :: Maybe Int
rangeLimit = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1,
          rangeReverse :: Bool
rangeReverse = Bool
True
        }
  RangeResult
kvs <- Future RangeResult -> Transaction RangeResult
forall a. Future a -> Transaction a
await Future RangeResult
rr
  case RangeResult
kvs of
    RangeDone Seq (ByteString, ByteString)
Empty -> Maybe (ByteString, ByteString)
-> Transaction (Maybe (ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing
    RangeDone ((ByteString, ByteString)
kv :<| Seq (ByteString, ByteString)
_) -> Maybe (ByteString, ByteString)
-> Transaction (Maybe (ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString, ByteString)
kv)
    RangeMore ((ByteString, ByteString)
kv :<| Seq (ByteString, ByteString)
_) Future RangeResult
_ -> Maybe (ByteString, ByteString)
-> Transaction (Maybe (ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString, ByteString)
kv)
    RangeMore Seq (ByteString, ByteString)
Empty Future RangeResult
_ -> Maybe (ByteString, ByteString)
-> Transaction (Maybe (ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing --NOTE: impossible case