{-# LANGUAGE StrictData #-}
{-# OPTIONS_HADDOCK prune not-home #-}

{- |
Module      : KeyedVals.Handle.Internal
Copyright   : (c) 2022 Tim Emiola
Maintainer  : Tim Emiola <adetokunbo@emio.la>
SPDX-License-Identifier: BSD3

Declares the abstract @'Handle'@
-}
module KeyedVals.Handle.Internal (
  -- * types used in the @Handle@ functions
  HandleErr (..),
  Glob,
  mkGlob,
  globPattern,
  isIn,
  Selection (..),

  -- * the abstract @Handle@
  Handle (..),

  -- * aliases used in the 'Handle' functions
  Key,
  Val,
  ValsByKey,
) where

import Control.Exception (Exception)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict (Map)
import Data.Text (Text)
import Numeric.Natural (Natural)
import Redis.Glob (matches, validate)


-- | A handle for accessing the 'ValsByKey' store.
data Handle m = Handle
  { forall (m :: * -> *).
Handle m -> Key -> m (Either HandleErr (Maybe Key))
hLoadVal :: !(Key -> m (Either HandleErr (Maybe Val)))
  , forall (m :: * -> *).
Handle m -> Key -> Key -> m (Either HandleErr ())
hSaveVal :: !(Key -> Val -> m (Either HandleErr ()))
  , forall (m :: * -> *).
Handle m -> Key -> m (Either HandleErr Natural)
hCountKVs :: !(Key -> m (Either HandleErr Natural))
  , forall (m :: * -> *).
Handle m -> Key -> m (Either HandleErr ValsByKey)
hLoadKVs :: !(Key -> m (Either HandleErr ValsByKey))
  , forall (m :: * -> *).
Handle m -> Key -> ValsByKey -> m (Either HandleErr ())
hSaveKVs :: !(Key -> ValsByKey -> m (Either HandleErr ()))
  , forall (m :: * -> *).
Handle m -> Key -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs :: !(Key -> ValsByKey -> m (Either HandleErr ()))
  , forall (m :: * -> *).
Handle m -> Key -> Key -> m (Either HandleErr (Maybe Key))
hLoadFrom :: !(Key -> Key -> m (Either HandleErr (Maybe Val)))
  , forall (m :: * -> *).
Handle m -> Key -> Key -> Key -> m (Either HandleErr ())
hSaveTo :: !(Key -> Key -> Val -> m (Either HandleErr ()))
  , forall (m :: * -> *).
Handle m -> Key -> Selection -> m (Either HandleErr ValsByKey)
hLoadSlice :: !(Key -> Selection -> m (Either HandleErr ValsByKey))
  , forall (m :: * -> *).
Handle m -> Selection -> m (Either HandleErr ())
hDeleteSelected :: !(Selection -> m (Either HandleErr ()))
  , forall (m :: * -> *).
Handle m -> Key -> Selection -> m (Either HandleErr ())
hDeleteSelectedKVs :: !(Key -> Selection -> m (Either HandleErr ()))
  , forall (m :: * -> *). Handle m -> m ()
hClose :: !(m ())
  }


-- | Represents the errors that might arise in 'Handle' functions
data HandleErr
  = ConnectionClosed
  | Unanticipated !Text
  | NotDecoded !Text
  | BadKey
  | Gone !Key
  deriving (HandleErr -> HandleErr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandleErr -> HandleErr -> Bool
$c/= :: HandleErr -> HandleErr -> Bool
== :: HandleErr -> HandleErr -> Bool
$c== :: HandleErr -> HandleErr -> Bool
Eq, Int -> HandleErr -> ShowS
[HandleErr] -> ShowS
HandleErr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandleErr] -> ShowS
$cshowList :: [HandleErr] -> ShowS
show :: HandleErr -> String
$cshow :: HandleErr -> String
showsPrec :: Int -> HandleErr -> ShowS
$cshowsPrec :: Int -> HandleErr -> ShowS
Show)


-- | Represents ways of restricting the keys used in a @'ValsByKey'@
data Selection
  = -- | any keys that match the glob pattern
    Match !Glob
  | -- | any of the specified keys
    AllOf !(NonEmpty Key)
  deriving (Selection -> Selection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selection -> Selection -> Bool
$c/= :: Selection -> Selection -> Bool
== :: Selection -> Selection -> Bool
$c== :: Selection -> Selection -> Bool
Eq, Int -> Selection -> ShowS
[Selection] -> ShowS
Selection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selection] -> ShowS
$cshowList :: [Selection] -> ShowS
show :: Selection -> String
$cshow :: Selection -> String
showsPrec :: Int -> Selection -> ShowS
$cshowsPrec :: Int -> Selection -> ShowS
Show)


-- | Represents a redis glob use to select keys
newtype Glob = Glob {Glob -> Key
globPattern :: ByteString}
  deriving (Glob -> Glob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Glob -> Glob -> Bool
$c/= :: Glob -> Glob -> Bool
== :: Glob -> Glob -> Bool
$c== :: Glob -> Glob -> Bool
Eq, Int -> Glob -> ShowS
[Glob] -> ShowS
Glob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Glob] -> ShowS
$cshowList :: [Glob] -> ShowS
show :: Glob -> String
$cshow :: Glob -> String
showsPrec :: Int -> Glob -> ShowS
$cshowsPrec :: Int -> Glob -> ShowS
Show)


{- | constructor for a 'Glob'

returns 'Nothing' if the pattern is invalid
-}
mkGlob :: ByteString -> Maybe Glob
mkGlob :: Key -> Maybe Glob
mkGlob = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key -> Glob
Glob forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Key
LB.toStrict) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
validate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ByteString
LB.fromStrict


-- | tests if a 'ByteString' matches a Selection
isIn :: ByteString -> Selection -> Bool
isIn :: Key -> Selection -> Bool
isIn Key
b (Match Glob
g) = Key -> ByteString
LB.fromStrict Key
b ByteString -> ByteString -> Bool
`matches` Key -> ByteString
LB.fromStrict (Glob -> Key
globPattern Glob
g)
isIn Key
b (AllOf (Key
key :| [Key]
ks)) = Key
key forall a. Eq a => a -> a -> Bool
== Key
b Bool -> Bool -> Bool
|| Key
b forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
ks


instance Exception HandleErr


-- | Represents a key used to store a 'Val'.
type Key = ByteString


-- | Represents a value stored in the service.
type Val = ByteString


-- | Represents a related group of @'Val'@s stored by @'Key'@.
type ValsByKey = Map Key Val