mono-traversable 0.3.1 → 0.4.0
raw patch · 7 files changed
+228/−222 lines, 7 filesdep ~base
Dependency ranges changed: base
Files
- mono-traversable.cabal +1/−1
- src/Data/Containers.hs +2/−1
- src/Data/MinLen.hs +124/−16
- src/Data/MonoTraversable.hs +63/−2
- src/Data/NonNull.hs +29/−177
- src/Data/Sequences.hs +7/−23
- test/Spec.hs +2/−2
mono-traversable.cabal view
@@ -1,5 +1,5 @@ name: mono-traversable-version: 0.3.1+version: 0.4.0 synopsis: Type classes for mapping, folding, and traversing monomorphic containers description: Monomorphic variants of the Functor, Foldable, and Traversable typeclasses. Contains even more experimental code for abstracting containers and sequences. homepage: https://github.com/snoyberg/mono-traversable
src/Data/Containers.hs view
@@ -30,8 +30,9 @@ import qualified Data.ByteString.Lazy as LByteString import qualified Data.ByteString as ByteString import Control.Arrow ((***))+import Data.GrowingAppend -class (Monoid set, Semigroup set, MonoFoldable set, Eq (ContainerKey set)) => SetContainer set where+class (Monoid set, Semigroup set, MonoFoldable set, Eq (ContainerKey set), GrowingAppend set) => SetContainer set where type ContainerKey set member :: ContainerKey set -> set -> Bool notMember :: ContainerKey set -> set -> Bool
src/Data/MinLen.hs view
@@ -1,27 +1,46 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} module Data.MinLen ( -- * Type level naturals Zero (..) , Succ (..) , TypeNat (..)+ , AddNat+ , MaxNat -- * Minimum length newtype wrapper , MinLen , unMinLen , toMinLenZero , toMinLen+ , unsafeToMinLen , mlcons , mlappend , mlunion , head , last- , tail- , init+ , tailML+ , initML , GrowingAppend+ , ofoldMap1+ , ofold1+ , ofoldr1+ , ofoldl1'+ , maximum+ , minimum+ , maximumBy+ , minimumBy ) where -import Prelude (Num (..), error, Maybe (..), Int, Ordering (..))+import Prelude (Num (..), Maybe (..), Int, Ordering (..), Eq, Ord, Read, Show, Functor (..), ($), flip)+import Data.Data (Data)+import Data.Typeable (Typeable) import Control.Category import Data.MonoTraversable import Data.Sequences@@ -35,10 +54,13 @@ class TypeNat nat where toValueNat :: Num i => nat -> i+ typeNat :: nat instance TypeNat Zero where toValueNat Zero = 0+ typeNat = Zero instance TypeNat nat => TypeNat (Succ nat) where toValueNat (Succ nat) = 1 + toValueNat nat+ typeNat = Succ typeNat type family AddNat x y type instance AddNat Zero y = y@@ -50,10 +72,38 @@ type instance MaxNat (Succ x) (Succ y) = Succ (MaxNat x y) newtype MinLen nat mono = MinLen { unMinLen :: mono }+ deriving (Eq, Ord, Read, Show, Data, Typeable, Functor)+type instance Element (MinLen nat mono) = Element mono+deriving instance MonoFunctor mono => MonoFunctor (MinLen nat mono)+deriving instance MonoFoldable mono => MonoFoldable (MinLen nat mono)+deriving instance MonoFoldableOrd mono => MonoFoldableOrd (MinLen nat mono)+deriving instance MonoTraversable mono => MonoTraversable (MinLen nat mono)+deriving instance GrowingAppend mono => GrowingAppend (MinLen nat mono) -natProxy :: MinLen nat mono -> nat-natProxy = error "Data.MinLen.natProxy" +instance GrowingAppend mono => Semigroup (MinLen nat mono) where+ MinLen x <> MinLen y = MinLen (x <> y)++instance SemiSequence seq => SemiSequence (MinLen nat seq) where+ type Index (MinLen nat seq) = Index seq++ intersperse e = fmap $ intersperse e+ reverse = fmap reverse+ find f = find f . unMinLen+ cons x = fmap $ cons x+ snoc xs x = fmap (flip snoc x) xs+ sortBy f = fmap $ sortBy f++instance MonoPointed mono => MonoPointed (MinLen Zero mono) where+ opoint = MinLen . opoint+ {-# INLINE opoint #-}+instance MonoPointed mono => MonoPointed (MinLen (Succ Zero) mono) where+ opoint = MinLen . opoint+ {-# INLINE opoint #-}++natProxy :: TypeNat nat => MinLen nat mono -> nat+natProxy _ = typeNat+ toMinLenZero :: mono -> MinLen Zero mono toMinLenZero = MinLen @@ -66,6 +116,12 @@ nat = natProxy res' res' = MinLen mono +-- | Although this function itself cannot cause a segfault, it breaks the+-- safety guarantees of @MinLen@ and can lead to a segfault when using+-- otherwise safe functions.+unsafeToMinLen :: mono -> MinLen nat mono+unsafeToMinLen = MinLen+ mlcons :: IsSequence seq => Element seq -> MinLen nat seq -> MinLen (Succ nat) seq mlcons e (MinLen seq) = MinLen (cons e seq) {-# INLINE mlcons #-}@@ -82,18 +138,70 @@ last = lastEx . unMinLen {-# INLINE last #-} -tail :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq-tail = MinLen . tailEx . unMinLen-{-# INLINE tail #-}--init :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq-init = MinLen . initEx . unMinLen-{-# INLINE init #-}+tailML :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq+tailML = MinLen . tailEx . unMinLen -instance GrowingAppend mono => Semigroup (MinLen nat mono) where- MinLen x <> MinLen y = MinLen (x <> y)- {-# INLINE (<>) #-}+initML :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq+initML = MinLen . initEx . unMinLen mlunion :: GrowingAppend mono => MinLen x mono -> MinLen y mono -> MinLen (MaxNat x y) mono mlunion (MinLen x) (MinLen y) = MinLen (x <> y)-{-# INLINE mlunion #-}+++ofoldMap1 :: (MonoFoldable mono, Semigroup m) => (Element mono -> m) -> MinLen (Succ nat) mono -> m+ofoldMap1 f = ofoldMap1Ex f . unMinLen+{-# INLINE ofoldMap1 #-}++ofold1 :: (MonoFoldable mono, Semigroup (Element mono)) => MinLen (Succ nat) mono -> Element mono+ofold1 = ofoldMap1 id+{-# INLINE ofold1 #-}+++-- @'foldr1' f = 'Prelude.foldr1' f . 'otoList'@+ofoldr1 :: MonoFoldable mono+ => (Element mono -> Element mono -> Element mono)+ -> MinLen (Succ nat) mono+ -> Element mono+ofoldr1 f = ofoldr1Ex f . unMinLen+{-# INLINE ofoldr1 #-}++-- | A variant of 'ofoldl\'' that has no base case,+-- and thus may only be applied to non-empty structures.+--+-- @'foldl1\'' f = 'Prelude.foldl1' f . 'otoList'@+ofoldl1' :: MonoFoldable mono+ => (Element mono -> Element mono -> Element mono)+ -> MinLen (Succ nat) mono+ -> Element mono+ofoldl1' f = ofoldl1Ex' f . unMinLen+{-# INLINE ofoldl1' #-}++-- | like Data.List, but not partial on a MonoFoldable+maximum :: MonoFoldableOrd mono+ => MinLen (Succ nat) mono+ -> Element mono+maximum = maximumEx . unMinLen+{-# INLINE maximum #-}++-- | like Data.List, but not partial on a MonoFoldable+minimum :: MonoFoldableOrd mono+ => MinLen (Succ nat) mono+ -> Element mono+minimum = minimumEx . unMinLen+{-# INLINE minimum #-}++-- | like Data.List, but not partial on a MonoFoldable+maximumBy :: MonoFoldableOrd mono+ => (Element mono -> Element mono -> Ordering)+ -> MinLen (Succ nat) mono+ -> Element mono+maximumBy cmp = maximumByEx cmp . unMinLen+{-# INLINE maximumBy #-}++-- | like Data.List, but not partial on a MonoFoldable+minimumBy :: MonoFoldableOrd mono+ => (Element mono -> Element mono -> Ordering)+ -> MinLen (Succ nat) mono+ -> Element mono+minimumBy cmp = minimumByEx cmp . unMinLen+{-# INLINE minimumBy #-}
src/Data/MonoTraversable.hs view
@@ -52,8 +52,8 @@ import Data.IntMap (IntMap) import Data.IntSet (IntSet) import Data.Semigroup (Option)-import Data.List.NonEmpty (NonEmpty)-import Data.Functor.Identity (Identity)+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Functor.Identity (Identity (Identity)) import Data.Map (Map) import Data.HashMap.Strict (HashMap) import Data.Vector (Vector)@@ -75,7 +75,10 @@ import Data.Functor.Product (Product) import Data.Semigroupoid.Static (Static) import Data.Set (Set)+import qualified Data.Set as Set import Data.HashSet (HashSet)+import qualified Data.HashSet as HashSet+import Data.Hashable (Hashable) import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Storable as VS@@ -618,6 +621,7 @@ class (MonoFoldable mono, Monoid mono) => MonoFoldableMonoid mono where -- FIXME is this really just MonoMonad? oconcatMap :: (Element mono -> mono) -> mono -> mono oconcatMap = ofoldMap+ {-# INLINE oconcatMap #-} instance (MonoFoldable (t a), Monoid (t a)) => MonoFoldableMonoid (t a) -- FIXME instance MonoFoldableMonoid S.ByteString where oconcatMap = S.concatMap@@ -848,3 +852,60 @@ x <- mx x' <- ofoldlM f x mono unwrap x'++-- | Instances must obey the laws:+--+-- * @otoList . mconcat . map opoint == id@+class MonoPointed mono where+ opoint :: Element mono -> mono+instance MonoPointed S.ByteString where+ opoint = S.singleton+ {-# INLINE opoint #-}+instance MonoPointed L.ByteString where+ opoint = L.singleton+ {-# INLINE opoint #-}+instance MonoPointed T.Text where+ opoint = T.singleton+ {-# INLINE opoint #-}+instance MonoPointed TL.Text where+ opoint = TL.singleton+ {-# INLINE opoint #-}+instance MonoPointed IntSet.IntSet where+ opoint = IntSet.singleton+ {-# INLINE opoint #-}+instance MonoPointed [a] where+ opoint = (:[])+ {-# INLINE opoint #-}+instance MonoPointed (Maybe a) where+ opoint = Just+ {-# INLINE opoint #-}+instance MonoPointed (Seq a) where+ opoint = Seq.singleton+ {-# INLINE opoint #-}+instance MonoPointed (Option a) where+ opoint = Option . Just+ {-# INLINE opoint #-}+instance MonoPointed (NonEmpty a) where+ opoint = (:| [])+ {-# INLINE opoint #-}+instance MonoPointed (Identity a) where+ opoint = Identity+ {-# INLINE opoint #-}+instance MonoPointed (Vector a) where+ opoint = V.singleton+ {-# INLINE opoint #-}+instance MonoPointed (Set a) where+ opoint = Set.singleton+ {-# INLINE opoint #-}+instance Hashable a => MonoPointed (HashSet a) where+ opoint = HashSet.singleton+ {-# INLINE opoint #-}+instance U.Unbox a => MonoPointed (U.Vector a) where+ opoint = U.singleton+ {-# INLINE opoint #-}+instance VS.Storable a => MonoPointed (VS.Vector a) where+ opoint = VS.singleton+ {-# INLINE opoint #-}+instance MonoPointed (Either a b) where+ opoint = Right+ {-# INLINE opoint #-}
src/Data/NonNull.hs view
@@ -13,7 +13,10 @@ -- 'NonNull' is a typeclass for a container with 1 or more elements. -- "Data.List.NonEmpty" and 'NotEmpty a' are members of the typeclass module Data.NonNull (- NonNull(..)+ NonNull+ , fromNullable+ , nonNull+ , toNullable , fromNonEmpty , ncons , nuncons@@ -25,8 +28,6 @@ , tail , last , init- , NotEmpty- , asNotEmpty , ofoldMap1 , ofold1 , ofoldr1@@ -42,55 +43,33 @@ import Data.MonoTraversable import Data.Sequences import Control.Exception.Base (Exception, throw)-import Data.Semigroup-import qualified Data.Monoid as Monoid import Data.Data import qualified Data.List.NonEmpty as NE-import Control.Monad (liftM)+import Data.MinLen data NullError = NullError String deriving (Show, Typeable) instance Exception NullError --- | a 'NonNull' has 1 or more items------ In contrast, 'MonoFoldable' is allowed to have zero items.------ Any NonNull functions that--- decreases the number of elements in the sequences--- will return a different 'Nullable' type.------ The Nullable type for a 'NonEmpty' List is the normal List '[]'------ NonNull allows one to safely perform what would otherwise be partial functions.--- Hopefully you have abandoned partial functions, perhaps you are using the safe package.--- However, safe essentially provides convenience functions for null checking.--- With NonNull rather than always reacting with null checks we can proactively encode in our program when we know that a type is NonNull.--- Now we have an invariant encoded in our types, making our program easier to understand.--- This information is leveraged to avoid awkward null checking later on.-class (MonoFoldable mono, MonoFoldable (Nullable mono), Element mono ~ Element (Nullable mono)) => NonNull mono where- type Nullable mono-- -- | safely convert a 'Nullable' to a 'NonNull'- fromNullable :: Nullable mono -> Maybe mono+type NonNull mono = MinLen (Succ Zero) mono - -- | convert a 'Nullable' with elements to a 'NonNull'- -- throw an exception if the 'Nullable' is empty.- -- do not use this unless you have proved your structure is non-null- nonNull :: Nullable mono -> mono- nonNull nullable = case fromNullable nullable of- Nothing -> throw $ NullError "Data.NonNull.nonNull (NonNull default): expected non-null"- Just xs -> xs+-- | safely convert a 'Nullable' to a 'NonNull'+fromNullable :: MonoFoldable mono => mono -> Maybe (NonNull mono)+fromNullable = toMinLen - -- | used internally to construct a 'NonNull'.- -- does not check whether the 'Nullable' is empty- -- do not use this unless you have proved your structure is nonNull- -- nonNullUnsafe :: Nullable seq -> seq+-- | convert a 'Nullable' with elements to a 'NonNull'+-- throw an exception if the 'Nullable' is empty.+-- do not use this unless you have proved your structure is non-null+nonNull :: MonoFoldable mono => mono -> NonNull mono+nonNull nullable = case fromNullable nullable of+ Nothing -> throw $ NullError "Data.NonNull.nonNull (NonNull default): expected non-null"+ Just xs -> xs - -- | convert a 'NonNull' to a 'Nullable'- toNullable :: mono -> Nullable mono+-- | convert a 'NonNull' to a 'Nullable'+toNullable :: NonNull mono -> mono+toNullable = unMinLen -- | safely construct a 'NonNull' from a 'NonEmpty' list-fromNonEmpty :: (NonNull seq, IsSequence (Nullable seq)) => NE.NonEmpty (Element seq) -> seq+fromNonEmpty :: IsSequence seq => NE.NonEmpty (Element seq) -> NonNull seq fromNonEmpty = nonNull . fromList . NE.toList {-# INLINE fromNonEmpty #-} @@ -104,175 +83,48 @@ -- * if you don't need to cons, use 'fromNullable' or 'nonNull' if you can create your structure in one go. -- * if you need to cons, you might be able to start off with an efficient data structure such as a 'NonEmpty' List. -- 'fronNonEmpty' will convert that to your data structure using the structure's fromList function.-ncons :: (NonNull seq, SemiSequence (Nullable seq)) => Element seq -> Nullable seq -> seq+ncons :: SemiSequence seq => Element seq -> seq -> NonNull seq ncons x xs = nonNull $ cons x xs -- | like 'uncons' of 'SemiSequence'-nuncons :: (NonNull seq, IsSequence (Nullable seq)) => seq -> (Element seq, Maybe seq)+nuncons :: IsSequence seq => NonNull seq -> (Element seq, Maybe (NonNull seq)) nuncons xs = case uncons $ toNullable xs of Nothing -> error "Data.NonNull.nuncons: data structure is null, it should be non-null" Just (x, xsNullable) -> (x, fromNullable xsNullable) -- | like 'uncons' of 'SemiSequence'-splitFirst :: (IsSequence (Nullable seq), NonNull seq) => seq -> (Element seq, Nullable seq)+splitFirst :: IsSequence seq => NonNull seq -> (Element seq, seq) splitFirst xs = case uncons $ toNullable xs of Nothing -> error "Data.NonNull.splitFirst: data structure is null, it should be non-null" Just tup -> tup -- | like 'Sequence.filter', but starts with a NonNull-nfilter :: (NonNull seq, IsSequence (Nullable seq))- => (Element seq -> Bool) -> seq -> Nullable seq+nfilter :: IsSequence seq => (Element seq -> Bool) -> NonNull seq -> seq nfilter f = filter f . toNullable -- | like 'Sequence.filterM', but starts with a NonNull-nfilterM :: (NonNull seq, Monad m, IsSequence (Nullable seq))- => (Element seq -> m Bool) -> seq -> m (Nullable seq)+nfilterM :: (Monad m, IsSequence seq) => (Element seq -> m Bool) -> NonNull seq -> m seq nfilterM f = filterM f . toNullable -- | i must be > 0. like 'Sequence.replicate' -- -- i <= 0 is treated the same as providing 1-nReplicate :: (NonNull seq, Num (Index (Nullable seq)), Ord (Index (Nullable seq)), IsSequence (Nullable seq))- => Index (Nullable seq) -> Element seq -> seq+nReplicate :: IsSequence seq => Index seq -> Element seq -> NonNull seq nReplicate i = nonNull . replicate (max 1 i) -{--maybeToNullable :: (Monoid (Nullable seq), NonNull seq) => Maybe seq -> Nullable seq-maybeToNullable Nothing = mempty-maybeToNullable (Just xs) = toNullable xs--}- -- | like Data.List, but not partial on a NonEmpty-head :: (MonoFoldable (Nullable seq), NonNull seq) => seq -> Element seq-head = headEx . toNullable-{-# INLINE head #-}---- | like Data.List, but not partial on a NonEmpty-tail :: (IsSequence (Nullable seq), NonNull seq) => seq -> Nullable seq+tail :: IsSequence seq => NonNull seq -> seq tail = tailEx . toNullable {-# INLINE tail #-} -- | like Data.List, but not partial on a NonEmpty-last :: (MonoFoldable (Nullable seq), NonNull seq) => seq -> Element seq-last = lastEx . toNullable-{-# INLINE last #-}---- | like Data.List, but not partial on a NonEmpty-init :: (IsSequence (Nullable seq), NonNull seq) => seq -> Nullable seq+init :: IsSequence seq => NonNull seq -> seq init = initEx . toNullable {-# INLINE init #-} ----- | NonNull list reuses 'Data.List.NonEmpty'-instance NonNull (NE.NonEmpty a) where- type Nullable (NE.NonEmpty a) = [a]-- fromNullable = NE.nonEmpty-- nonNull = NE.fromList- -- nonNullUnsafe = nonNull-- toNullable = NE.toList----- | a newtype wrapper indicating there are 1 or more elements--- unwrap with 'toNullable'-newtype NotEmpty seq = NotEmpty { fromNotEmpty :: seq }- deriving (Eq, Ord, Read, Show, Data, Typeable, Functor)-type instance Element (NotEmpty seq) = Element seq-deriving instance MonoFunctor seq => MonoFunctor (NotEmpty seq)-deriving instance MonoFoldable seq => MonoFoldable (NotEmpty seq)-instance MonoTraversable seq => MonoTraversable (NotEmpty seq) where- otraverse f = fmap NotEmpty . otraverse f . fromNotEmpty- omapM f = liftM NotEmpty . omapM f . fromNotEmpty---- | Helper functions for type inferences.------ Since 0.3.0-asNotEmpty :: NotEmpty a -> NotEmpty a-asNotEmpty = id-{-# INLINE asNotEmpty #-}--instance Monoid seq => Semigroup (NotEmpty seq) where- x <> y = NotEmpty (fromNotEmpty x `Monoid.mappend` fromNotEmpty y)- sconcat = NotEmpty . Monoid.mconcat . fmap fromNotEmpty . NE.toList----instance SemiSequence seq => SemiSequence (NotEmpty seq) where- type Index (NotEmpty seq) = Index seq-- singleton = NotEmpty . singleton- intersperse e = fmap $ intersperse e- reverse = fmap reverse- find f = find f . fromNotEmpty- cons x = fmap $ cons x- snoc xs x = fmap (flip snoc x) xs- sortBy f = fmap $ sortBy f----- normally we favor defaulting, should we use it here?--- this re-uses MonoFoldable functions and MonoFoldable uses defaulting-instance MonoFoldable seq => NonNull (NotEmpty seq) where- type Nullable (NotEmpty seq) = seq-- fromNullable xs | onull xs = Nothing- | otherwise = Just $ NotEmpty xs-- nonNull xs | onull xs = throw $ NullError "Data.NonNull.nonNull expected NotEmpty"- | otherwise = NotEmpty xs-- -- nonNullUnsafe = NotEmpty- toNullable = fromNotEmpty- infixr 5 <| -- | Prepend an element to a NonNull-(<|) :: (SemiSequence (Nullable seq), NonNull seq) => Element seq -> seq -> seq+(<|) :: SemiSequence seq => Element seq -> NonNull seq -> NonNull seq x <| y = ncons x (toNullable y)---ofoldMap1 :: (NonNull seq, Semigroup m) => (Element seq -> m) -> seq -> m-ofoldMap1 f = ofoldMap1Ex f . toNullable-{-# INLINE ofoldMap1 #-}--ofold1 :: (NonNull seq, Semigroup (Element seq)) => seq -> Element seq-ofold1 = ofoldMap1 id-{-# INLINE ofold1 #-}---- @'foldr1' f = 'Prelude.foldr1' f . 'otoList'@-ofoldr1 :: NonNull seq => (Element seq -> Element seq -> Element seq) -> seq -> Element seq-ofoldr1 f = ofoldr1Ex f . toNullable-{-# INLINE ofoldr1 #-}---- | A variant of 'ofoldl\'' that has no base case,--- and thus may only be applied to non-empty structures.------ @'foldl1\'' f = 'Prelude.foldl1' f . 'otoList'@-ofoldl1' :: NonNull seq => (Element seq -> Element seq -> Element seq) -> seq -> Element seq-ofoldl1' f = ofoldl1Ex' f . toNullable-{-# INLINE ofoldl1' #-}---- | like Data.List, but not partial on a NonNull-maximum :: (MonoFoldableOrd (Nullable seq), NonNull seq) => seq -> Element seq-maximum = maximumEx . toNullable-{-# INLINE maximum #-}---- | like Data.List, but not partial on a NonNull-minimum :: (MonoFoldableOrd (Nullable seq), NonNull seq) => seq -> Element seq-minimum = minimumEx . toNullable-{-# INLINE minimum #-}---- | like Data.List, but not partial on a NonNull-maximumBy :: (MonoFoldableOrd (Nullable seq), NonNull seq)- => (Element seq -> Element seq -> Ordering) -> seq -> Element seq-maximumBy cmp = maximumByEx cmp . toNullable-{-# INLINE maximumBy #-}---- | like Data.List, but not partial on a NonNull-minimumBy :: (MonoFoldableOrd (Nullable seq), NonNull seq)- => (Element seq -> Element seq -> Ordering) -> seq -> Element seq-minimumBy cmp = minimumByEx cmp . toNullable-{-# INLINE minimumBy #-}
src/Data/Sequences.hs view
@@ -27,6 +27,8 @@ import Data.String (IsString) import qualified Data.List.NonEmpty as NE import qualified Data.ByteString.Unsafe as SU+import Data.GrowingAppend+import Data.Vector.Instances () -- | 'SemiSequence' was created to share code between 'IsSequence' and 'NonNull'. -- You should always use 'IsSequence' or 'NonNull' rather than using 'SemiSequence'@@ -43,9 +45,8 @@ -- This exists on 'NonNull' as 'nfilter' -- -- 'filter' and other such functions are placed in 'IsSequence'-class (Integral (Index seq)) => SemiSequence seq where+class (Integral (Index seq), GrowingAppend seq) => SemiSequence seq where type Index seq- singleton :: Element seq -> seq intersperse :: Element seq -> seq -> seq @@ -61,13 +62,16 @@ snoc :: seq -> Element seq -> seq +singleton :: IsSequence seq => Element seq -> seq+singleton = opoint+{-# INLINE singleton #-} -- | Sequence Laws: -- -- > fromList . otoList = id -- > fromList (x <> y) = fromList x <> fromList y -- > otoList (fromList x <> fromList y) = x <> y-class (Monoid seq, MonoTraversable seq, SemiSequence seq) => IsSequence seq where+class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => IsSequence seq where fromList :: [Element seq] -> seq -- this definition creates the Monoid constraint -- However, all the instances define their own fromList@@ -219,14 +223,12 @@ instance SemiSequence [a] where type Index [a] = Int- singleton = return intersperse = List.intersperse reverse = List.reverse find = List.find sortBy = List.sortBy cons = (:) snoc = defaultSnoc- {-# INLINE singleton #-} {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-}@@ -292,14 +294,12 @@ instance SemiSequence (NE.NonEmpty a) where type Index (NE.NonEmpty a) = Int - singleton = (NE.:| []) intersperse = NE.intersperse reverse = NE.reverse find = find cons = NE.cons snoc xs x = NE.fromList $ flip snoc x $ NE.toList xs sortBy f = NE.fromList . List.sortBy f . NE.toList- {-# INLINE singleton #-} {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-}@@ -309,14 +309,12 @@ instance SemiSequence S.ByteString where type Index S.ByteString = Int- singleton = S.singleton intersperse = S.intersperse reverse = S.reverse find = S.find cons = S.cons snoc = S.snoc sortBy = defaultSortBy- {-# INLINE singleton #-} {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-}@@ -375,14 +373,12 @@ instance SemiSequence T.Text where type Index T.Text = Int- singleton = T.singleton intersperse = T.intersperse reverse = T.reverse find = T.find cons = T.cons snoc = T.snoc sortBy = defaultSortBy- {-# INLINE singleton #-} {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-}@@ -438,14 +434,12 @@ instance SemiSequence L.ByteString where type Index L.ByteString = Int64- singleton = L.singleton intersperse = L.intersperse reverse = L.reverse find = L.find cons = L.cons snoc = L.snoc sortBy = defaultSortBy- {-# INLINE singleton #-} {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-}@@ -501,14 +495,12 @@ instance SemiSequence TL.Text where type Index TL.Text = Int64- singleton = TL.singleton intersperse = TL.intersperse reverse = TL.reverse find = TL.find cons = TL.cons snoc = TL.snoc sortBy = defaultSortBy- {-# INLINE singleton #-} {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-}@@ -564,7 +556,6 @@ instance SemiSequence (Seq.Seq a) where type Index (Seq.Seq a) = Int- singleton = Seq.singleton cons = (Seq.<|) snoc = (Seq.|>) reverse = Seq.reverse@@ -572,7 +563,6 @@ intersperse = defaultIntersperse find = defaultFind- {-# INLINE singleton #-} {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-}@@ -634,7 +624,6 @@ instance SemiSequence (V.Vector a) where type Index (V.Vector a) = Int- singleton = V.singleton reverse = V.reverse find = V.find cons = V.cons@@ -642,7 +631,6 @@ sortBy = defaultSortBy intersperse = defaultIntersperse- {-# INLINE singleton #-} {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-}@@ -706,7 +694,6 @@ instance U.Unbox a => SemiSequence (U.Vector a) where type Index (U.Vector a) = Int- singleton = U.singleton intersperse = defaultIntersperse reverse = U.reverse@@ -714,7 +701,6 @@ cons = U.cons snoc = U.snoc sortBy = defaultSortBy- {-# INLINE singleton #-} {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-}@@ -778,7 +764,6 @@ instance VS.Storable a => SemiSequence (VS.Vector a) where type Index (VS.Vector a) = Int- singleton = VS.singleton reverse = VS.reverse find = VS.find cons = VS.cons@@ -786,7 +771,6 @@ intersperse = defaultIntersperse sortBy = defaultSortBy- {-# INLINE singleton #-} {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-}
test/Spec.hs view
@@ -156,7 +156,7 @@ test :: (OrdSequence typ, Arbitrary (Element typ), Show (Element typ), Show typ, Eq typ, Eq (Element typ)) => String -> typ -> Spec- test = test' NN.asNotEmpty+ test = test' id test "strict ByteString" S.empty test "lazy ByteString" L.empty test "strict Text" T.empty@@ -165,7 +165,7 @@ test "unboxed Vector" (U.empty :: U.Vector Int) test "storable Vector" (VS.empty :: VS.Vector Int) test "list" ([5 :: Int])- test' (id :: NE.NonEmpty Int -> NE.NonEmpty Int) "NonEmpty" ([] :: [Int])+ -- test' (id :: NE.NonEmpty Int -> NE.NonEmpty Int) "NonEmpty" ([] :: [Int]) describe "Containers" $ do let test typ dummy xlookup xinsert xdelete = describe typ $ do