alignment 0.1.0.4 → 0.1.0.5

raw patch · 4 files changed

+99/−76 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• LICENCE +1/−1
• alignment.cabal +8/−8
• changelog.md +7/−0
• src/Data/Alignment.hs +83/−67

@@ -1,4 +1,4 @@-Copyright (c) 2022 Tony Morris+Copyright (c) 2022-2025 Tony Morris  All rights reserved. 

@@ -1,28 +1,28 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                   alignment-version:                0.1.0.4+version:                0.1.0.5 synopsis:               Zip-alignment description:-  <<https://system-f.gitlab.io/logo/systemf-450x450.jpg>>-  .   Zipping with alignment+  .+  <<https://logo.systemf.com.au/systemf-450x450.png>> license:                BSD3 license-file:           LICENCE author:                 Tony Morris <oᴉ˙ldɟb@llǝʞsɐɥ> maintainer:             Tony Morris <oᴉ˙ldɟb@llǝʞsɐɥ>-copyright:              Copyright (C) 2022 Tony Morris+copyright:              Copyright (C) 2022-2025 Tony Morris category:               Data build-type:             Simple extra-source-files:     changelog.md cabal-version:          >=1.10-homepage:               https://gitlab.com/system-f/alignment-bug-reports:            https://gitlab.com/system-f/alignment/issues-tested-with:            GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1+homepage:               https://gitlab.com/system-f/alignment/code+bug-reports:            https://gitlab.com/system-f/alignment/code/issues+tested-with:            GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1, GHC == 9.4.8  source-repository       head   type:                 git-  location:             git@gitlab.com:system-f/alignment.git+  location:             git@gitlab.com:system-f/code/alignment.git  library   exposed-modules:      Data.Alignment

@@ -1,3 +1,10 @@+0.1.0.5++* Remove optics `allThoseA'` and `allThoseB'`+* Add optics `allTheseThoseA1` and `allTheseThoseB1`+* Instances for `Bifoldable1` and `Bitraversable1`+* Minor code improvements+ 0.1.0.4  * Bump versions

