Report bytestring parsing errors in get as exceptions

Until now, bytestring parsing in `get` and friends would return
`Nothing`, which is indistinguishable from the key not being present.

Author: matus-chordify

src/Database/Redis/Schema.hs

@@ -332,8 +332,8 @@ class Value inst val where
   txValGet :: Identifier val -> Tx inst (Maybe val)
 
   default txValGet :: SimpleValue inst val => Identifier val -> Tx inst (Maybe val)
-  txValGet (SviTopLevel keyBS) = fmap (fromBS =<<) . txWrap $ Hedis.get keyBS
-  txValGet (SviHash keyBS hkeyBS) = fmap (fromBS =<<) . txWrap $ Hedis.hget keyBS hkeyBS
+  txValGet (SviTopLevel keyBS) = txFromBSOrThrow $ txWrap (Hedis.get keyBS)
+  txValGet (SviHash keyBS hkeyBS) = txFromBSOrThrow $ txWrap (Hedis.hget keyBS hkeyBS)
 
   -- | Write a value to Redis in a transaction.
   txValSet :: Identifier val -> val -> Tx inst ()
@@ -367,10 +367,10 @@ class Value inst val where
   valGet :: Identifier val -> RedisM inst (Maybe val)
 
   default valGet :: SimpleValue inst val => Identifier val -> RedisM inst (Maybe val)
-  valGet (SviTopLevel keyBS) =
-    fmap (fromBS =<<) . expectRight "valGet/plain" =<< Hedis.get keyBS
-  valGet (SviHash keyBS hkeyBS) =
-    fmap (fromBS =<<) . expectRight "valGet/hash" =<< Hedis.hget keyBS hkeyBS
+  valGet ident = do
+    traverse fromBSOrThrow =<< expectRight "valGet" =<< case ident of
+      SviTopLevel keyBS -> Hedis.get keyBS
+      SviHash keyBS hkeyBS -> Hedis.hget keyBS hkeyBS
 
   -- | Write a value.
   valSet :: Identifier val -> val -> RedisM inst ()
@@ -568,6 +568,21 @@ watch ref = case toIdentifier ref of
 unwatch :: RedisM inst ()
 unwatch = Redis Hedis.unwatch >>= expect "unwatch: OK expected" (Right Hedis.Ok)
 
+fromBSOrThrow :: Serializable val => ByteString -> RedisM inst val
+fromBSOrThrow bs = case fromBS bs of
+  Nothing -> throw $ CouldNotDecodeValue (Just bs)
+  Just val -> pure val
+
+-- Tx is Applicative so it's tricky to decouple the handling
+-- of missing values from the handling of other exceptions.
+-- This function does both to keep things simple.
+txFromBSOrThrow :: Serializable val => Tx inst (Maybe ByteString) -> Tx inst (Maybe val)
+txFromBSOrThrow = txCheckMap $ \case
+    Nothing -> Right Nothing  -- item not present
+    Just bs -> case fromBS bs of
+      Nothing -> Left $ CouldNotDecodeValue (Just bs)
+      Just val -> Right (Just val)
+
 -- | Decode a list of ByteStrings.
 -- On failure, return the first ByteString that could not be decoded.
 fromBSMany :: Serializable val => [ByteString] -> Either ByteString [val]
@@ -868,7 +883,8 @@ lPushLeft (toIdentifier -> keyBS) vals =
 lPopRight :: forall ref a. (Ref ref, ValueType ref ~ [a], Serializable a) => ref -> RedisM (RefInstance ref) (Maybe a)
 lPopRight (toIdentifier -> keyBS) =
   Redis (Hedis.rpop keyBS)
-  >>= fmap (fromBS =<<) . expectRight "rpop"
+  >>= expectRight "rpop"
+  >>= traverse fromBSOrThrow
 
 -- | Pop from the right, blocking.
 lPopRightBlocking :: forall ref a. (Ref ref, ValueType ref ~ [a], Serializable a) => TTL -> ref -> RedisM (RefInstance ref) (Maybe a)