{-# LANGUAGE NoImplicitPrelude #-}

module Tendermint.SDK.BaseApp.Store.List
  ( List
  , makeList
  , makeFullStoreKey
  , append
  , delete
  , deleteWhen
  , foldl
  , toList
  , length
  , elemIndex
  , (!!)
  ) where

import           Control.Lens                          (from, iso, to, view,
                                                        (^.))
import           Control.Monad                         (when)
import qualified Data.ByteArray.HexString              as Hex
import           Data.Kind                             (Type)
import           Data.String.Conversions               (cs)
import           Data.Word                             (Word64)
import           Polysemy                              (Members, Sem)
import           Polysemy.Error                        (Error)
import           Prelude                               hiding (foldl, length,
                                                        (!!))
import           Tendermint.SDK.BaseApp.Errors         (AppError,
                                                        SDKError (InternalError),
                                                        throwSDKError)
import qualified Tendermint.SDK.BaseApp.Store.Map      as M
import qualified Tendermint.SDK.BaseApp.Store.RawStore as S
import           Tendermint.SDK.Codec                  (HasCodec (..))

data List (a :: Type) = List
  { List a -> Store (List a)
listStore :: S.Store (List a)
  }

newtype Idx = Idx {Idx -> Word64
unIdx :: Word64} deriving (Idx -> Idx -> Bool
(Idx -> Idx -> Bool) -> (Idx -> Idx -> Bool) -> Eq Idx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Idx -> Idx -> Bool
$c/= :: Idx -> Idx -> Bool
== :: Idx -> Idx -> Bool
$c== :: Idx -> Idx -> Bool
Eq, Int -> Idx -> ShowS
[Idx] -> ShowS
Idx -> String
(Int -> Idx -> ShowS)
-> (Idx -> String) -> ([Idx] -> ShowS) -> Show Idx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Idx] -> ShowS
$cshowList :: [Idx] -> ShowS
show :: Idx -> String
$cshow :: Idx -> String
showsPrec :: Int -> Idx -> ShowS
$cshowsPrec :: Int -> Idx -> ShowS
Show, Eq Idx
Eq Idx =>
(Idx -> Idx -> Ordering)
-> (Idx -> Idx -> Bool)
-> (Idx -> Idx -> Bool)
-> (Idx -> Idx -> Bool)
-> (Idx -> Idx -> Bool)
-> (Idx -> Idx -> Idx)
-> (Idx -> Idx -> Idx)
-> Ord Idx
Idx -> Idx -> Bool
Idx -> Idx -> Ordering
Idx -> Idx -> Idx
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 :: Idx -> Idx -> Idx
$cmin :: Idx -> Idx -> Idx
max :: Idx -> Idx -> Idx
$cmax :: Idx -> Idx -> Idx
>= :: Idx -> Idx -> Bool
$c>= :: Idx -> Idx -> Bool
> :: Idx -> Idx -> Bool
$c> :: Idx -> Idx -> Bool
<= :: Idx -> Idx -> Bool
$c<= :: Idx -> Idx -> Bool
< :: Idx -> Idx -> Bool
$c< :: Idx -> Idx -> Bool
compare :: Idx -> Idx -> Ordering
$ccompare :: Idx -> Idx -> Ordering
$cp1Ord :: Eq Idx
Ord, Integer -> Idx
Idx -> Idx
Idx -> Idx -> Idx
(Idx -> Idx -> Idx)
-> (Idx -> Idx -> Idx)
-> (Idx -> Idx -> Idx)
-> (Idx -> Idx)
-> (Idx -> Idx)
-> (Idx -> Idx)
-> (Integer -> Idx)
-> Num Idx
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Idx
$cfromInteger :: Integer -> Idx
signum :: Idx -> Idx
$csignum :: Idx -> Idx
abs :: Idx -> Idx
$cabs :: Idx -> Idx
negate :: Idx -> Idx
$cnegate :: Idx -> Idx
* :: Idx -> Idx -> Idx
$c* :: Idx -> Idx -> Idx
- :: Idx -> Idx -> Idx
$c- :: Idx -> Idx -> Idx
+ :: Idx -> Idx -> Idx
$c+ :: Idx -> Idx -> Idx
Num)

