summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2020-10-20 20:54:17 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2020-10-20 20:54:17 +0200
commit0c4c6618d43a8b7179f11b8edb1f289169b5f2bc (patch)
treefa6bef59c89c1c55cf7ae3ee4d7589c9c17a576c
parent93e583408af5f41f9dde324f198e47fa94e1881e (diff)
Contact: fix view to actually include parents
-rw-r--r--src/Contact.hs18
1 files changed, 10 insertions, 8 deletions
diff --git a/src/Contact.hs b/src/Contact.hs
index b725378..814e324 100644
--- a/src/Contact.hs
+++ b/src/Contact.hs
@@ -7,6 +7,7 @@ module Contact (
contactAccept,
) where
+import Control.Arrow
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
@@ -51,14 +52,15 @@ instance SharedType ContactData where
sharedTypeID _ = mkSharedTypeID "34fbb61e-6022-405f-b1b3-a5a1abecd25e"
contactView :: [Stored ContactData] -> [Contact]
-contactView = helper [] . filterAncestors
- where helper used (x:xs) | Just cid <- validateIdentityF (cdIdentity (fromStored x))
- , not $ any (sameIdentity cid) used
- = Contact { contactIdentity = cid
- , contactName = lookupProperty cid cdName (x:xs)
- } : helper (cid:used) xs
- | otherwise = helper used xs
- helper _ [] = []
+contactView = helper []
+ where helper used = filterAncestors >>> \case
+ x:xs | Just cid <- validateIdentityF (cdIdentity (fromStored x))
+ , not $ any (sameIdentity cid) used
+ -> Contact { contactIdentity = cid
+ , contactName = lookupProperty cid cdName (x:xs)
+ } : helper (cid:used) (cdPrev (fromStored x) ++ xs)
+ | otherwise -> helper used (cdPrev (fromStored x) ++ xs)
+ [] -> []
lookupProperty :: forall a. ComposedIdentity -> (ContactData -> Maybe a) -> [Stored ContactData] -> Maybe a
lookupProperty idt sel = join . fmap (sel . fromStored) . listToMaybe . filterAncestors . helper