diff --git a/mono-traversable.cabal b/mono-traversable.cabal --- a/mono-traversable.cabal +++ b/mono-traversable.cabal @@ -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 diff --git a/src/Data/Containers.hs b/src/Data/Containers.hs --- a/src/Data/Containers.hs +++ b/src/Data/Containers.hs @@ -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 diff --git a/src/Data/MonoTraversable.hs b/src/Data/MonoTraversable.hs --- a/src/Data/MonoTraversable.hs +++ b/src/Data/MonoTraversable.hs @@ -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 diff --git a/src/Data/NonNull.hs b/src/Data/NonNull.hs --- a/src/Data/NonNull.hs +++ b/src/Data/NonNull.hs @@ -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)) diff --git a/src/Data/Sequences.hs b/src/Data/Sequences.hs --- a/src/Data/Sequences.hs +++ b/src/Data/Sequences.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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 "" "" ""