instance S.RawKey Idx where
    rawKey :: p ByteString (f ByteString) -> p Idx (f Idx)
rawKey = (Idx -> ByteString) -> (ByteString -> Idx) -> Iso' Idx ByteString
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Idx ma :: Word64
ma) -> Word64
ma Word64 -> Getting ByteString Word64 ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString Word64 ByteString
forall k. RawKey k => Iso' k ByteString
S.rawKey)
                (\bs :: ByteString
bs -> ByteString
bs ByteString -> Getting Idx ByteString Idx -> Idx
forall s a. s -> Getting a s a -> a
^. AnIso Word64 Word64 ByteString ByteString
-> Iso ByteString ByteString Word64 Word64
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso Word64 Word64 ByteString ByteString
forall k. RawKey k => Iso' k ByteString
S.rawKey ((Word64 -> Const Idx Word64)
 -> ByteString -> Const Idx ByteString)
-> ((Idx -> Const Idx Idx) -> Word64 -> Const Idx Word64)
-> Getting Idx ByteString Idx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Idx)
-> (Idx -> Const Idx Idx) -> Word64 -> Const Idx Word64
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Word64 -> Idx
Idx)

instance HasCodec Idx where
    encode :: Idx -> ByteString
encode = Getting ByteString Idx ByteString -> Idx -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString Idx ByteString
forall k. RawKey k => Iso' k ByteString
S.rawKey
    decode :: ByteString -> Either Text Idx
decode = Idx -> Either Text Idx
forall a b. b -> Either a b
Right (Idx -> Either Text Idx)
-> (ByteString -> Idx) -> ByteString -> Either Text Idx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Idx ByteString Idx -> ByteString -> Idx
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (AnIso Idx Idx ByteString ByteString
-> Iso ByteString ByteString Idx Idx
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso Idx Idx ByteString ByteString
forall k. RawKey k => Iso' k ByteString
S.rawKey)

data IdxKey = IdxKey

instance S.RawKey IdxKey where
  rawKey :: p ByteString (f ByteString) -> p IdxKey (f IdxKey)
rawKey =
    let k :: ByteString
k = HexString -> ByteString
forall ba. ByteArray ba => HexString -> ba
Hex.toBytes "0x00"
    in (IdxKey -> ByteString)
-> (ByteString -> IdxKey) -> Iso' IdxKey ByteString
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (ByteString -> IdxKey -> ByteString
forall a b. a -> b -> a
const ByteString
k)
         (\bs :: ByteString
bs -> if ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
k
                   then IdxKey
IdxKey
                   else String -> IdxKey
forall a. HasCallStack => String -> a
error "Error parsing IdxKey"
         )

instance S.IsKey IdxKey (List a) where
  type Value IdxKey (List a) = M.Map Idx Idx

data ValueKey = ValueKey

instance S.RawKey ValueKey where
  rawKey :: p ByteString (f ByteString) -> p ValueKey (f ValueKey)
rawKey =
    let k :: ByteString
k = HexString -> ByteString
forall ba. ByteArray ba => HexString -> ba
Hex.toBytes "0x01"
    in (ValueKey -> ByteString)
-> (ByteString -> ValueKey) -> Iso' ValueKey ByteString
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (ByteString -> ValueKey -> ByteString
forall a b. a -> b -> a
const ByteString
k)
         (\bs :: ByteString
bs -> if ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
k
                   then ValueKey
ValueKey
                   else String -> ValueKey
forall a. HasCallStack => String -> a
error "Error parsing ValueKey"
         )

instance S.IsKey ValueKey (List a) where
  type Value ValueKey (List a) = M.Map Idx a


instance S.IsKey Idx (List a) where
  type Value Idx (List a) = a

