From 359e531f4c2d99a69b2ba447693a73ebfb073662 Mon Sep 17 00:00:00 2001 From: iko Date: Mon, 20 Jan 2020 20:00:35 +0300 Subject: [PATCH 1/2] Fixed unexpected behaviour --- src/Control/Monad/Validation.hs | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/src/Control/Monad/Validation.hs b/src/Control/Monad/Validation.hs index 6039ca1..1eaf1db 100644 --- a/src/Control/Monad/Validation.hs +++ b/src/Control/Monad/Validation.hs @@ -81,25 +81,18 @@ mmAppend (MonoidMap a) (MonoidMap b) = MonoidMap $ M.unionWith (<>) a b -- | Convenient for 'vZoom' as first artument. Will prevent generation -- of map with 'mempty' values mmSingleton :: (Eq v, Monoid v, Ord k) => k -> v -> MonoidMap k v -mmSingleton k = memptyWrap mempty $ MonoidMap . M.singleton k +mmSingleton k v + | v == mempty = mempty + | otherwise = MonoidMap . M.singleton k $ v -- | Set given value to 'mempty' setMempty :: (Monoid s) => ASetter' s a -> a -> s setMempty setter a = set setter a mempty -memptyWrap :: (Eq a, Monoid a) => b -> (a -> b) -> a -> b -memptyWrap b f a - | a == mempty = b - | otherwise = f a - --- | If given container is not 'mempty', then use given function to --- append all its elements and return 'Just' result -neConcat - :: (Foldable f, Eq (f a), Monoid a, Monoid (f a)) - => (a -> a -> a) - -> f a - -> Maybe a -neConcat f = memptyWrap Nothing (Just . F.foldl' f mempty) +neConcat :: Foldable f => (a -> a -> a) -> f a -> Maybe a +neConcat f a + | F.null a = Nothing + | otherwise = Just $ F.foldl1 f a textErrors :: [Text] -> Maybe Text textErrors = neConcat (\a b -> a <> ", " <> b) From a7d3397ecda3fa6377113fd754806badc2abd70f Mon Sep 17 00:00:00 2001 From: iko Date: Mon, 27 Jan 2020 19:17:17 +0300 Subject: [PATCH 2/2] changed foldl to foldr --- src/Control/Monad/Validation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Control/Monad/Validation.hs b/src/Control/Monad/Validation.hs index 1eaf1db..1d34c76 100644 --- a/src/Control/Monad/Validation.hs +++ b/src/Control/Monad/Validation.hs @@ -92,7 +92,7 @@ setMempty setter a = set setter a mempty neConcat :: Foldable f => (a -> a -> a) -> f a -> Maybe a neConcat f a | F.null a = Nothing - | otherwise = Just $ F.foldl1 f a + | otherwise = Just $ F.foldr1 f a textErrors :: [Text] -> Maybe Text textErrors = neConcat (\a b -> a <> ", " <> b)