packages feed

mono-traversable 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+686/−307 lines, 6 filesdep ~base

Dependency ranges changed: base

Files

mono-traversable.cabal view
@@ -1,5 +1,5 @@ name:                mono-traversable-version:             0.1.0.0+version:             0.2.0.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@@ -13,6 +13,7 @@ cabal-version:       >=1.10  library+  ghc-options: -Wall   exposed-modules:     Data.Containers                        Data.MonoTraversable                        Data.Sequences@@ -23,7 +24,7 @@                      , hashable                      , bytestring >= 0.9                      , text >=0.11-                     , semigroups >=0.9+                     , semigroups >= 0.9                      , transformers >=0.3                      , vector >=0.10                      , semigroupoids >=3.0
src/Data/Containers.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-} -- | Warning: This module should be considered highly experimental. module Data.Containers where @@ -10,104 +11,120 @@ import qualified Data.Set as Set import qualified Data.HashSet as HashSet import Data.Monoid (Monoid)-import Data.MonoTraversable (MonoFoldable, MonoTraversable, Element)+import Data.MonoTraversable (MonoFunctor(..), MonoFoldable, MonoTraversable, Element) import qualified Data.IntMap as IntMap import Data.Function (on) import qualified Data.List as List import qualified Data.IntSet as IntSet -class (Monoid set, MonoFoldable set) => Container set where+import qualified Data.Text.Lazy as LText+import qualified Data.Text as Text+import qualified Data.ByteString.Lazy as LByteString+import qualified Data.ByteString as ByteString+import Control.Arrow ((***))++class (Monoid set, MonoFoldable set) => SetContainer set where     type ContainerKey set     member :: ContainerKey set -> set -> Bool     notMember ::  ContainerKey set -> set -> Bool     union :: set -> set -> set     difference :: set -> set -> set     intersection :: set -> set -> set-instance Ord k => Container (Map.Map k v) where+instance Ord k => SetContainer (Map.Map k v) where     type ContainerKey (Map.Map k v) = k     member = Map.member     notMember = Map.notMember     union = Map.union     difference = Map.difference     intersection = Map.intersection-instance (Eq k, Hashable k) => Container (HashMap.HashMap k v) where-    type ContainerKey (HashMap.HashMap k v) = k++instance (Eq key, Hashable key) => SetContainer (HashMap.HashMap key value) where+    type ContainerKey (HashMap.HashMap key value) = key     member = HashMap.member     notMember k = not . HashMap.member k     union = HashMap.union     difference = HashMap.difference     intersection = HashMap.intersection-instance Container (IntMap.IntMap v) where-    type ContainerKey (IntMap.IntMap v) = Int++instance SetContainer (IntMap.IntMap value) where+    type ContainerKey (IntMap.IntMap value) = Int     member = IntMap.member     notMember = IntMap.notMember     union = IntMap.union     difference = IntMap.difference     intersection = IntMap.intersection-instance Ord e => Container (Set.Set e) where-    type ContainerKey (Set.Set e) = e++instance Ord element => SetContainer (Set.Set element) where+    type ContainerKey (Set.Set element) = element     member = Set.member     notMember = Set.notMember     union = Set.union     difference = Set.difference     intersection = Set.intersection-instance (Eq e, Hashable e) => Container (HashSet.HashSet e) where-    type ContainerKey (HashSet.HashSet e) = e++instance (Eq element, Hashable element) => SetContainer (HashSet.HashSet element) where+    type ContainerKey (HashSet.HashSet element) = element     member = HashSet.member     notMember e = not . HashSet.member e     union = HashSet.union     difference = HashSet.difference     intersection = HashSet.intersection-instance Container IntSet.IntSet where++instance SetContainer IntSet.IntSet where     type ContainerKey IntSet.IntSet = Int     member = IntSet.member     notMember = IntSet.notMember     union = IntSet.union     difference = IntSet.difference     intersection = IntSet.intersection-instance Ord k => Container [(k, v)] where-    type ContainerKey [(k, v)] = k++instance Ord key => SetContainer [(key, value)] where+    type ContainerKey [(key, value)] = key     member k = List.any ((== k) . fst)     notMember k = not . member k     union = List.unionBy ((==) `on` fst)     x `difference` y = Map.toList (Map.fromList x `Map.difference` Map.fromList y)     intersection = List.intersectBy ((==) `on` fst) -class (MonoTraversable m, Container m) => IsMap m where+class (MonoTraversable map, SetContainer map) => IsMap map where     -- | Using just @Element@ can lead to very confusing error messages.-    type MapValue m-    lookup :: ContainerKey m -> m -> Maybe (MapValue m)-    insertMap :: ContainerKey m -> MapValue m -> m -> m-    deleteMap :: ContainerKey m -> m -> m-    singletonMap :: ContainerKey m -> MapValue m -> m-    mapFromList :: [(ContainerKey m, MapValue m)] -> m-    mapToList :: m -> [(ContainerKey m, MapValue m)]-instance Ord k => IsMap (Map.Map k v) where-    type MapValue (Map.Map k v) = v+    type MapValue map+    lookup       :: ContainerKey map -> map -> Maybe (MapValue map)+    insertMap    :: ContainerKey map -> MapValue map -> map -> map+    deleteMap    :: ContainerKey map -> map -> map+    singletonMap :: ContainerKey map -> MapValue map -> map+    mapFromList  :: [(ContainerKey map, MapValue map)] -> map+    mapToList    :: map -> [(ContainerKey map, MapValue map)]++instance Ord key => IsMap (Map.Map key value) where+    type MapValue (Map.Map key value) = value     lookup = Map.lookup     insertMap = Map.insert     deleteMap = Map.delete     singletonMap = Map.singleton     mapFromList = Map.fromList     mapToList = Map.toList-instance (Eq k, Hashable k) => IsMap (HashMap.HashMap k v) where-    type MapValue (HashMap.HashMap k v) = v++instance (Eq key, Hashable key) => IsMap (HashMap.HashMap key value) where+    type MapValue (HashMap.HashMap key value) = value     lookup = HashMap.lookup     insertMap = HashMap.insert     deleteMap = HashMap.delete     singletonMap = HashMap.singleton     mapFromList = HashMap.fromList     mapToList = HashMap.toList-instance IsMap (IntMap.IntMap v) where-    type MapValue (IntMap.IntMap v) = v++instance IsMap (IntMap.IntMap value) where+    type MapValue (IntMap.IntMap value) = value     lookup = IntMap.lookup     insertMap = IntMap.insert     deleteMap = IntMap.delete     singletonMap = IntMap.singleton     mapFromList = IntMap.fromList     mapToList = IntMap.toList-instance Ord k => IsMap [(k, v)] where-    type MapValue [(k, v)] = v++instance Ord key => IsMap [(key, value)] where+    type MapValue [(key, value)] = value     lookup = List.lookup     insertMap k v = ((k, v):) . deleteMap k     deleteMap k = List.filter ((/= k) . fst)@@ -115,27 +132,55 @@     mapFromList = id     mapToList = id -class (Container s, Element s ~ ContainerKey s) => IsSet s where-    insertSet :: Element s -> s -> s-    deleteSet :: Element s -> s -> s-    singletonSet :: Element s -> s-    setFromList :: [Element s] -> s-    setToList :: s -> [Element s]-instance Ord e => IsSet (Set.Set e) where+class (SetContainer set, Element set ~ ContainerKey set) => IsSet set where+    insertSet :: Element set -> set -> set+    deleteSet :: Element set -> set -> set+    singletonSet :: Element set -> set+    setFromList :: [Element set] -> set+    setToList :: set -> [Element set]++instance Ord element => IsSet (Set.Set element) where     insertSet = Set.insert     deleteSet = Set.delete     singletonSet = Set.singleton     setFromList = Set.fromList     setToList = Set.toList-instance (Eq e, Hashable e) => IsSet (HashSet.HashSet e) where++instance (Eq element, Hashable element) => IsSet (HashSet.HashSet element) where     insertSet = HashSet.insert     deleteSet = HashSet.delete     singletonSet = HashSet.singleton     setFromList = HashSet.fromList     setToList = HashSet.toList+ instance IsSet IntSet.IntSet where     insertSet = IntSet.insert     deleteSet = IntSet.delete     singletonSet = IntSet.singleton     setFromList = IntSet.fromList     setToList = IntSet.toList+++-- | zip operations on MonoFunctors.+class MonoFunctor mono => MonoZip mono where+    ozipWith :: (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono+    ozip :: mono -> mono -> [(Element mono, Element mono)]+    ounzip :: [(Element mono, Element mono)] -> (mono, mono)+++instance MonoZip ByteString.ByteString where+    ozip     = ByteString.zip+    ounzip   = ByteString.unzip+    ozipWith f xs = ByteString.pack . ByteString.zipWith f xs+instance MonoZip LByteString.ByteString where+    ozip     = LByteString.zip+    ounzip   = LByteString.unzip+    ozipWith f xs = LByteString.pack . LByteString.zipWith f xs+instance MonoZip Text.Text where+    ozip     = Text.zip+    ounzip   = (Text.pack *** Text.pack) . List.unzip+    ozipWith = Text.zipWith+instance MonoZip LText.Text where+    ozip     = LText.zip+    ounzip   = (LText.pack *** LText.pack) . List.unzip+    ozipWith = LText.zipWith
src/Data/MonoTraversable.hs view
@@ -73,7 +73,7 @@ import qualified Data.Vector.Storable as VS import qualified Data.IntSet as IntSet -type family Element mofu+type family Element mono type instance Element S.ByteString = Word8 type instance Element L.ByteString = Word8 type instance Element T.Text = Char@@ -123,10 +123,12 @@ type instance Element (U.Vector a) = a type instance Element (VS.Vector a) = a -class MonoFunctor mofu where-    omap :: (Element mofu -> Element mofu) -> mofu -> mofu-    default omap :: (Functor f, Element (f a) ~ a, f a ~ mofu) => (a -> a) -> f a -> f a++class MonoFunctor mono where+    omap :: (Element mono -> Element mono) -> mono -> mono+    default omap :: (Functor f, Element (f a) ~ a, f a ~ mono) => (a -> a) -> f a -> f a     omap = fmap+ instance MonoFunctor S.ByteString where     omap = S.map instance MonoFunctor L.ByteString where@@ -179,53 +181,53 @@ instance VS.Storable a => MonoFunctor (VS.Vector a) where     omap = VS.map -class MonoFoldable mofo where-    ofoldMap :: Monoid m => (Element mofo -> m) -> mofo -> m-    default ofoldMap :: (t a ~ mofo, a ~ Element (t a), F.Foldable t, Monoid m) => (Element mofo -> m) -> mofo -> m+class MonoFoldable mono where+    ofoldMap :: Monoid m => (Element mono -> m) -> mono -> m+    default ofoldMap :: (t a ~ mono, a ~ Element (t a), F.Foldable t, Monoid m) => (Element mono -> m) -> mono -> m     ofoldMap = F.foldMap -    ofoldr :: (Element mofo -> b -> b) -> b -> mofo -> b-    default ofoldr :: (t a ~ mofo, a ~ Element (t a), F.Foldable t) => (Element mofo -> b -> b) -> b -> mofo -> b+    ofoldr :: (Element mono -> b -> b) -> b -> mono -> b+    default ofoldr :: (t a ~ mono, a ~ Element (t a), F.Foldable t) => (Element mono -> b -> b) -> b -> mono -> b     ofoldr = F.foldr     -    ofoldl' :: (a -> Element mofo -> a) -> a -> mofo -> a-    default ofoldl' :: (t b ~ mofo, b ~ Element (t b), F.Foldable t) => (a -> Element mofo -> a) -> a -> mofo -> a+    ofoldl' :: (a -> Element mono -> a) -> a -> mono -> a+    default ofoldl' :: (t b ~ mono, b ~ Element (t b), F.Foldable t) => (a -> Element mono -> a) -> a -> mono -> a     ofoldl' = F.foldl' -    otoList :: mofo -> [Element mofo]-    otoList t = build (\ mofo n -> ofoldr mofo n t)+    otoList :: mono -> [Element mono]+    otoList t = build (\ mono n -> ofoldr mono n t)     -    oall :: (Element mofo -> Bool) -> mofo -> Bool+    oall :: (Element mono -> Bool) -> mono -> Bool     oall f = getAll . ofoldMap (All . f)     -    oany :: (Element mofo -> Bool) -> mofo -> Bool+    oany :: (Element mono -> Bool) -> mono -> Bool     oany f = getAny . ofoldMap (Any . f)     -    onull :: mofo -> Bool+    onull :: mono -> Bool     onull = oall (const False)     -    olength :: mofo -> Int+    olength :: mono -> Int     olength = ofoldl' (\i _ -> i + 1) 0     -    olength64 :: mofo -> Int64+    olength64 :: mono -> Int64     olength64 = ofoldl' (\i _ -> i + 1) 0     -    ocompareLength :: Integral i => mofo -> i -> Ordering+    ocompareLength :: Integral i => mono -> i -> Ordering     ocompareLength c0 i0 = olength c0 `compare` fromIntegral i0 -- FIXME more efficient implementation -    otraverse_ :: (MonoFoldable mofo, Applicative f) => (Element mofo -> f b) -> mofo -> f ()+    otraverse_ :: (MonoFoldable mono, Applicative f) => (Element mono -> f b) -> mono -> f ()     otraverse_ f = ofoldr ((*>) . f) (pure ())     -    ofor_ :: (MonoFoldable mofo, Applicative f) => mofo -> (Element mofo -> f b) -> f ()+    ofor_ :: (MonoFoldable mono, Applicative f) => mono -> (Element mono -> f b) -> f ()     ofor_ = flip otraverse_     -    omapM_ :: (MonoFoldable mofo, Monad m) => (Element mofo -> m b) -> mofo -> m ()+    omapM_ :: (MonoFoldable mono, Monad m) => (Element mono -> m b) -> mono -> m ()     omapM_ f = ofoldr ((>>) . f) (return ())     -    oforM_ :: (MonoFoldable mofo, Monad m) => mofo -> (Element mofo -> m b) -> m ()+    oforM_ :: (MonoFoldable mono, Monad m) => mono -> (Element mono -> m b) -> m ()     oforM_ = flip omapM_     -    ofoldlM :: (MonoFoldable mofo, Monad m) => (a -> Element mofo -> m a) -> a -> mofo -> m a+    ofoldlM :: (MonoFoldable mono, Monad m) => (a -> Element mono -> m a) -> a -> mono -> m a     ofoldlM f z0 xs = ofoldr f' return xs z0       where f' x k z = f z x >>= k     @@ -309,15 +311,15 @@     olength = VS.length  -- | The 'sum' function computes the sum of the numbers of a structure.-osum :: (MonoFoldable mofo, Num (Element mofo)) => mofo -> Element mofo+osum :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono osum = getSum . ofoldMap Sum  -- | The 'product' function computes the product of the numbers of a structure.-oproduct :: (MonoFoldable mofo, Num (Element mofo)) => mofo -> Element mofo+oproduct :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono oproduct = Data.Monoid.getProduct . ofoldMap Data.Monoid.Product -class (MonoFoldable mofo, Monoid mofo) => MonoFoldableMonoid mofo where-    oconcatMap :: (Element mofo -> mofo) -> mofo -> mofo+class (MonoFoldable mono, Monoid mono) => MonoFoldableMonoid mono where+    oconcatMap :: (Element mono -> mono) -> mono -> mono     oconcatMap = ofoldMap instance (MonoFoldable (t a), Monoid (t a)) => MonoFoldableMonoid (t a) -- FIXME instance MonoFoldableMonoid S.ByteString where@@ -329,12 +331,12 @@ instance MonoFoldableMonoid TL.Text where     oconcatMap = TL.concatMap -class (MonoFunctor mot, MonoFoldable mot) => MonoTraversable mot where-    otraverse :: Applicative f => (Element mot -> f (Element mot)) -> mot -> f mot-    default otraverse :: (Traversable t, mot ~ t a, a ~ Element mot, Applicative f) => (Element mot -> f (Element mot)) -> mot -> f mot+class (MonoFunctor mono, MonoFoldable mono) => MonoTraversable mono where+    otraverse :: Applicative f => (Element mono -> f (Element mono)) -> mono -> f mono+    default otraverse :: (Traversable t, mono ~ t a, a ~ Element mono, Applicative f) => (Element mono -> f (Element mono)) -> mono -> f mono     otraverse = traverse-    omapM :: Monad m => (Element mot -> m (Element mot)) -> mot -> m mot-    default omapM :: (Traversable t, mot ~ t a, a ~ Element mot, Monad m) => (Element mot -> m (Element mot)) -> mot -> m mot+    omapM :: Monad m => (Element mono -> m (Element mono)) -> mono -> m mono+    default omapM :: (Traversable t, mono ~ t a, a ~ Element mono, Monad m) => (Element mono -> m (Element mono)) -> mono -> m mono     omapM = mapM instance MonoTraversable S.ByteString where     otraverse f = fmap S.pack . traverse f . S.unpack@@ -368,8 +370,8 @@     otraverse f = fmap VS.fromList . traverse f . VS.toList     omapM = VS.mapM -ofor :: (MonoTraversable mot, Applicative f) => mot -> (Element mot -> f (Element mot)) -> f mot+ofor :: (MonoTraversable mono, Applicative f) => mono -> (Element mono -> f (Element mono)) -> f mono ofor = flip otraverse -oforM :: (MonoTraversable mot, Monad f) => mot -> (Element mot -> f (Element mot)) -> f mot+oforM :: (MonoTraversable mono, Monad f) => mono -> (Element mono -> f (Element mono)) -> f mono oforM = flip omapM
src/Data/NonNull.hs view
@@ -1,5 +1,10 @@ {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-} -- | Warning, this is Experimental! -- -- Data.NonNull attempts to extend the concepts from@@ -11,124 +16,339 @@ -- -- This code is experimental and likely to change dramatically and future versions. -- Please send your feedback.-module Data.NonNull where+module Data.NonNull (+    NonNull(..)+  , SafeSequence(..)+  , NotEmpty+  , MonoFoldable1(..)+  , OrdNonNull(..)+  , (<|)+) where -import Prelude hiding (head, tail, init, last)+import Prelude hiding (head, tail, init, last, reverse, seq, filter, replicate) import Data.MonoTraversable import Data.Sequences-import qualified Data.List.NonEmpty as NE+import Control.Exception.Base (Exception, throw) import Data.Semigroup-import qualified Data.Foldable as Foldable+import qualified Data.Monoid as Monoid+import Data.Data+import Data.Maybe (fromMaybe)+import qualified Data.List.NonEmpty as NE+import qualified Data.Foldable as F +import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Storable as VS import qualified Data.Sequence as Seq-import Data.Sequence (Seq) +data NullError = NullError String deriving (Show, Typeable)+instance Exception NullError +-- | a 'NonNull' sequence has 1 or more items+-- In contrast, 'IsSequence' 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 (SemiSequence seq, IsSequence (Nullable seq), Element seq ~ Element (Nullable seq)) => NonNull seq where+    type Nullable seq --- | a NonNull sequence has 1 or more items-class IsSequence seq => NonNull seq where-    type NonEmpty seq+    -- | safely construct a 'NonNull' sequence from a 'NonEmpty' list+    fromNonEmpty :: NE.NonEmpty (Element seq) -> seq -    nsingleton :: Element seq -> NonEmpty seq+    -- | safely convert a 'Nullable' to a 'NonNull'+    fromNullable :: Nullable seq -> Maybe seq -    fromNonEmpty :: NE.NonEmpty (Element seq) -> NonEmpty 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 :: Nullable seq -> seq+    nonNull nullable = case fromNullable nullable of+                         Nothing -> throw $ NullError "Data.NonNull.nonNull (NonNull default): expected non-null"+                         Just xs -> xs +    -- | 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 'NonNull' to a 'Nullable'+    toNullable :: seq -> Nullable seq++    -- | Like cons, prepends an element.+    -- However, the prepend is to a Nullable, creating a 'NonNull'+    --+    -- Generally this uses cons underneath.+    -- cons is not efficient for most data structures.+    --+    -- Alternatives:+    --   * 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 :: Element seq -> Nullable seq -> seq++    -- | like 'uncons' of 'SemiSequence'+    nuncons :: seq -> (Element seq, Maybe 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 :: seq -> (Element seq, Nullable 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 :: (Element seq -> Bool) -> NonEmpty seq -> seq+    nfilter :: (Element seq -> Bool) -> seq -> Nullable seq +    -- | like 'Sequence.filterM', but starts with a NonNull+    nfilterM :: Monad m => (Element seq -> m Bool) -> seq -> m (Nullable seq)++    -- | i must be > 0. like 'Sequence.replicate'+    nReplicate :: Index seq -> Element seq -> seq++{-+maybeToNullable :: (Monoid (Nullable seq), NonNull seq) => Maybe seq -> Nullable seq+maybeToNullable Nothing   = mempty+maybeToNullable (Just xs) = toNullable xs+-}++-- | SafeSequence contains functions that would be partial on a 'Nullable'+class SafeSequence seq where     -- | like Data.List, but not partial on a NonEmpty-    head :: NonEmpty seq -> Element seq+    head :: seq -> Element seq     -- | like Data.List, but not partial on a NonEmpty-    tail :: NonEmpty seq -> seq+    tail :: seq -> Nullable seq     -- | like Data.List, but not partial on a NonEmpty-    last :: NonEmpty seq -> Element seq+    last :: seq -> Element seq     -- | like Data.List, but not partial on a NonEmpty-    init :: NonEmpty seq -> seq+    init :: seq -> Nullable seq  ++ -- | NonNull list reuses 'Data.List.NonEmpty'-instance NonNull [a] where-    type NonEmpty [a] = NE.NonEmpty a-    nsingleton = (NE.:| [])+instance NonNull (NE.NonEmpty a) where+    type Nullable (NE.NonEmpty a) = [a]+     fromNonEmpty = id+    {-# INLINE fromNonEmpty #-}+    fromNullable = NE.nonEmpty++    nonNull = NE.fromList+    -- nonNullUnsafe = nonNull++    toNullable = NE.toList++    ncons = (NE.:|)+     nfilter = NE.filter+    nfilterM f = filterM f . toNullable++    nReplicate i x = NE.unfold unfold i+      where+        unfold countdown | countdown < 1 = (x, Nothing)+                         | otherwise     = (x, Just (countdown - 1))++instance SafeSequence (NE.NonEmpty a) where     head = NE.head     tail = NE.tail     last = NE.last     init = NE.init  --- | a wrapper indicating there are 1 or more elements--- unwrap with toSequence-data NotEmpty seq = NotEmpty { toSequence :: seq }+-- | 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)+deriving instance MonoTraversable seq => MonoTraversable (NotEmpty seq) -instance NonNull (Seq.Seq a) where-    type NonEmpty (Seq a) = NotEmpty (Seq a)-    nsingleton = NotEmpty . Seq.singleton-    fromNonEmpty = NotEmpty . Seq.fromList . NE.toList-    nfilter f = Seq.filter f . toSequence-    head = flip Seq.index 1 . toSequence-    last (NotEmpty seq) = Seq.index   seq (Seq.length seq - 1)-    tail = Seq.drop 1 . toSequence-    init (NotEmpty seq) = Seq.take (Seq.length seq - 1) seq+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 NonNull (V.Vector a) where-    type NonEmpty (V.Vector a) = NotEmpty (V.Vector a)-    nsingleton = NotEmpty . V.singleton-    fromNonEmpty = NotEmpty . V.fromList . NE.toList-    nfilter f = V.filter f . toSequence-    head = V.head . toSequence-    tail = V.tail . toSequence-    last = V.last . toSequence-    init = V.init . toSequence -infixr 5 .:, <| --- | a stream is a NonNull that supports efficient modification of the front of the sequence-class NonNull seq => Stream seq where-    -- | Prepend an element, creating a NonEmpty-    -- Data.List.NonEmpty gets to use the (:|) operator,-    -- but this can't because it is not a data constructor-    (.:) :: Element seq -> seq -> NonEmpty seq-    -- | Prepend an element to a NonEmpty-    (<|) :: Element seq -> NonEmpty seq -> NonEmpty seq+instance SemiSequence seq => SemiSequence (NotEmpty seq) where+    type Index (NotEmpty seq) = Index seq -instance Stream [a] where-    (.:) = (NE.:|)-    (<|) = (NE.<|)+    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 -instance Stream (Seq a) where-    (.:) x = NotEmpty . (x Seq.<|)-    (<|) x = NotEmpty . (x Seq.<|) . toSequence +-- normally we favor defaulting, should we use it here?+-- this re-uses IsSequence functions and IsSequence uses defaulting+instance IsSequence seq => NonNull (NotEmpty seq) where+    type Nullable (NotEmpty seq) = seq -{--class (NonNull seq, Ord (Element seq)) => OrdNonNull seq where-    -- | like Data.List, but not partial on a NonEmpty-    maximum :: NonEmpty seq -> Element seq-    -- | like Data.List, but not partial on a NonEmpty-    minimum :: NonEmpty seq -> Element seq-    -- | like Data.List, but not partial on a NonEmpty-    maximumBy :: (Element seq -> Element seq -> Ordering) -> NonEmpty seq -> Element seq-    -- | like Data.List, but not partial on a NonEmpty-    minimumBy :: (Element seq -> Element seq -> Ordering) -> NonEmpty seq -> Element seq+    fromNonEmpty = NotEmpty . fromList . NE.toList+    fromNullable xs | onull xs = Nothing+                    | otherwise = Just $ NotEmpty xs -instance Ord a => OrdNonNull [a] where-    maximum = Foldable.maximum-    minimum = Foldable.minimum-    maximumBy = Foldable.maximumBy-    minimumBy = Foldable.minimumBy+    nonNull xs | onull xs = throw $ NullError "Data.NonNull.nonNull expected NotEmpty"+               | otherwise = NotEmpty xs -instance Ord a => OrdNonNull (Seq a) where-    maximum = Foldable.maximum-    minimum = Foldable.minimum-    maximumBy = Foldable.maximumBy-    minimumBy = Foldable.minimumBy+    -- nonNullUnsafe = NotEmpty+    toNullable = fromNotEmpty+    ncons x xs = NotEmpty $ cons x xs -instance Ord a => OrdNonNull (V.Vector a) where-    maximum = Foldable.maximum-    minimum = Foldable.minimum-    maximumBy = Foldable.maximumBy-    minimumBy = Foldable.minimumBy-    -}+    -- | i must be > 0. like 'Sequence.replicate'+    -- < 0 produces a 1 element NonEmpty+    nReplicate i x | i < 1 = ncons x mempty+                   | otherwise = NotEmpty $ replicate i x++    nfilter f = filter f . toNullable+    nfilterM f = filterM f . toNullable+++instance SafeSequence (NotEmpty (Seq.Seq a)) where+    head = flip Seq.index 1 . fromNotEmpty+    last (NotEmpty xs) = Seq.index xs (Seq.length xs - 1)+    tail = Seq.drop 1 . fromNotEmpty+    init (NotEmpty xs) = Seq.take (Seq.length xs - 1) xs++instance SafeSequence (NotEmpty (V.Vector a)) where+    head = V.head . fromNotEmpty+    tail = V.tail . fromNotEmpty+    last = V.last . fromNotEmpty+    init = V.init . fromNotEmpty++instance U.Unbox a => SafeSequence (NotEmpty (U.Vector a)) where+    head = U.head . fromNotEmpty+    tail = U.tail . fromNotEmpty+    last = U.last . fromNotEmpty+    init = U.init . fromNotEmpty++instance VS.Storable a => SafeSequence (NotEmpty (VS.Vector a)) where+    head = VS.head . fromNotEmpty+    tail = VS.tail . fromNotEmpty+    last = VS.last . fromNotEmpty+    init = VS.init . fromNotEmpty++instance SafeSequence (NotEmpty S.ByteString) where+    head = S.head . fromNotEmpty+    tail = S.tail . fromNotEmpty+    last = S.last . fromNotEmpty+    init = S.init . fromNotEmpty++instance SafeSequence (NotEmpty T.Text) where+    head = T.head . fromNotEmpty+    tail = T.tail . fromNotEmpty+    last = T.last . fromNotEmpty+    init = T.init . fromNotEmpty++instance SafeSequence (NotEmpty L.ByteString) where+    head = L.head . fromNotEmpty+    tail = L.tail . fromNotEmpty+    last = L.last . fromNotEmpty+    init = L.init . fromNotEmpty++instance SafeSequence (NotEmpty TL.Text) where+    head = TL.head . fromNotEmpty+    tail = TL.tail . fromNotEmpty+    last = TL.last . fromNotEmpty+    init = TL.init . fromNotEmpty++infixr 5 <|++-- | Prepend an element to a NonNull+(<|) :: NonNull seq => Element seq -> seq -> seq+(<|) = cons+++-- | fold operations that assume one or more elements+-- Guaranteed to be safe on a NonNull+class (NonNull seq, MonoFoldable (Nullable seq)) => MonoFoldable1 seq where+  ofoldMap1 :: Semigroup m => (Element seq -> m) -> seq -> m+  ofoldMap1 f = maybe (error "Data.NonNull.foldMap1 (MonoFoldable1)") id . getOption . ofoldMap (Option . Just . f) . toNullable++  -- ofold1 :: (Semigroup m ~ Element seq) => seq -> Element seq+  -- ofold1 = ofoldMap1 id++  -- @'foldr1' f = 'Prelude.foldr1' f . 'otoList'@+  ofoldr1 :: (Element seq -> Element seq -> Element seq) -> seq -> Element seq+  ofoldr1 f = fromMaybe (error "Data.NonNull.foldr1 (MonoFoldable1): empty structure") .+                  (ofoldr mf Nothing) . toNullable+    where+      mf x Nothing = Just x+      mf x (Just y) = Just (f x y)++  -- | 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' :: (Element seq -> Element seq -> Element seq) -> seq -> Element seq+  ofoldl1' f = fromMaybe (error "ofoldl1': empty structure") .+                  (ofoldl' mf Nothing) . toNullable+    where+      mf Nothing y = Just y+      mf (Just x) y = Just (f x y)+++instance MonoFoldable1 (NE.NonEmpty a)+-- normally we favor defaulting, should we be using it here?+instance (MonoFoldable mono, IsSequence mono) => MonoFoldable1 (NotEmpty mono)+++class (MonoFoldable1 seq, OrdSequence (Nullable seq)) => OrdNonNull seq where+    -- | like Data.List, but not partial on a NonNull+    maximum :: seq -> Element seq+    default maximum :: (MonoFoldable1 seq) => seq -> Element seq+    maximum = ofoldr1 max++    -- | like Data.List, but not partial on a NonNull+    minimum :: seq -> Element seq+    default minimum :: (MonoFoldable1 seq, Element (Nullable seq) ~ Element seq) => seq -> Element seq+    minimum = ofoldr1 min++    -- | like Data.List, but not partial on a NonNull+    maximumBy :: (Element seq -> Element seq -> Ordering) -> seq -> Element seq+    default maximumBy :: (MonoFoldable1 seq) => (Element seq -> Element seq -> Ordering) -> seq -> Element seq+    maximumBy cmp = ofoldr1 max'+      where max' x y = case cmp x y of+                            GT -> x+                            _  -> y++    -- | like Data.List, but not partial on a NonNull+    minimumBy :: (Element seq -> Element seq -> Ordering) -> seq -> Element seq+    default minimumBy :: (MonoFoldable1 seq) => (Element seq -> Element seq -> Ordering) -> seq -> Element seq+    minimumBy cmp = ofoldr1 min'+      where min' x y = case cmp x y of+                            GT -> y+                            _  -> x++instance Ord a => OrdNonNull (NE.NonEmpty a) where+    maximum = F.maximum+    minimum = F.minimum+    maximumBy = F.maximumBy+    minimumBy = F.minimumBy++instance Ord a => OrdNonNull (NotEmpty (Seq.Seq a))+instance Ord a => OrdNonNull (NotEmpty (V.Vector a))+instance OrdNonNull (NotEmpty (S.ByteString))+instance OrdNonNull (NotEmpty (L.ByteString))+instance OrdNonNull (NotEmpty (T.Text))+instance OrdNonNull (NotEmpty (TL.Text))
src/Data/Sequences.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}@@ -8,14 +6,13 @@ -- | Warning: This module should be considered highly experimental. module Data.Sequences where -import Data.Monoid+import Data.Monoid (Monoid, mconcat, mempty) import Data.MonoTraversable import Data.Int (Int64, Int) import qualified Data.List as List import qualified Control.Monad (filterM, replicateM)-import Prelude (Bool (..), Monad (..), Maybe (..), Ordering (..), Ord (..), Eq (..), Functor (..), fromIntegral, otherwise, (-), not, fst, snd, Integral)-import Data.Char (Char)-import Data.Word (Word8)+import Prelude (Bool (..), Monad (..), Maybe (..), Ordering (..), Ord (..), Eq (..), Functor (..), fromIntegral, otherwise, (-), not, fst, snd, Integral, ($), flip)+import Data.Char (Char, isSpace) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Text as T@@ -27,41 +24,55 @@ import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Storable as VS-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy.Encoding as TL-import Data.Text.Encoding.Error (lenientDecode)-import GHC.Exts (Constraint)-import qualified Data.Set as Set-import qualified Data.HashSet as HashSet-import Data.Hashable (Hashable)+import Data.String (IsString)+import qualified Data.List.NonEmpty as NE --- | Laws:+-- | 'SemiSequence' was created to share code between 'IsSequence' and 'NonNull'.+-- You should always use 'IsSequence' or 'NonNull' rather than using 'SemiSequence'+-- 'SemiSequence' is exported so that you can define new instances of 'IsSequence' or 'NonNull' ----- > fromList . toList = id--- > fromList (x <> y) = fromList x <> fromList y--- > otoList (fromList x <> fromList y) = x <> y-class (Monoid seq, MonoTraversable seq, Integral (Index seq)) => IsSequence seq where+-- @Semi@ means 'SemiGroup'+-- A 'SemiSequence' can accomodate a 'SemiGroup' such as 'NonEmpty'+-- A Monoid should be able to fill out 'IsSequence'+--+-- As a base for 'NonNull',+-- a 'SemiSequence' keeps the same type when increasing its number of elements.+-- However, a decreasing function such as filter may change a 'NonNull' type.+-- For example, from 'NonEmpty' to '[]'+-- This exists on 'NonNull' as 'nfilter'+--+-- 'filter' and other such functions are placed in 'IsSequence'+class (Integral (Index seq)) => SemiSequence seq where     type Index seq     singleton :: Element seq -> seq -    fromList :: [Element seq] -> seq-    fromList = mconcat . fmap singleton+    intersperse :: Element seq -> seq -> seq -    replicate :: Index seq -> Element seq -> seq-    replicate i = fromList . List.genericReplicate i+    -- FIXME split :: (Element seq -> Bool) -> seq -> [seq] -    replicateM :: Monad m => Index seq -> m (Element seq) -> m seq-    replicateM i = liftM fromList . Control.Monad.replicateM (fromIntegral i)+    reverse :: seq -> seq -    filter :: (Element seq -> Bool) -> seq -> seq-    filter f = fromList . List.filter f . otoList+    find :: (Element seq -> Bool) -> seq -> Maybe (Element seq) -    filterM :: Monad m => (Element seq -> m Bool) -> seq -> m seq-    filterM f = Control.Monad.liftM fromList . filterM f . otoList+    sortBy :: (Element seq -> Element seq -> Ordering) -> seq -> seq -    intersperse :: Element seq -> seq -> seq-    intersperse e = fromList . List.intersperse e . otoList+    cons :: Element seq -> seq -> seq +    snoc :: seq -> Element seq -> seq+++-- | 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+    fromList :: [Element seq] -> seq+    -- this definition creates the Monoid constraint+    -- However, all the instances define their own fromList+    fromList = mconcat . fmap singleton++    -- below functions change type fron the perspective of NonEmpty     break :: (Element seq -> Bool) -> seq -> (seq, seq)     break f = (fromList *** fromList) . List.break f . otoList @@ -83,26 +94,32 @@     drop :: Index seq -> seq -> seq     drop i = snd . splitAt i -    -- FIXME split :: (Element seq -> Bool) -> seq -> [seq]--    reverse :: seq -> seq-    reverse = fromList . List.reverse . otoList--    find :: (Element seq -> Bool) -> seq -> Maybe (Element seq)-    find f = List.find f . otoList-         partition :: (Element seq -> Bool) -> seq -> (seq, seq)     partition f = (fromList *** fromList) . List.partition f . otoList     -    sortBy :: (Element seq -> Element seq -> Ordering) -> seq -> seq-    sortBy f = fromList . List.sortBy f . otoList-    -    cons :: Element seq -> seq -> seq-    cons e = fromList . (e:) . otoList-     uncons :: seq -> Maybe (Element seq, seq)     uncons = fmap (second fromList) . uncons . otoList +    unsnoc :: seq -> Maybe (seq, Element seq)+    unsnoc seq =+        case reverse (otoList seq) of+            [] -> Nothing+            x:xs -> Just (fromList (reverse xs), x)++    filter :: (Element seq -> Bool) -> seq -> seq+    filter f = fromList . List.filter f . otoList++    filterM :: Monad m => (Element seq -> m Bool) -> seq -> m seq+    filterM f = liftM fromList . filterM f . otoList++    -- replicates are not in SemiSequence to allow for zero+    replicate :: Index seq -> Element seq -> seq+    replicate i = fromList . List.genericReplicate i++    replicateM :: Monad m => Index seq -> m (Element seq) -> m seq+    replicateM i = liftM fromList . Control.Monad.replicateM (fromIntegral i)++    -- below functions are not in SemiSequence because they return a List (instead of NonEmpty)     groupBy :: (Element seq -> Element seq -> Bool) -> seq -> [seq]     groupBy f = fmap fromList . List.groupBy f . otoList @@ -117,16 +134,63 @@     permutations :: seq -> [seq]     permutations = List.map fromList . List.permutations . otoList -instance IsSequence [a] where++defaultFind :: MonoFoldable seq => (Element seq -> Bool) -> seq -> Maybe (Element seq)+defaultFind f = List.find f . otoList++defaultIntersperse :: IsSequence seq => Element seq -> seq -> seq+defaultIntersperse e = fromList . List.intersperse e . otoList++defaultReverse :: IsSequence seq => seq -> seq+defaultReverse = fromList . List.reverse . otoList++defaultSortBy :: IsSequence seq => (Element seq -> Element seq -> Ordering) -> seq -> seq+defaultSortBy f = fromList . List.sortBy f . otoList++defaultCons :: IsSequence seq => Element seq -> seq -> seq+defaultCons e = fromList . (e:) . otoList++defaultSnoc :: IsSequence seq => seq -> Element seq -> seq+defaultSnoc seq e = fromList (otoList seq List.++ [e])+++-- | like Data.List.head, but not partial+headMay :: IsSequence seq => seq -> Maybe (Element seq)+headMay = fmap fst . uncons++-- | like Data.List.last, but not partial+lastMay :: IsSequence seq => seq -> Maybe (Element seq)+lastMay = fmap snd . unsnoc++-- | like Data.List.tail, but an input of @mempty@ returns @mempty@+tailDef :: IsSequence seq => seq -> seq+tailDef xs = case uncons xs of+               Nothing -> mempty+               Just tuple -> snd tuple++-- | like Data.List.init, but an input of @mempty@ returns @mempty@+initDef :: IsSequence seq => seq -> seq+initDef xs = case unsnoc xs of+               Nothing -> mempty+               Just tuple -> fst tuple++++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++instance IsSequence [a] where     fromList = id     {-# INLINE fromList #-}-    replicate = List.replicate-    replicateM = Control.Monad.replicateM     filter = List.filter     filterM = Control.Monad.filterM-    intersperse = List.intersperse     break = List.break     span = List.span     dropWhile = List.dropWhile@@ -134,13 +198,11 @@     splitAt = List.splitAt     take = List.take     drop = List.drop-    reverse = List.reverse-    find = List.find-    partition = List.partition-    sortBy = List.sortBy-    cons = (:)     uncons [] = Nothing     uncons (x:xs) = Just (x, xs)+    partition = List.partition+    replicate = List.replicate+    replicateM = Control.Monad.replicateM     groupBy = List.groupBy     groupAllOn f (head : tail) =         (head : matches) : groupAllOn f nonMatches@@ -148,13 +210,31 @@         (matches, nonMatches) = partition ((== f head) . f) tail     groupAllOn _ [] = [] -instance IsSequence S.ByteString where+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++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++instance IsSequence S.ByteString where     fromList = S.pack     replicate = S.replicate     filter = S.filter-    intersperse = S.intersperse     break = S.break     span = S.span     dropWhile = S.dropWhile@@ -162,21 +242,27 @@     splitAt = S.splitAt     take = S.take     drop = S.drop-    reverse = S.reverse-    find = S.find     partition = S.partition-    cons = S.cons     uncons = S.uncons+    unsnoc s+        | S.null s = Nothing+        | otherwise = Just (S.init s, S.last s)     groupBy = S.groupBy-    -- sortBy -instance IsSequence T.Text where+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++instance IsSequence T.Text where     fromList = T.pack     replicate i c = T.replicate i (T.singleton c)     filter = T.filter-    intersperse = T.intersperse     break = T.break     span = T.span     dropWhile = T.dropWhile@@ -184,21 +270,27 @@     splitAt = T.splitAt     take = T.take     drop = T.drop-    reverse = T.reverse-    find = T.find     partition = T.partition-    cons = T.cons     uncons = T.uncons+    unsnoc t+        | T.null t = Nothing+        | otherwise = Just (T.init t, T.last t)     groupBy = T.groupBy-    -- sortBy -instance IsSequence L.ByteString where+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++instance IsSequence L.ByteString where     fromList = L.pack     replicate = L.replicate     filter = L.filter-    intersperse = L.intersperse     break = L.break     span = L.span     dropWhile = L.dropWhile@@ -206,21 +298,27 @@     splitAt = L.splitAt     take = L.take     drop = L.drop-    reverse = L.reverse-    find = L.find     partition = L.partition-    cons = L.cons     uncons = L.uncons+    unsnoc s+        | L.null s = Nothing+        | otherwise = Just (L.init s, L.last s)     groupBy = L.groupBy-    -- sortBy -instance IsSequence TL.Text where+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++instance IsSequence TL.Text where     fromList = TL.pack     replicate i c = TL.replicate i (TL.singleton c)     filter = TL.filter-    intersperse = TL.intersperse     break = TL.break     span = TL.span     dropWhile = TL.dropWhile@@ -228,24 +326,30 @@     splitAt = TL.splitAt     take = TL.take     drop = TL.drop-    reverse = TL.reverse-    find = TL.find     partition = TL.partition-    cons = TL.cons     uncons = TL.uncons+    unsnoc t+        | TL.null t = Nothing+        | otherwise = Just (TL.init t, TL.last t)     groupBy = TL.groupBy-    -- sortBy --instance IsSequence (Seq.Seq a) where+instance SemiSequence (Seq.Seq a) where     type Index (Seq.Seq a) = Int     singleton = Seq.singleton+    cons = (Seq.<|)+    snoc = (Seq.|>)+    reverse = Seq.reverse+    sortBy = Seq.sortBy++    intersperse = defaultIntersperse+    find = defaultFind++instance IsSequence (Seq.Seq a) where     fromList = Seq.fromList     replicate = Seq.replicate     replicateM = Seq.replicateM     filter = Seq.filter     --filterM = Seq.filterM-    --intersperse = Seq.intersperse     break = Seq.breakl     span = Seq.spanl     dropWhile = Seq.dropWhileL@@ -253,26 +357,34 @@     splitAt = Seq.splitAt     take = Seq.take     drop = Seq.drop-    reverse = Seq.reverse-    --find = Seq.find     partition = Seq.partition-    sortBy = Seq.sortBy-    cons = (Seq.<|)     uncons s =         case Seq.viewl s of             Seq.EmptyL -> Nothing             x Seq.:< xs -> Just (x, xs)+    unsnoc s =+        case Seq.viewr s of+            Seq.EmptyR -> Nothing+            xs Seq.:> x -> Just (xs, x)     --groupBy = Seq.groupBy -instance IsSequence (V.Vector a) where+instance SemiSequence (V.Vector a) where     type Index (V.Vector a) = Int     singleton = V.singleton+    reverse = V.reverse+    find = V.find+    cons = V.cons+    snoc = V.snoc++    sortBy = defaultSortBy+    intersperse = defaultIntersperse++instance IsSequence (V.Vector a) where     fromList = V.fromList     replicate = V.replicate     replicateM = V.replicateM     filter = V.filter     filterM = V.filterM-    --intersperse = V.intersperse     break = V.break     span = V.span     dropWhile = V.dropWhile@@ -280,25 +392,32 @@     splitAt = V.splitAt     take = V.take     drop = V.drop-    reverse = V.reverse-    find = V.find     partition = V.partition-    --sortBy = V.sortBy-    cons = V.cons     uncons v         | V.null v = Nothing         | otherwise = Just (V.head v, V.tail v)+    unsnoc v+        | V.null v = Nothing+        | otherwise = Just (V.init v, V.last v)     --groupBy = V.groupBy -instance U.Unbox a => IsSequence (U.Vector a) where+instance U.Unbox a => SemiSequence (U.Vector a) where     type Index (U.Vector a) = Int     singleton = U.singleton++    intersperse = defaultIntersperse+    reverse = U.reverse+    find = U.find+    cons = U.cons+    snoc = U.snoc+    sortBy = defaultSortBy++instance U.Unbox a => IsSequence (U.Vector a) where     fromList = U.fromList     replicate = U.replicate     replicateM = U.replicateM     filter = U.filter     filterM = U.filterM-    --intersperse = U.intersperse     break = U.break     span = U.span     dropWhile = U.dropWhile@@ -306,25 +425,32 @@     splitAt = U.splitAt     take = U.take     drop = U.drop-    reverse = U.reverse-    find = U.find     partition = U.partition-    --sortBy = U.sortBy-    cons = U.cons     uncons v         | U.null v = Nothing         | otherwise = Just (U.head v, U.tail v)+    unsnoc v+        | U.null v = Nothing+        | otherwise = Just (U.init v, U.last v)     --groupBy = U.groupBy -instance VS.Storable a => IsSequence (VS.Vector a) where+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+    snoc = VS.snoc++    intersperse = defaultIntersperse+    sortBy = defaultSortBy++instance VS.Storable a => IsSequence (VS.Vector a) where     fromList = VS.fromList     replicate = VS.replicate     replicateM = VS.replicateM     filter = VS.filter     filterM = VS.filterM-    --intersperse = U.intersperse     break = VS.break     span = VS.span     dropWhile = VS.dropWhile@@ -332,14 +458,13 @@     splitAt = VS.splitAt     take = VS.take     drop = VS.drop-    reverse = VS.reverse-    find = VS.find     partition = VS.partition-    --sortBy = U.sortBy-    cons = VS.cons     uncons v         | VS.null v = Nothing         | otherwise = Just (VS.head v, VS.tail v)+    unsnoc v+        | VS.null v = Nothing+        | otherwise = Just (VS.init v, VS.last v)     --groupBy = U.groupBy  class (IsSequence seq, Eq (Element seq)) => EqSequence seq where@@ -449,82 +574,50 @@ instance (Ord a, U.Unbox a) => OrdSequence (U.Vector a) instance (Ord a, VS.Storable a) => OrdSequence (VS.Vector a) -class (IsSequence l, IsSequence s) => LazySequence l s | l -> s, s -> l where-    toChunks :: l -> [s]-    fromChunks :: [s] -> l-    toStrict :: l -> s-    fromStrict :: s -> l--instance LazySequence L.ByteString S.ByteString where-    toChunks = L.toChunks-    fromChunks = L.fromChunks-    toStrict = mconcat . L.toChunks-    fromStrict = L.fromChunks . return--instance LazySequence TL.Text T.Text where-    toChunks = TL.toChunks-    fromChunks = TL.fromChunks-    toStrict = TL.toStrict-    fromStrict = TL.fromStrict--class (IsSequence t, IsSequence b) => Textual t b | t -> b, b -> t where+class (IsSequence t, IsString t, Element t ~ Char) => Textual t where     words :: t -> [t]     unwords :: [t] -> t     lines :: t -> [t]     unlines :: [t] -> t-    encodeUtf8 :: t -> b-    decodeUtf8 :: b -> t     toLower :: t -> t     toUpper :: t -> t     toCaseFold :: t -> t -instance (c ~ Char, w ~ Word8) => Textual [c] [w] where+    breakWord :: t -> (t, t)+    breakWord = fmap (dropWhile isSpace) . break isSpace++    breakLine :: t -> (t, t)+    breakLine =+        (killCR *** drop 1) . break (== '\n')+      where+        killCR t =+            case unsnoc t of+                Just (t', '\r') -> t'+                _ -> t++instance (c ~ Char) => Textual [c] where     words = List.words     unwords = List.unwords     lines = List.lines     unlines = List.unlines-    encodeUtf8 = L.unpack . TL.encodeUtf8 . TL.pack-    decodeUtf8 = TL.unpack . TL.decodeUtf8With lenientDecode . L.pack     toLower = TL.unpack . TL.toLower . TL.pack     toUpper = TL.unpack . TL.toUpper . TL.pack     toCaseFold = TL.unpack . TL.toCaseFold . TL.pack -instance Textual T.Text S.ByteString where+instance Textual T.Text where     words = T.words     unwords = T.unwords     lines = T.lines     unlines = T.unlines-    encodeUtf8 = T.encodeUtf8-    decodeUtf8 = T.decodeUtf8With lenientDecode     toLower = T.toLower     toUpper = T.toUpper     toCaseFold = T.toCaseFold -instance Textual TL.Text L.ByteString where+instance Textual TL.Text where     words = TL.words     unwords = TL.unwords     lines = TL.lines     unlines = TL.unlines-    encodeUtf8 = TL.encodeUtf8-    decodeUtf8 = TL.decodeUtf8With lenientDecode     toLower = TL.toLower     toUpper = TL.toUpper     toCaseFold = TL.toCaseFold---- | A @map@-like function which doesn't obey the @Functor@ laws,--- and/or requires extra constraints on the contained values.-class LooseMap t where-    type LooseMapConstraint t e :: Constraint-    looseMap :: (LooseMapConstraint t e1, LooseMapConstraint t e2) => (e1 -> e2) -> t e1 -> t e2-instance LooseMap Set.Set where-    type LooseMapConstraint Set.Set a = Ord a-    looseMap = Set.map-instance LooseMap HashSet.HashSet where-    type LooseMapConstraint HashSet.HashSet a = (Eq a, Hashable a)-    looseMap = HashSet.map-instance LooseMap U.Vector where-    type LooseMapConstraint U.Vector a = U.Unbox a-    looseMap = U.map-instance LooseMap VS.Vector where-    type LooseMapConstraint VS.Vector a = VS.Storable a-    looseMap = VS.map
test/Spec.hs view
@@ -7,7 +7,7 @@ import Data.Text (Text) import qualified Data.ByteString.Lazy as L import Data.Sequences-import Prelude (Bool (..), ($), IO, min, abs, Eq (..), (&&), fromIntegral, Ord (..), String, mod, Int)+import Prelude (Bool (..), ($), IO, min, abs, Eq (..), (&&), fromIntegral, Ord (..), String, mod, Int, show)  main :: IO () main = hspec $ do@@ -39,3 +39,21 @@         it "Text" $ groupAll ("abcabcabc" :: Text) == ["aaa", "bbb", "ccc"]     describe "groupAllOn" $ do         it "list" $ groupAllOn (`mod` 3) ([1..9] :: [Int]) == [[1, 4, 7], [2, 5, 8], [3, 6, 9]]+    describe "breakWord" $ do+        let test x y z = it (show (x, y, z)) $ breakWord (x :: Text) `shouldBe` (y, z)+        test "hello world" "hello" "world"+        test "hello     world" "hello" "world"+        test "hello\r\nworld" "hello" "world"+        test "hello there  world" "hello" "there  world"+        test "" "" ""+        test "hello    \n\r\t" "hello" ""+    describe "breakLine" $ do+        let test x y z = it (show (x, y, z)) $ breakLine (x :: Text) `shouldBe` (y, z)+        test "hello world" "hello world" ""+        test "hello\r\n world" "hello" " world"+        test "hello\n world" "hello" " world"+        test "hello\r world" "hello\r world" ""+        test "hello\r\nworld" "hello" "world"+        test "hello\r\nthere\nworld" "hello" "there\nworld"+        test "hello\n\r\nworld" "hello" "\r\nworld"+        test "" "" ""