makeList
  :: S.IsKey key ns
  => S.Value key ns ~ List a
  => key
  -> S.Store ns
  -> S.Value key ns
makeList :: key -> Store ns -> Value key ns
makeList key :: key
key store :: Store ns
store =
  Store (List a) -> Value key ns
forall a. Store (List a) -> List a
List (Store (List a) -> Value key ns) -> Store (List a) -> Value key ns
forall a b. (a -> b) -> a -> b
$ Store ns -> Store (List a) -> Store (List a)
forall k1 k2 (parentns :: k1) (childns :: k2).
Store parentns -> Store childns -> Store childns
S.nestStore Store ns
store (Store (List a) -> Store (List a))
-> Store (List a) -> Store (List a)
forall a b. (a -> b) -> a -> b
$
    KeyRoot (List a) -> Store (List a)
forall k (ns :: k). KeyRoot ns -> Store ns
S.makeStore (KeyRoot (List a) -> Store (List a))
-> (ByteString -> KeyRoot (List a)) -> ByteString -> Store (List a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> KeyRoot (List a)
forall k (ns :: k). ByteString -> KeyRoot ns
S.KeyRoot (ByteString -> Store (List a)) -> ByteString -> Store (List a)
forall a b. (a -> b) -> a -> b
$ key
key key -> Getting ByteString key ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString key ByteString
forall k. RawKey k => Iso' k ByteString
S.rawKey

makeFullStoreKey
  :: List a
  -> Word64
  -> S.StoreKey
makeFullStoreKey :: List a -> Word64 -> StoreKey
makeFullStoreKey List{..} i :: Word64
i =
  Store (List a) -> Idx -> StoreKey
forall k1 k2 (ns :: k1). IsKey k2 ns => Store ns -> k2 -> StoreKey
S.makeStoreKey Store (List a)
listStore (Word64 -> Idx
Idx Word64
i)

getIdxMap
  :: List a
  -> M.Map Idx Idx
getIdxMap :: List a -> Map Idx Idx
getIdxMap List{..} =
  IdxKey -> Store (List a) -> Value IdxKey (List a)
forall k1 key (ns :: k1) k2 v.
(IsKey key ns, Value key ns ~ Map k2 v) =>
key -> Store ns -> Value key ns
M.makeMap IdxKey
IdxKey Store (List a)
listStore

getValueMap
  :: List a
  -> M.Map Idx a
getValueMap :: List a -> Map Idx a
getValueMap List{..} =
  ValueKey -> Store (List a) -> Value ValueKey (List a)
forall k1 key (ns :: k1) k2 v.
(IsKey key ns, Value key ns ~ Map k2 v) =>
key -> Store ns -> Value key ns
M.makeMap ValueKey
ValueKey Store (List a)
listStore

data HeadKey = HeadKey

instance S.RawKey HeadKey where
  rawKey :: p ByteString (f ByteString) -> p HeadKey (f HeadKey)
rawKey =
    let k :: ByteString
k = HexString -> ByteString
forall ba. ByteArray ba => HexString -> ba
Hex.toBytes "0x02"
    in (HeadKey -> ByteString)
-> (ByteString -> HeadKey) -> Iso' HeadKey ByteString
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (ByteString -> HeadKey -> ByteString
forall a b. a -> b -> a
const ByteString
k)
         (\bs :: ByteString
bs -> if ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
k
                   then HeadKey
HeadKey
                   else String -> HeadKey
forall a. HasCallStack => String -> a
error "Error parsing HeadKey"
         )

instance S.IsKey HeadKey (List a) where
  type Value HeadKey (List a) = Idx

append
  :: Members [Error AppError, S.ReadStore, S.WriteStore] r
  => HasCodec a
  => a
  -> List a
  -> Sem r ()
append :: a -> List a -> Sem r ()
append a :: a
a l :: List a
l@List{..} = do
  Maybe Idx
mhd <- Store (List a) -> HeadKey -> Sem r (Maybe (Value HeadKey (List a)))
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns),
 Members '[ReadStore, Error AppError] r) =>
