module Data.NonEmptyPrivate where import qualified Data.NonEmpty.Foldable as FoldU import qualified Data.NonEmpty.Class as C import qualified Data.Empty as Empty import qualified Data.Sequence as Seq import Data.Sequence (Seq, ) import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold import qualified Data.List.Match as Match import qualified Data.List.HT as ListHT import qualified Data.List as List import Data.Traversable (Traversable, mapAccumL, mapAccumR) import Data.Foldable (Foldable, ) import Control.Monad.HT (void, ) import Control.Monad (Monad, return, (=<<), ) import Control.Applicative (Applicative, liftA2, pure, (<*>), ) import Control.DeepSeq (NFData, rnf, ) import Data.Functor (Functor, fmap, ) import Data.Function (flip, const, ($), (.), ) import Data.Either (Either(Left, Right), ) import Data.Maybe (Maybe(Just, Nothing), maybe, mapMaybe, ) import Data.Bool.HT (if', ) import Data.Bool (Bool(True), (&&), ) import Data.Ord (Ord, Ordering(GT), (<=), (>), compare, comparing, ) import Data.Eq ((==), ) import Data.Tuple.HT (mapFst, mapSnd, swap, ) import Data.Tuple (fst, snd, ) import qualified Prelude as P import Prelude (Eq, Show, Num, Int, uncurry, ($!), ) import qualified Test.QuickCheck as QC {- $setup >>> import qualified Data.NonEmpty as NonEmpty >>> import qualified Data.Either.HT as EitherHT >>> import Data.Tuple.HT (swap) >>> import Data.Maybe (mapMaybe) -} {- We could also have (:!) as constructor, but in order to import it unqualified we have to import 'T' unqualified, too, and this would cause name clashes with locally defined types with name @T@. -} {- | The type 'T' can be used for many kinds of list-like structures with restrictions on the size. * @T [] a@ is a lazy list containing at least one element. * @T (T []) a@ is a lazy list containing at least two elements. * @T Vector a@ is a vector with at least one element. You may also use unboxed vectors but the first element will be stored in a box and you will not be able to use many functions from this module. * @T Maybe a@ is a list that contains one or two elements. * @Maybe@ is isomorphic to @Optional Empty@. * @T Empty a@ is a list that contains exactly one element. * @T (T Empty) a@ is a list that contains exactly two elements. * @Optional (T Empty) a@ is a list that contains zero or two elements. * You can create a list type for every finite set of allowed list length by nesting Optional and NonEmpty constructors. If list length @n@ is allowed, then place @Optional@ at depth @n@, if it is disallowed then place @NonEmpty@. The maximum length is marked by @Empty@. -} data T f a = Cons { T f a -> a head :: a, T f a -> f a tail :: f a } deriving (T f a -> T f a -> Bool (T f a -> T f a -> Bool) -> (T f a -> T f a -> Bool) -> Eq (T f a) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall (f :: * -> *) a. (Eq a, Eq (f a)) => T f a -> T f a -> Bool /= :: T f a -> T f a -> Bool $c/= :: forall (f :: * -> *) a. (Eq a, Eq (f a)) => T f a -> T f a -> Bool == :: T f a -> T f a -> Bool $c== :: forall (f :: * -> *) a. (Eq a, Eq (f a)) => T f a -> T f a -> Bool Eq, Eq (T f a) Eq (T f a) -> (T f a -> T f a -> Ordering) -> (T f a -> T f a -> Bool) -> (T f a -> T f a -> Bool) -> (T f a -> T f a -> Bool) -> (T f a -> T f a -> Bool) -> (T f a -> T f a -> T f a) -> (T f a -> T f a -> T f a) -> Ord (T f a) T f a -> T f a -> Bool T f a -> T f a -> Ordering T f a -> T f a -> T f a forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall (f :: * -> *) a. (Ord a, Ord (f a)) => Eq (T f a) forall (f :: * -> *) a. (Ord a, Ord (f a)) => T f a -> T f a -> Bool forall (f :: * -> *) a. (Ord a, Ord (f a)) => T f a -> T f a -> Ordering forall (f :: * -> *) a. (Ord a, Ord (f a)) => T f a -> T f a -> T f a min :: T f a -> T f a -> T f a $cmin :: forall (f :: * -> *) a. (Ord a, Ord (f a)) => T f a -> T f a -> T f a max :: T f a -> T f a -> T f a $cmax :: forall (f :: * -> *) a. (Ord a, Ord (f a)) => T f a -> T f a -> T f a >= :: T f a -> T f a -> Bool $c>= :: forall (f :: * -> *) a. (Ord a, Ord (f a)) => T f a -> T f a -> Bool > :: T f a -> T f a -> Bool $c> :: forall (f :: * -> *) a. (Ord a, Ord (f a)) => T f a -> T f a -> Bool <= :: T f a -> T f a -> Bool $c<= :: forall (f :: * -> *) a. (Ord a, Ord (f a)) => T f a -> T f a -> Bool < :: T f a -> T f a -> Bool $c< :: forall (f :: * -> *) a. (Ord a, Ord (f a)) => T f a -> T f a -> Bool compare :: T f a -> T f a -> Ordering $ccompare :: forall (f :: * -> *) a. (Ord a, Ord (f a)) => T f a -> T f a -> Ordering $cp1Ord :: forall (f :: * -> *) a. (Ord a, Ord (f a)) => Eq (T f a) Ord) instance (C.NFData f, NFData a) => NFData (T f a) where rnf :: T f a -> () rnf = T f a -> () forall (f :: * -> *) a. (NFData f, NFData a) => f a -> () C.rnf instance (C.NFData f) => C.NFData (T f) where rnf :: T f a -> () rnf (Cons a x f a xs) = (a, ()) -> () forall a. NFData a => a -> () rnf (a x, f a -> () forall (f :: * -> *) a. (NFData f, NFData a) => f a -> () C.rnf f a xs) instance (C.Show f, Show a) => Show (T f a) where showsPrec :: Int -> T f a -> ShowS showsPrec = Int -> T f a -> ShowS forall (f :: * -> *) a. (Show f, Show a) => Int -> f a -> ShowS C.showsPrec instance (C.Show f) => C.Show (T f) where showsPrec :: Int -> T f a -> ShowS showsPrec Int p (Cons a x f a xs) = Bool -> ShowS -> ShowS P.showParen (Int pInt -> Int -> Bool forall a. Ord a => a -> a -> Bool >Int 5) (ShowS -> ShowS) -> ShowS -> ShowS forall a b. (a -> b) -> a -> b $ Int -> a -> ShowS forall a. Show a => Int -> a -> ShowS P.showsPrec Int 6 a x ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ShowS P.showString String "!:" ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> f a -> ShowS forall (f :: * -> *) a. (Show f, Show a) => Int -> f a -> ShowS C.showsPrec Int 5 f a xs infixr 5 !:, `append`, `appendRight`, `appendLeft` (!:) :: a -> f a -> T f a !: :: a -> f a -> T f a (!:) = a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons {- | Force immediate generation of Cons. -} force :: T f a -> T f a force :: T f a -> T f a force T f a x = a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons (T f a -> a forall (f :: * -> *) a. T f a -> a head T f a x) (T f a -> f a forall (f :: * -> *) a. T f a -> f a tail T f a x) instance Functor f => Functor (T f) where fmap :: (a -> b) -> T f a -> T f b fmap a -> b f (Cons a x f a xs) = a -> b f a x b -> f b -> T f b forall a (f :: * -> *). a -> f a -> T f a !: (a -> b) -> f a -> f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f f a xs instance Foldable f => Foldable (T f) where foldr :: (a -> b -> b) -> b -> T f a -> b foldr a -> b -> b f b y (Cons a x f a xs) = a -> b -> b f a x (b -> b) -> b -> b forall a b. (a -> b) -> a -> b $ (a -> b -> b) -> b -> f a -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b Fold.foldr a -> b -> b f b y f a xs foldl1 :: (a -> a -> a) -> T f a -> a foldl1 = (a -> a -> a) -> T f a -> a forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> T f a -> a foldl1 foldr1 :: (a -> a -> a) -> T f a -> a foldr1 a -> a -> a f (Cons a x f a xs) = a -> (a -> a) -> Maybe a -> a forall b a. b -> (a -> b) -> Maybe a -> b maybe a x (a -> a -> a f a x) (Maybe a -> a) -> Maybe a -> a forall a b. (a -> b) -> a -> b $ (a -> Maybe a -> Maybe a) -> Maybe a -> f a -> Maybe a forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b Fold.foldr (\a y -> a -> Maybe a forall a. a -> Maybe a Just (a -> Maybe a) -> (Maybe a -> a) -> Maybe a -> Maybe a forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> (a -> a) -> Maybe a -> a forall b a. b -> (a -> b) -> Maybe a -> b maybe a y (a -> a -> a f a y)) Maybe a forall a. Maybe a Nothing f a xs {- foldr1 f (Cons x xs) = case xs of [] -> x y:ys -> f x $ Fold.foldr1 f (Cons y ys) -} instance Traversable f => Traversable (T f) where sequenceA :: T f (f a) -> f (T f a) sequenceA (Cons f a x f (f a) xs) = (a -> f a -> T f a) -> f a -> f (f a) -> f (T f a) forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons f a x (f (f a) -> f (T f a)) -> f (f a) -> f (T f a) forall a b. (a -> b) -> a -> b $ f (f a) -> f (f a) forall (t :: * -> *) (f :: * -> *) a. (Traversable t, Applicative f) => t (f a) -> f (t a) Trav.sequenceA f (f a) xs instance (Applicative f, C.Empty f, C.Cons f, C.Append f) => Applicative (T f) where pure :: a -> T f a pure = a -> T f a forall (f :: * -> *) a. Empty f => a -> T f a singleton <*> :: T f (a -> b) -> T f a -> T f b (<*>) = T f (a -> b) -> T f a -> T f b forall (f :: * -> *) a b. (Applicative f, Cons f, Append f) => T f (a -> b) -> T f a -> T f b apply instance (Monad f, C.Empty f, C.Cons f, C.Append f) => Monad (T f) where return :: a -> T f a return = a -> T f a forall (f :: * -> *) a. Empty f => a -> T f a singleton >>= :: T f a -> (a -> T f b) -> T f b (>>=) = T f a -> (a -> T f b) -> T f b forall (f :: * -> *) a b. (Monad f, Cons f, Append f) => T f a -> (a -> T f b) -> T f b bind instance (C.Arbitrary f) => C.Arbitrary (T f) where arbitrary :: Gen (T f a) arbitrary = Gen (T f a) forall a (f :: * -> *). (Arbitrary a, Arbitrary f) => Gen (T f a) arbitrary shrink :: T f a -> [T f a] shrink = T f a -> [T f a] forall a (f :: * -> *). (Arbitrary a, Arbitrary f) => T f a -> [T f a] shrink instance (QC.Arbitrary a, C.Arbitrary f) => QC.Arbitrary (T f a) where arbitrary :: Gen (T f a) arbitrary = Gen (T f a) forall a (f :: * -> *). (Arbitrary a, Arbitrary f) => Gen (T f a) arbitrary shrink :: T f a -> [T f a] shrink = T f a -> [T f a] forall a (f :: * -> *). (Arbitrary a, Arbitrary f) => T f a -> [T f a] shrink arbitrary :: (QC.Arbitrary a, C.Arbitrary f) => QC.Gen (T f a) arbitrary :: Gen (T f a) arbitrary = (a -> f a -> T f a) -> Gen a -> Gen (f a) -> Gen (T f a) forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons Gen a forall a. Arbitrary a => Gen a QC.arbitrary Gen (f a) forall (f :: * -> *) a. (Arbitrary f, Arbitrary a) => Gen (f a) C.arbitrary shrink :: (QC.Arbitrary a, C.Arbitrary f) => T f a -> [T f a] shrink :: T f a -> [T f a] shrink (Cons a x f a xs) = ((a, Aux f a) -> T f a) -> [(a, Aux f a)] -> [T f a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\(a y, Aux f a ys) -> a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons a y f a ys) ([(a, Aux f a)] -> [T f a]) -> [(a, Aux f a)] -> [T f a] forall a b. (a -> b) -> a -> b $ (a, Aux f a) -> [(a, Aux f a)] forall a. Arbitrary a => a -> [a] QC.shrink (a x, f a -> Aux f a forall (f :: * -> *) a. f a -> Aux f a Aux f a xs) newtype Aux f a = Aux (f a) instance (C.Arbitrary f, QC.Arbitrary a) => QC.Arbitrary (Aux f a) where arbitrary :: Gen (Aux f a) arbitrary = (f a -> Aux f a) -> Gen (f a) -> Gen (Aux f a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap f a -> Aux f a forall (f :: * -> *) a. f a -> Aux f a Aux Gen (f a) forall (f :: * -> *) a. (Arbitrary f, Arbitrary a) => Gen (f a) C.arbitrary shrink :: Aux f a -> [Aux f a] shrink (Aux f a x) = (f a -> Aux f a) -> [f a] -> [Aux f a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap f a -> Aux f a forall (f :: * -> *) a. f a -> Aux f a Aux ([f a] -> [Aux f a]) -> [f a] -> [Aux f a] forall a b. (a -> b) -> a -> b $ f a -> [f a] forall (f :: * -> *) a. (Arbitrary f, Arbitrary a) => f a -> [f a] C.shrink f a x instance (C.Gen f) => C.Gen (T f) where genOf :: Gen a -> Gen (T f a) genOf Gen a gen = (a -> f a -> T f a) -> Gen a -> Gen (f a) -> Gen (T f a) forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons Gen a gen (Gen (f a) -> Gen (T f a)) -> Gen (f a) -> Gen (T f a) forall a b. (a -> b) -> a -> b $ Gen a -> Gen (f a) forall (f :: * -> *) a. Gen f => Gen a -> Gen (f a) C.genOf Gen a gen {- | Implementation of 'Applicative.<*>' without the 'C.Empty' constraint that is needed for 'Applicative.pure'. -} apply :: (Applicative f, C.Cons f, C.Append f) => T f (a -> b) -> T f a -> T f b apply :: T f (a -> b) -> T f a -> T f b apply (Cons a -> b f f (a -> b) fs) (Cons a x f a xs) = b -> f b -> T f b forall (f :: * -> *) a. a -> f a -> T f a Cons (a -> b f a x) ((a -> b) -> f a -> f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f f a xs f b -> f b -> f b forall (f :: * -> *) a. Append f => f a -> f a -> f a `C.append` (f (a -> b) fs f (a -> b) -> f a -> f b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> a -> f a -> f a forall (f :: * -> *) a. Cons f => a -> f a -> f a C.cons a x f a xs)) {- | Implementation of 'Monad.>>=' without the 'C.Empty' constraint that is needed for 'Monad.return'. -} bind :: (Monad f, C.Cons f, C.Append f) => T f a -> (a -> T f b) -> T f b bind :: T f a -> (a -> T f b) -> T f b bind (Cons a x f a xs) a -> T f b k = T f b -> f b -> T f b forall (f :: * -> *) a. Append f => T f a -> f a -> T f a appendRight (a -> T f b k a x) (T f b -> f b forall (f :: * -> *) a. Cons f => T f a -> f a flatten (T f b -> f b) -> (a -> T f b) -> a -> f b forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> T f b k (a -> f b) -> f a -> f b forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< f a xs) toList :: Foldable f => T f a -> [a] toList :: T f a -> [a] toList (Cons a x f a xs) = a x a -> [a] -> [a] forall a. a -> [a] -> [a] : f a -> [a] forall (t :: * -> *) a. Foldable t => t a -> [a] Fold.toList f a xs flatten :: C.Cons f => T f a -> f a flatten :: T f a -> f a flatten (Cons a x f a xs) = a -> f a -> f a forall (f :: * -> *) a. Cons f => a -> f a -> f a C.cons a x f a xs fetch :: C.ViewL f => f a -> Maybe (T f a) fetch :: f a -> Maybe (T f a) fetch = ((a, f a) -> T f a) -> Maybe (a, f a) -> Maybe (T f a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((a -> f a -> T f a) -> (a, f a) -> T f a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons) (Maybe (a, f a) -> Maybe (T f a)) -> (f a -> Maybe (a, f a)) -> f a -> Maybe (T f a) forall b c a. (b -> c) -> (a -> b) -> a -> c . f a -> Maybe (a, f a) forall (f :: * -> *) a. ViewL f => f a -> Maybe (a, f a) C.viewL {- | Caution: @viewL (NonEmpty.Cons x []) = Nothing@ because the tail is empty, and thus cannot be NonEmpty! This instance mainly exist to allow cascaded applications of 'fetch'. -} instance C.ViewL f => C.ViewL (T f) where viewL :: T f a -> Maybe (a, T f a) viewL (Cons a x f a xs) = (T f a -> (a, T f a)) -> Maybe (T f a) -> Maybe (a, T f a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((,) a x) (Maybe (T f a) -> Maybe (a, T f a)) -> Maybe (T f a) -> Maybe (a, T f a) forall a b. (a -> b) -> a -> b $ f a -> Maybe (T f a) forall (f :: * -> *) a. ViewL f => f a -> Maybe (T f a) fetch f a xs instance C.Cons f => C.Cons (T f) where cons :: a -> T f a -> T f a cons a x0 (Cons a x1 f a xs) = a x0 a -> f a -> T f a forall a (f :: * -> *). a -> f a -> T f a !: a -> f a -> f a forall (f :: * -> *) a. Cons f => a -> f a -> f a C.cons a x1 f a xs instance C.Snoc f => C.Snoc (T f) where snoc :: T f a -> a -> T f a snoc (Cons a x0 f a xs) a x1 = a x0 a -> f a -> T f a forall a (f :: * -> *). a -> f a -> T f a !: f a -> a -> f a forall (f :: * -> *) a. Snoc f => f a -> a -> f a C.snoc f a xs a x1 {- | Synonym for 'Cons'. For symmetry to 'snoc'. -} cons :: a -> f a -> T f a cons :: a -> f a -> T f a cons = a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons snoc :: Traversable f => f a -> a -> T f a snoc :: f a -> a -> T f a snoc f a xs a x = (a -> f a -> T f a) -> (a, f a) -> T f a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons ((a, f a) -> T f a) -> (a, f a) -> T f a forall a b. (a -> b) -> a -> b $ (a -> a -> (a, a)) -> a -> f a -> (a, f a) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumR ((a -> a -> (a, a)) -> a -> a -> (a, a) forall a b c. (a -> b -> c) -> b -> a -> c flip (,)) a x f a xs -- name of the class could also be ShiftL class Snoc f where snocFast :: f a -> a -> T f a instance Snoc [] where snocFast :: [a] -> a -> T [] a snocFast = [a] -> a -> T [] a forall (f :: * -> *) a. (ViewL f, Empty f, Snoc f) => f a -> a -> T f a snocGeneric instance Snoc Seq where snocFast :: Seq a -> a -> T Seq a snocFast = Seq a -> a -> T Seq a forall (f :: * -> *) a. (ViewL f, Empty f, Snoc f) => f a -> a -> T f a snocGeneric instance Snoc Empty.T where snocFast :: T a -> a -> T T a snocFast ~T a Empty.Cons a x = a -> T a -> T T a forall (f :: * -> *) a. a -> f a -> T f a Cons a x T a forall a. T a Empty.Cons instance Snoc Maybe where snocFast :: Maybe a -> a -> T Maybe a snocFast Maybe a mx a y = (a -> Maybe a -> T Maybe a) -> (a, Maybe a) -> T Maybe a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> Maybe a -> T Maybe a forall (f :: * -> *) a. a -> f a -> T f a Cons ((a, Maybe a) -> T Maybe a) -> (a, Maybe a) -> T Maybe a forall a b. (a -> b) -> a -> b $ (a, Maybe a) -> (a -> (a, Maybe a)) -> Maybe a -> (a, Maybe a) forall b a. b -> (a -> b) -> Maybe a -> b maybe (a y, Maybe a forall a. Maybe a Nothing) (\a x -> (a x, a -> Maybe a forall a. a -> Maybe a Just a y)) Maybe a mx -- | For 'Seq' faster than 'snoc'. snocGeneric :: (C.ViewL f, C.Empty f, C.Snoc f) => f a -> a -> T f a snocGeneric :: f a -> a -> T f a snocGeneric f a xs a x = (a -> f a -> T f a) -> (a, f a) -> T f a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons ((a, f a) -> T f a) -> (a, f a) -> T f a forall a b. (a -> b) -> a -> b $ case f a -> Maybe (a, f a) forall (f :: * -> *) a. ViewL f => f a -> Maybe (a, f a) C.viewL f a xs of Maybe (a, f a) Nothing -> (a x, f a forall (f :: * -> *) a. Empty f => f a C.empty) Just (a y,f a ys) -> (a y, f a -> a -> f a forall (f :: * -> *) a. Snoc f => f a -> a -> f a C.snoc f a ys a x) snocAlt :: (C.Cons f, Traversable f) => f a -> a -> f a snocAlt :: f a -> a -> f a snocAlt f a xs a x = T f a -> f a forall (f :: * -> *) a. Cons f => T f a -> f a flatten (T f a -> f a) -> T f a -> f a forall a b. (a -> b) -> a -> b $ f a -> a -> T f a forall (f :: * -> *) a. Traversable f => f a -> a -> T f a snoc f a xs a x instance C.Empty f => C.Singleton (T f) where singleton :: a -> T f a singleton = a -> T f a forall (f :: * -> *) a. Empty f => a -> T f a singleton singleton :: C.Empty f => a -> T f a singleton :: a -> T f a singleton a x = a x a -> f a -> T f a forall a (f :: * -> *). a -> f a -> T f a !: f a forall (f :: * -> *) a. Empty f => f a C.empty viewL :: T f a -> (a, f a) viewL :: T f a -> (a, f a) viewL (Cons a x f a xs) = (a x, f a xs) viewR :: (Traversable f) => T f a -> (f a, a) viewR :: T f a -> (f a, a) viewR (Cons a x f a xs) = (a, f a) -> (f a, a) forall a b. (a, b) -> (b, a) swap ((a, f a) -> (f a, a)) -> (a, f a) -> (f a, a) forall a b. (a -> b) -> a -> b $ (a -> a -> (a, a)) -> a -> f a -> (a, f a) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL ((a -> a -> (a, a)) -> a -> a -> (a, a) forall a b c. (a -> b -> c) -> b -> a -> c flip (,)) a x f a xs mapHead :: (a -> a) -> T f a -> T f a mapHead :: (a -> a) -> T f a -> T f a mapHead a -> a f (Cons a x f a xs) = a -> a f a x a -> f a -> T f a forall a (f :: * -> *). a -> f a -> T f a !: f a xs mapTail :: (f a -> g a) -> T f a -> T g a mapTail :: (f a -> g a) -> T f a -> T g a mapTail f a -> g a f (Cons a x f a xs) = a x a -> g a -> T g a forall a (f :: * -> *). a -> f a -> T f a !: f a -> g a f f a xs init :: (Traversable f) => T f a -> f a init :: T f a -> f a init = (f a, a) -> f a forall a b. (a, b) -> a fst ((f a, a) -> f a) -> (T f a -> (f a, a)) -> T f a -> f a forall b c a. (b -> c) -> (a -> b) -> a -> c . T f a -> (f a, a) forall (f :: * -> *) a. Traversable f => T f a -> (f a, a) viewR last :: (Foldable f) => T f a -> a last :: T f a -> a last = (a -> a -> a) -> T f a -> a forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> T f a -> a foldl1 ((a -> a -> a) -> a -> a -> a forall a b c. (a -> b -> c) -> b -> a -> c flip a -> a -> a forall a b. a -> b -> a const) foldl1 :: (Foldable f) => (a -> a -> a) -> T f a -> a foldl1 :: (a -> a -> a) -> T f a -> a foldl1 a -> a -> a f (Cons a x f a xs) = (a -> a -> a) -> a -> f a -> a forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b Fold.foldl a -> a -> a f a x f a xs {- | It holds: > foldl1Map f g = foldl1 f . fmap g but 'foldl1Map' does not need a 'Functor' instance. -} foldl1Map :: (Foldable f) => (b -> b -> b) -> (a -> b) -> T f a -> b foldl1Map :: (b -> b -> b) -> (a -> b) -> T f a -> b foldl1Map b -> b -> b f a -> b g (Cons a x f a xs) = (b -> a -> b) -> b -> f a -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b Fold.foldl (\b b a a -> b -> b -> b f b b (a -> b g a a)) (a -> b g a x) f a xs -- cf. NumericPrelude: Algebra.Additive.sumNestedCommutative {- Estimate costs of @foldBalanced ListHT.merge@. @a, b, c@ length of sub-lists and our measure for the cost. xs = [a,b,c] ys = [a,b,c,a+b,c+a+b] costs: (a+b) + (c+a+b) = 2a+2b+c xs = [a,b,c,d] ys = [a,b,c,d,a+b,c+d,a+b+c+d] costs: (a+b) + (c+d) + (a+b+c+d) = 2a+2b+2c+2d xs = [a,b,c,d,e] ys = [a,b,c,d,e,a+b,c+d,e+(a+b),c+d+e+(a+b)] costs: (a+b) + (c+d) + (e+(a+b)) + (c+d+e+(a+b)) = 3a+3b+2c+2d+2e Analysis is easiest if @length xs@ is a power of two, e.g. @2^n@. Then the operator tree has height @n@. That is, we get a run-time of @n * sum (map length xs)@. This is usually better than @sort (concat xs)@ which has run-time @let m = sum (map length xs) in m * logBase 2 m@. -} {- | Fold a non-empty list in a balanced way. /Balanced/ means that each element has approximately the same depth in the operator tree. /Approximately the same depth/ means that the difference between maximum and minimum depth is at most 1. The accumulation operation must be associative and commutative in order to get the same result as 'foldl1' or 'foldr1'. -} foldBalanced :: (a -> a -> a) -> T [] a -> a foldBalanced :: (a -> a -> a) -> T [] a -> a foldBalanced = (a -> [a] -> [a]) -> (a -> a -> a) -> T [] a -> a forall a. (a -> [a] -> [a]) -> (a -> a -> a) -> T [] a -> a foldBalancedGen (:) foldBalancedStrict :: (a -> a -> a) -> T [] a -> a foldBalancedStrict :: (a -> a -> a) -> T [] a -> a foldBalancedStrict = (a -> [a] -> [a]) -> (a -> a -> a) -> T [] a -> a forall a. (a -> [a] -> [a]) -> (a -> a -> a) -> T [] a -> a foldBalancedGen (\a x -> ((:) (a -> [a] -> [a]) -> a -> [a] -> [a] forall a b. (a -> b) -> a -> b $! a x)) foldBalancedGen :: (a -> [a] -> [a]) -> (a -> a -> a) -> T [] a -> a foldBalancedGen :: (a -> [a] -> [a]) -> (a -> a -> a) -> T [] a -> a foldBalancedGen a -> [a] -> [a] listCons a -> a -> a f xs :: T [] a xs@(Cons a _ [a] rs) = let reduce :: [a] -> [a] reduce (a z0:a z1:[a] zs) = a -> [a] -> [a] listCons (a -> a -> a f a z0 a z1) ([a] -> [a] reduce [a] zs) reduce [a] zs = [a] zs ys :: T [] a ys = T [] a -> [a] -> T [] a forall (f :: * -> *) a. Append f => T f a -> f a -> T f a appendRight T [] a xs ([a] -> T [] a) -> [a] -> T [] a forall a b. (a -> b) -> a -> b $ [a] -> [a] -> [a] forall b a. [b] -> [a] -> [a] Match.take [a] rs ([a] -> [a]) -> [a] -> [a] forall a b. (a -> b) -> a -> b $ [a] -> [a] reduce ([a] -> [a]) -> [a] -> [a] forall a b. (a -> b) -> a -> b $ T [] a -> [a] forall (f :: * -> *) a. Cons f => T f a -> f a flatten T [] a ys in T [] a -> a forall (f :: * -> *) a. Foldable f => T f a -> a last T [] a ys -- | maximum is a total function maximum :: (Ord a, Foldable f) => T f a -> a maximum :: T f a -> a maximum = (a -> a -> a) -> T f a -> a forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> T f a -> a foldl1 a -> a -> a forall a. Ord a => a -> a -> a P.max -- | minimum is a total function minimum :: (Ord a, Foldable f) => T f a -> a minimum :: T f a -> a minimum = (a -> a -> a) -> T f a -> a forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> T f a -> a foldl1 a -> a -> a forall a. Ord a => a -> a -> a P.min -- | maximumBy is a total function maximumBy :: (Foldable f) => (a -> a -> Ordering) -> T f a -> a maximumBy :: (a -> a -> Ordering) -> T f a -> a maximumBy a -> a -> Ordering f = (a -> a -> a) -> T f a -> a forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> T f a -> a foldl1 (\a x a y -> case a -> a -> Ordering f a x a y of Ordering P.LT -> a y; Ordering _ -> a x) -- | minimumBy is a total function minimumBy :: (Foldable f) => (a -> a -> Ordering) -> T f a -> a minimumBy :: (a -> a -> Ordering) -> T f a -> a minimumBy a -> a -> Ordering f = (a -> a -> a) -> T f a -> a forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> T f a -> a foldl1 (\a x a y -> case a -> a -> Ordering f a x a y of Ordering P.GT -> a y; Ordering _ -> a x) -- | maximumKey is a total function maximumKey :: (Ord b, Foldable f) => (a -> b) -> T f a -> a maximumKey :: (a -> b) -> T f a -> a maximumKey a -> b f = (b, a) -> a forall a b. (a, b) -> b snd ((b, a) -> a) -> (T f a -> (b, a)) -> T f a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . ((b, a) -> (b, a) -> Ordering) -> Mapped (T f) a (b, a) -> (b, a) forall (t :: * -> *) a. Foldable t => (a -> a -> Ordering) -> t a -> a Fold.maximumBy (((b, a) -> b) -> (b, a) -> (b, a) -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing (b, a) -> b forall a b. (a, b) -> a fst) (Mapped (T f) a (b, a) -> (b, a)) -> (T f a -> Mapped (T f) a (b, a)) -> T f a -> (b, a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> (b, a)) -> T f a -> Mapped (T f) a (b, a) forall (f :: * -> *) a b. (a -> b) -> f a -> Mapped f a b FoldU.Mapped ((a -> b) -> a -> (b, a) forall a b. (a -> b) -> a -> (b, a) attachKey a -> b f) -- | minimumKey is a total function minimumKey :: (Ord b, Foldable f) => (a -> b) -> T f a -> a minimumKey :: (a -> b) -> T f a -> a minimumKey a -> b f = (b, a) -> a forall a b. (a, b) -> b snd ((b, a) -> a) -> (T f a -> (b, a)) -> T f a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . ((b, a) -> (b, a) -> Ordering) -> Mapped (T f) a (b, a) -> (b, a) forall (t :: * -> *) a. Foldable t => (a -> a -> Ordering) -> t a -> a Fold.minimumBy (((b, a) -> b) -> (b, a) -> (b, a) -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing (b, a) -> b forall a b. (a, b) -> a fst) (Mapped (T f) a (b, a) -> (b, a)) -> (T f a -> Mapped (T f) a (b, a)) -> T f a -> (b, a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> (b, a)) -> T f a -> Mapped (T f) a (b, a) forall (f :: * -> *) a b. (a -> b) -> f a -> Mapped f a b FoldU.Mapped ((a -> b) -> a -> (b, a) forall a b. (a -> b) -> a -> (b, a) attachKey a -> b f) -- | maximumKey is a total function _maximumKey :: (Ord b, Foldable f, Functor f) => (a -> b) -> T f a -> a _maximumKey :: (a -> b) -> T f a -> a _maximumKey a -> b f = (b, a) -> a forall a b. (a, b) -> b snd ((b, a) -> a) -> (T f a -> (b, a)) -> T f a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . ((b, a) -> (b, a) -> Ordering) -> T f (b, a) -> (b, a) forall (f :: * -> *) a. Foldable f => (a -> a -> Ordering) -> T f a -> a maximumBy (((b, a) -> b) -> (b, a) -> (b, a) -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing (b, a) -> b forall a b. (a, b) -> a fst) (T f (b, a) -> (b, a)) -> (T f a -> T f (b, a)) -> T f a -> (b, a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> (b, a)) -> T f a -> T f (b, a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((a -> b) -> a -> (b, a) forall a b. (a -> b) -> a -> (b, a) attachKey a -> b f) -- | minimumKey is a total function _minimumKey :: (Ord b, Foldable f, Functor f) => (a -> b) -> T f a -> a _minimumKey :: (a -> b) -> T f a -> a _minimumKey a -> b f = (b, a) -> a forall a b. (a, b) -> b snd ((b, a) -> a) -> (T f a -> (b, a)) -> T f a -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . ((b, a) -> (b, a) -> Ordering) -> T f (b, a) -> (b, a) forall (f :: * -> *) a. Foldable f => (a -> a -> Ordering) -> T f a -> a minimumBy (((b, a) -> b) -> (b, a) -> (b, a) -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing (b, a) -> b forall a b. (a, b) -> a fst) (T f (b, a) -> (b, a)) -> (T f a -> T f (b, a)) -> T f a -> (b, a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> (b, a)) -> T f a -> T f (b, a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((a -> b) -> a -> (b, a) forall a b. (a -> b) -> a -> (b, a) attachKey a -> b f) attachKey :: (a -> b) -> a -> (b, a) attachKey :: (a -> b) -> a -> (b, a) attachKey a -> b f a a = (a -> b f a a, a a) -- | sum does not need a zero for initialization sum :: (Num a, Foldable f) => T f a -> a sum :: T f a -> a sum = (a -> a -> a) -> T f a -> a forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> T f a -> a foldl1 a -> a -> a forall a. Num a => a -> a -> a (P.+) -- | product does not need a one for initialization product :: (Num a, Foldable f) => T f a -> a product :: T f a -> a product = (a -> a -> a) -> T f a -> a forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> T f a -> a foldl1 a -> a -> a forall a. Num a => a -> a -> a (P.*) chop :: (a -> Bool) -> [a] -> T [] [a] chop :: (a -> Bool) -> [a] -> T [] [a] chop a -> Bool p = ([a] -> [[a]] -> T [] [a]) -> ([a], [[a]]) -> T [] [a] forall a b c. (a -> b -> c) -> (a, b) -> c uncurry [a] -> [[a]] -> T [] [a] forall a (f :: * -> *). a -> f a -> T f a cons (([a], [[a]]) -> T [] [a]) -> ([a] -> ([a], [[a]])) -> [a] -> T [] [a] forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> ([a], [[a]]) -> ([a], [[a]])) -> ([a], [[a]]) -> [a] -> ([a], [[a]]) forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b P.foldr (\ a x ~([a] y,[[a]] ys) -> if a -> Bool p a x then ([],[a] y[a] -> [[a]] -> [[a]] forall a. a -> [a] -> [a] :[[a]] ys) else ((a xa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] y),[[a]] ys) ) ([],[]) instance (C.Cons f, C.Append f) => C.Append (T f) where append :: T f a -> T f a -> T f a append T f a xs T f a ys = T f a -> f a -> T f a forall (f :: * -> *) a. Append f => T f a -> f a -> T f a appendRight T f a xs (T f a -> f a forall (f :: * -> *) a. Cons f => T f a -> f a flatten T f a ys) append :: (C.Append f, Traversable f) => T f a -> T f a -> T (T f) a append :: T f a -> T f a -> T (T f) a append T f a xs T f a ys = (f a -> T f a) -> T f a -> T (T f) a forall (f :: * -> *) a (g :: * -> *). (f a -> g a) -> T f a -> T g a mapTail ((f a -> T f a -> T f a) -> T f a -> f a -> T f a forall a b c. (a -> b -> c) -> b -> a -> c flip f a -> T f a -> T f a forall (f :: * -> *) a. (Append f, Traversable f) => f a -> T f a -> T f a appendLeft T f a ys) T f a xs appendRight :: (C.Append f) => T f a -> f a -> T f a appendRight :: T f a -> f a -> T f a appendRight (Cons a x f a xs) f a ys = a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons a x (f a -> f a -> f a forall (f :: * -> *) a. Append f => f a -> f a -> f a C.append f a xs f a ys) appendLeft :: (C.Append f, Traversable f) => f a -> T f a -> T f a appendLeft :: f a -> T f a -> T f a appendLeft f a xt (Cons a y f a ys) = (f a -> f a) -> T f a -> T f a forall (f :: * -> *) a (g :: * -> *). (f a -> g a) -> T f a -> T g a mapTail ((f a -> f a -> f a) -> f a -> f a -> f a forall a b c. (a -> b -> c) -> b -> a -> c flip f a -> f a -> f a forall (f :: * -> *) a. Append f => f a -> f a -> f a C.append f a ys) (T f a -> T f a) -> T f a -> T f a forall a b. (a -> b) -> a -> b $ f a -> a -> T f a forall (f :: * -> *) a. Traversable f => f a -> a -> T f a snoc f a xt a y {- | generic variants: 'Data.Monoid.HT.cycle' or better @Semigroup.cycle@ -} cycle :: (C.Cons f, C.Append f) => T f a -> T f a cycle :: T f a -> T f a cycle T f a x = let y :: T f a y = T f a -> T f a -> T f a forall (f :: * -> *) a. Append f => f a -> f a -> f a C.append T f a x T f a y in T f a y instance (C.Zip f) => C.Zip (T f) where zipWith :: (a -> b -> c) -> T f a -> T f b -> T f c zipWith = (a -> b -> c) -> T f a -> T f b -> T f c forall (f :: * -> *) a b c. Zip f => (a -> b -> c) -> T f a -> T f b -> T f c zipWith zipWith :: (C.Zip f) => (a -> b -> c) -> T f a -> T f b -> T f c zipWith :: (a -> b -> c) -> T f a -> T f b -> T f c zipWith a -> b -> c f (Cons a a f a as) (Cons b b f b bs) = c -> f c -> T f c forall (f :: * -> *) a. a -> f a -> T f a Cons (a -> b -> c f a a b b) ((a -> b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. Zip f => (a -> b -> c) -> f a -> f b -> f c C.zipWith a -> b -> c f f a as f b bs) instance (C.Repeat f) => C.Repeat (T f) where repeat :: a -> T f a repeat a a = a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons a a (f a -> T f a) -> f a -> T f a forall a b. (a -> b) -> a -> b $ a -> f a forall (f :: * -> *) a. Repeat f => a -> f a C.repeat a a instance (C.Iterate f) => C.Iterate (T f) where iterate :: (a -> a) -> a -> T f a iterate a -> a f a a = a -> f a -> T f a forall (f :: * -> *) a. a -> f a -> T f a Cons a a (f a -> T f a) -> f a -> T f a forall a b. (a -> b) -> a -> b $ (a -> a) -> a -> f a forall (f :: * -> *) a. Iterate f => (a -> a) -> a -> f a C.iterate a -> a f (a -> a f a a) {- This implementation needs quadratic time with respect to the number of 'Cons'. Maybe a linear time solution can be achieved using a type function that maps a container type to the type of the reversed container. -} reverse :: (Traversable f, C.Reverse f) => T f a -> T f a reverse :: T f a -> T f a reverse (Cons a x f a xs) = f a -> a -> T f a forall (f :: * -> *) a. Traversable f => f a -> a -> T f a snoc (f a -> f a forall (f :: * -> *) a. Reverse f => f a -> f a C.reverse f a xs) a x instance (Traversable f, C.Reverse f) => C.Reverse (T f) where reverse :: T f a -> T f a reverse = T f a -> T f a forall (f :: * -> *) a. (Traversable f, Reverse f) => T f a -> T f a reverse {- | If you nest too many non-empty lists then the efficient merge-sort (linear-logarithmic runtime) will degenerate to an inefficient insert-sort (quadratic runtime). -} instance (C.Sort f, InsertBy f) => C.Sort (T f) where sort :: T f a -> T f a sort (Cons a x f a xs) = a -> f a -> T f a forall (f :: * -> *) a. (Insert f, Ord a) => a -> f a -> T f a insert a x (f a -> T f a) -> f a -> T f a forall a b. (a -> b) -> a -> b $ f a -> f a forall (f :: * -> *) a. (Sort f, Ord a) => f a -> f a C.sort f a xs instance (C.SortBy f, InsertBy f) => C.SortBy (T f) where sortBy :: (a -> a -> Ordering) -> T f a -> T f a sortBy a -> a -> Ordering f (Cons a x f a xs) = (a -> a -> Ordering) -> a -> f a -> T f a forall (f :: * -> *) a. InsertBy f => (a -> a -> Ordering) -> a -> f a -> T f a insertBy a -> a -> Ordering f a x (f a -> T f a) -> f a -> T f a forall a b. (a -> b) -> a -> b $ (a -> a -> Ordering) -> f a -> f a forall (f :: * -> *) a. SortBy f => (a -> a -> Ordering) -> f a -> f a C.sortBy a -> a -> Ordering f f a xs class Insert f where {- | Insert an element into an ordered list while preserving the order. -} insert :: (Ord a) => a -> f a -> T f a instance (Insert f) => Insert (T f) where insert :: a -> T f a -> T (T f) a insert a y xt :: T f a xt@(Cons a x f a xs) = (a -> T f a -> T (T f) a) -> (a, T f a) -> T (T f) a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> T f a -> T (T f) a forall (f :: * -> *) a. a -> f a -> T f a Cons ((a, T f a) -> T (T f) a) -> (a, T f a) -> T (T f) a forall a b. (a -> b) -> a -> b $ case a -> a -> Ordering forall a. Ord a => a -> a -> Ordering compare a y a x of Ordering GT -> (a x, a -> f a -> T f a forall (f :: * -> *) a. (Insert f, Ord a) => a -> f a -> T f a insert a y f a xs) Ordering _ -> (a y, T f a xt) instance Insert Empty.T where insert :: a -> T a -> T T a insert = a -> T a -> T T a forall a (f :: * -> *). (Ord a, InsertBy f, SortBy f) => a -> f a -> T f a insertDefault instance Insert [] where insert :: a -> [a] -> T [] a insert = a -> [a] -> T [] a forall a (f :: * -> *). (Ord a, InsertBy f, SortBy f) => a -> f a -> T f a insertDefault instance Insert Maybe where insert :: a -> Maybe a -> T Maybe a insert = a -> Maybe a -> T Maybe a forall a (f :: * -> *). (Ord a, InsertBy f, SortBy f) => a -> f a -> T f a insertDefault instance Insert Seq where insert :: a -> Seq a -> T Seq a insert = a -> Seq a -> T Seq a forall a (f :: * -> *). (Ord a, InsertBy f, SortBy f) => a -> f a -> T f a insertDefault {- This does not work consistently! A Set is not a sorted list, since it collapses duplicate elements. *Data.NonEmptyPrivate> mapTail (mapTail Set.toList) $ insert '3' $ insert '7' $ Set.fromList "346" '3'!:'3'!:'4':'6':'7':[] instance Insert Set where insert y xt = uncurry Cons $ fromMaybe (y, xt) $ do (x,xs) <- Set.minView xt case compare y x of GT -> return (x, Set.insert y xs) EQ -> return (x, xs) LT -> mzero We have preserved that function in NonEmpty.Mixed. -} {- | Default implementation for 'insert' based on 'insertBy'. -} insertDefault :: (Ord a, InsertBy f, C.SortBy f) => a -> f a -> T f a insertDefault :: a -> f a -> T f a insertDefault = (a -> a -> Ordering) -> a -> f a -> T f a forall (f :: * -> *) a. InsertBy f => (a -> a -> Ordering) -> a -> f a -> T f a insertBy a -> a -> Ordering forall a. Ord a => a -> a -> Ordering compare class Insert f => InsertBy f where insertBy :: (a -> a -> Ordering) -> a -> f a -> T f a instance (InsertBy f) => InsertBy (T f) where insertBy :: (a -> a -> Ordering) -> a -> T f a -> T (T f) a insertBy a -> a -> Ordering f a y xt :: T f a xt@(Cons a x f a xs) = (a -> T f a -> T (T f) a) -> (a, T f a) -> T (T f) a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> T f a -> T (T f) a forall (f :: * -> *) a. a -> f a -> T f a Cons ((a, T f a) -> T (T f) a) -> (a, T f a) -> T (T f) a forall a b. (a -> b) -> a -> b $ case a -> a -> Ordering f a y a x of Ordering GT -> (a x, (a -> a -> Ordering) -> a -> f a -> T f a forall (f :: * -> *) a. InsertBy f => (a -> a -> Ordering) -> a -> f a -> T f a insertBy a -> a -> Ordering f a y f a xs) Ordering _ -> (a y, T f a xt) instance InsertBy Empty.T where insertBy :: (a -> a -> Ordering) -> a -> T a -> T T a insertBy a -> a -> Ordering _ a x T a Empty.Cons = a -> T a -> T T a forall (f :: * -> *) a. a -> f a -> T f a Cons a x T a forall a. T a Empty.Cons instance InsertBy [] where insertBy :: (a -> a -> Ordering) -> a -> [a] -> T [] a insertBy a -> a -> Ordering f a y [a] xt = (a -> [a] -> T [] a) -> (a, [a]) -> T [] a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> [a] -> T [] a forall (f :: * -> *) a. a -> f a -> T f a Cons ((a, [a]) -> T [] a) -> (a, [a]) -> T [] a forall a b. (a -> b) -> a -> b $ case [a] xt of [] -> (a y, [a] xt) a x:[a] xs -> case a -> a -> Ordering f a y a x of Ordering GT -> (a x, (a -> a -> Ordering) -> a -> [a] -> [a] forall a. (a -> a -> Ordering) -> a -> [a] -> [a] List.insertBy a -> a -> Ordering f a y [a] xs) Ordering _ -> (a y, [a] xt) instance InsertBy Maybe where insertBy :: (a -> a -> Ordering) -> a -> Maybe a -> T Maybe a insertBy a -> a -> Ordering f a y Maybe a mx = (a -> Maybe a -> T Maybe a) -> (a, Maybe a) -> T Maybe a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> Maybe a -> T Maybe a forall (f :: * -> *) a. a -> f a -> T f a Cons ((a, Maybe a) -> T Maybe a) -> (a, Maybe a) -> T Maybe a forall a b. (a -> b) -> a -> b $ case Maybe a mx of Maybe a Nothing -> (a y, Maybe a forall a. Maybe a Nothing) Just a x -> (a -> Maybe a) -> (a, a) -> (a, Maybe a) forall b c a. (b -> c) -> (a, b) -> (a, c) mapSnd a -> Maybe a forall a. a -> Maybe a Just ((a, a) -> (a, Maybe a)) -> (a, a) -> (a, Maybe a) forall a b. (a -> b) -> a -> b $ case a -> a -> Ordering f a y a x of Ordering GT -> (a x, a y) Ordering _ -> (a y, a x) instance InsertBy Seq where {- If we assume a sorted list we could do binary search for the splitting point. -} insertBy :: (a -> a -> Ordering) -> a -> Seq a -> T Seq a insertBy a -> a -> Ordering f a y Seq a xt = (a -> Seq a -> T Seq a) -> (a, Seq a) -> T Seq a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> Seq a -> T Seq a forall (f :: * -> *) a. a -> f a -> T f a Cons ((a, Seq a) -> T Seq a) -> (a, Seq a) -> T Seq a forall a b. (a -> b) -> a -> b $ case (a -> Bool) -> Seq a -> (Seq a, Seq a) forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a) Seq.spanl ((Ordering GT Ordering -> Ordering -> Bool forall a. Eq a => a -> a -> Bool ==) (Ordering -> Bool) -> (a -> Ordering) -> a -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> a -> Ordering f a y) Seq a xt of (Seq a ys,Seq a zs) -> case Seq a -> ViewL a forall a. Seq a -> ViewL a Seq.viewl Seq a ys of ViewL a Seq.EmptyL -> (a y, Seq a xt) a w Seq.:< Seq a ws -> (a w, Seq a ws Seq a -> Seq a -> Seq a forall a. Seq a -> Seq a -> Seq a Seq.>< a y a -> Seq a -> Seq a forall a. a -> Seq a -> Seq a Seq.<| Seq a zs) {- Certainly not as efficient as insertBy as class method since all elements of the list are touched. -} insertByTraversable :: (Traversable f) => (a -> a -> Ordering) -> a -> f a -> T f a insertByTraversable :: (a -> a -> Ordering) -> a -> f a -> T f a insertByTraversable a -> a -> Ordering cmp a y0 = ((Bool, a) -> f a -> T f a) -> ((Bool, a), f a) -> T f a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry ((f a -> a -> T f a) -> a -> f a -> T f a forall a b c. (a -> b -> c) -> b -> a -> c flip f a -> a -> T f a forall (f :: * -> *) a. Traversable f => f a -> a -> T f a snoc (a -> f a -> T f a) -> ((Bool, a) -> a) -> (Bool, a) -> f a -> T f a forall b c a. (b -> c) -> (a -> b) -> a -> c . (Bool, a) -> a forall a b. (a, b) -> b snd) (((Bool, a), f a) -> T f a) -> (f a -> ((Bool, a), f a)) -> f a -> T f a forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Bool, a) -> a -> ((Bool, a), a)) -> (Bool, a) -> f a -> ((Bool, a), f a) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL (\(Bool searching,a y) a x -> let stillSearching :: Bool stillSearching = Bool searching Bool -> Bool -> Bool && a -> a -> Ordering cmp a y a x Ordering -> Ordering -> Bool forall a. Eq a => a -> a -> Bool == Ordering GT in (a -> (Bool, a)) -> (a, a) -> ((Bool, a), a) forall a c b. (a -> c) -> (a, b) -> (c, b) mapFst ((,) Bool stillSearching) ((a, a) -> ((Bool, a), a)) -> (a, a) -> ((Bool, a), a) forall a b. (a -> b) -> a -> b $ Bool -> (a, a) -> (a, a) -> (a, a) forall a. Bool -> a -> a -> a if' Bool stillSearching (a y,a x) (a x,a y)) (Bool True, a y0) mapWithIndex :: (Traversable f) => (Int -> a -> b) -> Int -> f a -> f b mapWithIndex :: (Int -> a -> b) -> Int -> f a -> f b mapWithIndex Int -> a -> b f Int n = (Int, f b) -> f b forall a b. (a, b) -> b snd ((Int, f b) -> f b) -> (f a -> (Int, f b)) -> f a -> f b forall b c a. (b -> c) -> (a -> b) -> a -> c . (Int -> a -> (Int, b)) -> Int -> f a -> (Int, f b) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL (\Int k a x -> (Int -> Int forall a. Enum a => a -> a P.succ Int k, Int -> a -> b f Int k a x)) Int n removeAt :: (Traversable f) => Int -> T f a -> (a, f a) removeAt :: Int -> T f a -> (a, f a) removeAt Int n (Cons a x0 f a xs) = (a -> (Int, a) -> (a, a)) -> a -> f (Int, a) -> (a, f a) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL (\a x (Int k,a y) -> if Int kInt -> Int -> Bool forall a. Ord a => a -> a -> Bool <=Int n then (a y,a x) else (a x,a y)) a x0 (f (Int, a) -> (a, f a)) -> f (Int, a) -> (a, f a) forall a b. (a -> b) -> a -> b $ (Int -> a -> (Int, a)) -> Int -> f a -> f (Int, a) forall (f :: * -> *) a b. Traversable f => (Int -> a -> b) -> Int -> f a -> f b mapWithIndex (,) Int 1 f a xs removeEach :: (Traversable f) => T f a -> T f (a, f a) removeEach :: T f a -> T f (a, f a) removeEach T f a xs = (Int -> a -> (a, f a)) -> Int -> T f a -> T f (a, f a) forall (f :: * -> *) a b. Traversable f => (Int -> a -> b) -> Int -> f a -> f b mapWithIndex (\Int n a _ -> Int -> T f a -> (a, f a) forall (f :: * -> *) a. Traversable f => Int -> T f a -> (a, f a) removeAt Int n T f a xs) Int 0 T f a xs takeUntil :: (a -> Bool) -> T [] a -> T [] a takeUntil :: (a -> Bool) -> T [] a -> T [] a takeUntil a -> Bool p (Cons a x [a] xs) = a x a -> [a] -> T [] a forall a (f :: * -> *). a -> f a -> T f a !: if a -> Bool p a x then [] else (a -> Bool) -> [a] -> [a] forall a. (a -> Bool) -> [a] -> [a] ListHT.takeUntil a -> Bool p [a] xs takeUntilAlt :: (a -> Bool) -> T [] a -> T [] a takeUntilAlt :: (a -> Bool) -> T [] a -> T [] a takeUntilAlt a -> Bool p T [] a xs = (a -> () -> a) -> T [] a -> T [] () -> T [] a forall (f :: * -> *) a b c. Zip f => (a -> b -> c) -> T f a -> T f b -> T f c zipWith a -> () -> a forall a b. a -> b -> a const T [] a xs (T [] () -> T [] a) -> T [] () -> T [] a forall a b. (a -> b) -> a -> b $ () -> [()] -> T [] () forall (f :: * -> *) a. a -> f a -> T f a Cons () ([()] -> T [] ()) -> [()] -> T [] () forall a b. (a -> b) -> a -> b $ [a] -> [()] forall (m :: * -> *) a. Monad m => m a -> m () void ([a] -> [()]) -> [a] -> [()] forall a b. (a -> b) -> a -> b $ (a -> Bool) -> [a] -> [a] forall a. (a -> Bool) -> [a] -> [a] List.takeWhile (Bool -> Bool P.not (Bool -> Bool) -> (a -> Bool) -> a -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Bool p) ([a] -> [a]) -> [a] -> [a] forall a b. (a -> b) -> a -> b $ T [] a -> [a] forall (f :: * -> *) a. Cons f => T f a -> f a flatten T [] a xs {- It is somehow better than the variant in NonEmpty.Mixed, since it can be applied to nested NonEmptys. Type @g@ could be fixed to List, since context (C.Cons g, C.Empty g) means that @g@ is a supertype of something isomorphic to list. However, repeatedly prepending an element might be more efficient than repeated conversion from list to a structure like Sequence. -} tails :: (Traversable f, C.Cons g, C.Empty g) => f a -> T f (g a) tails :: f a -> T f (g a) tails = (a -> g a -> g a) -> g a -> f a -> T f (g a) forall (f :: * -> *) a b. Traversable f => (a -> b -> b) -> b -> f a -> T f b scanr a -> g a -> g a forall (f :: * -> *) a. Cons f => a -> f a -> f a C.cons g a forall (f :: * -> *) a. Empty f => f a C.empty {- | Only advised for structures with efficient appending of single elements like 'Sequence'. Alternatively you may consider 'initsRev'. -} inits :: (Traversable f, C.Snoc g, C.Empty g) => f a -> T f (g a) inits :: f a -> T f (g a) inits = (g a -> a -> g a) -> g a -> f a -> T f (g a) forall (f :: * -> *) b a. Traversable f => (b -> a -> b) -> b -> f a -> T f b scanl g a -> a -> g a forall (f :: * -> *) a. Snoc f => f a -> a -> f a C.snoc g a forall (f :: * -> *) a. Empty f => f a C.empty {- suggested in <http://www.haskell.org/pipermail/libraries/2014-July/023291.html> -} initsRev :: (Traversable f, C.Cons g, C.Empty g, C.Reverse g) => f a -> T f (g a) initsRev :: f a -> T f (g a) initsRev = (g a -> g a) -> T f (g a) -> T f (g a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap g a -> g a forall (f :: * -> *) a. Reverse f => f a -> f a C.reverse (T f (g a) -> T f (g a)) -> (f a -> T f (g a)) -> f a -> T f (g a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (g a -> a -> g a) -> g a -> f a -> T f (g a) forall (f :: * -> *) b a. Traversable f => (b -> a -> b) -> b -> f a -> T f b scanl ((a -> g a -> g a) -> g a -> a -> g a forall a b c. (a -> b -> c) -> b -> a -> c flip a -> g a -> g a forall (f :: * -> *) a. Cons f => a -> f a -> f a C.cons) g a forall (f :: * -> *) a. Empty f => f a C.empty {- Not exported by NonEmpty. I think the transposeClip function is better. -} class TransposeOuter f where transpose :: TransposeInner g => f (g a) -> g (f a) instance TransposeOuter [] where transpose :: [g a] -> g [a] transpose = let go :: [g a] -> g (f a) go [] = g (f a) forall (g :: * -> *) a. TransposeInner g => g a transposeStart go (g a xs : [g a] xss) = g a -> g (f a) -> g (f a) forall (g :: * -> *) (f :: * -> *) a. (TransposeInner g, Singleton f, Cons f) => g a -> g (f a) -> g (f a) zipHeadTail g a xs (g (f a) -> g (f a)) -> g (f a) -> g (f a) forall a b. (a -> b) -> a -> b $ [g a] -> g (f a) go [g a] xss in [g a] -> g [a] forall (g :: * -> *) (f :: * -> *) a. (TransposeInner g, Singleton f, Cons f) => [g a] -> g (f a) go {- We cannot define this instance, because @transpose ([] !: [2] !: []) = [2 !: []]@ instance TransposeOuter f => TransposeOuter (T f) where transpose = let go (Cons xs xss) = zipHeadTail xs $ go xss in go -} class TransposeInner g where transposeStart :: g a zipHeadTail :: (C.Singleton f, C.Cons f) => g a -> g (f a) -> g (f a) instance TransposeInner [] where transposeStart :: [a] transposeStart = [] zipHeadTail :: [a] -> [f a] -> [f a] zipHeadTail = let go :: [a] -> [f a] -> [f a] go (a x:[a] xs) (f a ys:[f a] yss) = a -> f a -> f a forall (f :: * -> *) a. Cons f => a -> f a -> f a C.cons a x f a ys f a -> [f a] -> [f a] forall a. a -> [a] -> [a] : [a] -> [f a] -> [f a] go [a] xs [f a] yss go [] [f a] yss = [f a] yss go [a] xs [] = (a -> f a) -> [a] -> [f a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> f a forall (f :: * -> *) a. Singleton f => a -> f a C.singleton [a] xs in [a] -> [f a] -> [f a] forall (f :: * -> *) a. (Cons f, Singleton f) => [a] -> [f a] -> [f a] go {- We cannot define this instance, because @transpose ([] :: [NonEmpty.T [] Int]) = []@, but in order to satisfy the types it must be ([] !: []). instance TransposeInner f => TransposeInner (T f) where transposeStart = Cons ??? transposeStart zipHeadTail (Cons x xs) (Cons ys yss) = Cons (C.cons x ys) (zipHeadTail xs yss) -} {- transpose :: [[a]] -> [[a]] transpose = let go [] = [] go (xs : xss) = zipHeadTail xs $ go xss in go zipHeadTail :: [a] -> [[a]] -> [[a]] zipHeadTail (x:xs) (ys:yss) = (x:ys) : zipHeadTail xs yss zipHeadTail [] yss = yss zipHeadTail xs [] = fmap (:[]) xs -} transposePrelude :: [[a]] -> [[a]] transposePrelude :: [[a]] -> [[a]] transposePrelude = let go :: [[a]] -> [[a]] go [] = [] go ([] : [[a]] xss) = [[a]] -> [[a]] go [[a]] xss go ((a x:[a] xs) : [[a]] xss) = case [(a, [a])] -> ([a], [[a]]) forall a b. [(a, b)] -> ([a], [b]) ListHT.unzip ([(a, [a])] -> ([a], [[a]])) -> [(a, [a])] -> ([a], [[a]]) forall a b. (a -> b) -> a -> b $ ([a] -> Maybe (a, [a])) -> [[a]] -> [(a, [a])] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe [a] -> Maybe (a, [a]) forall a. [a] -> Maybe (a, [a]) ListHT.viewL [[a]] xss of ([a] ys, [[a]] yss) -> (a x a -> [a] -> [a] forall a. a -> [a] -> [a] : [a] ys) [a] -> [[a]] -> [[a]] forall a. a -> [a] -> [a] : [[a]] -> [[a]] go ([a] xs [a] -> [[a]] -> [[a]] forall a. a -> [a] -> [a] : [[a]] yss) in [[a]] -> [[a]] forall a. [[a]] -> [[a]] go propTranspose :: [[P.Int]] -> P.Bool propTranspose :: [[Int]] -> Bool propTranspose [[Int]] xs = [[Int]] -> [[Int]] forall a. [[a]] -> [[a]] List.transpose [[Int]] xs [[Int]] -> [[Int]] -> Bool forall a. Eq a => a -> a -> Bool P.== [[Int]] -> [[Int]] forall (f :: * -> *) (g :: * -> *) a. (TransposeOuter f, TransposeInner g) => f (g a) -> g (f a) transpose [[Int]] xs propTransposePrelude :: [[P.Int]] -> P.Bool propTransposePrelude :: [[Int]] -> Bool propTransposePrelude [[Int]] xs = [[Int]] -> [[Int]] forall a. [[a]] -> [[a]] List.transpose [[Int]] xs [[Int]] -> [[Int]] -> Bool forall a. Eq a => a -> a -> Bool P.== [[Int]] -> [[Int]] forall a. [[a]] -> [[a]] transposePrelude [[Int]] xs scanl :: Traversable f => (b -> a -> b) -> b -> f a -> T f b scanl :: (b -> a -> b) -> b -> f a -> T f b scanl b -> a -> b f b b = b -> f b -> T f b forall (f :: * -> *) a. a -> f a -> T f a Cons b b (f b -> T f b) -> (f a -> f b) -> f a -> T f b forall b c a. (b -> c) -> (a -> b) -> a -> c . (b, f b) -> f b forall a b. (a, b) -> b snd ((b, f b) -> f b) -> (f a -> (b, f b)) -> f a -> f b forall b c a. (b -> c) -> (a -> b) -> a -> c . (b -> a -> (b, b)) -> b -> f a -> (b, f b) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL (\b b0 -> (\b b1 -> (b b1,b b1)) (b -> (b, b)) -> (a -> b) -> a -> (b, b) forall b c a. (b -> c) -> (a -> b) -> a -> c . b -> a -> b f b b0) b b scanr :: Traversable f => (a -> b -> b) -> b -> f a -> T f b scanr :: (a -> b -> b) -> b -> f a -> T f b scanr a -> b -> b f b b = (b -> f b -> T f b) -> (b, f b) -> T f b forall a b c. (a -> b -> c) -> (a, b) -> c uncurry b -> f b -> T f b forall (f :: * -> *) a. a -> f a -> T f a Cons ((b, f b) -> T f b) -> (f a -> (b, f b)) -> f a -> T f b forall b c a. (b -> c) -> (a -> b) -> a -> c . (b -> a -> (b, b)) -> b -> f a -> (b, f b) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumR (\b b0 -> (b -> b -> (b, b)) -> b -> b -> (b, b) forall a b c. (a -> b -> c) -> b -> a -> c flip (,) b b0 (b -> (b, b)) -> (a -> b) -> a -> (b, b) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> b -> b) -> b -> a -> b forall a b c. (a -> b -> c) -> b -> a -> c flip a -> b -> b f b b0) b b mapAdjacent :: (Traversable f) => (a -> a -> b) -> T f a -> f b mapAdjacent :: (a -> a -> b) -> T f a -> f b mapAdjacent a -> a -> b f (Cons a x f a xs) = (a, f b) -> f b forall a b. (a, b) -> b snd ((a, f b) -> f b) -> (a, f b) -> f b forall a b. (a -> b) -> a -> b $ (a -> a -> (a, b)) -> a -> f a -> (a, f b) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL (\a a0 a a1 -> (a a1, a -> a -> b f a a0 a a1)) a x f a xs {- A nice function but not particularly related to NonEmpty. Maybe move it to Class module? -} mapAdjacent1 :: (Traversable f) => (a -> a -> b -> c) -> a -> f (a,b) -> f c mapAdjacent1 :: (a -> a -> b -> c) -> a -> f (a, b) -> f c mapAdjacent1 a -> a -> b -> c f = ((a, f c) -> f c forall a b. (a, b) -> b snd((a, f c) -> f c) -> (f (a, b) -> (a, f c)) -> f (a, b) -> f c forall b c a. (b -> c) -> (a -> b) -> a -> c .) ((f (a, b) -> (a, f c)) -> f (a, b) -> f c) -> (a -> f (a, b) -> (a, f c)) -> a -> f (a, b) -> f c forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> (a, b) -> (a, c)) -> a -> f (a, b) -> (a, f c) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL (\a a0 (a a1,b b) -> (a a1, a -> a -> b -> c f a a0 a a1 b b)) {- | prop> \xs -> mapMaybe EitherHT.maybeLeft (NonEmpty.flatten xs) == either NonEmpty.flatten fst (NonEmpty.partitionEithersLeft (xs::NonEmpty.T[](Either Char Int))) prop> \xs -> mapMaybe EitherHT.maybeRight (NonEmpty.flatten xs) == either (const []) (NonEmpty.flatten . snd) (NonEmpty.partitionEithersLeft (xs::NonEmpty.T[](Either Char Int))) prop> \xs -> NonEmpty.partitionEithersRight (fmap EitherHT.swap xs) == EitherHT.mapLeft swap (EitherHT.swap (NonEmpty.partitionEithersLeft (xs::NonEmpty.T[](Either Char Int)))) -} partitionEithersLeft :: T [] (Either a b) -> Either (T [] a) ([a], T [] b) partitionEithersLeft :: T [] (Either a b) -> Either (T [] a) ([a], T [] b) partitionEithersLeft (Cons Either a b x [Either a b] xs) = case (Either a b x, [Either a b] -> ([a], [b]) forall a b. [Either a b] -> ([a], [b]) ListHT.unzipEithers [Either a b] xs) of (Right b r, ([a] ls,[b] rs)) -> ([a], T [] b) -> Either (T [] a) ([a], T [] b) forall a b. b -> Either a b Right ([a] ls, b -> [b] -> T [] b forall (f :: * -> *) a. a -> f a -> T f a Cons b r [b] rs) (Left a l, ([a] ls,[b] rs)) -> Either (T [] a) ([a], T [] b) -> (T [] b -> Either (T [] a) ([a], T [] b)) -> Maybe (T [] b) -> Either (T [] a) ([a], T [] b) forall b a. b -> (a -> b) -> Maybe a -> b maybe (T [] a -> Either (T [] a) ([a], T [] b) forall a b. a -> Either a b Left (T [] a -> Either (T [] a) ([a], T [] b)) -> T [] a -> Either (T [] a) ([a], T [] b) forall a b. (a -> b) -> a -> b $ a -> [a] -> T [] a forall (f :: * -> *) a. a -> f a -> T f a Cons a l [a] ls) (([a], T [] b) -> Either (T [] a) ([a], T [] b) forall a b. b -> Either a b Right (([a], T [] b) -> Either (T [] a) ([a], T [] b)) -> (T [] b -> ([a], T [] b)) -> T [] b -> Either (T [] a) ([a], T [] b) forall b c a. (b -> c) -> (a -> b) -> a -> c . (,) (a la -> [a] -> [a] forall a. a -> [a] -> [a] :[a] ls)) (Maybe (T [] b) -> Either (T [] a) ([a], T [] b)) -> Maybe (T [] b) -> Either (T [] a) ([a], T [] b) forall a b. (a -> b) -> a -> b $ [b] -> Maybe (T [] b) forall (f :: * -> *) a. ViewL f => f a -> Maybe (T f a) fetch [b] rs {- | prop> \xs -> NonEmpty.partitionEithersLeft (fmap EitherHT.swap xs) == EitherHT.mapRight swap (EitherHT.swap (NonEmpty.partitionEithersRight (xs::NonEmpty.T[](Either Char Int)))) -} partitionEithersRight :: T [] (Either a b) -> Either (T [] a, [b]) (T [] b) partitionEithersRight :: T [] (Either a b) -> Either (T [] a, [b]) (T [] b) partitionEithersRight (Cons Either a b x [Either a b] xs) = case (Either a b x, [Either a b] -> ([a], [b]) forall a b. [Either a b] -> ([a], [b]) ListHT.unzipEithers [Either a b] xs) of (Left a l, ([a] ls,[b] rs)) -> (T [] a, [b]) -> Either (T [] a, [b]) (T [] b) forall a b. a -> Either a b Left (a -> [a] -> T [] a forall (f :: * -> *) a. a -> f a -> T f a Cons a l [a] ls, [b] rs) (Right b r, ([a] ls,[b] rs)) -> Either (T [] a, [b]) (T [] b) -> (T [] a -> Either (T [] a, [b]) (T [] b)) -> Maybe (T [] a) -> Either (T [] a, [b]) (T [] b) forall b a. b -> (a -> b) -> Maybe a -> b maybe (T [] b -> Either (T [] a, [b]) (T [] b) forall a b. b -> Either a b Right (T [] b -> Either (T [] a, [b]) (T [] b)) -> T [] b -> Either (T [] a, [b]) (T [] b) forall a b. (a -> b) -> a -> b $ b -> [b] -> T [] b forall (f :: * -> *) a. a -> f a -> T f a Cons b r [b] rs) ((T [] a, [b]) -> Either (T [] a, [b]) (T [] b) forall a b. a -> Either a b Left ((T [] a, [b]) -> Either (T [] a, [b]) (T [] b)) -> (T [] a -> (T [] a, [b])) -> T [] a -> Either (T [] a, [b]) (T [] b) forall b c a. (b -> c) -> (a -> b) -> a -> c . (T [] a -> [b] -> (T [] a, [b])) -> [b] -> T [] a -> (T [] a, [b]) forall a b c. (a -> b -> c) -> b -> a -> c flip (,) (b rb -> [b] -> [b] forall a. a -> [a] -> [a] :[b] rs)) (Maybe (T [] a) -> Either (T [] a, [b]) (T [] b)) -> Maybe (T [] a) -> Either (T [] a, [b]) (T [] b) forall a b. (a -> b) -> a -> b $ [a] -> Maybe (T [] a) forall (f :: * -> *) a. ViewL f => f a -> Maybe (T f a) fetch [a] ls