@@ -2,6 +2,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Use fmap" #-}  module Data.Alignment( -- * Types@@ -17,18 +19,18 @@ , allThese2 , allThose , allThoseA-, allThoseA' , allThoseAOr , allThoseB-, allThoseB' , allThoseBOr , allTheseThoseA+, allTheseThoseA1 , allTheseThoseB+, allTheseThoseB1 ) where  import Control.Applicative     ( Applicative(liftA2, pure, (<*>)), (<$>), ZipList(ZipList) )-import Control.Category ( Category((.)) )+import Control.Category ( Category((.), id) ) import Control.Lens     ( Identity(Identity),       _Just,@@ -39,14 +41,16 @@       Field2(_2),       Lens,       Lens',-      Traversal' )+      Traversal,+      Traversal',+      Traversal1 ) import Data.Bifoldable ( Bifoldable(bifoldMap) ) import Data.Bifunctor ( Bifunctor(bimap) ) import Data.Bifunctor.Swap ( Swap(..) ) import Data.Bitraversable ( Bitraversable(..) ) import Data.List.NonEmpty ( NonEmpty(..) ) import Data.Bool ( (&&) )-import Data.Either ( Either(..) )+import Data.Either ( Either(..), either ) import Data.Eq ( Eq((==)) ) import Data.Foldable ( Foldable(foldMap) ) import Data.Functor ( Functor(fmap), (<$) )@@ -60,10 +64,14 @@       Ord1(..),       Show1(..) ) import qualified Data.List.NonEmpty as NonEmpty(cons, toList)-import Data.Maybe ( Maybe(..) )+import Data.Maybe ( Maybe(..), maybe ) import Data.Monoid ( (<>), Monoid(mempty) ) import Data.Ord ( Ord(compare) ) import Data.Semigroup ( Semigroup )+import Data.Semigroup.Bifoldable ( Bifoldable1(bifoldMap1) )+import Data.Semigroup.Bitraversable ( Bitraversable1(bitraverse1) )+import Data.Semigroup.Foldable ( Foldable1(foldMap1) )+import Data.Semigroup.Traversable ( Traversable1(traverse1) ) import Data.Traversable ( Traversable(traverse) ) import GHC.Show ( Show(showsPrec) ) @@ -109,13 +117,28 @@   bifoldMap f g (This t r) =     foldMap (bifoldMap f g) t <> foldMap (bifoldMap (foldMap f) (foldMap g)) r +instance Foldable1 f => Bifoldable1 (This f) where+  bifoldMap1 f g (This t r) =+    let x =+          foldMap1 (bifoldMap1 f g) t+    in  maybe x (either (foldMap1 f) (foldMap1 g)) r+ instance Traversable f => Bitraversable (This f) where   bitraverse f g (This t r) =     This <$> traverse (bitraverse f g) t <*> traverse (bitraverse (traverse f) (traverse g)) r +instance Traversable1 f => Bitraversable1 (This f) where+  bitraverse1 f g (This t r) =+    let x =+          This <$> traverse1 (bitraverse1 f g) t+    in  maybe+          ((\k -> k Nothing) <$> x)+          (\q -> x <.> either (fmap (Just . Left) . traverse1 f) (fmap (Just . Right) . traverse1 g) q)+          r+ instance Functor f => Functor (This f a) where   fmap =-    bimap (\x -> x)+    bimap id  -- | --@@ -169,7 +192,7 @@     -> f b     -> This f a b   align =-    alignWith (\x -> x) (\x -> x) (\x -> x)+    alignWith id id id   alignWith ::     ((a, b) -> (c, d))     -> (a -> c)@@ -352,7 +375,7 @@     (f (a, b))     (f' (a, b)) these f (This t r) =-  fmap (\t' -> This t' r) (f t)+  fmap (`This` r) (f t)  -- | --@@ -373,7 +396,7 @@     (This f a b)     (Maybe (Either (NonEmpty a) (NonEmpty b))) those f (This t r) =-  fmap (\r' -> This t r') (f r)+  fmap (This t) (f r)  -- | --@@ -485,40 +508,18 @@  -- | ----- >>> over allThoseA' reverse (This [("abc", 'x'), ("def", 'y')] Nothing)+-- >>> over allThoseAOr reverse (This [("abc", 'x'), ("def", 'y')] Nothing) -- This [("abc",'x'),("def",'y')] Nothing--- >>> over allThoseA' reverse (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))--- This [("abc",'x'),("def",'y')] Just (Left ("cba" :| ["fed"]))--- >>> over allThoseA' reverse (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))+-- >>> over allThoseAOr reverse (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))+-- This [("abc",'x'),("def",'y')] Just (Left ("def" :| ["abc"]))+-- >>> over allThoseAOr reverse (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde")))) -- This [("abc",'x'),("def",'y')] Just (Right ('a' :| "bcde"))--- >>> Control.Lens.preview allThoseA' (This [("abc", 'x'), ("def", 'y')] Nothing)--- Nothing--- >>> Control.Lens.preview allThoseA' (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))--- Just "abc"--- >>> Control.Lens.preview allThoseA' (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))--- Nothing-allThoseA' ::-  Traversable f =>-  Traversal'-    (This f a b)-    a-allThoseA' =-  allThoseA . traverse---- |------ >>> over allThoseBOr reverse (This [("abc", 'x'), ("def", 'y')] Nothing)--- This [("abc",'x'),("def",'y')] Nothing--- >>> over allThoseBOr reverse (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))--- This [("abc",'x'),("def",'y')] Just (Left ("abc" :| ["def"]))--- >>> over allThoseBOr reverse (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))--- This [("abc",'x'),("def",'y')] Just (Right ('e' :| "dcba"))--- >>> Control.Lens.preview allThoseBOr (This [("abc", 'x'), ("def", 'y')] Nothing)--- Just ""--- >>> Control.Lens.preview allThoseBOr (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))+-- >>> Control.Lens.preview allThoseAOr (This [("abc", 'x'), ("def", 'y')] Nothing)+-- Just []+-- >>> Control.Lens.preview allThoseAOr (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))+-- Just ["abc","def"]+-- >>> Control.Lens.preview allThoseAOr (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde")))) -- Nothing--- >>> Control.Lens.preview allThoseBOr (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))--- Just "abcde" allThoseAOr ::   Traversal'     (This f a b)@@ -530,7 +531,7 @@ allThoseAOr f (This t (Just (Left a))) =   let lst [] = Nothing       lst (x:y) = Just (x:|y)-  in  This t <$> (fmap Left . lst <$> f (NonEmpty.toList a))+  in  This t . fmap Left . lst <$> f (NonEmpty.toList a)  -- | --@@ -555,28 +556,6 @@  -- | ----- >>> over allThoseB' Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] Nothing)--- This [("abc",'x'),("def",'y')] Nothing--- >>> over allThoseB' Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))--- This [("abc",'x'),("def",'y')] Just (Left ("abc" :| ["def"]))--- >>> over allThoseB' Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))--- This [("abc",'x'),("def",'y')] Just (Right ('A' :| "BCDE"))--- >>> Control.Lens.preview allThoseB' (This [("abc", 'x'), ("def", 'y')] Nothing)--- Nothing--- >>> Control.Lens.preview allThoseB' (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))--- Nothing--- >>> Control.Lens.preview allThoseB' (This [("abc", 'x'), ("def", 'y')] (Just (Right ('a':|"bcde"))))--- Just 'a'-allThoseB' ::-  Traversable f =>-  Traversal'-    (This f a b)-    b-allThoseB' =-  allThoseB . traverse---- |--- -- >>> over allThoseBOr reverse (This [("abc", 'x'), ("def", 'y')] Nothing) -- This [("abc",'x'),("def",'y')] Nothing -- >>> over allThoseBOr reverse (This [("abc", 'x'), ("def", 'y')] (Just (Left ("abc":|["def"]))))@@ -598,7 +577,7 @@ allThoseBOr f (This t (Just (Right b))) =   let lst [] = Nothing       lst (x:y) = Just (x:|y)-  in  This t <$> (fmap Right . lst <$> f (NonEmpty.toList b))+  in  This t . fmap Right . lst <$> f (NonEmpty.toList b) allThoseBOr _ th@(This _ (Just (Left _))) =   pure th @@ -618,9 +597,11 @@ -- Just "abc" allTheseThoseA ::   Traversable f =>-  Traversal'+  Traversal     (This f a b)+    (This f a' b)     a+    a' allTheseThoseA f (This t r) =   let th =         case r of@@ -633,6 +614,23 @@   in  This <$>         traverse (\(a, b) -> (, b) <$> f a) t <*> th +allTheseThoseA1 ::+  Traversable1 f =>+  Traversal1+    (This f a b)+    (This f a' b)+    a+    a'+allTheseThoseA1 f (This t r) =+  let x = This <$> traverse1 (\(a, b) -> (, b) <$> f a) t+  in  maybe+        ((\k -> k Nothing) <$> x)+        (+          either+            ((\p -> (\k -> k . Just . Left) <$> x <.> p) . traverse1 f)+             (\z -> (\k -> k (Just (Right z))) <$> x))+        r+ -- | -- -- >>> over allTheseThoseB Data.Char.toUpper (This [("abc", 'x'), ("def", 'y')] Nothing)@@ -649,9 +647,11 @@ -- Just 'x' allTheseThoseB ::   Traversable f =>-  Traversal'+  Traversal     (This f a b)+    (This f a b')     b+    b' allTheseThoseB f (This t r) =   let th =         case r of@@ -663,3 +663,19 @@             Just . Right <$> traverse f bs   in  This <$>         traverse (\(a, b) -> (a ,) <$> f b) t <*> th++allTheseThoseB1 ::+  Traversable1 f =>+  Traversal1+    (This f a b)+    (This f a b')+    b+    b'+allTheseThoseB1 f (This t r) =+  let x = This <$> traverse1 (\(a, b) -> (a ,) <$> f b) t+  in  maybe+        ((\k -> k Nothing) <$> x)+        (either+          (\z -> (\k -> k (Just (Left z))) <$> x)+          ((\p -> (\k -> k . Just . Right) <$> x <.> p) . traverse1 f))+          r