Store ns -> k2 -> Sem r (Maybe (Value k2 ns))
S.get Store (List a)
listStore HeadKey
HeadKey
  let valueMap :: Map Idx a
valueMap = List a -> Map Idx a
forall a. List a -> Map Idx a
getValueMap List a
l
  case Maybe Idx
mhd of
    Nothing -> do
      Store (List a) -> HeadKey -> Value HeadKey (List a) -> Sem r ()
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns), Member WriteStore r) =>
Store ns -> k2 -> Value k2 ns -> Sem r ()
S.put Store (List a)
listStore HeadKey
HeadKey 0
      Idx -> a -> Map Idx a -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k, HasCodec v) =>
k -> v -> Map k v -> Sem r ()
M.insert 0 a
a Map Idx a
valueMap
    Just hd :: Idx
hd -> do
      let hd' :: Idx
hd' = Idx
hd Idx -> Idx -> Idx
forall a. Num a => a -> a -> a
+ 1
          idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
      Idx -> Idx -> Map Idx Idx -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k, HasCodec v) =>
k -> v -> Map k v -> Sem r ()
M.insert  Idx
hd' Idx
hd Map Idx Idx
idxMap
      Idx -> a -> Map Idx a -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k, HasCodec v) =>
k -> v -> Map k v -> Sem r ()
M.insert Idx
hd' a
a Map Idx a
valueMap
      Store (List a) -> HeadKey -> Value HeadKey (List a) -> Sem r ()
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns), Member WriteStore r) =>
Store ns -> k2 -> Value k2 ns -> Sem r ()
S.put Store (List a)
listStore HeadKey
HeadKey Value HeadKey (List a)
Idx
hd'

-- | Delete the first occurence in the list.
delete
  :: Members [Error AppError, S.ReadStore, S.WriteStore] r
  => HasCodec a
  => Eq a
  => a
  -> List a
  -> Sem r ()
delete :: a -> List a -> Sem r ()
delete a :: a
a l :: List a
l@List{..} = do
  Maybe Idx
mhd <- Store (List a) -> HeadKey -> Sem r (Maybe (Value HeadKey (List a)))
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns),
 Members '[ReadStore, Error AppError] r) =>
Store ns -> k2 -> Sem r (Maybe (Value k2 ns))
S.get Store (List a)
listStore HeadKey
HeadKey
  case Maybe Idx
mhd of
    -- the list looks like []
    Nothing -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    -- the list looks like (? : as)
    Just hd :: Idx
hd -> do
      let valueMap :: Map Idx a
valueMap = List a -> Map Idx a
forall a. List a -> Map Idx a
getValueMap List a
l
          idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
      a
a' <- Idx -> Map Idx a -> Sem r a
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[ReadStore, Error AppError] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r v
assertLookup Idx
hd Map Idx a
valueMap
      Maybe Idx
mNext <- Idx -> Map Idx Idx -> Sem r (Maybe Idx)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Idx
hd Map Idx Idx
idxMap
      if a
a'a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a
        -- the list looks like (a : as)
        then List a -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error AppError, ReadStore, WriteStore] r =>
List a -> Sem r ()
deleteHead List a
l
        -- the list looks like (b : as)
        else Idx -> Maybe Idx -> Sem r ()
delete' Idx
hd Maybe Idx
mNext
    where
      delete' :: Idx -> Maybe Idx -> Sem r ()
delete' prevIdx :: Idx
prevIdx mcurrIdx :: Maybe Idx
mcurrIdx =
        case Maybe Idx
mcurrIdx of
          Nothing -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just currIdx :: Idx
currIdx -> do
            let valueMap :: Map Idx a
valueMap = List a -> Map Idx a
forall a. List a -> Map Idx a
getValueMap List a
l
                idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
            a
