diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2013 Michael Snoyman, http://www.fpcomplete.com/ + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,6 @@ +mono-traversable +================ + +Type classes for mapping, folding, and traversing monomorphic containers + +[![Build Status](https://secure.travis-ci.org/snoyberg/mono-traversable.png)](http://travis-ci.org/snoyberg/mono-traversable) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/mono-traversable.cabal b/mono-traversable.cabal new file mode 100644 --- /dev/null +++ b/mono-traversable.cabal @@ -0,0 +1,44 @@ +name: mono-traversable +version: 0.1.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 +license: MIT +license-file: LICENSE +author: Michael Snoyman, John Wiegley, Greg Weber +maintainer: michael@snoyman.com +category: Data +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + exposed-modules: Data.Containers + Data.MonoTraversable + Data.Sequences + Data.NonNull + build-depends: base >= 4 && < 5 + , containers >= 0.4 + , unordered-containers >=0.2 + , hashable + , bytestring >= 0.9 + , text >=0.11 + , semigroups >=0.9 + , transformers >=0.3 + , vector >=0.10 + , semigroupoids >=3.0 + , comonad >=3.0.3 + hs-source-dirs: src + default-language: Haskell2010 + +test-suite test + main-is: main.hs + type: exitcode-stdio-1.0 + hs-source-dirs: test + other-modules: Spec + default-language: Haskell2010 + build-depends: base + , mono-traversable + , bytestring + , text + , hspec diff --git a/src/Data/Containers.hs b/src/Data/Containers.hs new file mode 100644 --- /dev/null +++ b/src/Data/Containers.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +-- | Warning: This module should be considered highly experimental. +module Data.Containers where + +import qualified Data.Map as Map +import qualified Data.HashMap.Strict as HashMap +import Data.Hashable (Hashable) +import qualified Data.Set as Set +import qualified Data.HashSet as HashSet +import Data.Monoid (Monoid) +import Data.MonoTraversable (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 + 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 + 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 + 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 + 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 + 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 + member = HashSet.member + notMember e = not . HashSet.member e + union = HashSet.union + difference = HashSet.difference + intersection = HashSet.intersection +instance Container 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 + 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 + -- | 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 + 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 + 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 + 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 + lookup = List.lookup + insertMap k v = ((k, v):) . deleteMap k + deleteMap k = List.filter ((/= k) . fst) + singletonMap k v = [(k, v)] + 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 + 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 + 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 diff --git a/src/Data/MonoTraversable.hs b/src/Data/MonoTraversable.hs new file mode 100644 --- /dev/null +++ b/src/Data/MonoTraversable.hs @@ -0,0 +1,375 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +-- | Type classes mirroring standard typeclasses, but working with monomorphic containers. +-- +-- The motivation is that some commonly used data types (i.e., @ByteString@ and +-- @Text@) do not allow for instances of typeclasses like @Functor@ and +-- @Foldable@, since they are monomorphic structures. This module allows both +-- monomorphic and polymorphic data types to be instances of the same +-- typeclasses. +-- +-- All of the laws for the polymorphic typeclasses apply to their monomorphic +-- cousins. Thus, even though a @MonoFunctor@ instance for @Set@ could +-- theoretically be defined, it is omitted since it could violate the functor +-- law of @omap f . omap g = omap (f . g)@. +-- +-- Note that all typeclasses have been prefixed with @Mono@, and functions have +-- been prefixed with @o@. The mnemonic for @o@ is \"only one,\" or alternatively +-- \"it's mono, but m is overused in Haskell, so we'll use the second letter +-- instead.\" (Agreed, it's not a great mangling scheme, input is welcome!) +module Data.MonoTraversable where + +import Control.Applicative +import Control.Category +import Control.Monad (Monad (..), liftM) +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L +import qualified Data.Foldable as F +import Data.Functor +import Data.Monoid (Monoid (..), Any (..), All (..), Sum (..)) +import qualified Data.Monoid +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import Data.Traversable +import Data.Word (Word8) +import Data.Int (Int, Int64) +import GHC.Exts (build) +import Prelude (Bool (..), const, Char, flip, ($), IO, Maybe, Either, + replicate, (+), Integral, Ordering (..), compare, fromIntegral, Num) +import Control.Arrow (Arrow) +import Data.Tree (Tree) +import Data.Sequence (Seq, ViewL, ViewR) +import Data.IntMap (IntMap) +import Data.IntSet (IntSet) +import Data.Semigroup (Option) +import Data.List.NonEmpty (NonEmpty) +import Data.Functor.Identity (Identity) +import Data.Map (Map) +import Data.HashMap.Strict (HashMap) +import Data.Vector (Vector) +import Control.Monad.Trans.Maybe (MaybeT) +import Control.Monad.Trans.List (ListT) +import Control.Monad.Trans.Identity (IdentityT) +import Data.Functor.Apply (MaybeApply, WrappedApplicative) +import Control.Comonad (Cokleisli) +import Control.Monad.Trans.Writer (WriterT) +import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT) +import Control.Monad.Trans.State (StateT) +import qualified Control.Monad.Trans.State.Strict as Strict (StateT) +import Control.Monad.Trans.RWS (RWST) +import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST) +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.Trans.Error (ErrorT) +import Control.Monad.Trans.Cont (ContT) +import Data.Functor.Compose (Compose) +import Data.Functor.Product (Product) +import Data.Semigroupoid.Static (Static) +import Data.Set (Set) +import Data.HashSet (HashSet) +import qualified Data.Vector.Unboxed as U +import qualified Data.Vector.Storable as VS +import qualified Data.IntSet as IntSet + +type family Element mofu +type instance Element S.ByteString = Word8 +type instance Element L.ByteString = Word8 +type instance Element T.Text = Char +type instance Element TL.Text = Char +type instance Element [a] = a +type instance Element (IO a) = a +type instance Element (ZipList a) = a +type instance Element (Maybe a) = a +type instance Element (Tree a) = a +type instance Element (Seq a) = a +type instance Element (ViewL a) = a +type instance Element (ViewR a) = a +type instance Element (IntMap a) = a +type instance Element IntSet = Int +type instance Element (Option a) = a +type instance Element (NonEmpty a) = a +type instance Element (Identity a) = a +type instance Element (r -> a) = a +type instance Element (Either a b) = b +type instance Element (a, b) = b +type instance Element (Const m a) = a +type instance Element (WrappedMonad m a) = a +type instance Element (Map k v) = v +type instance Element (HashMap k v) = v +type instance Element (Set e) = e +type instance Element (HashSet e) = e +type instance Element (Vector a) = a +type instance Element (WrappedArrow a b c) = c +type instance Element (MaybeApply f a) = a +type instance Element (WrappedApplicative f a) = a +type instance Element (Cokleisli w a b) = b +type instance Element (MaybeT m a) = a +type instance Element (ListT m a) = a +type instance Element (IdentityT m a) = a +type instance Element (WriterT w m a) = a +type instance Element (Strict.WriterT w m a) = a +type instance Element (StateT s m a) = a +type instance Element (Strict.StateT s m a) = a +type instance Element (RWST r w s m a) = a +type instance Element (Strict.RWST r w s m a) = a +type instance Element (ReaderT r m a) = a +type instance Element (ErrorT e m a) = a +type instance Element (ContT r m a) = a +type instance Element (Compose f g a) = a +type instance Element (Product f g a) = a +type instance Element (Static f a b) = b +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 + omap = fmap +instance MonoFunctor S.ByteString where + omap = S.map +instance MonoFunctor L.ByteString where + omap = L.map +instance MonoFunctor T.Text where + omap = T.map +instance MonoFunctor TL.Text where + omap = TL.map +instance MonoFunctor [a] +instance MonoFunctor (IO a) +instance MonoFunctor (ZipList a) +instance MonoFunctor (Maybe a) +instance MonoFunctor (Tree a) +instance MonoFunctor (Seq a) +instance MonoFunctor (ViewL a) +instance MonoFunctor (ViewR a) +instance MonoFunctor (IntMap a) +instance MonoFunctor (Option a) +instance MonoFunctor (NonEmpty a) +instance MonoFunctor (Identity a) +instance MonoFunctor (r -> a) +instance MonoFunctor (Either a b) +instance MonoFunctor (a, b) +instance MonoFunctor (Const m a) +instance Monad m => MonoFunctor (WrappedMonad m a) +instance MonoFunctor (Map k v) +instance MonoFunctor (HashMap k v) +instance MonoFunctor (Vector a) +instance Arrow a => MonoFunctor (WrappedArrow a b c) +instance Functor f => MonoFunctor (MaybeApply f a) +instance Functor f => MonoFunctor (WrappedApplicative f a) +instance MonoFunctor (Cokleisli w a b) +instance Functor m => MonoFunctor (MaybeT m a) +instance Functor m => MonoFunctor (ListT m a) +instance Functor m => MonoFunctor (IdentityT m a) +instance Functor m => MonoFunctor (WriterT w m a) +instance Functor m => MonoFunctor (Strict.WriterT w m a) +instance Functor m => MonoFunctor (StateT s m a) +instance Functor m => MonoFunctor (Strict.StateT s m a) +instance Functor m => MonoFunctor (RWST r w s m a) +instance Functor m => MonoFunctor (Strict.RWST r w s m a) +instance Functor m => MonoFunctor (ReaderT r m a) +instance Functor m => MonoFunctor (ErrorT e m a) +instance Functor m => MonoFunctor (ContT r m a) +instance (Functor f, Functor g) => MonoFunctor (Compose f g a) +instance (Functor f, Functor g) => MonoFunctor (Product f g a) +instance Functor f => MonoFunctor (Static f a b) +instance U.Unbox a => MonoFunctor (U.Vector a) where + omap = U.map +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 + 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 = 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' = F.foldl' + + otoList :: mofo -> [Element mofo] + otoList t = build (\ mofo n -> ofoldr mofo n t) + + oall :: (Element mofo -> Bool) -> mofo -> Bool + oall f = getAll . ofoldMap (All . f) + + oany :: (Element mofo -> Bool) -> mofo -> Bool + oany f = getAny . ofoldMap (Any . f) + + onull :: mofo -> Bool + onull = oall (const False) + + olength :: mofo -> Int + olength = ofoldl' (\i _ -> i + 1) 0 + + olength64 :: mofo -> Int64 + olength64 = ofoldl' (\i _ -> i + 1) 0 + + ocompareLength :: Integral i => mofo -> 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_ f = ofoldr ((*>) . f) (pure ()) + + ofor_ :: (MonoFoldable mofo, Applicative f) => mofo -> (Element mofo -> f b) -> f () + ofor_ = flip otraverse_ + + omapM_ :: (MonoFoldable mofo, Monad m) => (Element mofo -> m b) -> mofo -> m () + omapM_ f = ofoldr ((>>) . f) (return ()) + + oforM_ :: (MonoFoldable mofo, Monad m) => mofo -> (Element mofo -> m b) -> m () + oforM_ = flip omapM_ + + ofoldlM :: (MonoFoldable mofo, Monad m) => (a -> Element mofo -> m a) -> a -> mofo -> m a + ofoldlM f z0 xs = ofoldr f' return xs z0 + where f' x k z = f z x >>= k + +instance MonoFoldable S.ByteString where + ofoldMap f = ofoldr (mappend . f) mempty + ofoldr = S.foldr + ofoldl' = S.foldl' + otoList = S.unpack + oall = S.all + oany = S.any + onull = S.null + olength = S.length +instance MonoFoldable L.ByteString where + ofoldMap f = ofoldr (mappend . f) mempty + ofoldr = L.foldr + ofoldl' = L.foldl' + otoList = L.unpack + oall = L.all + oany = L.any + onull = L.null + olength64 = L.length +instance MonoFoldable T.Text where + ofoldMap f = ofoldr (mappend . f) mempty + ofoldr = T.foldr + ofoldl' = T.foldl' + otoList = T.unpack + oall = T.all + oany = T.any + onull = T.null + olength = T.length +instance MonoFoldable TL.Text where + ofoldMap f = ofoldr (mappend . f) mempty + ofoldr = TL.foldr + ofoldl' = TL.foldl' + otoList = TL.unpack + oall = TL.all + oany = TL.any + onull = TL.null + olength64 = TL.length +instance MonoFoldable IntSet where + ofoldMap f = ofoldr (mappend . f) mempty + ofoldr = IntSet.foldr + ofoldl' = IntSet.foldl' + otoList = IntSet.toList + onull = IntSet.null + olength = IntSet.size +instance MonoFoldable [a] where + otoList = id + {-# INLINE otoList #-} +instance MonoFoldable (Maybe a) +instance MonoFoldable (Tree a) +instance MonoFoldable (Seq a) +instance MonoFoldable (ViewL a) +instance MonoFoldable (ViewR a) +instance MonoFoldable (IntMap a) +instance MonoFoldable (Option a) +instance MonoFoldable (NonEmpty a) +instance MonoFoldable (Identity a) +instance MonoFoldable (Map k v) +instance MonoFoldable (HashMap k v) +instance MonoFoldable (Vector a) +instance MonoFoldable (Set e) +instance MonoFoldable (HashSet e) +instance U.Unbox a => MonoFoldable (U.Vector a) where + ofoldMap f = ofoldr (mappend . f) mempty + ofoldr = U.foldr + ofoldl' = U.foldl' + otoList = U.toList + oall = U.all + oany = U.any + onull = U.null + olength = U.length +instance VS.Storable a => MonoFoldable (VS.Vector a) where + ofoldMap f = ofoldr (mappend . f) mempty + ofoldr = VS.foldr + ofoldl' = VS.foldl' + otoList = VS.toList + oall = VS.all + oany = VS.any + onull = VS.null + 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 = 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 = Data.Monoid.getProduct . ofoldMap Data.Monoid.Product + +class (MonoFoldable mofo, Monoid mofo) => MonoFoldableMonoid mofo where + oconcatMap :: (Element mofo -> mofo) -> mofo -> mofo + oconcatMap = ofoldMap +instance (MonoFoldable (t a), Monoid (t a)) => MonoFoldableMonoid (t a) -- FIXME +instance MonoFoldableMonoid S.ByteString where + oconcatMap = S.concatMap +instance MonoFoldableMonoid L.ByteString where + oconcatMap = L.concatMap +instance MonoFoldableMonoid T.Text where + oconcatMap = T.concatMap +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 + 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 = mapM +instance MonoTraversable S.ByteString where + otraverse f = fmap S.pack . traverse f . S.unpack + omapM f = liftM S.pack . mapM f . S.unpack +instance MonoTraversable L.ByteString where + otraverse f = fmap L.pack . traverse f . L.unpack + omapM f = liftM L.pack . mapM f . L.unpack +instance MonoTraversable T.Text where + otraverse f = fmap T.pack . traverse f . T.unpack + omapM f = liftM T.pack . mapM f . T.unpack +instance MonoTraversable TL.Text where + otraverse f = fmap TL.pack . traverse f . TL.unpack + omapM f = liftM TL.pack . mapM f . TL.unpack +instance MonoTraversable [a] +instance MonoTraversable (Maybe a) +instance MonoTraversable (Tree a) +instance MonoTraversable (Seq a) +instance MonoTraversable (ViewL a) +instance MonoTraversable (ViewR a) +instance MonoTraversable (IntMap a) +instance MonoTraversable (Option a) +instance MonoTraversable (NonEmpty a) +instance MonoTraversable (Identity a) +instance MonoTraversable (Map k v) +instance MonoTraversable (HashMap k v) +instance MonoTraversable (Vector a) +instance U.Unbox a => MonoTraversable (U.Vector a) where + otraverse f = fmap U.fromList . traverse f . U.toList + omapM = U.mapM +instance VS.Storable a => MonoTraversable (VS.Vector a) where + 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 = flip otraverse + +oforM :: (MonoTraversable mot, Monad f) => mot -> (Element mot -> f (Element mot)) -> f mot +oforM = flip omapM diff --git a/src/Data/NonNull.hs b/src/Data/NonNull.hs new file mode 100644 --- /dev/null +++ b/src/Data/NonNull.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +-- | Warning, this is Experimental! +-- +-- Data.NonNull attempts to extend the concepts from +-- 'Data.List.NonEmpty' to any 'IsSequence'. +-- +-- 'NonNull' is for a sequence with 1 or more elements. +-- 'Stream' is for a 'NonNull' that supports efficient +-- modification of the front of the sequence. +-- +-- This code is experimental and likely to change dramatically and future versions. +-- Please send your feedback. +module Data.NonNull where + +import Prelude hiding (head, tail, init, last) +import Data.MonoTraversable +import Data.Sequences +import qualified Data.List.NonEmpty as NE +import Data.Semigroup +import qualified Data.Foldable as Foldable + +import qualified Data.Vector as V +import qualified Data.Sequence as Seq +import Data.Sequence (Seq) + + + +-- | a NonNull sequence has 1 or more items +class IsSequence seq => NonNull seq where + type NonEmpty seq + + nsingleton :: Element seq -> NonEmpty seq + + fromNonEmpty :: NE.NonEmpty (Element seq) -> NonEmpty seq + + -- | like 'Sequence.filter', but starts with a NonNull + nfilter :: (Element seq -> Bool) -> NonEmpty seq -> seq + + -- | like Data.List, but not partial on a NonEmpty + head :: NonEmpty seq -> Element seq + -- | like Data.List, but not partial on a NonEmpty + tail :: NonEmpty seq -> seq + -- | like Data.List, but not partial on a NonEmpty + last :: NonEmpty seq -> Element seq + -- | like Data.List, but not partial on a NonEmpty + init :: NonEmpty seq -> seq + + +-- | NonNull list reuses 'Data.List.NonEmpty' +instance NonNull [a] where + type NonEmpty [a] = NE.NonEmpty a + nsingleton = (NE.:| []) + fromNonEmpty = id + nfilter = NE.filter + 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 } + +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 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 Stream [a] where + (.:) = (NE.:|) + (<|) = (NE.<|) + +instance Stream (Seq a) where + (.:) x = NotEmpty . (x Seq.<|) + (<|) x = NotEmpty . (x Seq.<|) . toSequence + + +{- +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 + +instance Ord a => OrdNonNull [a] where + maximum = Foldable.maximum + minimum = Foldable.minimum + maximumBy = Foldable.maximumBy + minimumBy = Foldable.minimumBy + +instance Ord a => OrdNonNull (Seq a) where + maximum = Foldable.maximum + minimum = Foldable.minimum + maximumBy = Foldable.maximumBy + minimumBy = Foldable.minimumBy + +instance Ord a => OrdNonNull (V.Vector a) where + maximum = Foldable.maximum + minimum = Foldable.minimum + maximumBy = Foldable.maximumBy + minimumBy = Foldable.minimumBy + -} diff --git a/src/Data/Sequences.hs b/src/Data/Sequences.hs new file mode 100644 --- /dev/null +++ b/src/Data/Sequences.hs @@ -0,0 +1,530 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ConstraintKinds #-} +-- | Warning: This module should be considered highly experimental. +module Data.Sequences where + +import Data.Monoid +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 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 Control.Category +import Control.Arrow ((***), second) +import Control.Monad (liftM) +import qualified Data.Sequence as Seq +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) + +-- | Laws: +-- +-- > 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 + type Index seq + singleton :: Element seq -> seq + + fromList :: [Element seq] -> seq + fromList = mconcat . fmap singleton + + 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) + + 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 = Control.Monad.liftM fromList . filterM f . otoList + + intersperse :: Element seq -> seq -> seq + intersperse e = fromList . List.intersperse e . otoList + + break :: (Element seq -> Bool) -> seq -> (seq, seq) + break f = (fromList *** fromList) . List.break f . otoList + + span :: (Element seq -> Bool) -> seq -> (seq, seq) + span f = (fromList *** fromList) . List.span f . otoList + + dropWhile :: (Element seq -> Bool) -> seq -> seq + dropWhile f = fromList . List.dropWhile f . otoList + + takeWhile :: (Element seq -> Bool) -> seq -> seq + takeWhile f = fromList . List.takeWhile f . otoList + + splitAt :: Index seq -> seq -> (seq, seq) + splitAt i = (fromList *** fromList) . List.genericSplitAt i . otoList + + take :: Index seq -> seq -> seq + take i = fst . splitAt i + + 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 + + groupBy :: (Element seq -> Element seq -> Bool) -> seq -> [seq] + groupBy f = fmap fromList . List.groupBy f . otoList + + -- | Similar to standard 'groupBy', but operates on the whole collection, + -- not just the consecutive items. + groupAllOn :: Eq b => (Element seq -> b) -> seq -> [seq] + groupAllOn f = fmap fromList . groupAllOn f . otoList + + subsequences :: seq -> [seq] + subsequences = List.map fromList . List.subsequences . otoList + + permutations :: seq -> [seq] + permutations = List.map fromList . List.permutations . otoList + +instance IsSequence [a] where + type Index [a] = Int + singleton = return + 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 + takeWhile = List.takeWhile + 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) + groupBy = List.groupBy + groupAllOn f (head : tail) = + (head : matches) : groupAllOn f nonMatches + where + (matches, nonMatches) = partition ((== f head) . f) tail + groupAllOn _ [] = [] + +instance IsSequence S.ByteString where + type Index S.ByteString = Int + singleton = S.singleton + fromList = S.pack + replicate = S.replicate + filter = S.filter + intersperse = S.intersperse + break = S.break + span = S.span + dropWhile = S.dropWhile + takeWhile = S.takeWhile + splitAt = S.splitAt + take = S.take + drop = S.drop + reverse = S.reverse + find = S.find + partition = S.partition + cons = S.cons + uncons = S.uncons + groupBy = S.groupBy + -- sortBy + +instance IsSequence T.Text where + type Index T.Text = Int + singleton = T.singleton + 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 + takeWhile = T.takeWhile + splitAt = T.splitAt + take = T.take + drop = T.drop + reverse = T.reverse + find = T.find + partition = T.partition + cons = T.cons + uncons = T.uncons + groupBy = T.groupBy + -- sortBy + +instance IsSequence L.ByteString where + type Index L.ByteString = Int64 + singleton = L.singleton + fromList = L.pack + replicate = L.replicate + filter = L.filter + intersperse = L.intersperse + break = L.break + span = L.span + dropWhile = L.dropWhile + takeWhile = L.takeWhile + splitAt = L.splitAt + take = L.take + drop = L.drop + reverse = L.reverse + find = L.find + partition = L.partition + cons = L.cons + uncons = L.uncons + groupBy = L.groupBy + -- sortBy + +instance IsSequence TL.Text where + type Index TL.Text = Int64 + singleton = TL.singleton + 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 + takeWhile = TL.takeWhile + splitAt = TL.splitAt + take = TL.take + drop = TL.drop + reverse = TL.reverse + find = TL.find + partition = TL.partition + cons = TL.cons + uncons = TL.uncons + groupBy = TL.groupBy + -- sortBy + + +instance IsSequence (Seq.Seq a) where + type Index (Seq.Seq a) = Int + singleton = Seq.singleton + 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 + takeWhile = Seq.takeWhileL + 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) + --groupBy = Seq.groupBy + +instance IsSequence (V.Vector a) where + type Index (V.Vector a) = Int + singleton = V.singleton + 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 + takeWhile = V.takeWhile + 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) + --groupBy = V.groupBy + +instance U.Unbox a => IsSequence (U.Vector a) where + type Index (U.Vector a) = Int + singleton = U.singleton + 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 + takeWhile = U.takeWhile + 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) + --groupBy = U.groupBy + +instance VS.Storable a => IsSequence (VS.Vector a) where + type Index (VS.Vector a) = Int + singleton = VS.singleton + 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 + takeWhile = VS.takeWhile + 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) + --groupBy = U.groupBy + +class (IsSequence seq, Eq (Element seq)) => EqSequence seq where + stripPrefix :: seq -> seq -> Maybe seq + stripPrefix x y = fmap fromList (otoList x `stripPrefix` otoList y) + + isPrefixOf :: seq -> seq -> Bool + isPrefixOf x y = otoList x `isPrefixOf` otoList y + + stripSuffix :: seq -> seq -> Maybe seq + stripSuffix x y = fmap fromList (otoList x `stripSuffix` otoList y) + + isSuffixOf :: seq -> seq -> Bool + isSuffixOf x y = otoList x `isSuffixOf` otoList y + + isInfixOf :: seq -> seq -> Bool + isInfixOf x y = otoList x `isInfixOf` otoList y + + group :: seq -> [seq] + group = groupBy (==) + + -- | Similar to standard 'group', but operates on the whole collection, + -- not just the consecutive items. + groupAll :: seq -> [seq] + groupAll = groupAllOn id + + elem :: Element seq -> seq -> Bool + elem e = List.elem e . otoList + + notElem :: Element seq -> seq -> Bool + notElem e = List.notElem e . otoList + +instance Eq a => EqSequence [a] where + stripPrefix = List.stripPrefix + isPrefixOf = List.isPrefixOf + stripSuffix x y = fmap reverse (List.stripPrefix (reverse x) (reverse y)) + isSuffixOf x y = List.isPrefixOf (reverse x) (reverse y) + isInfixOf = List.isInfixOf + group = List.group + elem = List.elem + notElem = List.notElem + +instance EqSequence S.ByteString where + stripPrefix x y + | x `S.isPrefixOf` y = Just (S.drop (S.length x) y) + | otherwise = Nothing + isPrefixOf = S.isPrefixOf + stripSuffix x y + | x `S.isSuffixOf` y = Just (S.take (S.length y - S.length x) y) + | otherwise = Nothing + isSuffixOf = S.isSuffixOf + isInfixOf = S.isInfixOf + group = S.group + elem = S.elem + notElem = S.notElem + +instance EqSequence L.ByteString where + stripPrefix x y + | x `L.isPrefixOf` y = Just (L.drop (L.length x) y) + | otherwise = Nothing + isPrefixOf = L.isPrefixOf + stripSuffix x y + | x `L.isSuffixOf` y = Just (L.take (L.length y - L.length x) y) + | otherwise = Nothing + isSuffixOf = L.isSuffixOf + isInfixOf x y = L.unpack x `List.isInfixOf` L.unpack y + group = L.group + elem = L.elem + notElem = L.notElem + +instance EqSequence T.Text where + stripPrefix = T.stripPrefix + isPrefixOf = T.isPrefixOf + stripSuffix = T.stripSuffix + isSuffixOf = T.isSuffixOf + isInfixOf = T.isInfixOf + group = T.group + +instance EqSequence TL.Text where + stripPrefix = TL.stripPrefix + isPrefixOf = TL.isPrefixOf + stripSuffix = TL.stripSuffix + isSuffixOf = TL.isSuffixOf + isInfixOf = TL.isInfixOf + group = TL.group + +instance Eq a => EqSequence (Seq.Seq a) +instance Eq a => EqSequence (V.Vector a) +instance (Eq a, U.Unbox a) => EqSequence (U.Vector a) +instance (Eq a, VS.Storable a) => EqSequence (VS.Vector a) + +class (EqSequence seq, Ord (Element seq)) => OrdSequence seq where + sort :: seq -> seq + sort = fromList . List.sort . otoList + +instance Ord a => OrdSequence [a] where + sort = List.sort + +instance OrdSequence S.ByteString where + sort = S.sort + +instance OrdSequence L.ByteString +instance OrdSequence T.Text +instance OrdSequence TL.Text +instance Ord a => OrdSequence (Seq.Seq a) +instance Ord a => OrdSequence (V.Vector a) +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 + 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 + 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 + 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 + 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 new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} +module Spec where + +import Test.Hspec +import Test.Hspec.QuickCheck +import Data.MonoTraversable +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) + +main :: IO () +main = hspec $ do + describe "cnull" $ do + it "empty list" $ onull [] `shouldBe` True + it "non-empty list" $ onull [()] `shouldBe` False + it "empty text" $ onull ("" :: Text) `shouldBe` True + it "non-empty text" $ onull ("foo" :: Text) `shouldBe` False + describe "clength" $ do + prop "list" $ \i' -> + let x = replicate i () :: [()] + i = min 500 $ abs i' + in olength x == i + prop "text" $ \i' -> + let x = replicate i 'a' :: Text + i = min 500 $ abs i' + in olength x == i + prop "lazy bytestring" $ \i' -> + let x = replicate i 6 :: L.ByteString + i = min 500 $ abs i' + in olength64 x == i + describe "ccompareLength" $ do + prop "list" $ \i' j -> + let i = min 500 $ abs i' + x = replicate i () :: [()] + in ocompareLength x j == compare i j + describe "groupAll" $ do + it "list" $ groupAll ("abcabcabc" :: String) == ["aaa", "bbb", "ccc"] + 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]] diff --git a/test/main.hs b/test/main.hs new file mode 100644 --- /dev/null +++ b/test/main.hs @@ -0,0 +1,1 @@ +import Spec (main)