summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-11-06 21:00:15 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2024-11-06 21:00:15 +0100
commitc4ff2f54c52e9ebb1c47aeb79284faf3fcbad4e3 (patch)
treef1c80ddc25adcbbeaae84e01a073810aaf95e60f
parentf4394413ab3cf2dfb94b1f024a047938cfd471e9 (diff)
parent58244ef30fcfb2584c651c23595b36d55b77f5b1 (diff)
Merge branch 'release-0.1'HEADmaster
-rw-r--r--erebos.cabal4
-rw-r--r--src/Erebos/Object/Internal.hs94
2 files changed, 52 insertions, 46 deletions
diff --git a/erebos.cabal b/erebos.cabal
index 93af480..5f3f33d 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -7,14 +7,14 @@ Description:
Library and simple CLI interface implementing the Erebos identity
management, decentralized messaging and synchronization protocol, along
with local storage.
- .
+
Erebos identity is based on locally stored cryptographic keys, all
communication is end-to-end encrypted. Multiple devices can be attached to
the same identity, after which they function interchangeably, without any
one being in any way "primary"; messages and other state data are then
synchronized automatically whenever the devices are able to connect with
one another.
- .
+
See README for usage of the CLI tool.
License: BSD-3-Clause
License-File: LICENSE
diff --git a/src/Erebos/Object/Internal.hs b/src/Erebos/Object/Internal.hs
index 638689a..312c3af 100644
--- a/src/Erebos/Object/Internal.hs
+++ b/src/Erebos/Object/Internal.hs
@@ -841,91 +841,97 @@ loadEmpty :: String -> LoadRec ()
loadEmpty name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbEmpty name
loadMbEmpty :: String -> LoadRec (Maybe ())
-loadMbEmpty name = (lookup (BC.pack name) <$> loadRecItems) >>= \case
- Nothing -> return Nothing
- Just (RecEmpty) -> return (Just ())
- Just _ -> throwError $ "Expecting type int of record item '"++name++"'"
+loadMbEmpty name = listToMaybe . mapMaybe p <$> loadRecItems
+ where
+ bname = BC.pack name
+ p ( name', RecEmpty ) | name' == bname
+ = Just ()
+ p _ = Nothing
loadInt :: Num a => String -> LoadRec a
loadInt name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbInt name
loadMbInt :: Num a => String -> LoadRec (Maybe a)
-loadMbInt name = (lookup (BC.pack name) <$> loadRecItems) >>= \case
- Nothing -> return Nothing
- Just (RecInt x) -> return (Just $ fromInteger x)
- Just _ -> throwError $ "Expecting type int of record item '"++name++"'"
+loadMbInt name = listToMaybe . mapMaybe p <$> loadRecItems
+ where
+ bname = BC.pack name
+ p ( name', RecInt x ) | name' == bname
+ = Just (fromInteger x)
+ p _ = Nothing
loadNum :: (Real a, Fractional a) => String -> LoadRec a
loadNum name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbNum name
loadMbNum :: (Real a, Fractional a) => String -> LoadRec (Maybe a)
-loadMbNum name = (lookup (BC.pack name) <$> loadRecItems) >>= \case
- Nothing -> return Nothing
- Just (RecNum x) -> return (Just $ fromRational x)
- Just _ -> throwError $ "Expecting type number of record item '"++name++"'"
+loadMbNum name = listToMaybe . mapMaybe p <$> loadRecItems
+ where
+ bname = BC.pack name
+ p ( name', RecNum x ) | name' == bname
+ = Just (fromRational x)
+ p _ = Nothing
loadText :: StorableText a => String -> LoadRec a
loadText name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbText name
loadMbText :: StorableText a => String -> LoadRec (Maybe a)
-loadMbText name = (lookup (BC.pack name) <$> loadRecItems) >>= \case
- Nothing -> return Nothing
- Just (RecText x) -> Just <$> fromText x
- Just _ -> throwError $ "Expecting type text of record item '"++name++"'"
+loadMbText name = listToMaybe <$> loadTexts name
loadTexts :: StorableText a => String -> LoadRec [a]
-loadTexts name = do
- items <- map snd . filter ((BC.pack name ==) . fst) <$> loadRecItems
- forM items $ \case RecText x -> fromText x
- _ -> throwError $ "Expecting type text of record item '"++name++"'"
+loadTexts name = sequence . mapMaybe p =<< loadRecItems
+ where
+ bname = BC.pack name
+ p ( name', RecText x ) | name' == bname
+ = Just (fromText x)
+ p _ = Nothing
loadBinary :: BA.ByteArray a => String -> LoadRec a
loadBinary name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbBinary name
loadMbBinary :: BA.ByteArray a => String -> LoadRec (Maybe a)
-loadMbBinary name = (lookup (BC.pack name) <$> loadRecItems) >>= \case
- Nothing -> return Nothing
- Just (RecBinary x) -> return $ Just $ BA.convert x
- Just _ -> throwError $ "Expecting type binary of record item '"++name++"'"
+loadMbBinary name = listToMaybe <$> loadBinaries name
loadBinaries :: BA.ByteArray a => String -> LoadRec [a]
-loadBinaries name = do
- items <- map snd . filter ((BC.pack name ==) . fst) <$> loadRecItems
- forM items $ \case RecBinary x -> return $ BA.convert x
- _ -> throwError $ "Expecting type binary of record item '"++name++"'"
+loadBinaries name = mapMaybe p <$> loadRecItems
+ where
+ bname = BC.pack name
+ p ( name', RecBinary x ) | name' == bname
+ = Just (BA.convert x)
+ p _ = Nothing
loadDate :: StorableDate a => String -> LoadRec a
loadDate name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbDate name
loadMbDate :: StorableDate a => String -> LoadRec (Maybe a)
-loadMbDate name = (lookup (BC.pack name) <$> loadRecItems) >>= \case
- Nothing -> return Nothing
- Just (RecDate x) -> return $ Just $ fromDate x
- Just _ -> throwError $ "Expecting type date of record item '"++name++"'"
+loadMbDate name = listToMaybe . mapMaybe p <$> loadRecItems
+ where
+ bname = BC.pack name
+ p ( name', RecDate x ) | name' == bname
+ = Just (fromDate x)
+ p _ = Nothing
loadUUID :: StorableUUID a => String -> LoadRec a
loadUUID name = maybe (throwError $ "Missing record iteem '"++name++"'") return =<< loadMbUUID name
loadMbUUID :: StorableUUID a => String -> LoadRec (Maybe a)
-loadMbUUID name = (lookup (BC.pack name) <$> loadRecItems) >>= \case
- Nothing -> return Nothing
- Just (RecUUID x) -> return $ Just $ fromUUID x
- Just _ -> throwError $ "Expecting type UUID of record item '"++name++"'"
+loadMbUUID name = listToMaybe . mapMaybe p <$> loadRecItems
+ where
+ bname = BC.pack name
+ p ( name', RecUUID x ) | name' == bname
+ = Just (fromUUID x)
+ p _ = Nothing
loadRawRef :: String -> LoadRec Ref
loadRawRef name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbRawRef name
loadMbRawRef :: String -> LoadRec (Maybe Ref)
-loadMbRawRef name = (lookup (BC.pack name) <$> loadRecItems) >>= \case
- Nothing -> return Nothing
- Just (RecRef x) -> return (Just x)
- Just _ -> throwError $ "Expecting type ref of record item '"++name++"'"
+loadMbRawRef name = listToMaybe <$> loadRawRefs name
loadRawRefs :: String -> LoadRec [Ref]
-loadRawRefs name = do
- items <- map snd . filter ((BC.pack name ==) . fst) <$> loadRecItems
- forM items $ \case RecRef x -> return x
- _ -> throwError $ "Expecting type ref of record item '"++name++"'"
+loadRawRefs name = mapMaybe p <$> loadRecItems
+ where
+ bname = BC.pack name
+ p ( name', RecRef x ) | name' == bname = Just x
+ p _ = Nothing
loadRef :: Storable a => String -> LoadRec a
loadRef name = load <$> loadRawRef name