a' <- Idx -> Map Idx a -> Sem r a
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[ReadStore, Error AppError] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r v
assertLookup Idx
currIdx Map Idx a
valueMap
            Maybe Idx
mNext <- Idx -> Map Idx Idx -> Sem r (Maybe Idx)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Idx
currIdx Map Idx Idx
idxMap
            if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
              then Idx -> Idx -> List a -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error AppError, ReadStore, WriteStore] r =>
Idx -> Idx -> List a -> Sem r ()
snipNode Idx
prevIdx Idx
currIdx List a
l
              else Idx -> Maybe Idx -> Sem r ()
delete' Idx
currIdx Maybe Idx
mNext

-- | Delete an element whenever the predicate evaluates to 'True'
deleteWhen
  :: Members [Error AppError, S.ReadStore, S.WriteStore] r
  => HasCodec a
  => (a -> Bool)
  -> List a
  -> Sem r ()
deleteWhen :: (a -> Bool) -> List a -> Sem r ()
deleteWhen p :: a -> Bool
p l :: List a
l@List{..} = do
  Maybe Idx
mhd <- Store (List a) -> HeadKey -> Sem r (Maybe (Value HeadKey (List a)))
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns),
 Members '[ReadStore, Error AppError] r) =>
Store ns -> k2 -> Sem r (Maybe (Value k2 ns))
S.get Store (List a)
listStore HeadKey
HeadKey
  case Maybe Idx
mhd of
    Nothing -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just hd :: Idx
hd -> do
      let valueMap :: Map Idx a
valueMap = List a -> Map Idx a
forall a. List a -> Map Idx a
getValueMap List a
l
      a
a <- Idx -> Map Idx a -> Sem r a
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[ReadStore, Error AppError] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r v
assertLookup Idx
hd Map Idx a
valueMap
      if a -> Bool
p a
a
        then do
          List a -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error AppError, ReadStore, WriteStore] r =>
List a -> Sem r ()
deleteHead List a
l
          (a -> Bool) -> List a -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) a.
(Members '[Error AppError, ReadStore, WriteStore] r, HasCodec a) =>
(a -> Bool) -> List a -> Sem r ()
deleteWhen a -> Bool
p List a
l
        else do
          let idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
          Maybe Idx
mNext <- Idx -> Map Idx Idx -> Sem r (Maybe Idx)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Idx
hd Map Idx Idx
idxMap
          Idx -> Maybe Idx -> Sem r ()
deleteWhen' Idx
hd Maybe Idx
mNext
  where
    deleteWhen' :: Idx -> Maybe Idx -> Sem r ()
deleteWhen' prevIdx :: Idx
prevIdx mcurrIdx :: Maybe Idx
mcurrIdx =
      case Maybe Idx
mcurrIdx of
        Nothing -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just currIdx :: Idx
currIdx -> do
          let valueMap :: Map Idx a
valueMap = List a -> Map Idx a
forall a. List a -> Map Idx a
getValueMap List a
l
              idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
          a
a <- Idx -> Map Idx a -> Sem r a
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[ReadStore, Error AppError] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r v
assertLookup Idx
currIdx Map Idx a
valueMap
          Maybe Idx
mNext <- Idx -> Map Idx Idx -> Sem r (Maybe Idx)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Idx
currIdx Map Idx Idx
idxMap
          Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
a) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
            Idx -> Idx -> List a -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error AppError, ReadStore, WriteStore] r =>
Idx -> Idx -> List a -> Sem r ()
snipNode Idx
prevIdx Idx
currIdx List a
l
          Idx -> Maybe Idx -> Sem r ()
deleteWhen' Idx
currIdx Maybe Idx
mNext

foldl
  :: Members [Error AppError, S.ReadStore] r
  => HasCodec a
  => (b -> a -> b)
  -> b
  -> List a
  -> Sem r b
foldl :: (b -> a -> b) -> b -> List a -> Sem r b
foldl f :: b -> a -> b
f b :: b
b l :: List a
l@List{..} = do
  Maybe Idx
mhd <- Store (List a) -> HeadKey -> Sem r (Maybe (Value HeadKey (List a)))
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns),
 Members '[ReadStore, Error AppError] r) =>
Store ns -> k2 -> Sem r (Maybe (Value k2 ns))
S.get Store (List a)
listStore HeadKey
HeadKey
  Maybe Idx -> b -> Sem r b
foldl' Maybe Idx
mhd b
b
  where
    foldl' :: Maybe Idx -> b -> Sem r b
foldl' mcurrentHead :: Maybe Idx
mcurrentHead acc :: b
acc =
      case Maybe Idx
mcurrentHead of
        Nothing -> b -> Sem r b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
acc
        Just hd :: Idx
hd -> do
          let valMap :: Map Idx a
valMap = List a -> Map Idx a
forall a. List a -> Map Idx a
getValueMap List a
l
              idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
          a
a <- Idx -> Map Idx a -> Sem r a
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[ReadStore, Error AppError] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r v
assertLookup Idx
hd Map Idx a
valMap
          Maybe Idx
mNext <- Idx -> Map Idx Idx -> Sem r (Maybe Idx)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Idx
hd Map Idx Idx
idxMap
          Maybe Idx -> b -> Sem r b
foldl' Maybe Idx
mNext (b -> Sem r b) -> b -> Sem r b
forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
acc a
a

-- | View the 'List' as a 'List'.
toList
  :: Members [Error AppError, S.ReadStore] r
  => HasCodec a
  => List a
  -> Sem r [a]
toList :: List a -> Sem r [a]
toList = ([a] -> [a]) -> Sem r [a] -> Sem r [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse (Sem r [a] -> Sem r [a])
-> (List a -> Sem r [a]) -> List a -> Sem r [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> a -> [a]) -> [a] -> List a -> Sem r [a]
forall (r :: [(* -> *) -> * -> *]) a b.
(Members '[Error AppError, ReadStore] r, HasCodec a) =>
(b -> a -> b) -> b -> List a -> Sem r b
foldl ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

length
  :: Members [Error AppError, S.ReadStore] r
  => HasCodec a
  => List a
  -> Sem r Word64
length :: List a -> Sem r Word64
length = (Word64 -> a -> Word64) -> Word64 -> List a -> Sem r Word64
forall (r :: [(* -> *) -> * -> *]) a b.
(Members '[Error AppError, ReadStore] r, HasCodec a) =>
(b -> a -> b) -> b -> List a -> Sem r b
foldl (\n :: Word64
n _ -> Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ 1) 0

elemIndex
  :: Members [Error AppError, S.ReadStore] r
  => HasCodec a
  => Eq a
  => a
  -> List a
  -> Sem r (Maybe Word64)
elemIndex :: a -> List a -> Sem r (Maybe Word64)
elemIndex a :: a
a l :: List a
l@List{..} = do
  Maybe Idx
mhd <- Store (List a) -> HeadKey -> Sem r (Maybe (Value HeadKey (List a)))
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns),
 Members '[ReadStore, Error AppError] r) =>
Store ns -> k2 -> Sem r (Maybe (Value k2 ns))
S.get Store (List a)
listStore HeadKey
HeadKey
  Idx -> Maybe Idx -> Sem r (Maybe Word64)
elemIndex' 0 Maybe Idx
mhd
  where
    elemIndex' :: Idx -> Maybe Idx -> Sem r (Maybe Word64)
elemIndex' i :: Idx
i mcurrentHead :: Maybe Idx
mcurrentHead =
      case Maybe Idx
mcurrentHead of
        Nothing -> Maybe Word64 -> Sem r (Maybe Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word64
forall a. Maybe a
Nothing
        Just hd :: Idx
hd -> do
          let valMap :: Map Idx a
valMap = List a -> Map Idx a
forall a. List a -> Map Idx a
getValueMap List a
l
          a
a' <- Idx -> Map Idx a -> Sem r a
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[ReadStore, Error AppError] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r v
assertLookup Idx
hd Map Idx a
valMap
          if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
            then Maybe Word64 -> Sem r (Maybe Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Word64 -> Sem r (Maybe Word64))
-> Maybe Word64 -> Sem r (Maybe Word64)
forall a b. (a -> b) -> a -> b
$ Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Idx -> Word64
unIdx Idx
i
            else do
              let idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
              Maybe Idx
mNext <- Idx -> Map Idx Idx -> Sem r (Maybe Idx)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Idx
hd Map Idx Idx
idxMap
              Idx -> Maybe Idx -> Sem r (Maybe Word64)
elemIndex' (Idx
i Idx -> Idx -> Idx
forall a. Num a => a -> a -> a
+ 1) Maybe Idx
mNext

(!!)
  :: Members [Error AppError, S.ReadStore] r
  => HasCodec a
  => List a
  -> Word64
  -> Sem r (Maybe a)
l :: List a
l@List{..} !! :: List a -> Word64 -> Sem r (Maybe a)
!! idx :: Word64
idx = do
  Maybe Idx
mhd <- Store (List a) -> HeadKey -> Sem r (Maybe (Value HeadKey (List a)))
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns),
 Members '[ReadStore, Error AppError] r) =>
Store ns -> k2 -> Sem r (Maybe (Value k2 ns))
S.get Store (List a)
listStore HeadKey
HeadKey
  Word64 -> Maybe Idx -> Sem r (Maybe a)
getAtIndex 0 Maybe Idx
mhd
  where
    getAtIndex :: Word64 -> Maybe Idx -> Sem r (Maybe a)
getAtIndex currPos :: Word64
currPos mhd :: Maybe Idx
mhd =
      case Maybe Idx
mhd of
        Nothing -> Maybe a -> Sem r (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        Just hd :: Idx
hd ->
          if Word64
idx Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
currPos
            then
              let valMap :: Map Idx a
valMap = List a -> Map Idx a
forall a. List a -> Map Idx a
getValueMap List a
l
              in a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Sem r a -> Sem r (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Idx -> Map Idx a -> Sem r a
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[ReadStore, Error AppError] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r v
assertLookup Idx
hd Map Idx a
valMap
            else do
              let idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
              Maybe Idx
mNext <- Idx -> Map Idx Idx -> Sem r (Maybe Idx)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Idx
hd Map Idx Idx
idxMap
              Word64 -> Maybe Idx -> Sem r (Maybe a)
getAtIndex (Word64
currPos Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ 1) Maybe Idx
mNext

infixl 9  !!

--------------------------------------------------------------------------------

snipNode
  :: Members [Error AppError, S.ReadStore, S.WriteStore] r
  => Idx
  -- ^ previous index
  -> Idx
  -- ^ current index (node to delete)
  -> List a
  -> Sem r ()
snipNode :: Idx -> Idx -> List a -> Sem r ()
snipNode prevIdx :: Idx
prevIdx currIdx :: Idx
currIdx l :: List a
l = do
  let idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
  Maybe Idx
mNext <- Idx -> Map Idx Idx -> Sem r (Maybe Idx)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Idx
currIdx Map Idx Idx
idxMap
  case Maybe Idx
mNext of
    -- (n) - (a) - [] ~> []
    Nothing -> Idx -> Map Idx Idx -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k) =>
k -> Map k v -> Sem r ()
M.delete Idx
prevIdx Map Idx Idx
idxMap
    -- (n) - (a) - rest ~> (n) ~> rest
    Just next :: Idx
next -> do
      Idx -> Idx -> Map Idx Idx -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k, HasCodec v) =>
k -> v -> Map k v -> Sem r ()
M.insert Idx
prevIdx Idx
next Map Idx Idx
idxMap
  Idx -> List a -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error AppError, ReadStore, WriteStore] r =>
Idx -> List a -> Sem r ()
deleteDetachedNode Idx
currIdx List a
l

deleteHead
  :: Members [Error AppError, S.ReadStore, S.WriteStore] r
  => List a
  -> Sem r ()
deleteHead :: List a -> Sem r ()
deleteHead l :: List a
l@List{..} = do
  Maybe Idx
mhd <- Store (List a) -> HeadKey -> Sem r (Maybe (Value HeadKey (List a)))
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns),
 Members '[ReadStore, Error AppError] r) =>
Store ns -> k2 -> Sem r (Maybe (Value k2 ns))
S.get Store (List a)
listStore HeadKey
HeadKey
  case Maybe Idx
mhd of
    Nothing -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just hd :: Idx
hd -> do
      let idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
      Maybe Idx
mNext <- Idx -> Map Idx Idx -> Sem r (Maybe Idx)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup Idx
hd Map Idx Idx
idxMap
      case Maybe Idx
mNext of
        Nothing -> do
          Store (List a) -> HeadKey -> Sem r ()
forall k1 k2 (ns :: k1) (r :: [(* -> *) -> * -> *]).
(IsKey k2 ns, Member WriteStore r) =>
Store ns -> k2 -> Sem r ()
S.delete Store (List a)
listStore HeadKey
HeadKey
        Just next :: Idx
next -> do
          Store (List a) -> HeadKey -> Value HeadKey (List a) -> Sem r ()
forall k1 k2 (r :: [(* -> *) -> * -> *]) (ns :: k1).
(IsKey k2 ns, HasCodec (Value k2 ns), Member WriteStore r) =>
Store ns -> k2 -> Value k2 ns -> Sem r ()
S.put Store (List a)
listStore HeadKey
HeadKey Value HeadKey (List a)
Idx
next
      Idx -> List a -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error AppError, ReadStore, WriteStore] r =>
Idx -> List a -> Sem r ()
deleteDetachedNode Idx
hd List a
l

deleteDetachedNode
  :: Members [Error AppError, S.ReadStore, S.WriteStore] r
  => Idx
  -> List a
  -> Sem r ()
deleteDetachedNode :: Idx -> List a -> Sem r ()
deleteDetachedNode idx :: Idx
idx l :: List a
l =
  let valueMap :: Map Idx a
valueMap = List a -> Map Idx a
forall a. List a -> Map Idx a
getValueMap List a
l
      idxMap :: Map Idx Idx
idxMap = List a -> Map Idx Idx
forall a. List a -> Map Idx Idx
getIdxMap List a
l
  in do
    Idx -> Map Idx a -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k) =>
k -> Map k v -> Sem r ()
M.delete Idx
idx Map Idx a
valueMap
    Idx -> Map Idx Idx -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) k v.
(Member WriteStore r, RawKey k) =>
k -> Map k v -> Sem r ()
M.delete Idx
idx Map Idx Idx
idxMap

assertLookup
  :: Members [S.ReadStore, Error AppError] r
  => S.RawKey k
  => HasCodec v
  => k
  -> M.Map k v
  -> Sem r v
assertLookup :: k -> Map k v -> Sem r v
assertLookup k :: k
k m :: Map k v
m = do
  Maybe v
mRes <- k -> Map k v -> Sem r (Maybe v)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup k
k Map k v
m
  case Maybe v
mRes of
    Nothing -> SDKError -> Sem r v
forall (r :: [(* -> *) -> * -> *]) a.
Member (Error AppError) r =>
SDKError -> Sem r a
throwSDKError (SDKError -> Sem r v) -> SDKError -> Sem r v
forall a b. (a -> b) -> a -> b
$
      Text -> SDKError
InternalError (Text -> SDKError) -> Text -> SDKError
forall a b. (a -> b) -> a -> b
$ "Database integrity failed, lookup miss: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (k
k k -> Getting ByteString k ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString k ByteString
forall k. RawKey k => Iso' k ByteString
S.rawKey)
    Just res :: v
res -> v -> Sem r v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
res