mono-traversable-1.0.1/0000755000000000000000000000000012766512504013167 5ustar0000000000000000mono-traversable-1.0.1/ChangeLog.md0000644000000000000000000000466512766512504015353 0ustar0000000000000000## 1.0.1 * Add `replaceElem` and `replaceSeq` [#107](https://github.com/snoyberg/mono-traversable/pull/107) ## 1.0.0.1 * Add missing export [#101](https://github.com/snoyberg/mono-traversable/pull/101) ## 1.0.0 * Implement the cleanups described in [#95](https://github.com/snoyberg/mono-traversable/issues/95) * Split out `Data.MinLen` to `minlen` package, and have `Data.NonNull` stand on its own * Remove `Data.ByteVector` * Split out extra typeclass instances to `mono-traversable-instances` * Remove the `Eq` and `Ord` specific classes, and instead use rewrite rules * Provide the `Data.MonoTraversable.Unprefixed` module * Generalize `unwords` and `unlines` [#87](https://github.com/snoyberg/mono-traversable/pull/87) * Add `tailMay` and `initMay` [#89](https://github.com/snoyberg/mono-traversable/issues/89) ## 0.10.2 * Add `delete` and `deleteBy` methods to EqSequence [#94](https://github.com/snoyberg/mono-traversable/pull/94) ## 0.10.1.1 * Remove unneeded INLINEs [#90](https://github.com/snoyberg/mono-traversable/issues/90) ## 0.10.1 * Allow comonad-5 [#86](https://github.com/snoyberg/mono-traversable/issues/86) ## 0.10.0.1 * Instance for Data.Sequence.Seq is incorrect. [#83](https://github.com/snoyberg/mono-traversable/issues/83) ## 0.10.0 * Remove `Functor` instance for `MinLen` [#82](https://github.com/snoyberg/mono-traversable/issues/82) ## 0.9.3 * Added `intercalate`, `splitWhen`, `splitElem`, and `splitSeq` [#80](https://github.com/snoyberg/mono-traversable/pull/80) ## 0.9.2.1 * Tweak test suite for 32-bit systems [#78](https://github.com/snoyberg/mono-traversable/issues/78) ## 0.9.2 * MonoComonad ## 0.9.1 * Fill in missing Mono\* instances [#72](https://github.com/snoyberg/mono-traversable/pull/72) ## 0.9.0.1 * Documentation improvements ## 0.9.0 * Better fixity for mlcons [#56](https://github.com/snoyberg/mono-traversable/issues/56) ## 0.8.0.1 README updates ## 0.8.0 A new MonoFoldableEq class that takes `elem` and `notElem` from `EqSequence`. `EqSequence` now inherits from `MonoFoldableEq`. For most users that do not define instances this should not be a breaking change. However, any instance of `EqSequence` now needs to definie `MonoFoldableEq`. ## 0.7.0 * Work on better polymorphic containers * Rename `mapKeysWith` to `omapKeysWith` * Add new class `BiPolyMap` * Add `keys` to `IsSet` * New class `HasKeysSet` * Added `index`, `indexEx` and `unsafeIndex`. * Added `sortOn` mono-traversable-1.0.1/LICENSE0000644000000000000000000000207712766512504014202 0ustar0000000000000000Copyright (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. mono-traversable-1.0.1/mono-traversable.cabal0000644000000000000000000000514512766512504017440 0ustar0000000000000000name: mono-traversable version: 1.0.1 synopsis: Type classes for mapping, folding, and traversing monomorphic containers description: Monomorphic variants of the Functor, Foldable, and Traversable typeclasses. If you understand Haskell's basic typeclasses, you understand mono-traversable. In addition to what you are used to, it adds on an IsSequence typeclass and has code for marking data structures as non-empty. 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 ChangeLog.md cabal-version: >=1.10 library ghc-options: -Wall exposed-modules: Data.MonoTraversable Data.MonoTraversable.Unprefixed Data.Containers Data.Sequences Data.NonNull build-depends: base >= 4.5 && < 5 , containers >= 0.4 , unordered-containers >=0.2 , hashable , bytestring >= 0.9 , text >=0.11 , transformers >=0.3 , vector >=0.10 , vector-algorithms >= 0.6 , split >= 0.2 if impl(ghc < 8.0) build-depends: semigroups >= 0.10 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 ghc-options: -O0 build-depends: base , mono-traversable , bytestring , text , hspec , HUnit , transformers , vector , QuickCheck , semigroups , containers , unordered-containers , foldl benchmark sorting type: exitcode-stdio-1.0 hs-source-dirs: bench build-depends: base , criterion , mono-traversable , vector , mwc-random main-is: sorting.hs ghc-options: -Wall -O2 default-language: Haskell2010 source-repository head type: git location: git://github.com/snoyberg/mono-traversable.git mono-traversable-1.0.1/README.md0000644000000000000000000003061412766512504014452 0ustar0000000000000000mono-traversable ================ Type classes for mapping, folding, and traversing monomorphic and polymorphic containers. Haskell is good at operating over polymorphic containers such as a list `[a]`. A monomorphic container is one such as Text which has a type `Text` that does not expose a type variable for the underlying characters. mono-traversable also adds * `IsSequence`, etc for operating over sequential data types * `IsSet`, `IsMap`, etc for unifying set and map APIs * `NonNull` for making partial functions (head, tail) total In addition to this package, the [mono-traversable-instances](https://www.stackage.org/package/mono-traversable-instances) pacakge provides a number of orphan instances. Using Typeclasses ----------------- There are 2 use cases for mono-traversable: application authors and library authors. ### Library authors As a library author, if you want to allow a user to pass in a `Text` or a `String`, then you need to expose an API with a mono-traversable typeclass. You should think twice about using mono-traversable though because * Using Typeclasses makes type inference more difficult. It is usually better to force the user to give a `Text`. Another option is to just have multiple APIs. * If you are operating on polymorphic structures in which the normal typeclasses suffice, you should just use them from base. On the other hand, even if you are using polymorphic containers you may want to leverage `IsSequence` or `MinLen`. ### Application authors As an application author, you should consider using classy-prelude, which leans heavily on mono-traversable. When writing your own function signatures, you should default to making them concrete: if you are actually using a list, then make your function take a list rather than an `IsSequence`. This will improve type inference, error messages, and make your code easier to understand. When you decide to use a `Vector` instead of a list, change the type signature to use a `Vector`. When you actually need a function to both accept a `Vector` and a list, it is easy to change the function signature to the more abstract typeclasses that you require. Standard Typeclasses -------------------- in the upcoming GHC 7.10, using `Functor`, `Foldable`, and `Traversable` will become common-place. This means that rather than using `List.map`, `Vector.map`, etc, the map from the prelude will work on all data types that are a Functor. Of course, you can already do this now using `fmap`. For a Haskeller, it is important to understand `Functor`, `Applicative`, `Monad`, `Foldable`, and `Monoid`: these are encountered in every day code. For mono-traversable, it is most important to understand [Foldable](https://www.haskell.org/haskellwiki/Typeclassopedia#Foldable). mono-traversable Typeclasses ---------------------------- ### MonoFunctor Same as Functor, but cannot change the type. ``` haskell type family Element mono type instance Element Text = Char type instance Element [a] = a ``` Element is a type family. This tells the compiler to substitute `Char` for `Element Text`. We can create this rule for every monomorphic container we want to operate on such as `Text` And we can also create it for a polymorphic container. Now lets compare MonoFunctor to the normal Functor. ``` haskell fmap :: Functor f => (a -> b) -> f a -> f b omap :: MonoFunctor mono => (Element mono -> Element mono) -> mono -> mono ``` So there is no type-change from `a` to `b`, the contained type must stay the same (`Element mono -> Element mono`). Here is the MonoFunctor typeclass definition ``` haskell 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 ``` And we can write some instances ``` haskell instance MonoFunctor T.Text where omap = T.map instance MonoFunctor [a] ``` The list definition was able to default to using `fmap` so no body was needed. ### MonoFoldable Same as Foldable, but also operates over monomorphic containers. MonoFoldable is the heart of the power of mono-traversable (and arguably the package should be named mono-foldable) because anything that can be done with `Foldable` can be done with `MonoFoldable`. The reason why is that a monomorphic container can never change its type. So `omap` is a restricted `fmap`. However, folding generates a *new* structure, so we have no such concerns. In the classy-prelude package, map is set to `fmap` and omap must be used separately. However, foldMap is set to just use the mono-traversable version: `ofoldMap` ``` haskell class Foldable t where foldMap :: Monoid m => (a -> m) -> t a -> m foldr :: (a -> b -> b) -> b -> t a -> b ... class MonoFoldable mono where ofoldMap :: Monoid m => (Element mono -> m) -> mono -> m ofoldr :: (Element mono -> b -> b) -> b -> mono -> b ... ``` There are additional Typeclasses which build on MonoFoldable ``` haskell class (MonoFoldable mono, Monoid mono) => MonoFoldableMonoid mono where oconcatMap :: (Element mono -> mono) -> mono -> mono class (MonoFoldable mono, Ord (Element mono)) => MonoFoldableOrd mono where maximumEx :: mono -> Element mono minimumEx :: mono -> Element mono class MonoPointed mono where opoint :: Element mono -> mono ``` MonoPointed abstracts over the concept of a singleton. For any `Applicative`, `opoint` is the same as `pure` from Applicative. Since mono-traversable did not bother with a `MonoApplicative` typeclass, we added `MonoPointed` to still have the functionality of `pure`. ### MonoTraversable `MonoTraversable` is `Traversable` for monomorphic containers, just as `MonoFunctor` is `Functor` for monomorphic containers. ``` haskell class (Functor t, Foldable t) => Traversable t where traverse :: Applicative f => (a -> f b) -> t a -> f (t b) ... class (MonoFunctor mono, MonoFoldable mono) => MonoTraversable mono where otraverse :: Applicative f => (Element mono -> f (Element mono)) -> mono -> f mono ... ``` ### Containers * SetContainer: unifies operations across `Set` and `Map` * PolyMap: differenceMap and intersectionMap * IsSet: unifies operations across different `Set`s * IsMap: unifies operations across different `Map`s * MonoZip: zip operations on MonoFunctors. Note that because `Set` and `Map` are not a Functor (and therefore not MonoFoldable), one must use `mapFromList`, `mapToList`, `setFromList`, and `setToList`. ### Sequences `IsSequence` contains list-like operations. ``` haskell -- | 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, MonoPointed seq) => IsSequence seq where fromList :: [Element seq] -> seq break :: (Element seq -> Bool) -> seq -> (seq, seq) ... ``` The laws state that an IsSequence is a list-like (sequential) structure. * an `IsSequence` is not just something that can be converted to a list (`MonoFoldable`), but something that can be created from a list. * Converting to and from a list does not change the `IsSequence`, and it doesn't even change the `IsSequence` if you do the conversions on chunks of the `IsSequence`. SemiSequence is required by IsSequence. It is conceptually the same as IsSequence, but contains operations that can also be used on a `NonEmpty` or a `MinLen` (which are SemiGroups) because they do not reduce the number of elements in the sequence. There are some more typeclasess that build on top of IsSequence. ``` haskell class (IsSequence seq, Eq (Element seq)) => EqSequence seq where class (EqSequence seq, MonoFoldableOrd seq) => OrdSequence seq where class (IsSequence t, IsString t, Element t ~ Char) => Textual t where words :: t -> [t] unwords :: [t] -> t lines :: t -> [t] unlines :: [t] -> t toLower :: t -> t toUpper :: t -> t ... ``` Textual functions are always safe to use with Unicode (it is possible to misuse other functions that operate on individual characters). ### MinLen Did you notice minimumEx and maximumEx from above? Ex stands for 'Exception'. An exception will occur if you call minimumEx on an empty list. MinLen is a tool to guarantee that this never occurs, and instead to prove that there are one or more elements in your list. ``` haskell minimumEx :: MonoFoldable mono => mono -> Element mono -- | like Data.List, but not partial on a MonoFoldable minimum :: MonoFoldableOrd mono => MinLen (Succ nat) mono -> Element mono minimum = minimumEx . unMinLen newtype MinLen nat mono = MinLen { unMinLen :: mono } deriving (Eq, Ord, Read, Show, Data, Typeable, Functor) -- Type level naturals data Zero = Zero data Succ nat = Succ nat ``` The `minimum` function exposed from `MinLen` is very similar to `minimumEx`, but has a `MinLen` wrapper that ensures it will never throw an exception. `MinLen` is a newtype with a phantom type that contains information about the minimum number of elements we know are in the structure. That is done through type-level Peano numbers. What do we know about the input to minimum? If nat is Zero, then it reduces to `MinLen (Succ Zero) mono`. Succ means successor, and the successor of 0 is 1, so the data structure has a minimum length of 1. Lets see this in practice ``` haskell > minimum [] :3:9: Couldn't match expected type ‘MinLen (Succ nat0) mono’ with actual type ‘[t0]’ > minimum [1,2,3] -- same error as above > minimum (toMinList (3 :| [2,1])) 1 > minimum (3 `mlcons` toMinLenZero [2,1]) 1 ``` Here we used Data.List.NonEmpty combined with toMinList or we just work with a List and prove through the usage of cons that it has more than one element. Adding instances ---------------- If you have a _polymorphic_ data type which is a member of one of the relevant typeclasses ([Functor](http://hackage.haskell.org/package/base/docs/Data-Functor.html), [Foldable](http://hackage.haskell.org/package/base/docs/Data-Foldable.html), [Traversable](http://hackage.haskell.org/package/base/docs/Data-Traversable.html)), it's quite easy to add an instance for [MonoFunctor](https://hackage.haskell.org/package/mono-traversable/docs/Data-MonoTraversable.html#t:MonoFunctor), [MonoFoldable](https://hackage.haskell.org/package/mono-traversable/docs/Data-MonoTraversable.html#t:MonoFoldable) or [MonoTraversable](https://hackage.haskell.org/package/mono-traversable/docs/Data-MonoTraversable.html#t:MonoTraversable). You just have to declare the proper type instance: ``` haskell {-# LANGUAGE TypeFamilies #-} type instance Element (CustomType a) = a ``` And then, we can use the default implementation to declare instances: ``` haskell instance MonoFunctor (CustomType a) instance MonoFoldable (CustomType a) instance MonoTraversable (CustomType a) ``` Now you are ready to use ```CustomType a``` with the functions defined in this package. **Note**: if your type is a _monomorphic_ container without the proper typeclasses, then you will have to provide an implementation rather than using the default. However, this should be fairly simple, as can be seen [in the code](https://github.com/snoyberg/mono-traversable/blob/d85e4ed3c11afec2d49c0f4fe2812122a279e5d4/src/Data/MonoTraversable.hs#L428) mono-traversable versus lens Traversal -------------------------------------- lens is a library with a lot of functionality covering a variety of patterns. One piece of functionality it exposes is `Fold` and `Traversal` which can also be used to deal with monomorphic containers. You could prefer mono-traversable to using this part of lens because * Familiar API - If you know `Foldable`, you can use `MonoFoldable` just as easily * mono-traversable's typeclass based approach means many methods are included in the class but can be given specialised optimized implementations * You don't explicitly pass around the `Traversal` The last point is also a point of inflexibility and points to a use case where you could prefer using a lens `Traversal`. mono-traversable treats `ByteString` as a sequence of bytes. If you want to treat it as both bytes and characters, mono-traversable would require a newtype wrapper around `ByteString`, whereas a lens `Traversal` would use a different traversal function. mono-traversable is only an alternative for `Fold` and `Traversal`, not for `Lens`, `Prism`, `Iso`, `Getter`, `Setter`, `Review`, or `Equality`. [![Build Status](https://secure.travis-ci.org/snoyberg/mono-traversable.png)](http://travis-ci.org/snoyberg/mono-traversable) mono-traversable-1.0.1/Setup.hs0000644000000000000000000000005612766512504014624 0ustar0000000000000000import Distribution.Simple main = defaultMain mono-traversable-1.0.1/bench/0000755000000000000000000000000012766512504014246 5ustar0000000000000000mono-traversable-1.0.1/bench/sorting.hs0000644000000000000000000000202412766512504016265 0ustar0000000000000000import Criterion.Main import Data.Sequences import Data.MonoTraversable import qualified Data.List import qualified System.Random.MWC as MWC import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U asVector :: V.Vector a -> V.Vector a asVector = id asUVector :: U.Vector a -> U.Vector a asUVector = id main :: IO () main = do mapM mkGroup [10, 100, 1000, 10000] >>= defaultMain mkGroup :: Int -> IO Benchmark mkGroup size = do gen <- MWC.create inputV <- MWC.uniformVector gen size let inputL = otoList (inputV :: V.Vector Int) inputVU = fromList inputL :: U.Vector Int return $ bgroup (show size) [ bench "Data.List.sort" $ nf Data.List.sort inputL , bench "list sort" $ nf sort inputL , bench "list sort, via vector" $ nf (otoList . sort . asVector . fromList) inputL , bench "list sort, via uvector" $ nf (otoList . sort . asUVector . fromList) inputL , bench "vector sort" $ nf sort inputV , bench "uvector sort" $ nf sort inputVU ] mono-traversable-1.0.1/src/0000755000000000000000000000000012766512504013756 5ustar0000000000000000mono-traversable-1.0.1/src/Data/0000755000000000000000000000000012766512504014627 5ustar0000000000000000mono-traversable-1.0.1/src/Data/Containers.hs0000644000000000000000000007221612766512504017300 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} -- | Warning: This module should be considered highly experimental. module Data.Containers where import Prelude hiding (lookup) import Data.Maybe (fromMaybe) #if MIN_VERSION_containers(0, 5, 0) import qualified Data.Map.Strict as Map import qualified Data.IntMap.Strict as IntMap #else import qualified Data.Map as Map import qualified Data.IntMap as IntMap #endif 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.Semigroup (Semigroup) import Data.MonoTraversable (MonoFunctor(..), MonoFoldable, MonoTraversable, Element, GrowingAppend, ofoldl', otoList) import Data.Function (on) import qualified Data.List as List import qualified Data.IntSet as IntSet 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 ((***)) import GHC.Exts (Constraint) -- | A container whose values are stored in Key-Value pairs. class (Data.Monoid.Monoid set, Semigroup set, MonoFoldable set, Eq (ContainerKey set), GrowingAppend set) => SetContainer set where -- | The type of the key type ContainerKey set -- | Check if there is a value with the supplied key -- in the container. member :: ContainerKey set -> set -> Bool -- | Check if there isn't a value with the supplied key -- in the container. notMember :: ContainerKey set -> set -> Bool -- | Get the union of two containers. union :: set -> set -> set -- | Combine a collection of @SetContainer@s, with left-most values overriding -- when there are matching keys. -- -- @since 1.0.0 unions :: (MonoFoldable mono, Element mono ~ set) => mono -> set unions = ofoldl' union Data.Monoid.mempty {-# INLINE unions #-} -- | Get the difference of two containers. difference :: set -> set -> set -- | Get the intersection of two containers. intersection :: set -> set -> set -- | Get a list of all of the keys in the container. keys :: set -> [ContainerKey set] #if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.Map.Strict". #endif instance Ord k => SetContainer (Map.Map k v) where type ContainerKey (Map.Map k v) = k member = Map.member {-# INLINE member #-} notMember = Map.notMember {-# INLINE notMember #-} union = Map.union {-# INLINE union #-} unions = Map.unions . otoList {-# INLINE unions #-} difference = Map.difference {-# INLINE difference #-} intersection = Map.intersection {-# INLINE intersection #-} keys = Map.keys {-# INLINE keys #-} #if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.HashMap.Strict". #endif instance (Eq key, Hashable key) => SetContainer (HashMap.HashMap key value) where type ContainerKey (HashMap.HashMap key value) = key member = HashMap.member {-# INLINE member #-} notMember k = not . HashMap.member k {-# INLINE notMember #-} union = HashMap.union {-# INLINE union #-} unions = HashMap.unions . otoList {-# INLINE unions #-} difference = HashMap.difference {-# INLINE difference #-} intersection = HashMap.intersection {-# INLINE intersection #-} keys = HashMap.keys {-# INLINE keys #-} #if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.IntMap.Strict". #endif instance SetContainer (IntMap.IntMap value) where type ContainerKey (IntMap.IntMap value) = Int member = IntMap.member {-# INLINE member #-} notMember = IntMap.notMember {-# INLINE notMember #-} union = IntMap.union {-# INLINE union #-} unions = IntMap.unions . otoList {-# INLINE unions #-} difference = IntMap.difference {-# INLINE difference #-} intersection = IntMap.intersection {-# INLINE intersection #-} keys = IntMap.keys {-# INLINE keys #-} instance Ord element => SetContainer (Set.Set element) where type ContainerKey (Set.Set element) = element member = Set.member {-# INLINE member #-} notMember = Set.notMember {-# INLINE notMember #-} union = Set.union {-# INLINE union #-} unions = Set.unions . otoList {-# INLINE unions #-} difference = Set.difference {-# INLINE difference #-} intersection = Set.intersection {-# INLINE intersection #-} keys = Set.toList {-# INLINE keys #-} instance (Eq element, Hashable element) => SetContainer (HashSet.HashSet element) where type ContainerKey (HashSet.HashSet element) = element member = HashSet.member {-# INLINE member #-} notMember e = not . HashSet.member e {-# INLINE notMember #-} union = HashSet.union {-# INLINE union #-} difference = HashSet.difference {-# INLINE difference #-} intersection = HashSet.intersection {-# INLINE intersection #-} keys = HashSet.toList {-# INLINE keys #-} instance SetContainer IntSet.IntSet where type ContainerKey IntSet.IntSet = Int member = IntSet.member {-# INLINE member #-} notMember = IntSet.notMember {-# INLINE notMember #-} union = IntSet.union {-# INLINE union #-} difference = IntSet.difference {-# INLINE difference #-} intersection = IntSet.intersection {-# INLINE intersection #-} keys = IntSet.toList {-# INLINE keys #-} instance Eq key => SetContainer [(key, value)] where type ContainerKey [(key, value)] = key member k = List.any ((== k) . fst) {-# INLINE member #-} notMember k = not . member k {-# INLINE notMember #-} union = List.unionBy ((==) `on` fst) {-# INLINE union #-} x `difference` y = loop x where loop [] = [] loop ((k, v):rest) = case lookup k y of Nothing -> (k, v) : loop rest Just _ -> loop rest intersection = List.intersectBy ((==) `on` fst) {-# INLINE intersection #-} keys = map fst {-# INLINE keys #-} -- | A guaranteed-polymorphic @Map@, which allows for more polymorphic versions -- of functions. class PolyMap map where -- | Get the difference between two maps, using the left map's values. differenceMap :: map value1 -> map value2 -> map value1 {- differenceWithMap :: (value1 -> value2 -> Maybe value1) -> map value1 -> map value2 -> map value1 -} -- | Get the intersection of two maps, using the left map's values. intersectionMap :: map value1 -> map value2 -> map value1 -- | Get the intersection of two maps with a supplied function -- that takes in the left map's value and the right map's value. intersectionWithMap :: (value1 -> value2 -> value3) -> map value1 -> map value2 -> map value3 #if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.Map.Strict". #endif instance Ord key => PolyMap (Map.Map key) where differenceMap = Map.difference {-# INLINE differenceMap #-} --differenceWithMap = Map.differenceWith intersectionMap = Map.intersection {-# INLINE intersectionMap #-} intersectionWithMap = Map.intersectionWith {-# INLINE intersectionWithMap #-} #if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.HashMap.Strict". #endif instance (Eq key, Hashable key) => PolyMap (HashMap.HashMap key) where differenceMap = HashMap.difference {-# INLINE differenceMap #-} --differenceWithMap = HashMap.differenceWith intersectionMap = HashMap.intersection {-# INLINE intersectionMap #-} intersectionWithMap = HashMap.intersectionWith {-# INLINE intersectionWithMap #-} #if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.IntMap.Strict". #endif instance PolyMap IntMap.IntMap where differenceMap = IntMap.difference {-# INLINE differenceMap #-} --differenceWithMap = IntMap.differenceWith intersectionMap = IntMap.intersection {-# INLINE intersectionMap #-} intersectionWithMap = IntMap.intersectionWith {-# INLINE intersectionWithMap #-} -- | A @Map@ type polymorphic in both its key and value. class BiPolyMap map where type BPMKeyConstraint map key :: Constraint mapKeysWith :: (BPMKeyConstraint map k1, BPMKeyConstraint map k2) => (v -> v -> v) -- ^ combine values that now overlap -> (k1 -> k2) -> map k1 v -> map k2 v instance BiPolyMap Map.Map where type BPMKeyConstraint Map.Map key = Ord key mapKeysWith = Map.mapKeysWith {-# INLINE mapKeysWith #-} instance BiPolyMap HashMap.HashMap where type BPMKeyConstraint HashMap.HashMap key = (Hashable key, Eq key) mapKeysWith g f = mapFromList . unionsWith g . map go . mapToList where go (k, v) = [(f k, v)] {-# INLINE mapKeysWith #-} -- | Polymorphic typeclass for interacting with different map types class (MonoTraversable map, SetContainer map) => IsMap map where -- | In some cases, 'MapValue' and 'Element' will be different, e.g., the -- 'IsMap' instance of associated lists. type MapValue map -- | Look up a value in a map with a specified key. lookup :: ContainerKey map -> map -> Maybe (MapValue map) -- | Insert a key-value pair into a map. insertMap :: ContainerKey map -> MapValue map -> map -> map -- | Delete a key-value pair of a map using a specified key. deleteMap :: ContainerKey map -> map -> map -- | Create a map from a single key-value pair. singletonMap :: ContainerKey map -> MapValue map -> map -- | Convert a list of key-value pairs to a map mapFromList :: [(ContainerKey map, MapValue map)] -> map -- | Convert a map to a list of key-value pairs. mapToList :: map -> [(ContainerKey map, MapValue map)] -- | Like 'lookup', but uses a default value when the key does -- not exist in the map. findWithDefault :: MapValue map -> ContainerKey map -> map -> MapValue map findWithDefault def key = fromMaybe def . lookup key -- | Insert a key-value pair into a map. -- -- Inserts the value directly if the key does not exist in the map. Otherwise, -- apply a supplied function that accepts the new value and the previous value -- and insert that result into the map. insertWith :: (MapValue map -> MapValue map -> MapValue map) -- ^ function that accepts the new value and the -- previous value and returns the value that will be -- set in the map. -> ContainerKey map -- ^ key -> MapValue map -- ^ new value to insert -> map -- ^ input map -> map -- ^ resulting map insertWith f k v m = v' `seq` insertMap k v' m where v' = case lookup k m of Nothing -> v Just vold -> f v vold -- | Insert a key-value pair into a map. -- -- Inserts the value directly if the key does not exist in the map. Otherwise, -- apply a supplied function that accepts the key, the new value, and the -- previous value and insert that result into the map. insertWithKey :: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map) -- ^ function that accepts the key, the new value, and the -- previous value and returns the value that will be -- set in the map. -> ContainerKey map -- ^ key -> MapValue map -- ^ new value to insert -> map -- ^ input map -> map -- ^ resulting map insertWithKey f k v m = v' `seq` insertMap k v' m where v' = case lookup k m of Nothing -> v Just vold -> f k v vold -- | Insert a key-value pair into a map, return the previous key's value -- if it existed. -- -- Inserts the value directly if the key does not exist in the map. Otherwise, -- apply a supplied function that accepts the key, the new value, and the -- previous value and insert that result into the map. insertLookupWithKey :: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map) -- ^ function that accepts the key, the new value, and the -- previous value and returns the value that will be -- set in the map. -> ContainerKey map -- ^ key -> MapValue map -- ^ new value to insert -> map -- ^ input map -> (Maybe (MapValue map), map) -- ^ previous value and the resulting map insertLookupWithKey f k v m = v' `seq` (mold, insertMap k v' m) where (mold, v') = case lookup k m of Nothing -> (Nothing, v) Just vold -> (Just vold, f k v vold) -- | Apply a function to the value of a given key. -- -- Returns the input map when the key-value pair does not exist. adjustMap :: (MapValue map -> MapValue map) -- ^ function to apply to the previous value -> ContainerKey map -- ^ key -> map -- ^ input map -> map -- ^ resulting map adjustMap f k m = case lookup k m of Nothing -> m Just v -> let v' = f v in v' `seq` insertMap k v' m -- | Equivalent to 'adjustMap', but the function accepts the key, -- as well as the previous value. adjustWithKey :: (ContainerKey map -> MapValue map -> MapValue map) -- ^ function that accepts the key and the previous value -- and returns the new value -> ContainerKey map -- ^ key -> map -- ^ input map -> map -- ^ resulting map adjustWithKey f k m = case lookup k m of Nothing -> m Just v -> let v' = f k v in v' `seq` insertMap k v' m -- | Apply a function to the value of a given key. -- -- If the function returns 'Nothing', this deletes the key-value pair. -- -- Returns the input map when the key-value pair does not exist. updateMap :: (MapValue map -> Maybe (MapValue map)) -- ^ function that accepts the previous value -- and returns the new value or 'Nothing' -> ContainerKey map -- ^ key -> map -- ^ input map -> map -- ^ resulting map updateMap f k m = case lookup k m of Nothing -> m Just v -> case f v of Nothing -> deleteMap k m Just v' -> v' `seq` insertMap k v' m -- | Equivalent to 'updateMap', but the function accepts the key, -- as well as the previous value. updateWithKey :: (ContainerKey map -> MapValue map -> Maybe (MapValue map)) -- ^ function that accepts the key and the previous value -- and returns the new value or 'Nothing' -> ContainerKey map -- ^ key -> map -- ^ input map -> map -- ^ resulting map updateWithKey f k m = case lookup k m of Nothing -> m Just v -> case f k v of Nothing -> deleteMap k m Just v' -> v' `seq` insertMap k v' m -- | Apply a function to the value of a given key. -- -- If the map does not contain the key this returns 'Nothing' -- and the input map. -- -- If the map does contain the key but the function returns 'Nothing', -- this returns the previous value and the map with the key-value pair removed. -- -- If the map contains the key and the function returns a value, -- this returns the new value and the map with the key-value pair with the new value. updateLookupWithKey :: (ContainerKey map -> MapValue map -> Maybe (MapValue map)) -- ^ function that accepts the key and the previous value -- and returns the new value or 'Nothing' -> ContainerKey map -- ^ key -> map -- ^ input map -> (Maybe (MapValue map), map) -- ^ previous/new value and the resulting map updateLookupWithKey f k m = case lookup k m of Nothing -> (Nothing, m) Just v -> case f k v of Nothing -> (Just v, deleteMap k m) Just v' -> v' `seq` (Just v', insertMap k v' m) -- | Update/Delete the value of a given key. -- -- Applies a function to previous value of a given key, if it results in 'Nothing' -- delete the key-value pair from the map, otherwise replace the previous value -- with the new value. alterMap :: (Maybe (MapValue map) -> Maybe (MapValue map)) -- ^ function that accepts the previous value and -- returns the new value or 'Nothing' -> ContainerKey map -- ^ key -> map -- ^ input map -> map -- ^ resulting map alterMap f k m = case f mold of Nothing -> case mold of Nothing -> m Just _ -> deleteMap k m Just v -> insertMap k v m where mold = lookup k m -- | Combine two maps. -- -- When a key exists in both maps, apply a function -- to both of the values and use the result of that as the value -- of the key in the resulting map. unionWith :: (MapValue map -> MapValue map -> MapValue map) -- ^ function that accepts the first map's value and the second map's value -- and returns the new value that will be used -> map -- ^ first map -> map -- ^ second map -> map -- ^ resulting map unionWith f x y = mapFromList $ loop $ mapToList x ++ mapToList y where loop [] = [] loop ((k, v):rest) = case List.lookup k rest of Nothing -> (k, v) : loop rest Just v' -> (k, f v v') : loop (deleteMap k rest) -- Equivalent to 'unionWith', but the function accepts the key, -- as well as both of the map's values. unionWithKey :: (ContainerKey map -> MapValue map -> MapValue map -> MapValue map) -- ^ function that accepts the key, the first map's value and the -- second map's value and returns the new value that will be used -> map -- ^ first map -> map -- ^ second map -> map -- ^ resulting map unionWithKey f x y = mapFromList $ loop $ mapToList x ++ mapToList y where loop [] = [] loop ((k, v):rest) = case List.lookup k rest of Nothing -> (k, v) : loop rest Just v' -> (k, f k v v') : loop (deleteMap k rest) -- | Combine a list of maps. -- -- When a key exists in two different maps, apply a function -- to both of the values and use the result of that as the value -- of the key in the resulting map. unionsWith :: (MapValue map -> MapValue map -> MapValue map) -- ^ function that accepts the first map's value and the second map's value -- and returns the new value that will be used -> [map] -- ^ input list of maps -> map -- ^ resulting map unionsWith _ [] = mempty unionsWith _ [x] = x unionsWith f (x:y:z) = unionsWith f (unionWith f x y:z) -- | Apply a function over every key-value pair of a map. mapWithKey :: (ContainerKey map -> MapValue map -> MapValue map) -- ^ function that accepts the key and the previous value -- and returns the new value -> map -- ^ input map -> map -- ^ resulting map mapWithKey f = mapFromList . map go . mapToList where go (k, v) = (k, f k v) -- | Apply a function over every key of a pair and run -- 'unionsWith' over the results. omapKeysWith :: (MapValue map -> MapValue map -> MapValue map) -- ^ function that accepts the first map's value and the second map's value -- and returns the new value that will be used -> (ContainerKey map -> ContainerKey map) -- ^ function that accepts the previous key and -- returns the new key -> map -- ^ input map -> map -- ^ resulting map omapKeysWith g f = mapFromList . unionsWith g . map go . mapToList where go (k, v) = [(f k, v)] #if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.Map.Strict". #endif instance Ord key => IsMap (Map.Map key value) where type MapValue (Map.Map key value) = value lookup = Map.lookup {-# INLINE lookup #-} insertMap = Map.insert {-# INLINE insertMap #-} deleteMap = Map.delete {-# INLINE deleteMap #-} singletonMap = Map.singleton {-# INLINE singletonMap #-} mapFromList = Map.fromList {-# INLINE mapFromList #-} mapToList = Map.toList {-# INLINE mapToList #-} findWithDefault = Map.findWithDefault {-# INLINE findWithDefault #-} insertWith = Map.insertWith {-# INLINE insertWith #-} insertWithKey = Map.insertWithKey {-# INLINE insertWithKey #-} insertLookupWithKey = Map.insertLookupWithKey {-# INLINE insertLookupWithKey #-} adjustMap = Map.adjust {-# INLINE adjustMap #-} adjustWithKey = Map.adjustWithKey {-# INLINE adjustWithKey #-} updateMap = Map.update {-# INLINE updateMap #-} updateWithKey = Map.updateWithKey {-# INLINE updateWithKey #-} updateLookupWithKey = Map.updateLookupWithKey {-# INLINE updateLookupWithKey #-} alterMap = Map.alter {-# INLINE alterMap #-} unionWith = Map.unionWith {-# INLINE unionWith #-} unionWithKey = Map.unionWithKey {-# INLINE unionWithKey #-} unionsWith = Map.unionsWith {-# INLINE unionsWith #-} mapWithKey = Map.mapWithKey {-# INLINE mapWithKey #-} omapKeysWith = Map.mapKeysWith {-# INLINE omapKeysWith #-} #if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.HashMap.Strict". #endif instance (Eq key, Hashable key) => IsMap (HashMap.HashMap key value) where type MapValue (HashMap.HashMap key value) = value lookup = HashMap.lookup {-# INLINE lookup #-} insertMap = HashMap.insert {-# INLINE insertMap #-} deleteMap = HashMap.delete {-# INLINE deleteMap #-} singletonMap = HashMap.singleton {-# INLINE singletonMap #-} mapFromList = HashMap.fromList {-# INLINE mapFromList #-} mapToList = HashMap.toList {-# INLINE mapToList #-} --findWithDefault = HashMap.findWithDefault insertWith = HashMap.insertWith {-# INLINE insertWith #-} --insertWithKey = HashMap.insertWithKey --insertLookupWithKey = HashMap.insertLookupWithKey adjustMap = HashMap.adjust {-# INLINE adjustMap #-} --adjustWithKey = HashMap.adjustWithKey --updateMap = HashMap.update --updateWithKey = HashMap.updateWithKey --updateLookupWithKey = HashMap.updateLookupWithKey --alterMap = HashMap.alter unionWith = HashMap.unionWith {-# INLINE unionWith #-} --unionWithKey = HashMap.unionWithKey --unionsWith = HashMap.unionsWith --mapWithKey = HashMap.mapWithKey --mapKeysWith = HashMap.mapKeysWith #if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.IntMap.Strict". #endif instance IsMap (IntMap.IntMap value) where type MapValue (IntMap.IntMap value) = value lookup = IntMap.lookup {-# INLINE lookup #-} insertMap = IntMap.insert {-# INLINE insertMap #-} deleteMap = IntMap.delete {-# INLINE deleteMap #-} singletonMap = IntMap.singleton {-# INLINE singletonMap #-} mapFromList = IntMap.fromList {-# INLINE mapFromList #-} mapToList = IntMap.toList {-# INLINE mapToList #-} findWithDefault = IntMap.findWithDefault {-# INLINE findWithDefault #-} insertWith = IntMap.insertWith {-# INLINE insertWith #-} insertWithKey = IntMap.insertWithKey {-# INLINE insertWithKey #-} insertLookupWithKey = IntMap.insertLookupWithKey {-# INLINE insertLookupWithKey #-} adjustMap = IntMap.adjust {-# INLINE adjustMap #-} adjustWithKey = IntMap.adjustWithKey {-# INLINE adjustWithKey #-} updateMap = IntMap.update {-# INLINE updateMap #-} updateWithKey = IntMap.updateWithKey {-# INLINE updateWithKey #-} --updateLookupWithKey = IntMap.updateLookupWithKey alterMap = IntMap.alter {-# INLINE alterMap #-} unionWith = IntMap.unionWith {-# INLINE unionWith #-} unionWithKey = IntMap.unionWithKey {-# INLINE unionWithKey #-} unionsWith = IntMap.unionsWith {-# INLINE unionsWith #-} mapWithKey = IntMap.mapWithKey {-# INLINE mapWithKey #-} #if MIN_VERSION_containers(0, 5, 0) omapKeysWith = IntMap.mapKeysWith {-# INLINE omapKeysWith #-} #endif instance Eq key => IsMap [(key, value)] where type MapValue [(key, value)] = value lookup = List.lookup {-# INLINE lookup #-} insertMap k v = ((k, v):) . deleteMap k {-# INLINE insertMap #-} deleteMap k = List.filter ((/= k) . fst) {-# INLINE deleteMap #-} singletonMap k v = [(k, v)] {-# INLINE singletonMap #-} mapFromList = id {-# INLINE mapFromList #-} mapToList = id {-# INLINE mapToList #-} -- | Polymorphic typeclass for interacting with different set types class (SetContainer set, Element set ~ ContainerKey set) => IsSet set where -- | Insert a value into a set. insertSet :: Element set -> set -> set -- | Delete a value from a set. deleteSet :: Element set -> set -> set -- | Create a set from a single element. singletonSet :: Element set -> set -- | Convert a list to a set. setFromList :: [Element set] -> set -- | Convert a set to a list. setToList :: set -> [Element set] instance Ord element => IsSet (Set.Set element) where insertSet = Set.insert {-# INLINE insertSet #-} deleteSet = Set.delete {-# INLINE deleteSet #-} singletonSet = Set.singleton {-# INLINE singletonSet #-} setFromList = Set.fromList {-# INLINE setFromList #-} setToList = Set.toList {-# INLINE setToList #-} instance (Eq element, Hashable element) => IsSet (HashSet.HashSet element) where insertSet = HashSet.insert {-# INLINE insertSet #-} deleteSet = HashSet.delete {-# INLINE deleteSet #-} singletonSet = HashSet.singleton {-# INLINE singletonSet #-} setFromList = HashSet.fromList {-# INLINE setFromList #-} setToList = HashSet.toList {-# INLINE setToList #-} instance IsSet IntSet.IntSet where insertSet = IntSet.insert {-# INLINE insertSet #-} deleteSet = IntSet.delete {-# INLINE deleteSet #-} singletonSet = IntSet.singleton {-# INLINE singletonSet #-} setFromList = IntSet.fromList {-# INLINE setFromList #-} setToList = IntSet.toList {-# INLINE setToList #-} -- | Zip operations on 'MonoFunctor's. class MonoFunctor mono => MonoZip mono where -- | Combine each element of two 'MonoZip's using a supplied function. ozipWith :: (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono -- | Take two 'MonoZip's and return a list of the pairs of their elements. ozip :: mono -> mono -> [(Element mono, Element mono)] -- | Take a list of pairs of elements and return a 'MonoZip' of the first -- components and a 'MonoZip' of the second components. 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 {-# INLINE ozip #-} {-# INLINE ounzip #-} {-# INLINE ozipWith #-} instance MonoZip LByteString.ByteString where ozip = LByteString.zip ounzip = LByteString.unzip ozipWith f xs = LByteString.pack . LByteString.zipWith f xs {-# INLINE ozip #-} {-# INLINE ounzip #-} {-# INLINE ozipWith #-} instance MonoZip Text.Text where ozip = Text.zip ounzip = (Text.pack *** Text.pack) . List.unzip ozipWith = Text.zipWith {-# INLINE ozip #-} {-# INLINE ounzip #-} {-# INLINE ozipWith #-} instance MonoZip LText.Text where ozip = LText.zip ounzip = (LText.pack *** LText.pack) . List.unzip ozipWith = LText.zipWith {-# INLINE ozip #-} {-# INLINE ounzip #-} {-# INLINE ozipWith #-} -- | Type class for maps whose keys can be converted into sets. class SetContainer set => HasKeysSet set where -- | Type of the key set. type KeySet set -- | Convert a map into a set of its keys. keysSet :: set -> KeySet set instance Ord k => HasKeysSet (Map.Map k v) where type KeySet (Map.Map k v) = Set.Set k keysSet = Map.keysSet instance HasKeysSet (IntMap.IntMap v) where type KeySet (IntMap.IntMap v) = IntSet.IntSet keysSet = IntMap.keysSet instance (Hashable k, Eq k) => HasKeysSet (HashMap.HashMap k v) where type KeySet (HashMap.HashMap k v) = HashSet.HashSet k keysSet = setFromList . HashMap.keys mono-traversable-1.0.1/src/Data/MonoTraversable.hs0000644000000000000000000013017412766512504020274 0ustar0000000000000000{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE CPP #-} {-# 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 #if MIN_VERSION_base(4,8,0) import Control.Monad (Monad (..)) #else import Control.Monad (Monad (..), liftM) #endif import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Foldable as F import Data.Functor import Data.Maybe (fromMaybe) import Data.Monoid (Monoid (..), Any (..), All (..)) 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 (..), (+), Integral, Ordering (..), compare, fromIntegral, Num, (>=), (==), seq, otherwise, Eq, Ord, (-), (*)) import qualified Prelude import qualified Data.ByteString.Internal as Unsafe import qualified Foreign.ForeignPtr.Unsafe as Unsafe import Foreign.Ptr (plusPtr) import Foreign.ForeignPtr (touchForeignPtr) import Foreign.Storable (peek) import Control.Arrow (Arrow) import Data.Tree (Tree (..)) import Data.Sequence (Seq, ViewL (..), ViewR (..)) import qualified Data.Sequence as Seq import Data.IntMap (IntMap) import Data.IntSet (IntSet) import qualified Data.List as List 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.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.Cont (ContT) import Data.Functor.Compose (Compose) import Data.Functor.Product (Product) import Data.Set (Set) import qualified Data.Set as Set import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.Hashable (Hashable) import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Storable as VS import qualified Data.IntSet as IntSet import Data.Semigroup (Semigroup, Option (..), Arg) import qualified Data.ByteString.Unsafe as SU import Control.Monad.Trans.Identity (IdentityT) -- | Type family for getting the type of the elements -- of a monomorphic container. type family Element mono 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 (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 (ContT r m a) = a type instance Element (Compose f g a) = a type instance Element (Product f g a) = a type instance Element (U.Vector a) = a type instance Element (VS.Vector a) = a type instance Element (Arg a b) = b -- | Monomorphic containers that can be mapped over. class MonoFunctor mono where -- | Map over a monomorphic container 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 {-# INLINE omap #-} instance MonoFunctor S.ByteString where omap = S.map {-# INLINE omap #-} instance MonoFunctor L.ByteString where omap = L.map {-# INLINE omap #-} instance MonoFunctor T.Text where omap = T.map {-# INLINE omap #-} instance MonoFunctor TL.Text where omap = TL.map {-# INLINE omap #-} 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 MonoFunctor (Arg a b) instance Arrow a => MonoFunctor (WrappedArrow a b c) 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 (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 U.Unbox a => MonoFunctor (U.Vector a) where omap = U.map {-# INLINE omap #-} instance VS.Storable a => MonoFunctor (VS.Vector a) where omap = VS.map {-# INLINE omap #-} -- | @'replaceElem' old new@ replaces all @old@ elements with @new@. -- -- @since 1.0.1 replaceElem :: (MonoFunctor mono, Eq (Element mono)) => Element mono -> Element mono -> mono -> mono replaceElem old new = omap (\x -> if x == old then new else x) {-# INLINE [0] replaceElem #-} {-# RULES "strict Text replaceElem" replaceElem = replaceElemStrictText #-} replaceElemStrictText :: Char -> Char -> T.Text -> T.Text replaceElemStrictText old new = T.replace (T.singleton old) (T.singleton new) {-# RULES "lazy Text replaceElem" replaceElem = replaceElemLazyText #-} replaceElemLazyText :: Char -> Char -> TL.Text -> TL.Text replaceElemLazyText old new = TL.replace (TL.singleton old) (TL.singleton new) -- | Monomorphic containers that can be folded. class MonoFoldable mono where -- | Map each element of a monomorphic container to a 'Monoid' -- and combine the results. 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 {-# INLINE ofoldMap #-} -- | Right-associative fold of a monomorphic container. 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 {-# INLINE ofoldr #-} -- | Strict left-associative fold of a monomorphic container. 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' {-# INLINE ofoldl' #-} -- | Convert a monomorphic container to a list. otoList :: mono -> [Element mono] otoList t = build (\ mono n -> ofoldr mono n t) {-# INLINE otoList #-} -- | Are __all__ of the elements in a monomorphic container -- converted to booleans 'True'? oall :: (Element mono -> Bool) -> mono -> Bool oall f = getAll . ofoldMap (All . f) {-# INLINE oall #-} -- | Are __any__ of the elements in a monomorphic container -- converted to booleans 'True'? oany :: (Element mono -> Bool) -> mono -> Bool oany f = getAny . ofoldMap (Any . f) {-# INLINE oany #-} -- | Is the monomorphic container empty? onull :: mono -> Bool onull = oall (const False) {-# INLINE onull #-} -- | Length of a monomorphic container, returns a 'Int'. olength :: mono -> Int olength = ofoldl' (\i _ -> i + 1) 0 {-# INLINE olength #-} -- | Length of a monomorphic container, returns a 'Int64'. olength64 :: mono -> Int64 olength64 = ofoldl' (\i _ -> i + 1) 0 {-# INLINE olength64 #-} -- | Compare the length of a monomorphic container and a given number. ocompareLength :: Integral i => mono -> i -> Ordering -- Basic implementation using length for most instance. See the list -- instance below for support for infinite structures. Arguably, that -- should be the default instead of this. ocompareLength c0 i0 = olength c0 `compare` fromIntegral i0 {-# INLINE ocompareLength #-} -- | Map each element of a monomorphic container to an action, -- evaluate these actions from left to right, and ignore the results. otraverse_ :: Applicative f => (Element mono -> f b) -> mono -> f () otraverse_ f = ofoldr ((*>) . f) (pure ()) {-# INLINE otraverse_ #-} -- | 'ofor_' is 'otraverse_' with its arguments flipped. ofor_ :: Applicative f => mono -> (Element mono -> f b) -> f () ofor_ = flip otraverse_ {-# INLINE ofor_ #-} -- | Map each element of a monomorphic container to a monadic action, -- evaluate these actions from left to right, and ignore the results. #if MIN_VERSION_base(4,8,0) omapM_ :: Applicative m => (Element mono -> m ()) -> mono -> m () omapM_ = otraverse_ #else omapM_ :: Monad m => (Element mono -> m ()) -> mono -> m () omapM_ f = ofoldr ((>>) . f) (return ()) #endif {-# INLINE omapM_ #-} -- | 'oforM_' is 'omapM_' with its arguments flipped. #if MIN_VERSION_base(4,8,0) oforM_ :: Applicative m => mono -> (Element mono -> m ()) -> m () oforM_ = flip omapM_ #else oforM_ :: Monad m => mono -> (Element mono -> m ()) -> m () oforM_ = flip omapM_ #endif {-# INLINE oforM_ #-} -- | Monadic fold over the elements of a monomorphic container, associating to the left. ofoldlM :: 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 {-# INLINE ofoldlM #-} -- | Map each element of a monomorphic container to a semigroup, -- and combine the results. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- -- /See 'Data.NonNull.ofoldMap1' from "Data.NonNull" for a total version of this function./ ofoldMap1Ex :: Semigroup m => (Element mono -> m) -> mono -> m ofoldMap1Ex f = fromMaybe (Prelude.error "Data.MonoTraversable.ofoldMap1Ex") . getOption . ofoldMap (Option . Just . f) -- | Right-associative fold of a monomorphic container with no base element. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- -- /See 'Data.NonNull.ofoldr1Ex' from "Data.NonNull" for a total version of this function./ ofoldr1Ex :: (Element mono -> Element mono -> Element mono) -> mono -> Element mono default ofoldr1Ex :: (t a ~ mono, a ~ Element (t a), F.Foldable t) => (a -> a -> a) -> mono -> a ofoldr1Ex = F.foldr1 {-# INLINE ofoldr1Ex #-} -- | Strict left-associative fold of a monomorphic container with no base -- element. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- -- /See 'Data.NonNull.ofoldl1Ex'' from "Data.NonNull" for a total version of this function./ ofoldl1Ex' :: (Element mono -> Element mono -> Element mono) -> mono -> Element mono default ofoldl1Ex' :: (t a ~ mono, a ~ Element (t a), F.Foldable t) => (a -> a -> a) -> mono -> a ofoldl1Ex' = F.foldl1 {-# INLINE ofoldl1Ex' #-} -- | Get the first element of a monomorphic container. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- -- /See 'Data.NonNull.head' from "Data.NonNull" for a total version of this function./ headEx :: mono -> Element mono headEx = ofoldr const (Prelude.error "Data.MonoTraversable.headEx: empty") {-# INLINE headEx #-} -- | Get the last element of a monomorphic container. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- -- /See 'Data.NonNull.last from "Data.NonNull" for a total version of this function./ lastEx :: mono -> Element mono lastEx = ofoldl1Ex' (flip const) {-# INLINE lastEx #-} -- | Equivalent to 'headEx'. unsafeHead :: mono -> Element mono unsafeHead = headEx {-# INLINE unsafeHead #-} -- | Equivalent to 'lastEx'. unsafeLast :: mono -> Element mono unsafeLast = lastEx {-# INLINE unsafeLast #-} -- | Get the maximum element of a monomorphic container, -- using a supplied element ordering function. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- -- /See 'Data.NonNull.maximiumBy' from "Data.NonNull" for a total version of this function./ maximumByEx :: (Element mono -> Element mono -> Ordering) -> mono -> Element mono maximumByEx f = ofoldl1Ex' go where go x y = case f x y of LT -> y _ -> x {-# INLINE maximumByEx #-} -- | Get the minimum element of a monomorphic container, -- using a supplied element ordering function. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- -- /See 'Data.NonNull.minimumBy' from "Data.NonNull" for a total version of this function./ minimumByEx :: (Element mono -> Element mono -> Ordering) -> mono -> Element mono minimumByEx f = ofoldl1Ex' go where go x y = case f x y of GT -> y _ -> x {-# INLINE minimumByEx #-} 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 omapM_ f (Unsafe.PS fptr offset len) = do let start = Unsafe.unsafeForeignPtrToPtr fptr `plusPtr` offset end = start `plusPtr` len loop ptr | ptr >= end = evil (touchForeignPtr fptr) `seq` #if MIN_VERSION_base(4,8,0) pure () #else return () #endif | otherwise = #if MIN_VERSION_base(4,8,0) f (evil (peek ptr)) *> loop (ptr `plusPtr` 1) #else f (evil (peek ptr)) >> loop (ptr `plusPtr` 1) #endif loop start where #if MIN_VERSION_bytestring(0,10,6) evil = Unsafe.accursedUnutterablePerformIO #else evil = Unsafe.inlinePerformIO #endif {-# INLINE evil #-} ofoldr1Ex = S.foldr1 ofoldl1Ex' = S.foldl1' headEx = S.head lastEx = S.last unsafeHead = SU.unsafeHead {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-} {-# INLINE ofoldl' #-} {-# INLINE otoList #-} {-# INLINE oall #-} {-# INLINE oany #-} {-# INLINE onull #-} {-# INLINE olength #-} {-# INLINE omapM_ #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-} {-# RULES "strict ByteString: ofoldMap = concatMap" ofoldMap = S.concatMap #-} 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 omapM_ f = omapM_ (omapM_ f) . L.toChunks ofoldr1Ex = L.foldr1 ofoldl1Ex' = L.foldl1' headEx = L.head lastEx = L.last {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-} {-# INLINE ofoldl' #-} {-# INLINE otoList #-} {-# INLINE oall #-} {-# INLINE oany #-} {-# INLINE onull #-} {-# INLINE olength64 #-} {-# INLINE omapM_ #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# RULES "lazy ByteString: ofoldMap = concatMap" ofoldMap = L.concatMap #-} 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 ofoldr1Ex = T.foldr1 ofoldl1Ex' = T.foldl1' headEx = T.head lastEx = T.last {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-} {-# INLINE ofoldl' #-} {-# INLINE otoList #-} {-# INLINE oall #-} {-# INLINE oany #-} {-# INLINE onull #-} {-# INLINE olength #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# RULES "strict Text: ofoldMap = concatMap" ofoldMap = T.concatMap #-} 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 ofoldr1Ex = TL.foldr1 ofoldl1Ex' = TL.foldl1' headEx = TL.head lastEx = TL.last {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-} {-# INLINE ofoldl' #-} {-# INLINE otoList #-} {-# INLINE oall #-} {-# INLINE oany #-} {-# INLINE onull #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# RULES "lazy Text: ofoldMap = concatMap" ofoldMap = TL.concatMap #-} 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 ofoldr1Ex f = ofoldr1Ex f . IntSet.toList ofoldl1Ex' f = ofoldl1Ex' f . IntSet.toList {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-} {-# INLINE ofoldl' #-} {-# INLINE otoList #-} {-# INLINE onull #-} {-# INLINE olength #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} instance MonoFoldable [a] where otoList = id {-# INLINE otoList #-} ocompareLength [] i = 0 `compare` i ocompareLength (_:xs) i | i Prelude.<= 0 = GT | otherwise = ocompareLength xs (i - 1) instance MonoFoldable (Maybe a) where #if MIN_VERSION_base(4,8,0) omapM_ _ Nothing = pure () #else omapM_ _ Nothing = return () #endif omapM_ f (Just x) = f x {-# INLINE omapM_ #-} instance MonoFoldable (Tree a) instance MonoFoldable (Seq a) where headEx = flip Seq.index 0 lastEx xs = Seq.index xs (Seq.length xs - 1) {-# INLINE headEx #-} {-# INLINE lastEx #-} 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) where ofoldr = V.foldr ofoldl' = V.foldl' otoList = V.toList oall = V.all oany = V.any onull = V.null olength = V.length ofoldr1Ex = V.foldr1 ofoldl1Ex' = V.foldl1' headEx = V.head lastEx = V.last unsafeHead = V.unsafeHead unsafeLast = V.unsafeLast maximumByEx = V.maximumBy minimumByEx = V.minimumBy {-# INLINE ofoldr #-} {-# INLINE ofoldl' #-} {-# INLINE otoList #-} {-# INLINE oall #-} {-# INLINE oany #-} {-# INLINE onull #-} {-# INLINE olength #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-} {-# INLINE maximumByEx #-} {-# INLINE minimumByEx #-} 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 ofoldr1Ex = U.foldr1 ofoldl1Ex' = U.foldl1' headEx = U.head lastEx = U.last unsafeHead = U.unsafeHead unsafeLast = U.unsafeLast maximumByEx = U.maximumBy minimumByEx = U.minimumBy {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-} {-# INLINE ofoldl' #-} {-# INLINE otoList #-} {-# INLINE oall #-} {-# INLINE oany #-} {-# INLINE onull #-} {-# INLINE olength #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-} {-# INLINE maximumByEx #-} {-# INLINE minimumByEx #-} 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 ofoldr1Ex = VS.foldr1 ofoldl1Ex' = VS.foldl1' headEx = VS.head lastEx = VS.last unsafeHead = VS.unsafeHead unsafeLast = VS.unsafeLast maximumByEx = VS.maximumBy minimumByEx = VS.minimumBy {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-} {-# INLINE ofoldl' #-} {-# INLINE otoList #-} {-# INLINE oall #-} {-# INLINE oany #-} {-# INLINE onull #-} {-# INLINE olength #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-} {-# INLINE maximumByEx #-} {-# INLINE minimumByEx #-} instance MonoFoldable (Either a b) where ofoldMap f = ofoldr (mappend . f) mempty ofoldr f b (Right a) = f a b ofoldr _ b (Left _) = b ofoldl' f a (Right b) = f a b ofoldl' _ a (Left _) = a otoList (Left _) = [] otoList (Right b) = [b] oall _ (Left _) = True oall f (Right b) = f b oany _ (Left _) = False oany f (Right b) = f b onull (Left _) = True onull (Right _) = False olength (Left _) = 0 olength (Right _) = 1 ofoldr1Ex _ (Left _) = Prelude.error "ofoldr1Ex on Either" ofoldr1Ex _ (Right x) = x ofoldl1Ex' _ (Left _) = Prelude.error "ofoldl1Ex' on Either" ofoldl1Ex' _ (Right x) = x #if MIN_VERSION_base(4,8,0) omapM_ _ (Left _) = pure () #else omapM_ _ (Left _) = return () #endif omapM_ f (Right x) = f x {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-} {-# INLINE ofoldl' #-} {-# INLINE otoList #-} {-# INLINE oall #-} {-# INLINE oany #-} {-# INLINE onull #-} {-# INLINE olength #-} {-# INLINE omapM_ #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} instance MonoFoldable (a, b) instance MonoFoldable (Const m a) instance F.Foldable f => MonoFoldable (MaybeT f a) instance F.Foldable f => MonoFoldable (ListT f a) instance F.Foldable f => MonoFoldable (IdentityT f a) instance F.Foldable f => MonoFoldable (WriterT w f a) instance F.Foldable f => MonoFoldable (Strict.WriterT w f a) instance (F.Foldable f, F.Foldable g) => MonoFoldable (Compose f g a) instance (F.Foldable f, F.Foldable g) => MonoFoldable (Product f g a) -- | Safe version of 'headEx'. -- -- Returns 'Nothing' instead of throwing an exception when encountering -- an empty monomorphic container. headMay :: MonoFoldable mono => mono -> Maybe (Element mono) headMay mono | onull mono = Nothing | otherwise = Just (headEx mono) {-# INLINE headMay #-} -- | Safe version of 'lastEx'. -- -- Returns 'Nothing' instead of throwing an exception when encountering -- an empty monomorphic container. lastMay :: MonoFoldable mono => mono -> Maybe (Element mono) lastMay mono | onull mono = Nothing | otherwise = Just (lastEx mono) {-# INLINE lastMay #-} -- | 'osum' computes the sum of the numbers of a monomorphic container. osum :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono osum = ofoldl' (+) 0 {-# INLINE osum #-} -- | 'oproduct' computes the product of the numbers of a monomorphic container. oproduct :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono oproduct = ofoldl' (*) 1 {-# INLINE oproduct #-} -- | Are __all__ of the elements 'True'? -- -- Since 0.6.0 oand :: (Element mono ~ Bool, MonoFoldable mono) => mono -> Bool oand = oall id {-# INLINE oand #-} -- | Are __any__ of the elements 'True'? -- -- Since 0.6.0 oor :: (Element mono ~ Bool, MonoFoldable mono) => mono -> Bool oor = oany id {-# INLINE oor #-} -- | Synonym for 'ofoldMap' -- -- @since 1.0.0 oconcatMap :: (MonoFoldable mono, Monoid m) => (Element mono -> m) -> mono -> m oconcatMap = ofoldMap -- | Monoidally combine all values in the container -- -- @since 1.0.0 ofold :: (MonoFoldable mono, Monoid (Element mono)) => mono -> Element mono ofold = ofoldMap id {-# INLINE ofold #-} -- | Synonym for 'ofold' -- -- @since 1.0.0 oconcat :: (MonoFoldable mono, Monoid (Element mono)) => mono -> Element mono oconcat = ofold {-# INLINE oconcat #-} -- | Synonym for 'ofoldlM' -- -- @since 1.0.0 ofoldM :: (MonoFoldable mono, Monad m) => (a -> Element mono -> m a) -> a -> mono -> m a ofoldM = ofoldlM {-# INLINE ofoldM #-} -- | Perform all actions in the given container -- -- @since 1.0.0 #if MIN_VERSION_base(4,8,0) osequence_ :: (Applicative m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m () #else osequence_ :: (Monad m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m () #endif osequence_ = omapM_ id {-# INLINE osequence_ #-} -- | Checks if the monomorphic container includes the supplied element. oelem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool oelem e = List.elem e . otoList {-# INLINE [0] oelem #-} -- | Checks if the monomorphic container does not include the supplied element. onotElem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool onotElem e = List.notElem e . otoList {-# INLINE [0] onotElem #-} {-# RULES "strict ByteString elem" oelem = S.elem #-} {-# RULES "strict ByteString notElem" oelem = S.notElem #-} {-# RULES "lazy ByteString elem" oelem = L.elem #-} {-# RULES "lazy ByteString notElem" oelem = L.notElem #-} {-# RULES "Set elem" forall (k :: Ord k => k). oelem k = Set.member k #-} {-# RULES "Set notElem" forall (k :: Ord k => k). oelem k = Set.notMember k #-} -- | Get the minimum element of a monomorphic container. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- -- /See 'Data.NonNull.maximum' from "Data.NonNull" for a total version of this function./ maximumEx :: (MonoFoldable mono, Ord (Element mono)) => mono -> Element mono maximumEx = maximumByEx compare {-# INLINE [0] maximumEx #-} -- | Get the maximum element of a monomorphic container. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. -- -- /See 'Data.NonNull.minimum' from "Data.NonNull" for a total version of this function./ minimumEx :: (MonoFoldable mono, Ord (Element mono)) => mono -> Element mono minimumEx = minimumByEx compare {-# INLINE [0] minimumEx #-} {-# RULES "strict ByteString maximumEx" maximumEx = S.maximum #-} {-# RULES "strict ByteString minimumEx" minimumEx = S.minimum #-} {-# RULES "lazy ByteString maximumEx" maximumEx = L.maximum #-} {-# RULES "lazy ByteString minimumEx" minimumEx = L.minimum #-} {-# RULES "strict Text maximumEx" maximumEx = T.maximum #-} {-# RULES "strict Text minimumEx" minimumEx = T.minimum #-} {-# RULES "lazy Text maximumEx" maximumEx = TL.maximum #-} {-# RULES "lazy Text minimumEx" minimumEx = TL.minimum #-} {-# RULES "boxed Vector maximumEx" maximumEx = V.maximum #-} {-# RULES "boxed Vector minimumEx" minimumEx = V.minimum #-} {-# RULES "unboxed Vector maximumEx" forall (u :: U.Unbox a => U.Vector a). maximumEx u = U.maximum u #-} {-# RULES "unboxed Vector minimumEx" forall (u :: U.Unbox a => U.Vector a). minimumEx u = U.minimum u #-} {-# RULES "storable Vector maximumEx" forall (v :: VS.Storable a => VS.Vector a). maximumEx v = VS.maximum v #-} {-# RULES "storable Vector minimumEx" forall (v :: VS.Storable a => VS.Vector a). minimumEx v = VS.minimum v #-} -- | Safe version of 'maximumEx'. -- -- Returns 'Nothing' instead of throwing an exception when -- encountering an empty monomorphic container. maximumMay :: (MonoFoldable mono, Ord (Element mono)) => mono -> Maybe (Element mono) maximumMay mono | onull mono = Nothing | otherwise = Just (maximumEx mono) {-# INLINE maximumMay #-} -- | Safe version of 'maximumByEx'. -- -- Returns 'Nothing' instead of throwing an exception when -- encountering an empty monomorphic container. maximumByMay :: MonoFoldable mono => (Element mono -> Element mono -> Ordering) -> mono -> Maybe (Element mono) maximumByMay f mono | onull mono = Nothing | otherwise = Just (maximumByEx f mono) {-# INLINE maximumByMay #-} -- | Safe version of 'minimumEx'. -- -- Returns 'Nothing' instead of throwing an exception when -- encountering an empty monomorphic container. minimumMay :: (MonoFoldable mono, Ord (Element mono)) => mono -> Maybe (Element mono) minimumMay mono | onull mono = Nothing | otherwise = Just (minimumEx mono) {-# INLINE minimumMay #-} -- | Safe version of 'minimumByEx'. -- -- Returns 'Nothing' instead of throwing an exception when -- encountering an empty monomorphic container. minimumByMay :: MonoFoldable mono => (Element mono -> Element mono -> Ordering) -> mono -> Maybe (Element mono) minimumByMay f mono | onull mono = Nothing | otherwise = Just (minimumByEx f mono) {-# INLINE minimumByMay #-} -- | Monomorphic containers that can be traversed from left to right. class (MonoFunctor mono, MonoFoldable mono) => MonoTraversable mono where -- | Map each element of a monomorphic container to an action, -- evaluate these actions from left to right, and -- collect the results. 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 -- | Map each element of a monomorphic container to a monadic action, -- evaluate these actions from left to right, and -- collect the results. #if MIN_VERSION_base(4,8,0) omapM :: Applicative m => (Element mono -> m (Element mono)) -> mono -> m mono omapM = otraverse #else 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 #endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable S.ByteString where otraverse f = fmap S.pack . traverse f . S.unpack {-# INLINE otraverse #-} #if !MIN_VERSION_base(4,8,0) omapM f = liftM S.pack . mapM f . S.unpack {-# INLINE omapM #-} #endif instance MonoTraversable L.ByteString where otraverse f = fmap L.pack . traverse f . L.unpack {-# INLINE otraverse #-} #if !MIN_VERSION_base(4,8,0) omapM f = liftM L.pack . mapM f . L.unpack {-# INLINE omapM #-} #endif instance MonoTraversable T.Text where otraverse f = fmap T.pack . traverse f . T.unpack {-# INLINE otraverse #-} #if !MIN_VERSION_base(4,8,0) omapM f = liftM T.pack . mapM f . T.unpack {-# INLINE omapM #-} #endif instance MonoTraversable TL.Text where otraverse f = fmap TL.pack . traverse f . TL.unpack {-# INLINE otraverse #-} #if !MIN_VERSION_base(4,8,0) omapM f = liftM TL.pack . mapM f . TL.unpack {-# INLINE omapM #-} #endif 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 -- FIXME do something more efficient otraverse f = fmap U.fromList . traverse f . U.toList #if MIN_VERSION_base(4,8,0) omapM = otraverse #else omapM = U.mapM #endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance VS.Storable a => MonoTraversable (VS.Vector a) where -- FIXME do something more efficient otraverse f = fmap VS.fromList . traverse f . VS.toList #if MIN_VERSION_base(4,8,0) omapM = otraverse #else omapM = VS.mapM #endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable (Either a b) where otraverse _ (Left a) = pure (Left a) otraverse f (Right b) = fmap Right (f b) #if MIN_VERSION_base(4,8,0) omapM _ (Left a) = pure (Left a) omapM f (Right b) = fmap Right (f b) #else omapM _ (Left a) = return (Left a) omapM f (Right b) = liftM Right (f b) #endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable (a, b) instance MonoTraversable (Const m a) instance Traversable f => MonoTraversable (MaybeT f a) instance Traversable f => MonoTraversable (ListT f a) instance Traversable f => MonoTraversable (IdentityT f a) instance Traversable f => MonoTraversable (WriterT w f a) instance Traversable f => MonoTraversable (Strict.WriterT w f a) instance (Traversable f, Traversable g) => MonoTraversable (Compose f g a) instance (Traversable f, Traversable g) => MonoTraversable (Product f g a) -- | 'ofor' is 'otraverse' with its arguments flipped. ofor :: (MonoTraversable mono, Applicative f) => mono -> (Element mono -> f (Element mono)) -> f mono ofor = flip otraverse {-# INLINE ofor #-} -- | 'oforM' is 'omapM' with its arguments flipped. #if MIN_VERSION_base(4,8,0) oforM :: (MonoTraversable mono, Applicative f) => mono -> (Element mono -> f (Element mono)) -> f mono #else oforM :: (MonoTraversable mono, Monad f) => mono -> (Element mono -> f (Element mono)) -> f mono #endif oforM = flip omapM {-# INLINE oforM #-} -- | A strict left fold, together with an unwrap function. -- -- This is convenient when the accumulator value is not the same as the final -- expected type. It is provided mainly for integration with the @foldl@ -- package, to be used in conjunction with @purely@. -- -- Since 0.3.1 ofoldlUnwrap :: MonoFoldable mono => (x -> Element mono -> x) -> x -> (x -> b) -> mono -> b ofoldlUnwrap f x unwrap mono = unwrap (ofoldl' f x mono) -- | A monadic strict left fold, together with an unwrap function. -- -- Similar to 'foldlUnwrap', but allows monadic actions. To be used with -- @impurely@ from @foldl@. -- -- Since 0.3.1 ofoldMUnwrap :: (Monad m, MonoFoldable mono) => (x -> Element mono -> m x) -> m x -> (x -> m b) -> mono -> m b ofoldMUnwrap f mx unwrap mono = do x <- mx x' <- ofoldlM f x mono unwrap x' -- | Typeclass for monomorphic containers that an element can be -- lifted into. -- -- For any 'MonoFunctor', the following law holds: -- -- @ -- 'omap' f . 'opoint' = 'opoint' . f -- @ class MonoPointed mono where -- | Lift an element into a monomorphic container. -- -- 'opoint' is the same as 'Control.Applicative.pure' for an 'Applicative' opoint :: Element mono -> mono default opoint :: (Applicative f, (f a) ~ mono, Element (f a) ~ a) => Element mono -> mono opoint = pure {-# INLINE opoint #-} -- monomorphic instance MonoPointed S.ByteString where opoint = S.singleton {-# INLINE opoint #-} instance MonoPointed L.ByteString where opoint = L.singleton {-# INLINE opoint #-} instance MonoPointed T.Text where opoint = T.singleton {-# INLINE opoint #-} instance MonoPointed TL.Text where opoint = TL.singleton {-# INLINE opoint #-} -- Applicative instance MonoPointed [a] instance MonoPointed (Maybe a) instance MonoPointed (Option a) instance MonoPointed (NonEmpty a) instance MonoPointed (Identity a) instance MonoPointed (Vector a) instance MonoPointed (IO a) instance MonoPointed (ZipList a) instance MonoPointed (r -> a) instance Monoid a => MonoPointed (a, b) instance Monoid m => MonoPointed (Const m a) instance Monad m => MonoPointed (WrappedMonad m a) instance Applicative m => MonoPointed (ListT m a) instance Applicative m => MonoPointed (IdentityT m a) instance Arrow a => MonoPointed (WrappedArrow a b c) instance (Monoid w, Applicative m) => MonoPointed (WriterT w m a) instance (Monoid w, Applicative m) => MonoPointed (Strict.WriterT w m a) instance Applicative m => MonoPointed (ReaderT r m a) instance MonoPointed (ContT r m a) instance (Applicative f, Applicative g) => MonoPointed (Compose f g a) instance (Applicative f, Applicative g) => MonoPointed (Product f g a) -- Not Applicative instance MonoPointed (Seq a) where opoint = Seq.singleton {-# INLINE opoint #-} instance U.Unbox a => MonoPointed (U.Vector a) where opoint = U.singleton {-# INLINE opoint #-} instance VS.Storable a => MonoPointed (VS.Vector a) where opoint = VS.singleton {-# INLINE opoint #-} instance MonoPointed (Either a b) where opoint = Right {-# INLINE opoint #-} instance MonoPointed IntSet.IntSet where opoint = IntSet.singleton {-# INLINE opoint #-} instance MonoPointed (Set a) where opoint = Set.singleton {-# INLINE opoint #-} instance Hashable a => MonoPointed (HashSet a) where opoint = HashSet.singleton {-# INLINE opoint #-} instance Applicative f => MonoPointed (MaybeT f a) where opoint = MaybeT . fmap Just . pure {-# INLINE opoint #-} instance (Monoid w, Applicative m) => MonoPointed (RWST r w s m a) where opoint a = RWST (\_ s -> pure (a, s, mempty)) {-# INLINE opoint #-} instance (Monoid w, Applicative m) => MonoPointed (Strict.RWST r w s m a) where opoint a = Strict.RWST (\_ s -> pure (a, s, mempty)) {-# INLINE opoint #-} instance Applicative m => MonoPointed (StateT s m a) where opoint a = StateT (\s -> pure (a, s)) {-# INLINE opoint #-} instance Applicative m => MonoPointed (Strict.StateT s m a) where opoint a = Strict.StateT (\s -> pure (a, s)) {-# INLINE opoint #-} instance MonoPointed (ViewL a) where opoint a = a :< Seq.empty {-# INLINE opoint #-} instance MonoPointed (ViewR a) where opoint a = Seq.empty :> a {-# INLINE opoint #-} instance MonoPointed (Tree a) where opoint a = Node a [] {-# INLINE opoint #-} -- | Typeclass for monomorphic containers where it is always okay to -- "extract" a value from with 'oextract', and where you can extrapolate -- any "extracting" function to be a function on the whole part with -- 'oextend'. -- -- 'oextend' and 'oextract' should work together following the laws: -- -- @ -- 'oextend' 'oextract' = 'id' -- 'oextract' . 'oextend' f = f -- 'oextend' f . 'oextend' g = 'oextend' (f . 'oextend' g) -- @ -- -- As an intuition, @'oextend' f@ uses @f@ to "build up" a new @mono@ with -- pieces from the old one received by @f@. -- class MonoFunctor mono => MonoComonad mono where -- | Extract an element from @mono@. Can be thought of as a dual -- concept to @opoint@. oextract :: mono -> Element mono -- | "Extend" a @mono -> 'Element' mono@ function to be a @mono -> -- mono@; that is, builds a new @mono@ from the old one by using pieces -- glimpsed from the given function. oextend :: (mono -> Element mono) -> mono -> mono -- Not Comonad instance MonoComonad (ViewL a) where oextract ~(x :< _) = x {-# INLINE oextract #-} oextend f w@ ~(_ :< xxs) = f w :< case Seq.viewl xxs of EmptyL -> Seq.empty xs -> case oextend f xs of EmptyL -> Seq.empty y :< ys -> y Seq.<| ys instance MonoComonad (ViewR a) where oextract ~(_ :> x) = x {-# INLINE oextract #-} oextend f w@ ~(xxs :> _) = (case Seq.viewr xxs of EmptyR -> Seq.empty xs -> case oextend f xs of EmptyR -> Seq.empty ys :> y -> ys Seq.|> y ) :> f w -- | Containers which, when two values are combined, the combined length is no -- less than the larger of the two inputs. In code: -- -- @ -- olength (x <> y) >= max (olength x) (olength y) -- @ -- -- This class has no methods, and is simply used to assert that this law holds, -- in order to provide guarantees of correctness (see, for instance, -- "Data.NonNull"). -- -- This should have a @Semigroup@ superclass constraint, however, due to -- @Semigroup@ only recently moving to base, some packages do not provide -- instances. class MonoFoldable mono => GrowingAppend mono instance GrowingAppend (Seq.Seq a) instance GrowingAppend [a] instance GrowingAppend (V.Vector a) instance U.Unbox a => GrowingAppend (U.Vector a) instance VS.Storable a => GrowingAppend (VS.Vector a) instance GrowingAppend S.ByteString instance GrowingAppend L.ByteString instance GrowingAppend T.Text instance GrowingAppend TL.Text instance GrowingAppend (NonEmpty a) instance Ord k => GrowingAppend (Map k v) instance (Eq k, Hashable k) => GrowingAppend (HashMap k v) instance Ord v => GrowingAppend (Set.Set v) instance (Eq v, Hashable v) => GrowingAppend (HashSet.HashSet v) instance GrowingAppend IntSet.IntSet instance GrowingAppend (IntMap v) -- | 'intercalate' @seq seqs@ inserts @seq@ in between @seqs@ and -- concatenates the result. -- -- @since 1.0.0 ointercalate :: (MonoFoldable mono, Monoid (Element mono)) => Element mono -> mono -> Element mono ointercalate x = mconcat . List.intersperse x . otoList {-# INLINE [0] ointercalate #-} {-# RULES "ointercalate list" forall x. ointercalate x = List.intercalate x . otoList #-} {-# RULES "intercalate ByteString" forall x. ointercalate x = S.intercalate x . otoList #-} {-# RULES "intercalate LByteString" forall x. ointercalate x = L.intercalate x . otoList #-} {-# RULES "intercalate Text" forall x. ointercalate x = T.intercalate x . otoList #-} {-# RULES "intercalate LText" forall x. ointercalate x = TL.intercalate x . otoList #-} mono-traversable-1.0.1/src/Data/NonNull.hs0000644000000000000000000002570012766512504016554 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | "Data.NonNull" extends the concepts from -- "Data.List.NonEmpty" to any 'MonoFoldable'. -- -- 'NonNull' is a newtype wrapper for a container with 1 or more elements. module Data.NonNull ( NonNull , fromNullable , impureNonNull , nonNull , toNullable , fromNonEmpty , ncons , nuncons , splitFirst , nfilter , nfilterM , nReplicate , head , tail , last , init , ofoldMap1 , ofold1 , ofoldr1 , ofoldl1' , maximum , maximumBy , minimum , minimumBy , (<|) , toMinList , GrowingAppend ) where import Prelude hiding (head, tail, init, last, reverse, seq, filter, replicate, maximum, minimum) import Control.Arrow (second) import Control.Exception.Base (Exception, throw) #if !MIN_VERSION_base(4,8,0) import Control.Monad (liftM) #endif import Data.Data import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) import Data.MonoTraversable import Data.Sequences import Data.Semigroup (Semigroup (..)) import Control.Monad.Trans.State.Strict (evalState, state) data NullError = NullError String deriving (Show, Typeable) instance Exception NullError -- | A monomorphic container that is not null. newtype NonNull mono = NonNull { toNullable :: mono -- ^ __Safely__ convert from a non-null monomorphic container to a nullable monomorphic container. } deriving (Eq, Ord, Read, Show, Data, Typeable) type instance Element (NonNull mono) = Element mono deriving instance MonoFunctor mono => MonoFunctor (NonNull mono) deriving instance MonoFoldable mono => MonoFoldable (NonNull mono) instance MonoTraversable mono => MonoTraversable (NonNull mono) where otraverse f (NonNull x) = fmap NonNull (otraverse f x) {-# INLINE otraverse #-} #if !MIN_VERSION_base(4,8,0) omapM f (NonNull x) = liftM NonNull (omapM f x) {-# INLINE omapM #-} #endif instance GrowingAppend mono => GrowingAppend (NonNull mono) instance (Semigroup mono, GrowingAppend mono) => Semigroup (NonNull mono) where NonNull x <> NonNull y = NonNull (x <> y) instance SemiSequence seq => SemiSequence (NonNull seq) where type Index (NonNull seq) = Index seq intersperse e = unsafeMap $ intersperse e reverse = unsafeMap reverse find f = find f . toNullable cons x = unsafeMap $ cons x snoc xs x = unsafeMap (flip snoc x) xs sortBy f = unsafeMap $ sortBy f -- | This function is unsafe, and must not be exposed from this module. unsafeMap :: (mono -> mono) -> NonNull mono -> NonNull mono unsafeMap f (NonNull x) = NonNull (f x) instance MonoPointed mono => MonoPointed (NonNull mono) where opoint = NonNull . opoint {-# INLINE opoint #-} instance IsSequence mono => MonoComonad (NonNull mono) where oextract = head oextend f (NonNull mono) = NonNull . flip evalState mono . ofor mono . const . state $ \mono' -> (f (NonNull mono'), tailEx mono') -- | __Safely__ convert from an __unsafe__ monomorphic container to a __safe__ -- non-null monomorphic container. fromNullable :: MonoFoldable mono => mono -> Maybe (NonNull mono) fromNullable mono | onull mono = Nothing | otherwise = Just (NonNull mono) -- | __Unsafely__ convert from an __unsafe__ monomorphic container to a __safe__ -- non-null monomorphic container. -- -- Throws an exception if the monomorphic container is empty. -- -- @since 1.0.0 impureNonNull :: MonoFoldable mono => mono -> NonNull mono impureNonNull nullable = fromMaybe (throw $ NullError "Data.NonNull.impureNonNull (NonNull default): expected non-null") $ fromNullable nullable -- | Old synonym for 'impureNonNull' nonNull :: MonoFoldable mono => mono -> NonNull mono nonNull = impureNonNull {-# DEPRECATED nonNull "Please use the more explicit impureNonNull instead" #-} -- | __Safely__ convert from a 'NonEmpty' list to a non-null monomorphic container. fromNonEmpty :: IsSequence seq => NE.NonEmpty (Element seq) -> NonNull seq fromNonEmpty = impureNonNull . fromList . NE.toList {-# INLINE fromNonEmpty #-} -- | Specializes 'fromNonEmpty' to lists only. toMinList :: NE.NonEmpty a -> NonNull [a] toMinList = fromNonEmpty -- | Prepend an element to a 'SemiSequence', creating a non-null 'SemiSequence'. -- -- 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 :: SemiSequence seq => Element seq -> seq -> NonNull seq ncons x xs = nonNull $ cons x xs -- | Extract the first element of a sequnce and the rest of the non-null sequence if it exists. nuncons :: IsSequence seq => NonNull seq -> (Element seq, Maybe (NonNull seq)) nuncons xs = second fromNullable $ fromMaybe (error "Data.NonNull.nuncons: data structure is null, it should be non-null") $ uncons (toNullable xs) -- | Same as 'nuncons' with no guarantee that the rest of the sequence is non-null. splitFirst :: IsSequence seq => NonNull seq -> (Element seq, seq) splitFirst xs = fromMaybe (error "Data.NonNull.splitFirst: data structure is null, it should be non-null") $ uncons (toNullable xs) -- | Equivalent to @"Data.Sequence".'Data.Sequence.filter'@, -- but works on non-nullable sequences. nfilter :: IsSequence seq => (Element seq -> Bool) -> NonNull seq -> seq nfilter f = filter f . toNullable -- | Equivalent to @"Data.Sequence".'Data.Sequence.filterM'@, -- but works on non-nullable sequences. nfilterM :: (Monad m, IsSequence seq) => (Element seq -> m Bool) -> NonNull seq -> m seq nfilterM f = filterM f . toNullable -- | Equivalent to @"Data.Sequence".'Data.Sequence.replicate'@ -- -- @i@ must be @> 0@ -- -- @i <= 0@ is treated the same as providing @1@ nReplicate :: IsSequence seq => Index seq -> Element seq -> NonNull seq nReplicate i = nonNull . replicate (max 1 i) -- | __Safe__ version of 'tailEx', only working on non-nullable sequences. tail :: IsSequence seq => NonNull seq -> seq tail = tailEx . toNullable {-# INLINE tail #-} -- | __Safe__ version of 'initEx', only working on non-nullable sequences. init :: IsSequence seq => NonNull seq -> seq init = initEx . toNullable {-# INLINE init #-} infixr 5 <| -- | Prepend an element to a non-null 'SemiSequence'. (<|) :: SemiSequence seq => Element seq -> NonNull seq -> NonNull seq x <| y = ncons x (toNullable y) -- | Return the first element of a monomorphic container. -- -- Safe version of 'headEx', only works on monomorphic containers wrapped in a -- 'NonNull'. head :: MonoFoldable mono => NonNull mono -> Element mono head = headEx . toNullable {-# INLINE head #-} -- | Return the last element of a monomorphic container. -- -- Safe version of 'lastEx', only works on monomorphic containers wrapped in a -- 'NonNull'. last :: MonoFoldable mono => NonNull mono -> Element mono last = lastEx . toNullable {-# INLINE last #-} -- | Map each element of a monomorphic container to a semigroup, and combine the -- results. -- -- Safe version of 'ofoldMap1Ex', only works on monomorphic containers wrapped in a -- 'NonNull'. -- -- ==== __Examples__ -- -- @ -- > let xs = ncons ("hello", 1 :: 'Integer') [(" world", 2)] -- > 'ofoldMap1' 'fst' xs -- "hello world" -- @ ofoldMap1 :: (MonoFoldable mono, Semigroup m) => (Element mono -> m) -> NonNull mono -> m ofoldMap1 f = ofoldMap1Ex f . toNullable {-# INLINE ofoldMap1 #-} -- | Join a monomorphic container, whose elements are 'Semigroup's, together. -- -- Safe, only works on monomorphic containers wrapped in a 'NonNull'. -- -- ==== __Examples__ -- -- @ -- > let xs = ncons "a" ["b", "c"] -- > xs -- 'NonNull' {toNullable = ["a","b","c"]} -- -- > 'ofold1' xs -- "abc" -- @ ofold1 :: (MonoFoldable mono, Semigroup (Element mono)) => NonNull mono -> Element mono ofold1 = ofoldMap1 id {-# INLINE ofold1 #-} -- | Right-associative fold of a monomorphic container with no base element. -- -- Safe version of 'ofoldr1Ex', only works on monomorphic containers wrapped in a -- 'NonNull'. -- -- @'foldr1' f = "Prelude".'Prelude.foldr1' f . 'otoList'@ -- -- ==== __Examples__ -- -- @ -- > let xs = ncons "a" ["b", "c"] -- > 'ofoldr1' (++) xs -- "abc" -- @ ofoldr1 :: MonoFoldable mono => (Element mono -> Element mono -> Element mono) -> NonNull mono -> Element mono ofoldr1 f = ofoldr1Ex f . toNullable {-# INLINE ofoldr1 #-} -- | Strict left-associative fold of a monomorphic container with no base -- element. -- -- Safe version of 'ofoldl1Ex'', only works on monomorphic containers wrapped in a -- 'NonNull'. -- -- @'foldl1'' f = "Prelude".'Prelude.foldl1'' f . 'otoList'@ -- -- ==== __Examples__ -- -- @ -- > let xs = ncons "a" ["b", "c"] -- > 'ofoldl1'' (++) xs -- "abc" -- @ ofoldl1' :: MonoFoldable mono => (Element mono -> Element mono -> Element mono) -> NonNull mono -> Element mono ofoldl1' f = ofoldl1Ex' f . toNullable {-# INLINE ofoldl1' #-} -- | Get the maximum element of a monomorphic container. -- -- Safe version of 'maximumEx', only works on monomorphic containers wrapped in a -- 'NonNull'. -- -- ==== __Examples__ -- -- @ -- > let xs = ncons 1 [2, 3 :: Int] -- > 'maximum' xs -- 3 -- @ maximum :: (MonoFoldable mono, Ord (Element mono)) => NonNull mono -> Element mono maximum = maximumEx . toNullable {-# INLINE maximum #-} -- | Get the minimum element of a monomorphic container. -- -- Safe version of 'minimumEx', only works on monomorphic containers wrapped in a -- 'NonNull'. -- -- ==== __Examples__ -- -- @ -- > let xs = ncons 1 [2, 3 :: Int] -- > 'minimum' xs -- 1 -- @ minimum :: (MonoFoldable mono, Ord (Element mono)) => NonNull mono -> Element mono minimum = minimumEx . toNullable {-# INLINE minimum #-} -- | Get the maximum element of a monomorphic container, -- using a supplied element ordering function. -- -- Safe version of 'maximumByEx', only works on monomorphic containers wrapped in a -- 'NonNull'. maximumBy :: MonoFoldable mono => (Element mono -> Element mono -> Ordering) -> NonNull mono -> Element mono maximumBy cmp = maximumByEx cmp . toNullable {-# INLINE maximumBy #-} -- | Get the minimum element of a monomorphic container, -- using a supplied element ordering function. -- -- Safe version of 'minimumByEx', only works on monomorphic containers wrapped in a -- 'NonNull'. minimumBy :: MonoFoldable mono => (Element mono -> Element mono -> Ordering) -> NonNull mono -> Element mono minimumBy cmp = minimumByEx cmp . toNullable {-# INLINE minimumBy #-} mono-traversable-1.0.1/src/Data/Sequences.hs0000644000000000000000000013732112766512504017125 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} -- | Abstractions over sequential data structures, like lists and vectors. module Data.Sequences where import Data.Maybe (fromJust, isJust) import Data.Monoid (Monoid, mconcat, mempty) import Data.MonoTraversable import Data.Int (Int64, Int) import qualified Data.List as List import qualified Data.List.Split as List import qualified Control.Monad (filterM, replicateM) import Prelude (Bool (..), Monad (..), Maybe (..), Ordering (..), Ord (..), Eq (..), Functor (..), fromIntegral, otherwise, (-), fst, snd, Integral, ($), flip, maybe, error) import Data.Char (Char, isSpace) 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 ((***), first, 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 Data.String (IsString) import qualified Data.List.NonEmpty as NE import qualified Data.ByteString.Unsafe as SU import qualified Data.Vector.Generic as VG import qualified Data.Vector.Algorithms.Merge as VAM import Data.Ord (comparing) import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy.Encoding as TL import Data.Text.Encoding.Error (lenientDecode) import Data.Word (Word8) -- | 'SemiSequence' was created to share code between 'IsSequence' and 'NonNull'. -- -- @Semi@ means 'SemiGroup' -- A 'SemiSequence' can accomodate a 'SemiGroup' such as 'NonEmpty' or 'NonNull' -- A Monoid should be able to fill out 'IsSequence'. -- -- 'SemiSequence' operations maintain the same type because they all maintain the same number of elements or increase them. -- However, a decreasing function such as filter may change they type. -- For example, from 'NonEmpty' to '[]' -- This type-changing function exists on 'NonNull' as 'nfilter' -- -- 'filter' and other such functions are placed in 'IsSequence' -- -- /NOTE/: Like 'GrowingAppend', ideally we'd have a @Semigroup@ superclass -- constraint here, but that would pull in more dependencies to this package -- than desired. class (Integral (Index seq), GrowingAppend seq) => SemiSequence seq where -- | The type of the index of a sequence. type Index seq -- | 'intersperse' takes an element and intersperses that element between -- the elements of the sequence. -- -- @ -- > 'intersperse' ',' "abcde" -- "a,b,c,d,e" -- @ intersperse :: Element seq -> seq -> seq -- | Reverse a sequence -- -- @ -- > 'reverse' "hello world" -- "dlrow olleh" -- @ reverse :: seq -> seq -- | 'find' takes a predicate and a sequence and returns the first element in -- the sequence matching the predicate, or 'Nothing' if there isn't an element -- that matches the predicate. -- -- @ -- > 'find' (== 5) [1 .. 10] -- 'Just' 5 -- -- > 'find' (== 15) [1 .. 10] -- 'Nothing' -- @ find :: (Element seq -> Bool) -> seq -> Maybe (Element seq) -- | Sort a sequence using an supplied element ordering function. -- -- @ -- > let compare' x y = case 'compare' x y of LT -> GT; EQ -> EQ; GT -> LT -- > 'sortBy' compare' [5,3,6,1,2,4] -- [6,5,4,3,2,1] -- @ sortBy :: (Element seq -> Element seq -> Ordering) -> seq -> seq -- | Prepend an element onto a sequence. -- -- @ -- > 4 \``cons`` [1,2,3] -- [4,1,2,3] -- @ cons :: Element seq -> seq -> seq -- | Append an element onto a sequence. -- -- @ -- > [1,2,3] \``snoc`` 4 -- [1,2,3,4] -- @ snoc :: seq -> Element seq -> seq -- | Create a sequence from a single element. -- -- @ -- > 'singleton' 'a' :: 'String' -- "a" -- > 'singleton' 'a' :: 'Vector' 'Char' -- 'Data.Vector.fromList' "a" -- @ singleton :: IsSequence seq => Element seq -> seq singleton = opoint {-# INLINE singleton #-} -- | Sequence Laws: -- -- @ -- 'fromList' . 'otoList' = 'id' -- 'fromList' (x <> y) = 'fromList' x <> 'fromList' y -- 'otoList' ('fromList' x <> 'fromList' y) = x <> y -- @ class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => IsSequence seq where -- | Convert a list to a sequence. -- -- @ -- > 'fromList' ['a', 'b', 'c'] :: Text -- "abc" -- @ 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' applies a predicate to a sequence, and returns a tuple where -- the first element is the longest prefix (possibly empty) of elements that -- /do not satisfy/ the predicate. The second element of the tuple is the -- remainder of the sequence. -- -- @'break' p@ is equivalent to @'span' ('not' . p)@ -- -- @ -- > 'break' (> 3) ('fromList' [1,2,3,4,1,2,3,4] :: 'Vector' 'Int') -- (fromList [1,2,3],fromList [4,1,2,3,4]) -- -- > 'break' (< 'z') ('fromList' "abc" :: 'Text') -- ("","abc") -- -- > 'break' (> 'z') ('fromList' "abc" :: 'Text') -- ("abc","") -- @ break :: (Element seq -> Bool) -> seq -> (seq, seq) break f = (fromList *** fromList) . List.break f . otoList -- | 'span' applies a predicate to a sequence, and returns a tuple where -- the first element is the longest prefix (possibly empty) that -- /does satisfy/ the predicate. The second element of the tuple is the -- remainder of the sequence. -- -- @'span' p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ -- -- @ -- > 'span' (< 3) ('fromList' [1,2,3,4,1,2,3,4] :: 'Vector' 'Int') -- (fromList [1,2],fromList [3,4,1,2,3,4]) -- -- > 'span' (< 'z') ('fromList' "abc" :: 'Text') -- ("abc","") -- -- > 'span' (< 0) [1,2,3] -- ([],[1,2,3]) -- @ span :: (Element seq -> Bool) -> seq -> (seq, seq) span f = (fromList *** fromList) . List.span f . otoList -- | 'dropWhile' returns the suffix remaining after 'takeWhile'. -- -- @ -- > 'dropWhile' (< 3) [1,2,3,4,5,1,2,3] -- [3,4,5,1,2,3] -- -- > 'dropWhile' (< 'z') ('fromList' "abc" :: 'Text') -- "" -- @ dropWhile :: (Element seq -> Bool) -> seq -> seq dropWhile f = fromList . List.dropWhile f . otoList -- | 'takeWhile' applies a predicate to a sequence, and returns the -- longest prefix (possibly empty) of the sequence of elements that -- /satisfy/ the predicate. -- -- @ -- > 'takeWhile' (< 3) [1,2,3,4,5,1,2,3] -- [1,2] -- -- > 'takeWhile' (< 'z') ('fromList' "abc" :: 'Text') -- "abc" -- @ takeWhile :: (Element seq -> Bool) -> seq -> seq takeWhile f = fromList . List.takeWhile f . otoList -- | @'splitAt' n se@ returns a tuple where the first element is the prefix of -- the sequence @se@ with length @n@, and the second element is the remainder of -- the sequence. -- -- @ -- > 'splitAt' 6 "Hello world!" -- ("Hello ","world!") -- -- > 'splitAt' 3 ('fromList' [1,2,3,4,5] :: 'Vector' 'Int') -- (fromList [1,2,3],fromList [4,5]) -- @ splitAt :: Index seq -> seq -> (seq, seq) splitAt i = (fromList *** fromList) . List.genericSplitAt i . otoList -- | Equivalent to 'splitAt'. unsafeSplitAt :: Index seq -> seq -> (seq, seq) unsafeSplitAt i seq = (unsafeTake i seq, unsafeDrop i seq) -- | @'take' n@ returns the prefix of a sequence of length @n@, or the -- sequence itself if @n > 'olength' seq@. -- -- @ -- > 'take' 3 "abcdefg" -- "abc" -- > 'take' 4 ('fromList' [1,2,3,4,5,6] :: 'Vector' 'Int') -- fromList [1,2,3,4] -- @ take :: Index seq -> seq -> seq take i = fst . splitAt i -- | Equivalent to 'take'. unsafeTake :: Index seq -> seq -> seq unsafeTake = take -- | @'drop' n@ returns the suffix of a sequence after the first @n@ -- elements, or an empty sequence if @n > 'olength' seq@. -- -- @ -- > 'drop' 3 "abcdefg" -- "defg" -- > 'drop' 4 ('fromList' [1,2,3,4,5,6] :: 'Vector' 'Int') -- fromList [5,6] -- @ drop :: Index seq -> seq -> seq drop i = snd . splitAt i -- | Equivalent to 'drop' unsafeDrop :: Index seq -> seq -> seq unsafeDrop = drop -- | 'partition' takes a predicate and a sequence and returns the pair of -- sequences of elements which do and do not satisfy the predicate. -- -- @ -- 'partition' p se = ('filter' p se, 'filter' ('not' . p) se) -- @ partition :: (Element seq -> Bool) -> seq -> (seq, seq) partition f = (fromList *** fromList) . List.partition f . otoList -- | 'uncons' returns the tuple of the first element of a sequence and the rest -- of the sequence, or 'Nothing' if the sequence is empty. -- -- @ -- > 'uncons' ('fromList' [1,2,3,4] :: 'Vector' 'Int') -- 'Just' (1,fromList [2,3,4]) -- -- > 'uncons' ([] :: ['Int']) -- 'Nothing' -- @ uncons :: seq -> Maybe (Element seq, seq) uncons = fmap (second fromList) . uncons . otoList -- | 'unsnoc' returns the tuple of the init of a sequence and the last element, -- or 'Nothing' if the sequence is empty. -- -- @ -- > 'uncons' ('fromList' [1,2,3,4] :: 'Vector' 'Int') -- 'Just' (fromList [1,2,3],4) -- -- > 'uncons' ([] :: ['Int']) -- 'Nothing' -- @ unsnoc :: seq -> Maybe (seq, Element seq) unsnoc = fmap (first fromList) . unsnoc . otoList -- | 'filter' given a predicate returns a sequence of all elements that satisfy -- the predicate. -- -- @ -- > 'filter' (< 5) [1 .. 10] -- [1,2,3,4] -- @ filter :: (Element seq -> Bool) -> seq -> seq filter f = fromList . List.filter f . otoList -- | The monadic version of 'filter'. 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' n x@ is a sequence of length @n@ with @x@ as the -- value of every element. -- -- @ -- > 'replicate' 10 'a' :: Text -- "aaaaaaaaaa" -- @ replicate :: Index seq -> Element seq -> seq replicate i = fromList . List.genericReplicate i -- | The monadic version of 'replicateM'. 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) -- | 'group' takes a sequence and returns a list of sequences such that the -- concatenation of the result is equal to the argument. Each subsequence in -- the result contains only equal elements, using the supplied equality test. -- -- @ -- > 'groupBy' (==) "Mississippi" -- ["M","i","ss","i","ss","i","pp","i"] -- @ 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' returns a list of all subsequences of the argument. -- -- @ -- > 'subsequences' "abc" -- ["","a","b","ab","c","ac","bc","abc"] -- @ subsequences :: seq -> [seq] subsequences = List.map fromList . List.subsequences . otoList -- | 'permutations' returns a list of all permutations of the argument. -- -- @ -- > 'permutations' "abc" -- ["abc","bac","cba","bca","cab","acb"] -- @ permutations :: seq -> [seq] permutations = List.map fromList . List.permutations . otoList -- | __Unsafe__ -- -- Get the tail of a sequence, throw an exception if the sequence is empty. -- -- @ -- > 'tailEx' [1,2,3] -- [2,3] -- @ tailEx :: seq -> seq tailEx = snd . maybe (error "Data.Sequences.tailEx") id . uncons -- | Safe version of 'tailEx'. -- -- Returns 'Nothing' instead of throwing an exception when encountering -- an empty monomorphic container. -- -- @since 1.0.0 tailMay :: seq -> Maybe seq tailMay seq | onull seq = Nothing | otherwise = Just (tailEx seq) {-# INLINE tailMay #-} -- | __Unsafe__ -- -- Get the init of a sequence, throw an exception if the sequence is empty. -- -- @ -- > 'initEx' [1,2,3] -- [1,2] -- @ initEx :: seq -> seq initEx = fst . maybe (error "Data.Sequences.initEx") id . unsnoc -- | Safe version of 'initEx'. -- -- Returns 'Nothing' instead of throwing an exception when encountering -- an empty monomorphic container. -- -- @since 1.0.0 initMay :: IsSequence seq => seq -> Maybe seq initMay seq | onull seq = Nothing | otherwise = Just (initEx seq) {-# INLINE initMay #-} -- | Equivalent to 'tailEx'. unsafeTail :: seq -> seq unsafeTail = tailEx -- | Equivalent to 'initEx'. unsafeInit :: seq -> seq unsafeInit = initEx -- | Get the element of a sequence at a certain index, returns 'Nothing' -- if that index does not exist. -- -- @ -- > 'index' ('fromList' [1,2,3] :: 'Vector' 'Int') 1 -- 'Just' 2 -- > 'index' ('fromList' [1,2,3] :: 'Vector' 'Int') 4 -- 'Nothing' -- @ index :: seq -> Index seq -> Maybe (Element seq) index seq' idx = headMay (drop idx seq') -- | __Unsafe__ -- -- Get the element of a sequence at a certain index, throws an exception -- if the index does not exist. indexEx :: seq -> Index seq -> Element seq indexEx seq' idx = maybe (error "Data.Sequences.indexEx") id (index seq' idx) -- | Equivalent to 'indexEx'. unsafeIndex :: seq -> Index seq -> Element seq unsafeIndex = indexEx -- | 'splitWhen' splits a sequence into components delimited by separators, -- where the predicate returns True for a separator element. The resulting -- components do not contain the separators. Two adjacent separators result -- in an empty component in the output. The number of resulting components -- is greater by one than number of separators. -- -- Since 0.9.3 splitWhen :: (Element seq -> Bool) -> seq -> [seq] splitWhen = defaultSplitWhen {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} {-# INLINE dropWhile #-} {-# INLINE takeWhile #-} {-# INLINE splitAt #-} {-# INLINE unsafeSplitAt #-} {-# INLINE take #-} {-# INLINE unsafeTake #-} {-# INLINE drop #-} {-# INLINE unsafeDrop #-} {-# INLINE partition #-} {-# INLINE uncons #-} {-# INLINE unsnoc #-} {-# INLINE filter #-} {-# INLINE filterM #-} {-# INLINE replicate #-} {-# INLINE replicateM #-} {-# INLINE groupBy #-} {-# INLINE groupAllOn #-} {-# INLINE subsequences #-} {-# INLINE permutations #-} {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE unsafeTail #-} {-# INLINE unsafeInit #-} {-# INLINE index #-} {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} {-# INLINE splitWhen #-} -- | Use "Data.List"'s implementation of 'Data.List.find'. defaultFind :: MonoFoldable seq => (Element seq -> Bool) -> seq -> Maybe (Element seq) defaultFind f = List.find f . otoList {-# INLINE defaultFind #-} -- | Use "Data.List"'s implementation of 'Data.List.intersperse'. defaultIntersperse :: IsSequence seq => Element seq -> seq -> seq defaultIntersperse e = fromList . List.intersperse e . otoList {-# INLINE defaultIntersperse #-} -- | Use "Data.List"'s implementation of 'Data.List.reverse'. defaultReverse :: IsSequence seq => seq -> seq defaultReverse = fromList . List.reverse . otoList {-# INLINE defaultReverse #-} -- | Use "Data.List"'s implementation of 'Data.List.sortBy'. defaultSortBy :: IsSequence seq => (Element seq -> Element seq -> Ordering) -> seq -> seq defaultSortBy f = fromList . sortBy f . otoList {-# INLINE defaultSortBy #-} -- | Use 'splitWhen' from "Data.List.Split" defaultSplitWhen :: IsSequence seq => (Element seq -> Bool) -> seq -> [seq] defaultSplitWhen f = List.map fromList . List.splitWhen f . otoList {-# INLINE defaultSplitWhen #-} -- | Sort a vector using an supplied element ordering function. vectorSortBy :: VG.Vector v e => (e -> e -> Ordering) -> v e -> v e vectorSortBy f = VG.modify (VAM.sortBy f) {-# INLINE vectorSortBy #-} -- | Sort a vector. vectorSort :: (VG.Vector v e, Ord e) => v e -> v e vectorSort = VG.modify VAM.sort {-# INLINE vectorSort #-} -- | Use "Data.List"'s 'Data.List.:' to prepend an element to a sequence. defaultCons :: IsSequence seq => Element seq -> seq -> seq defaultCons e = fromList . (e:) . otoList {-# INLINE defaultCons #-} -- | Use "Data.List"'s 'Data.List.++' to append an element to a sequence. defaultSnoc :: IsSequence seq => seq -> Element seq -> seq defaultSnoc seq e = fromList (otoList seq List.++ [e]) {-# INLINE defaultSnoc #-} -- | 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 {-# INLINE tailDef #-} -- | 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 {-# INLINE initDef #-} instance SemiSequence [a] where type Index [a] = Int intersperse = List.intersperse reverse = List.reverse find = List.find sortBy f = V.toList . sortBy f . V.fromList cons = (:) snoc = defaultSnoc {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance IsSequence [a] where fromList = id filter = List.filter filterM = Control.Monad.filterM break = List.break span = List.span dropWhile = List.dropWhile takeWhile = List.takeWhile splitAt = List.splitAt take = List.take drop = List.drop uncons [] = Nothing uncons (x:xs) = Just (x, xs) unsnoc [] = Nothing unsnoc (x0:xs0) = Just (loop id x0 xs0) where loop front x [] = (front [], x) loop front x (y:z) = loop (front . (x:)) y z partition = List.partition replicate = List.replicate replicateM = Control.Monad.replicateM groupBy = List.groupBy groupAllOn f (head : tail) = (head : matches) : groupAllOn f nonMatches where (matches, nonMatches) = partition ((== f head) . f) tail groupAllOn _ [] = [] splitWhen = List.splitWhen {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} {-# INLINE dropWhile #-} {-# INLINE takeWhile #-} {-# INLINE splitAt #-} {-# INLINE take #-} {-# INLINE drop #-} {-# INLINE partition #-} {-# INLINE uncons #-} {-# INLINE unsnoc #-} {-# INLINE filter #-} {-# INLINE filterM #-} {-# INLINE replicate #-} {-# INLINE replicateM #-} {-# INLINE groupBy #-} {-# INLINE groupAllOn #-} {-# INLINE splitWhen #-} instance SemiSequence (NE.NonEmpty a) where type Index (NE.NonEmpty a) = Int intersperse = NE.intersperse reverse = NE.reverse find x = find x . NE.toList cons = NE.cons snoc xs x = NE.fromList $ flip snoc x $ NE.toList xs sortBy f = NE.fromList . sortBy f . NE.toList {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance SemiSequence S.ByteString where type Index S.ByteString = Int intersperse = S.intersperse reverse = S.reverse find = S.find cons = S.cons snoc = S.snoc sortBy = defaultSortBy {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance IsSequence S.ByteString where fromList = S.pack replicate = S.replicate filter = S.filter break = S.break span = S.span dropWhile = S.dropWhile takeWhile = S.takeWhile splitAt = S.splitAt take = S.take unsafeTake = SU.unsafeTake drop = S.drop unsafeDrop = SU.unsafeDrop partition = S.partition uncons = S.uncons unsnoc s | S.null s = Nothing | otherwise = Just (S.init s, S.last s) groupBy = S.groupBy tailEx = S.tail initEx = S.init unsafeTail = SU.unsafeTail splitWhen f s | S.null s = [S.empty] | otherwise = S.splitWith f s {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} {-# INLINE dropWhile #-} {-# INLINE takeWhile #-} {-# INLINE splitAt #-} {-# INLINE take #-} {-# INLINE unsafeTake #-} {-# INLINE drop #-} {-# INLINE unsafeDrop #-} {-# INLINE partition #-} {-# INLINE uncons #-} {-# INLINE unsnoc #-} {-# INLINE filter #-} {-# INLINE replicate #-} {-# INLINE groupBy #-} {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE unsafeTail #-} {-# INLINE splitWhen #-} index bs i | i >= S.length bs = Nothing | otherwise = Just (S.index bs i) indexEx = S.index unsafeIndex = SU.unsafeIndex {-# INLINE index #-} {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} instance SemiSequence T.Text where type Index T.Text = Int intersperse = T.intersperse reverse = T.reverse find = T.find cons = T.cons snoc = T.snoc sortBy = defaultSortBy {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance IsSequence T.Text where fromList = T.pack replicate i c = T.replicate i (T.singleton c) filter = T.filter break = T.break span = T.span dropWhile = T.dropWhile takeWhile = T.takeWhile splitAt = T.splitAt take = T.take drop = T.drop partition = T.partition uncons = T.uncons unsnoc t | T.null t = Nothing | otherwise = Just (T.init t, T.last t) groupBy = T.groupBy tailEx = T.tail initEx = T.init splitWhen = T.split {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} {-# INLINE dropWhile #-} {-# INLINE takeWhile #-} {-# INLINE splitAt #-} {-# INLINE take #-} {-# INLINE drop #-} {-# INLINE partition #-} {-# INLINE uncons #-} {-# INLINE unsnoc #-} {-# INLINE filter #-} {-# INLINE replicate #-} {-# INLINE groupBy #-} {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE splitWhen #-} index t i | i >= T.length t = Nothing | otherwise = Just (T.index t i) indexEx = T.index unsafeIndex = T.index {-# INLINE index #-} {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} instance SemiSequence L.ByteString where type Index L.ByteString = Int64 intersperse = L.intersperse reverse = L.reverse find = L.find cons = L.cons snoc = L.snoc sortBy = defaultSortBy {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance IsSequence L.ByteString where fromList = L.pack replicate = L.replicate filter = L.filter break = L.break span = L.span dropWhile = L.dropWhile takeWhile = L.takeWhile splitAt = L.splitAt take = L.take drop = L.drop partition = L.partition uncons = L.uncons unsnoc s | L.null s = Nothing | otherwise = Just (L.init s, L.last s) groupBy = L.groupBy tailEx = L.tail initEx = L.init splitWhen f s | L.null s = [L.empty] | otherwise = L.splitWith f s {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} {-# INLINE dropWhile #-} {-# INLINE takeWhile #-} {-# INLINE splitAt #-} {-# INLINE take #-} {-# INLINE drop #-} {-# INLINE partition #-} {-# INLINE uncons #-} {-# INLINE unsnoc #-} {-# INLINE filter #-} {-# INLINE replicate #-} {-# INLINE groupBy #-} {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE splitWhen #-} indexEx = L.index unsafeIndex = L.index {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} instance SemiSequence TL.Text where type Index TL.Text = Int64 intersperse = TL.intersperse reverse = TL.reverse find = TL.find cons = TL.cons snoc = TL.snoc sortBy = defaultSortBy {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance IsSequence TL.Text where fromList = TL.pack replicate i c = TL.replicate i (TL.singleton c) filter = TL.filter break = TL.break span = TL.span dropWhile = TL.dropWhile takeWhile = TL.takeWhile splitAt = TL.splitAt take = TL.take drop = TL.drop partition = TL.partition uncons = TL.uncons unsnoc t | TL.null t = Nothing | otherwise = Just (TL.init t, TL.last t) groupBy = TL.groupBy tailEx = TL.tail initEx = TL.init splitWhen = TL.split {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} {-# INLINE dropWhile #-} {-# INLINE takeWhile #-} {-# INLINE splitAt #-} {-# INLINE take #-} {-# INLINE drop #-} {-# INLINE partition #-} {-# INLINE uncons #-} {-# INLINE unsnoc #-} {-# INLINE filter #-} {-# INLINE replicate #-} {-# INLINE groupBy #-} {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE splitWhen #-} indexEx = TL.index unsafeIndex = TL.index {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} instance SemiSequence (Seq.Seq a) where type Index (Seq.Seq a) = Int cons = (Seq.<|) snoc = (Seq.|>) reverse = Seq.reverse sortBy = Seq.sortBy intersperse = defaultIntersperse find = defaultFind {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance IsSequence (Seq.Seq a) where fromList = Seq.fromList replicate = Seq.replicate replicateM = Seq.replicateM filter = Seq.filter --filterM = Seq.filterM break = Seq.breakl span = Seq.spanl dropWhile = Seq.dropWhileL takeWhile = Seq.takeWhileL splitAt = Seq.splitAt take = Seq.take drop = Seq.drop partition = Seq.partition 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 tailEx = Seq.drop 1 initEx xs = Seq.take (Seq.length xs - 1) xs {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} {-# INLINE dropWhile #-} {-# INLINE takeWhile #-} {-# INLINE splitAt #-} {-# INLINE take #-} {-# INLINE drop #-} {-# INLINE partition #-} {-# INLINE uncons #-} {-# INLINE unsnoc #-} {-# INLINE filter #-} {-# INLINE replicate #-} {-# INLINE replicateM #-} {-# INLINE tailEx #-} {-# INLINE initEx #-} index seq' i | i >= Seq.length seq' = Nothing | otherwise = Just (Seq.index seq' i) indexEx = Seq.index unsafeIndex = Seq.index {-# INLINE index #-} {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} instance SemiSequence (V.Vector a) where type Index (V.Vector a) = Int reverse = V.reverse find = V.find cons = V.cons snoc = V.snoc sortBy = vectorSortBy intersperse = defaultIntersperse {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance IsSequence (V.Vector a) where fromList = V.fromList replicate = V.replicate replicateM = V.replicateM filter = V.filter filterM = V.filterM break = V.break span = V.span dropWhile = V.dropWhile takeWhile = V.takeWhile splitAt = V.splitAt take = V.take drop = V.drop unsafeTake = V.unsafeTake unsafeDrop = V.unsafeDrop partition = V.partition 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 tailEx = V.tail initEx = V.init unsafeTail = V.unsafeTail unsafeInit = V.unsafeInit {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} {-# INLINE dropWhile #-} {-# INLINE takeWhile #-} {-# INLINE splitAt #-} {-# INLINE take #-} {-# INLINE unsafeTake #-} {-# INLINE drop #-} {-# INLINE unsafeDrop #-} {-# INLINE partition #-} {-# INLINE uncons #-} {-# INLINE unsnoc #-} {-# INLINE filter #-} {-# INLINE filterM #-} {-# INLINE replicate #-} {-# INLINE replicateM #-} {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE unsafeTail #-} {-# INLINE unsafeInit #-} index v i | i >= V.length v = Nothing | otherwise = Just (v V.! i) indexEx = (V.!) unsafeIndex = V.unsafeIndex {-# INLINE index #-} {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} instance U.Unbox a => SemiSequence (U.Vector a) where type Index (U.Vector a) = Int intersperse = defaultIntersperse reverse = U.reverse find = U.find cons = U.cons snoc = U.snoc sortBy = vectorSortBy {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance U.Unbox a => IsSequence (U.Vector a) where fromList = U.fromList replicate = U.replicate replicateM = U.replicateM filter = U.filter filterM = U.filterM break = U.break span = U.span dropWhile = U.dropWhile takeWhile = U.takeWhile splitAt = U.splitAt take = U.take drop = U.drop unsafeTake = U.unsafeTake unsafeDrop = U.unsafeDrop partition = U.partition 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 tailEx = U.tail initEx = U.init unsafeTail = U.unsafeTail unsafeInit = U.unsafeInit {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} {-# INLINE dropWhile #-} {-# INLINE takeWhile #-} {-# INLINE splitAt #-} {-# INLINE take #-} {-# INLINE unsafeTake #-} {-# INLINE drop #-} {-# INLINE unsafeDrop #-} {-# INLINE partition #-} {-# INLINE uncons #-} {-# INLINE unsnoc #-} {-# INLINE filter #-} {-# INLINE filterM #-} {-# INLINE replicate #-} {-# INLINE replicateM #-} {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE unsafeTail #-} {-# INLINE unsafeInit #-} index v i | i >= U.length v = Nothing | otherwise = Just (v U.! i) indexEx = (U.!) unsafeIndex = U.unsafeIndex {-# INLINE index #-} {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} instance VS.Storable a => SemiSequence (VS.Vector a) where type Index (VS.Vector a) = Int reverse = VS.reverse find = VS.find cons = VS.cons snoc = VS.snoc intersperse = defaultIntersperse sortBy = vectorSortBy {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance VS.Storable a => IsSequence (VS.Vector a) where fromList = VS.fromList replicate = VS.replicate replicateM = VS.replicateM filter = VS.filter filterM = VS.filterM break = VS.break span = VS.span dropWhile = VS.dropWhile takeWhile = VS.takeWhile splitAt = VS.splitAt take = VS.take drop = VS.drop unsafeTake = VS.unsafeTake unsafeDrop = VS.unsafeDrop partition = VS.partition 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 tailEx = VS.tail initEx = VS.init unsafeTail = VS.unsafeTail unsafeInit = VS.unsafeInit {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} {-# INLINE dropWhile #-} {-# INLINE takeWhile #-} {-# INLINE splitAt #-} {-# INLINE take #-} {-# INLINE unsafeTake #-} {-# INLINE drop #-} {-# INLINE unsafeDrop #-} {-# INLINE partition #-} {-# INLINE uncons #-} {-# INLINE unsnoc #-} {-# INLINE filter #-} {-# INLINE filterM #-} {-# INLINE replicate #-} {-# INLINE replicateM #-} {-# INLINE tailEx #-} {-# INLINE initEx #-} {-# INLINE unsafeTail #-} {-# INLINE unsafeInit #-} index v i | i >= VS.length v = Nothing | otherwise = Just (v VS.! i) indexEx = (VS.!) unsafeIndex = VS.unsafeIndex {-# INLINE index #-} {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} -- | @'splitElem'@ splits a sequence into components delimited by separator -- element. It's equivalent to 'splitWhen' with equality predicate: -- -- > splitElem sep === splitWhen (== sep) -- -- Since 0.9.3 splitElem :: (IsSequence seq, Eq (Element seq)) => Element seq -> seq -> [seq] splitElem x = splitWhen (== x) -- | @'splitSeq'@ splits a sequence into components delimited by -- separator subsequence. 'splitSeq' is the right inverse of 'intercalate': -- -- > ointercalate x . splitSeq x === id -- -- 'splitElem' can be considered a special case of 'splitSeq' -- -- > splitSeq (singleton sep) === splitElem sep -- -- @'splitSeq' mempty@ is another special case: it splits just before each -- element, and in line with 'splitWhen' rules, it has at least one output -- component: -- -- @ -- > 'splitSeq' "" "" -- [""] -- > 'splitSeq' "" "a" -- ["", "a"] -- > 'splitSeq' "" "ab" -- ["", "a", "b"] -- @ -- -- Since 0.9.3 splitSeq :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> [seq] splitSeq sep = List.map fromList . List.splitOn (otoList sep) . otoList -- | @'replaceSeq' old new@ replaces all @old@ subsequences with @new@. -- -- > replaceSeq old new === ointercalate new . splitSeq old -- -- @since 1.0.1 replaceSeq :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq -> seq replaceSeq old new = ointercalate new . splitSeq old -- | 'stripPrefix' drops the given prefix from a sequence. -- It returns 'Nothing' if the sequence did not start with the prefix -- given, or 'Just' the sequence after the prefix, if it does. -- -- @ -- > 'stripPrefix' "foo" "foobar" -- 'Just' "foo" -- > 'stripPrefix' "abc" "foobar" -- 'Nothing' -- @ stripPrefix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Maybe seq stripPrefix x y = fmap fromList (otoList x `List.stripPrefix` otoList y) -- | 'stripSuffix' drops the given suffix from a sequence. -- It returns 'Nothing' if the sequence did not end with the suffix -- given, or 'Just' the sequence before the suffix, if it does. -- -- @ -- > 'stripSuffix' "bar" "foobar" -- 'Just' "foo" -- > 'stripSuffix' "abc" "foobar" -- 'Nothing' -- @ stripSuffix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Maybe seq stripSuffix x y = fmap fromList (otoList x `stripSuffixList` otoList y) where stripSuffixList :: Eq a => [a] -> [a] -> Maybe [a] stripSuffixList x' y' = fmap reverse (stripPrefix (reverse x') (reverse y')) -- | 'isPrefixOf' takes two sequences and returns 'True' if the first -- sequence is a prefix of the second. isPrefixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool isPrefixOf x y = otoList x `List.isPrefixOf` otoList y -- | 'isSuffixOf' takes two sequences and returns 'True' if the first -- sequence is a suffix of the second. isSuffixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool isSuffixOf x y = otoList x `List.isSuffixOf` otoList y -- | 'isInfixOf' takes two sequences and returns 'true' if the first -- sequence is contained, wholly and intact, anywhere within the second. isInfixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool isInfixOf x y = otoList x `List.isInfixOf` otoList y -- | Equivalent to @'groupBy' (==)@ group :: (IsSequence seq, Eq (Element seq)) => seq -> [seq] group = groupBy (==) -- | Similar to standard 'group', but operates on the whole collection, -- not just the consecutive items. -- -- Equivalent to @'groupAllOn' id@ groupAll :: (IsSequence seq, Eq (Element seq)) => seq -> [seq] groupAll = groupAllOn id -- | -- -- @since 0.10.2 delete :: (IsSequence seq, Eq (Element seq)) => Element seq -> seq -> seq delete = deleteBy (==) -- | -- -- @since 0.10.2 deleteBy :: (IsSequence seq, Eq (Element seq)) => (Element seq -> Element seq -> Bool) -> Element seq -> seq -> seq deleteBy eq x = fromList . List.deleteBy eq x . otoList {-# INLINE [0] splitElem #-} {-# INLINE [0] splitSeq #-} {-# INLINE [0] replaceSeq #-} {-# INLINE [0] isPrefixOf #-} {-# INLINE [0] isSuffixOf #-} {-# INLINE [0] isInfixOf #-} {-# INLINE [0] stripPrefix #-} {-# INLINE [0] stripSuffix #-} {-# INLINE [0] group #-} {-# INLINE [0] groupAll #-} {-# INLINE [0] delete #-} {-# INLINE [0] deleteBy #-} {-# RULES "list splitSeq" splitSeq = List.splitOn #-} {-# RULES "list stripPrefix" stripPrefix = List.stripPrefix #-} {-# RULES "list isPrefixOf" isPrefixOf = List.isPrefixOf #-} {-# RULES "list isSuffixOf" isSuffixOf = List.isSuffixOf #-} {-# RULES "list isInfixOf" isInfixOf = List.isInfixOf #-} {-# RULES "list delete" delete = List.delete #-} {-# RULES "list deleteBy" deleteBy = List.deleteBy #-} {-# RULES "strict ByteString splitElem" splitElem = splitElemStrictBS #-} {-# RULES "strict ByteString stripPrefix" stripPrefix = stripPrefixStrictBS #-} {-# RULES "strict ByteString stripSuffix" stripSuffix = stripSuffixStrictBS #-} {-# RULES "strict ByteString group" group = S.group #-} {-# RULES "strict ByteString isPrefixOf" isPrefixOf = S.isPrefixOf #-} {-# RULES "strict ByteString isSuffixOf" isSuffixOf = S.isSuffixOf #-} {-# RULES "strict ByteString isInfixOf" isInfixOf = S.isInfixOf #-} splitElemStrictBS :: Word8 -> S.ByteString -> [S.ByteString] splitElemStrictBS sep s | S.null s = [S.empty] | otherwise = S.split sep s stripPrefixStrictBS :: S.ByteString -> S.ByteString -> Maybe S.ByteString stripPrefixStrictBS x y | x `S.isPrefixOf` y = Just (S.drop (S.length x) y) | otherwise = Nothing stripSuffixStrictBS :: S.ByteString -> S.ByteString -> Maybe S.ByteString stripSuffixStrictBS x y | x `S.isSuffixOf` y = Just (S.take (S.length y - S.length x) y) | otherwise = Nothing {-# RULES "lazy ByteString splitElem" splitElem = splitSeqLazyBS #-} {-# RULES "lazy ByteString stripPrefix" stripPrefix = stripPrefixLazyBS #-} {-# RULES "lazy ByteString stripSuffix" stripSuffix = stripSuffixLazyBS #-} {-# RULES "lazy ByteString group" group = L.group #-} {-# RULES "lazy ByteString isPrefixOf" isPrefixOf = L.isPrefixOf #-} {-# RULES "lazy ByteString isSuffixOf" isSuffixOf = L.isSuffixOf #-} splitSeqLazyBS :: Word8 -> L.ByteString -> [L.ByteString] splitSeqLazyBS sep s | L.null s = [L.empty] | otherwise = L.split sep s stripPrefixLazyBS :: L.ByteString -> L.ByteString -> Maybe L.ByteString stripPrefixLazyBS x y | x `L.isPrefixOf` y = Just (L.drop (L.length x) y) | otherwise = Nothing stripSuffixLazyBS :: L.ByteString -> L.ByteString -> Maybe L.ByteString stripSuffixLazyBS x y | x `L.isSuffixOf` y = Just (L.take (L.length y - L.length x) y) | otherwise = Nothing {-# RULES "strict Text splitSeq" splitSeq = splitSeqStrictText #-} {-# RULES "strict Text replaceSeq" replaceSeq = replaceSeqStrictText #-} {-# RULES "strict Text stripPrefix" stripPrefix = T.stripPrefix #-} {-# RULES "strict Text stripSuffix" stripSuffix = T.stripSuffix #-} {-# RULES "strict Text group" group = T.group #-} {-# RULES "strict Text isPrefixOf" isPrefixOf = T.isPrefixOf #-} {-# RULES "strict Text isSuffixOf" isSuffixOf = T.isSuffixOf #-} {-# RULES "strict Text isInfixOf" isInfixOf = T.isInfixOf #-} splitSeqStrictText :: T.Text -> T.Text -> [T.Text] splitSeqStrictText sep | T.null sep = (:) T.empty . List.map singleton . T.unpack | otherwise = T.splitOn sep replaceSeqStrictText :: T.Text -> T.Text -> T.Text -> T.Text replaceSeqStrictText old new | T.null old = T.intercalate new . splitSeqStrictText old | otherwise = T.replace old new {-# RULES "lazy Text splitSeq" splitSeq = splitSeqLazyText #-} {-# RULES "lazy Text replaceSeq" replaceSeq = replaceSeqLazyText #-} {-# RULES "lazy Text stripPrefix" stripPrefix = TL.stripPrefix #-} {-# RULES "lazy Text stripSuffix" stripSuffix = TL.stripSuffix #-} {-# RULES "lazy Text group" group = TL.group #-} {-# RULES "lazy Text isPrefixOf" isPrefixOf = TL.isPrefixOf #-} {-# RULES "lazy Text isSuffixOf" isSuffixOf = TL.isSuffixOf #-} {-# RULES "lazy Text isInfixOf" isInfixOf = TL.isInfixOf #-} splitSeqLazyText :: TL.Text -> TL.Text -> [TL.Text] splitSeqLazyText sep | TL.null sep = (:) TL.empty . List.map singleton . TL.unpack | otherwise = TL.splitOn sep replaceSeqLazyText :: TL.Text -> TL.Text -> TL.Text -> TL.Text replaceSeqLazyText old new | TL.null old = TL.intercalate new . splitSeqLazyText old | otherwise = TL.replace old new -- | Sort a ordered sequence. -- -- @ -- > 'sort' [4,3,1,2] -- [1,2,3,4] -- @ sort :: (IsSequence seq, Ord (Element seq)) => seq -> seq sort = fromList . V.toList . vectorSort . V.fromList . otoList {-# INLINE [0] sort #-} {-# RULES "strict ByteString sort" sort = S.sort #-} {-# RULES "boxed Vector sort" forall (v :: V.Vector a). sort v = vectorSort v #-} {-# RULES "unboxed Vector sort" forall (v :: U.Unbox a => U.Vector a). sort v = vectorSort v #-} {-# RULES "storable Vector sort" forall (v :: VS.Storable a => VS.Vector a). sort v = vectorSort v #-} -- | A typeclass for sequences whose elements are 'Char's. class (IsSequence t, IsString t, Element t ~ Char) => Textual t where -- | Break up a textual sequence into a list of words, which were delimited -- by white space. -- -- @ -- > 'words' "abc def ghi" -- ["abc","def","ghi"] -- @ words :: t -> [t] -- | Join a list of textual sequences using seperating spaces. -- -- @ -- > 'unwords' ["abc","def","ghi"] -- "abc def ghi" -- @ unwords :: (Element seq ~ t, MonoFoldable seq) => seq -> t -- | Break up a textual sequence at newline characters. -- -- -- @ -- > 'lines' "hello\\nworld" -- ["hello","world"] -- @ lines :: t -> [t] -- | Join a list of textual sequences using newlines. -- -- @ -- > 'unlines' ["abc","def","ghi"] -- "abc\\ndef\\nghi" -- @ unlines :: (Element seq ~ t, MonoFoldable seq) => seq -> t -- | Convert a textual sequence to lower-case. -- -- @ -- > 'toLower' "HELLO WORLD" -- "hello world" -- @ toLower :: t -> t -- | Convert a textual sequence to upper-case. -- -- @ -- > 'toUpper' "hello world" -- "HELLO WORLD" -- @ toUpper :: t -> t -- | Convert a textual sequence to folded-case. -- -- Slightly different from 'toLower', see @"Data.Text".'Data.Text.toCaseFold'@ toCaseFold :: t -> t -- | Split a textual sequence into two parts, split at the first space. -- -- @ -- > 'breakWord' "hello world" -- ("hello","world") -- @ breakWord :: t -> (t, t) breakWord = fmap (dropWhile isSpace) . break isSpace {-# INLINE breakWord #-} -- | Split a textual sequence into two parts, split at the newline. -- -- @ -- > 'breakLine' "abc\\ndef" -- ("abc","def") -- @ 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 . otoList lines = List.lines unlines = List.unlines . otoList toLower = TL.unpack . TL.toLower . TL.pack toUpper = TL.unpack . TL.toUpper . TL.pack toCaseFold = TL.unpack . TL.toCaseFold . TL.pack {-# INLINE words #-} {-# INLINE unwords #-} {-# INLINE lines #-} {-# INLINE unlines #-} {-# INLINE toLower #-} {-# INLINE toUpper #-} {-# INLINE toCaseFold #-} instance Textual T.Text where words = T.words unwords = T.unwords . otoList lines = T.lines unlines = T.unlines . otoList toLower = T.toLower toUpper = T.toUpper toCaseFold = T.toCaseFold {-# INLINE words #-} {-# INLINE unwords #-} {-# INLINE lines #-} {-# INLINE unlines #-} {-# INLINE toLower #-} {-# INLINE toUpper #-} {-# INLINE toCaseFold #-} instance Textual TL.Text where words = TL.words unwords = TL.unwords . otoList lines = TL.lines unlines = TL.unlines . otoList toLower = TL.toLower toUpper = TL.toUpper toCaseFold = TL.toCaseFold {-# INLINE words #-} {-# INLINE unwords #-} {-# INLINE lines #-} {-# INLINE unlines #-} {-# INLINE toLower #-} {-# INLINE toUpper #-} {-# INLINE toCaseFold #-} -- | Takes all of the `Just` values from a sequence of @Maybe t@s and -- concatenates them into an unboxed sequence of @t@s. -- -- Since 0.6.2 catMaybes :: (IsSequence (f (Maybe t)), Functor f, Element (f (Maybe t)) ~ Maybe t) => f (Maybe t) -> f t catMaybes = fmap fromJust . filter isJust -- | Same as @sortBy . comparing@. -- -- Since 0.7.0 sortOn :: (Ord o, SemiSequence seq) => (Element seq -> o) -> seq -> seq sortOn = sortBy . comparing {-# INLINE sortOn #-} -- | Lazy sequences containing strict chunks of data. -- -- @since 1.0.0 class (IsSequence lazy, IsSequence strict) => LazySequence lazy strict | lazy -> strict, strict -> lazy where toChunks :: lazy -> [strict] fromChunks :: [strict] -> lazy toStrict :: lazy -> strict fromStrict :: strict -> lazy instance LazySequence L.ByteString S.ByteString where toChunks = L.toChunks fromChunks = L.fromChunks toStrict = S.concat . 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 -- | Synonym for 'fromList' -- -- @since 1.0.0 pack :: IsSequence seq => [Element seq] -> seq pack = fromList {-# INLINE pack #-} -- | Synonym for 'otoList' -- -- @since 1.0.0 unpack :: MonoFoldable mono => mono -> [Element mono] unpack = otoList {-# INLINE unpack #-} -- | Repack from one type to another, dropping to a list in the middle. -- -- @repack = pack . unpack@. -- -- @since 1.0.0 repack :: (MonoFoldable a, IsSequence b, Element a ~ Element b) => a -> b repack = pack . unpack -- | Textual data which can be encoded to and decoded from UTF8. -- -- @since 1.0.0 class (Textual textual, IsSequence binary) => Utf8 textual binary | textual -> binary, binary -> textual where -- | Encode from textual to binary using UTF-8 encoding -- -- @since 1.0.0 encodeUtf8 :: textual -> binary -- | Note that this function is required to be pure. In the case of -- a decoding error, Unicode replacement characters must be used. -- -- @since 1.0.0 decodeUtf8 :: binary -> textual instance (c ~ Char, w ~ Word8) => Utf8 [c] [w] where encodeUtf8 = L.unpack . TL.encodeUtf8 . TL.pack decodeUtf8 = TL.unpack . TL.decodeUtf8With lenientDecode . L.pack instance Utf8 T.Text S.ByteString where encodeUtf8 = T.encodeUtf8 decodeUtf8 = T.decodeUtf8With lenientDecode instance Utf8 TL.Text L.ByteString where encodeUtf8 = TL.encodeUtf8 decodeUtf8 = TL.decodeUtf8With lenientDecode mono-traversable-1.0.1/src/Data/MonoTraversable/0000755000000000000000000000000012766512504017732 5ustar0000000000000000mono-traversable-1.0.1/src/Data/MonoTraversable/Unprefixed.hs0000644000000000000000000001310212766512504022374 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} -- | The functions in "Data.MonoTraversable" are all prefixed with the letter -- @o@ to avoid conflicts with their polymorphic counterparts. This module -- exports the same identifiers without the prefix, for all cases where the -- monomorphic variant loses no generality versus the polymorphic version. For -- example, 'olength' is just as general as @Data.Foldable.length@, so we -- export @length = length@. By contrast, 'omap' cannot fully subsume @fmap@ or -- @map@, so we do not provide such an export. -- -- @since 1.0.0 module Data.MonoTraversable.Unprefixed where import Data.Int (Int64) import Data.MonoTraversable import Data.Semigroup (Semigroup) import Data.Monoid (Monoid) import Control.Applicative (Applicative) -- | Synonym for 'ofoldMap' -- -- @since 1.0.0 foldMap :: (MonoFoldable mono, Data.Monoid.Monoid m) => (Element mono -> m) -> mono -> m foldMap = ofoldMap -- | Synonym for 'ofoldr' -- -- @since 1.0.0 foldr :: MonoFoldable mono => (Element mono -> b -> b) -> b -> mono -> b foldr = ofoldr -- | Synonym for 'ofoldl'' -- -- @since 1.0.0 foldl' :: MonoFoldable mono => (a -> Element mono -> a) -> a -> mono -> a foldl' = ofoldl' -- | Synonym for 'otoList' -- -- @since 1.0.0 toList :: MonoFoldable mono => mono -> [Element mono] toList = otoList -- | Synonym for 'oall' -- -- @since 1.0.0 all :: MonoFoldable mono => (Element mono -> Bool) -> mono -> Bool all = oall -- | Synonym for 'oany' -- -- @since 1.0.0 any :: MonoFoldable mono => (Element mono -> Bool) -> mono -> Bool any = oany -- | Synonym for 'onull' -- -- @since 1.0.0 null :: MonoFoldable mono => mono -> Bool null = onull -- | Synonym for 'olength' -- -- @since 1.0.0 length :: MonoFoldable mono => mono -> Int length = olength -- | Synonym for 'olength64' -- -- @since 1.0.0 length64 :: MonoFoldable mono => mono -> Int64 length64 = olength64 -- | Synonym for 'ocompareLength' -- -- @since 1.0.0 compareLength :: (MonoFoldable mono, Integral i) => mono -> i -> Ordering compareLength = ocompareLength -- | Synonym for 'otraverse_' -- -- @since 1.0.0 traverse_ :: (MonoFoldable mono, Control.Applicative.Applicative f) => (Element mono -> f b) -> mono -> f () traverse_ = otraverse_ -- | Synonym for 'ofor_' -- -- @since 1.0.0 for_ :: (MonoFoldable mono, Applicative f) => mono -> (Element mono -> f b) -> f () for_ = ofor_ -- | Synonym for 'omapM_' -- -- @since 1.0.0 #if MIN_VERSION_base(4,8,0) mapM_ :: (MonoFoldable mono, Applicative m) => (Element mono -> m ()) -> mono -> m () #else mapM_ :: (MonoFoldable mono, Monad m) => (Element mono -> m ()) -> mono -> m () #endif mapM_ = omapM_ -- | Synonym for 'oforM_' -- -- @since 1.0.0 #if MIN_VERSION_base(4,8,0) forM_ :: (MonoFoldable mono, Applicative m) => mono -> (Element mono -> m ()) -> m () #else forM_ :: (MonoFoldable mono, Monad m) => mono -> (Element mono -> m ()) -> m () #endif forM_ = oforM_ -- | Synonym for 'ofoldlM' -- -- @since 1.0.0 foldlM :: (MonoFoldable mono, Monad m) => (a -> Element mono -> m a) -> a -> mono -> m a foldlM = ofoldlM -- | Synonym for 'ofoldMap1Ex' -- -- @since 1.0.0 foldMap1Ex :: (MonoFoldable mono, Semigroup m) => (Element mono -> m) -> mono -> m foldMap1Ex = ofoldMap1Ex -- | Synonym for 'ofoldr1Ex' -- -- @since 1.0.0 foldr1Ex :: MonoFoldable mono => (Element mono -> Element mono -> Element mono) -> mono -> Element mono foldr1Ex = ofoldr1Ex -- | Synonym for 'ofoldl1Ex'' -- -- @since 1.0.0 foldl1Ex' :: MonoFoldable mono => (Element mono -> Element mono -> Element mono) -> mono -> Element mono foldl1Ex' = ofoldl1Ex' -- | Synonym for 'osum' -- -- @since 1.0.0 sum :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono sum = osum -- | Synonym for 'oproduct' -- -- @since 1.0.0 product :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono product = oproduct -- | Synonym for 'oand' -- -- @since 1.0.0 and :: (MonoFoldable mono, Element mono ~ Bool) => mono -> Bool and = oand -- | Synonym for 'oor' -- -- @since 1.0.0 or :: (MonoFoldable mono, Element mono ~ Bool) => mono -> Bool or = oor -- | Synonym for 'oconcatMap' -- -- @since 1.0.0 concatMap :: (MonoFoldable mono, Monoid m) => (Element mono -> m) -> mono -> m concatMap = oconcatMap -- | Synonym for 'oelem' -- -- @since 1.0.0 elem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool elem = oelem -- | Synonym for 'onotElem' -- -- @since 1.0.0 notElem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool notElem = onotElem -- | Synonym for 'opoint' -- -- @since 1.0.0 point :: MonoPointed mono => Element mono -> mono point = opoint -- | Synonym for 'ointercalate' -- -- @since 1.0.0 intercalate :: (MonoFoldable mono, Monoid (Element mono)) => Element mono -> mono -> Element mono intercalate = ointercalate -- | Synonym for 'ofold' -- -- @since 1.0.0 fold :: (MonoFoldable mono, Monoid (Element mono)) => mono -> Element mono fold = ofold -- | Synonym for 'oconcat' -- -- @since 1.0.0 concat :: (MonoFoldable mono, Monoid (Element mono)) => mono -> Element mono concat = oconcat -- | Synonym for 'ofoldM' -- -- @since 1.0.0 foldM :: (MonoFoldable mono, Monad m) => (a -> Element mono -> m a) -> a -> mono -> m a foldM = ofoldM -- | Synonym for 'osequence_' -- -- @since 1.0.0 #if MIN_VERSION_base(4,8,0) sequence_ :: (Applicative m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m () #else sequence_ :: (Monad m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m () #endif sequence_ = osequence_ mono-traversable-1.0.1/test/0000755000000000000000000000000012766512504014146 5ustar0000000000000000mono-traversable-1.0.1/test/main.hs0000644000000000000000000000002312766512504015421 0ustar0000000000000000import Spec (main) mono-traversable-1.0.1/test/Spec.hs0000644000000000000000000005260012766512504015377 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP #-} module Spec where import Data.MonoTraversable import Data.Containers import Data.Sequences import qualified Data.Sequence as Seq import qualified Data.NonNull as NN import Data.Monoid (mempty, mconcat) import Data.Maybe (fromMaybe) import qualified Data.List as List import Test.Hspec import Test.Hspec.QuickCheck import Test.HUnit ((@?=)) import Test.QuickCheck hiding (NonEmptyList(..)) import qualified Test.QuickCheck.Modifiers as QCM import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Storable as VS import qualified Data.List.NonEmpty as NE import qualified Data.Semigroup as SG import qualified Data.Map as Map import qualified Data.IntMap as IntMap import qualified Data.HashMap.Strict as HashMap import qualified Data.Set as Set import qualified Control.Foldl as Foldl import Control.Arrow (second) import Control.Applicative import Control.Monad.Trans.Writer import Prelude (Bool (..), ($), IO, Eq (..), fromIntegral, Ord (..), String, mod, Int, Integer, show, return, asTypeOf, (.), Show, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, maybe) import qualified Prelude newtype NonEmpty' a = NonEmpty' (NE.NonEmpty a) deriving (Show, Eq) instance Arbitrary a => Arbitrary (NonEmpty' a) where arbitrary = NonEmpty' <$> ((NE.:|) <$> arbitrary <*> arbitrary) -- | Arbitrary newtype for key-value pairs without any duplicate keys -- and is not empty newtype DuplPairs k v = DuplPairs { unDupl :: [(k,v)] } deriving (Eq, Show) removeDuplicateKeys :: Ord k => [(k,v)] -> [(k,v)] removeDuplicateKeys m = go Set.empty m where go _ [] = [] go used ((k,v):xs) | k `member` used = go used xs | otherwise = (k,v) : go (insertSet k used) xs instance (Arbitrary k, Arbitrary v, Ord k, Eq v) => Arbitrary (DuplPairs k v) where arbitrary = DuplPairs . removeDuplicateKeys <$> arbitrary `suchThat` (/= []) shrink (DuplPairs xs) = map (DuplPairs . removeDuplicateKeys) $ filter (/= []) $ shrink xs -- | Arbitrary newtype for small lists whose length is <= 10 -- -- Used for testing 'unionsWith' newtype SmallList a = SmallList { getSmallList :: [a] } deriving (Eq, Show, Ord) instance (Arbitrary a) => Arbitrary (SmallList a) where arbitrary = SmallList <$> arbitrary `suchThat` ((<= 10) . olength) shrink (SmallList xs) = map SmallList $ filter ((<= 10) . olength) $ shrink xs -- | Choose a random key from a key-value pair list indexIn :: (Show k, Testable prop) => [(k,v)] -> (k -> prop) -> Property indexIn = forAll . elements . map Prelude.fst -- | Type restricted 'fromList' fromListAs :: IsSequence a => [Element a] -> a -> a fromListAs xs _ = fromList xs -- | Type restricted 'mapFromListAs' mapFromListAs :: IsMap a => [(ContainerKey a, MapValue a)] -> a -> a mapFromListAs xs _ = mapFromList xs main :: IO () main = hspec $ do describe "onull" $ do it "works on empty lists" $ onull [] @?= True it "works on non-empty lists" $ onull [()] @?= False it "works on empty texts" $ onull ("" :: Text) @?= True it "works on non-empty texts" $ onull ("foo" :: Text) @?= False describe "osum" $ do prop "works on lists" $ \(Small x) (Small y) -> y >= x ==> osum [x..y] @?= ((x + y) * (y - x + 1) `div` (2 :: Int)) describe "oproduct" $ do prop "works on lists" $ \(Positive x) (Positive y) -> let fact n = oproduct [1..n] in (y :: Integer) > (x :: Integer) ==> oproduct [x..y] @?= fact y `div` fact (x - 1) describe "olength" $ do prop "works on lists" $ \(NonNegative i) -> olength (replicate i () :: [()]) @?= i prop "works on texts" $ \(NonNegative i) -> olength (replicate i 'a' :: Text) @?= i prop "works on lazy bytestrings" $ \(NonNegative (Small i)) -> olength64 (replicate i 6 :: L.ByteString) @?= i describe "omap" $ do prop "works on lists" $ \xs -> omap (+1) xs @?= map (+1) (xs :: [Int]) prop "works on lazy bytestrings" $ \xs -> omap (+1) (fromList xs :: L.ByteString) @?= fromList (map (+1) xs) prop "works on texts" $ \xs -> omap succ (fromList xs :: Text) @?= fromList (map succ xs) describe "oconcatMap" $ do prop "works on lists" $ \xs -> oconcatMap (: []) xs @?= (xs :: [Int]) describe "ocompareLength" $ do prop "works on lists" $ \(Positive i) j -> ocompareLength (replicate i () :: [()]) j @?= compare i j describe "groupAll" $ do it "works on lists" $ groupAll ("abcabcabc" :: String) @?= ["aaa", "bbb", "ccc"] it "works on texts" $ groupAll ("abcabcabc" :: Text) @?= ["aaa", "bbb", "ccc"] describe "unsnoc" $ do let test name dummy = prop name $ \(QCM.NonEmpty xs) -> let seq' = fromListAs xs dummy in case unsnoc seq' of Just (y, z) -> do y SG.<> singleton z @?= seq' snoc y z @?= seq' otoList (snoc y z) @?= xs Nothing -> expectationFailure "unsnoc returned Nothing" test "works on lists" ([] :: [Int]) test "works on texts" ("" :: Text) test "works on lazy bytestrings" L.empty describe "index" $ do let test name dummy = prop name $ \(NonNegative i') (QCM.NonEmpty xs) -> let seq' = fromListAs xs dummy mx = index xs (fromIntegral i) i = fromIntegral (i' :: Int) in do mx @?= index seq' i case mx of Nothing -> return () Just x -> indexEx seq' i @?= x test "works on lists" ([] :: [Int]) test "works on strict texts" ("" :: Text) test "works on lazy texts" ("" :: TL.Text) test "works on strict bytestrings" S.empty test "works on lazy bytestrings" L.empty test "works on Vector" (V.singleton (1 :: Int)) test "works on SVector" (VS.singleton (1 :: Int)) test "works on UVector" (U.singleton (1 :: Int)) test "works on Seq" (Seq.fromList [1 :: Int]) describe "groupAllOn" $ do it "works on lists" $ 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) @?= (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) @?= (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 "" "" "" describe "omapM_" $ do let test typ dummy = prop typ $ \input -> input @?= execWriter (omapM_ (tell . return) (fromListAs input dummy)) test "works on strict bytestrings" S.empty test "works on lazy bytestrings" L.empty test "works on strict texts" T.empty test "works on lazy texts" TL.empty describe "NonNull" $ do describe "fromNonEmpty" $ do prop "toMinList" $ \(NonEmpty' ne) -> (NE.toList ne :: [Int]) @?= NN.toNullable (NN.toMinList ne) let -- | Type restricted 'NN.ncons' nconsAs :: IsSequence seq => Element seq -> [Element seq] -> seq -> NN.NonNull seq nconsAs x xs _ = NN.ncons x (fromList xs) test :: (IsSequence typ, Ord (Element typ), Arbitrary (Element typ), Show (Element typ), Show typ, Eq typ, Eq (Element typ)) => String -> typ -> Spec test typ du = describe typ $ do prop "head" $ \x xs -> NN.head (nconsAs x xs du) @?= x prop "tail" $ \x xs -> NN.tail (nconsAs x xs du) @?= fromList xs prop "last" $ \x xs -> NN.last (reverse $ nconsAs x xs du) @?= x prop "init" $ \x xs -> NN.init (reverse $ nconsAs x xs du) @?= reverse (fromList xs) prop "maximum" $ \x xs -> NN.maximum (nconsAs x xs du) @?= Prelude.maximum (x:xs) prop "maximumBy" $ \x xs -> NN.maximumBy compare (nconsAs x xs du) @?= Prelude.maximum (x:xs) prop "minimum" $ \x xs -> NN.minimum (nconsAs x xs du) @?= Prelude.minimum (x:xs) prop "minimumBy" $ \x xs -> NN.minimumBy compare (nconsAs x xs du) @?= Prelude.minimum (x:xs) prop "ofoldMap1" $ \x xs -> SG.getMax (NN.ofoldMap1 SG.Max $ nconsAs x xs du) @?= Prelude.maximum (x:xs) prop "ofoldr1" $ \x xs -> NN.ofoldr1 Prelude.min (nconsAs x xs du) @?= Prelude.minimum (x:xs) prop "ofoldl1'" $ \x xs -> NN.ofoldl1' Prelude.min (nconsAs x xs du) @?= Prelude.minimum (x:xs) test "Strict ByteString" S.empty test "Lazy ByteString" L.empty test "Strict Text" T.empty test "Lazy Text" TL.empty test "Vector" (V.empty :: V.Vector Int) test "Unboxed Vector" (U.empty :: U.Vector Int) test "Storable Vector" (VS.empty :: VS.Vector Int) test "List" ([5 :: Int]) describe "Containers" $ do let test typ dummy xlookup xinsert xdelete = describe typ $ do prop "difference" $ \(DuplPairs xs) (DuplPairs ys) -> let m1 = mapFromList xs `difference` mapFromList ys m2 = mapFromListAs (xs `difference` ys) dummy in m1 @?= m2 prop "lookup" $ \(DuplPairs xs) -> indexIn xs $ \k -> let m = mapFromListAs xs dummy v1 = lookup k m in do v1 @?= lookup k xs v1 @?= xlookup k m prop "insert" $ \(DuplPairs xs) v -> indexIn xs $ \k -> let m = mapFromListAs xs dummy m1 = insertMap k v m in do m1 @?= mapFromList (insertMap k v xs) m1 @?= xinsert k v m prop "delete" $ \(DuplPairs xs) -> indexIn xs $ \k -> let m = mapFromListAs xs dummy m1 = deleteMap k m in do m1 @?= mapFromList (deleteMap k xs) m1 @?= xdelete k m prop "singletonMap" $ \k v -> singletonMap k v @?= (mapFromListAs [(k, v)] dummy) prop "findWithDefault" $ \(DuplPairs xs) k v -> findWithDefault v k (mapFromListAs xs dummy) @?= findWithDefault v k xs prop "insertWith" $ \(DuplPairs xs) k v -> insertWith (+) k v (mapFromListAs xs dummy) @?= mapFromList (insertWith (+) k v xs) prop "insertWithKey" $ \(DuplPairs xs) k v -> let m = mapFromListAs xs dummy f x y z = x + y + z in insertWithKey f k v m @?= mapFromList (insertWithKey f k v xs) prop "insertLookupWithKey" $ \(DuplPairs xs) k v -> let m = mapFromListAs xs dummy f x y z = x + y + z in insertLookupWithKey f k v m @?= second mapFromList (insertLookupWithKey f k v xs) prop "adjustMap" $ \(DuplPairs xs) k -> adjustMap succ k (mapFromListAs xs dummy) @?= mapFromList (adjustMap succ k xs) prop "adjustWithKey" $ \(DuplPairs xs) k -> adjustWithKey (+) k (mapFromListAs xs dummy) @?= mapFromList (adjustWithKey (+) k xs) prop "updateMap" $ \(DuplPairs xs) k -> let f i = if i < 0 then Nothing else Just $ i * 2 in updateMap f k (mapFromListAs xs dummy) @?= mapFromList (updateMap f k xs) prop "updateWithKey" $ \(DuplPairs xs) k' -> let f k i = if i < 0 then Nothing else Just $ i * k in updateWithKey f k' (mapFromListAs xs dummy) @?= mapFromList (updateWithKey f k' xs) prop "updateLookupWithKey" $ \(DuplPairs xs) k' -> let f k i = if i < 0 then Nothing else Just $ i * k in updateLookupWithKey f k' (mapFromListAs xs dummy) @?= second mapFromList (updateLookupWithKey f k' xs) prop "alter" $ \(DuplPairs xs) k -> let m = mapFromListAs xs dummy f Nothing = Just (-1) f (Just i) = if i < 0 then Nothing else Just (i * 2) in lookup k (alterMap f k m) @?= f (lookup k m) prop "unionWith" $ \(DuplPairs xs) (DuplPairs ys) -> let m1 = unionWith (+) (mapFromListAs xs dummy) (mapFromListAs ys dummy) m2 = mapFromList (unionWith (+) xs ys) in m1 @?= m2 prop "unionWithKey" $ \(DuplPairs xs) (DuplPairs ys) -> let f k x y = k + x + y m1 = unionWithKey f (mapFromListAs xs dummy) (mapFromListAs ys dummy) m2 = mapFromList (unionWithKey f xs ys) in m1 @?= m2 prop "unionsWith" $ \(SmallList xss) -> let duplXss = map unDupl xss ms = map mapFromList duplXss `asTypeOf` [dummy] in unionsWith (+) ms @?= mapFromList (unionsWith (+) duplXss) prop "mapWithKey" $ \(DuplPairs xs) -> let m1 = mapWithKey (+) (mapFromList xs) `asTypeOf` dummy m2 = mapFromList $ mapWithKey (+) xs in m1 @?= m2 prop "omapKeysWith" $ \(DuplPairs xs) -> let f = flip mod 5 m1 = omapKeysWith (+) f (mapFromList xs) `asTypeOf` dummy m2 = mapFromList $ omapKeysWith (+) f xs in m1 @?= m2 test "Data.Map" (Map.empty :: Map.Map Int Int) Map.lookup Map.insert Map.delete test "Data.IntMap" (IntMap.empty :: IntMap.IntMap Int) IntMap.lookup IntMap.insert IntMap.delete test "Data.HashMap" (HashMap.empty :: HashMap.HashMap Int Int) HashMap.lookup HashMap.insert HashMap.delete describe "Foldl Integration" $ do prop "vector" $ \xs -> do x1 <- Foldl.foldM Foldl.vector (xs :: [Int]) x2 <- Foldl.impurely ofoldMUnwrap Foldl.vector xs x2 @?= (x1 :: V.Vector Int) prop "length" $ \xs -> do let x1 = Foldl.fold Foldl.length (xs :: [Int]) x2 = Foldl.purely ofoldlUnwrap Foldl.length xs x2 @?= x1 describe "Replacing" $ do let test typ dummy = describe typ $ do prop "replaceElem old new === omap (\\x -> if x == old then new else x)" $ -- replace random element or any random value with random new value \x list new -> forAll (elements (x:list)) $ \old -> let seq' = fromListAs list dummy in replaceElem old new seq' @?= omap (\x -> if x == old then new else x) seq' #if MIN_VERSION_QuickCheck(2,8,0) prop "replaceSeq old new === ointercalate new . splitSeq old" $ -- replace random subsequence with random new sequence \list new -> forAll (sublistOf list) $ \old -> let [seq', old', new'] = map (`fromListAs` dummy) [list, old, new] in replaceSeq old' new' seq' @?= ointercalate new' (splitSeq old' seq') prop "replaceSeq old old === id" $ \list -> forAll (sublistOf list) $ \old -> let [seq', old'] = map (`fromListAs` dummy) [list, old] in replaceSeq old' old' seq' @?= seq' #endif test "List" ([] :: [Int]) test "Vector" (V.empty :: V.Vector Int) test "Storable Vector" (VS.empty :: VS.Vector Int) test "Unboxed Vector" (U.empty :: U.Vector Int) test "Strict ByteString" S.empty test "Lazy ByteString" L.empty test "Strict Text" T.empty test "Lazy Text" TL.empty describe "Sorting" $ do let test typ dummy = describe typ $ do prop "sortBy" $ \input -> do let f x y = compare y x fromList (sortBy f input) @?= sortBy f (fromListAs input dummy) prop "sort" $ \input -> fromList (sort input) @?= sort (fromListAs input dummy) test "List" ([] :: [Int]) test "Vector" (V.empty :: V.Vector Int) test "Storable Vector" (VS.empty :: VS.Vector Int) test "Unboxed Vector" (U.empty :: U.Vector Int) test "Strict ByteString" S.empty test "Lazy ByteString" L.empty test "Strict Text" T.empty test "Lazy Text" TL.empty describe "Intercalate" $ do let test typ dummy = describe typ $ do prop "intercalate === defaultIntercalate" $ \list lists -> let seq' = fromListAs list dummy seqs = map (`fromListAs` dummy) lists in ointercalate seq' seqs @?= fromList (List.intercalate list lists) test "List" ([] :: [Int]) test "Vector" (V.empty :: V.Vector Int) test "Storable Vector" (VS.empty :: VS.Vector Int) test "Unboxed Vector" (U.empty :: U.Vector Int) test "Strict ByteString" S.empty test "Lazy ByteString" L.empty test "Strict Text" T.empty test "Lazy Text" TL.empty describe "Splitting" $ do let test typ dummy = describe typ $ do let fromList' = (`fromListAs` dummy) let fromSepList sep = fromList' . map (fromMaybe sep) prop "intercalate sep . splitSeq sep === id" $ \(fromList' -> sep) -> \(mconcat . map (maybe sep fromList') -> xs) -> ointercalate sep (splitSeq sep xs) @?= xs prop "splitSeq mempty xs === mempty : map singleton (otoList xs)" $ \input -> splitSeq mempty (fromList' input) @?= mempty : map singleton input prop "splitSeq _ mempty == [mempty]" $ \(fromList' -> sep) -> splitSeq sep mempty @?= [mempty] prop "intercalate (singleton sep) . splitElem sep === id" $ \sep -> \(fromSepList sep -> xs) -> ointercalate (singleton sep) (splitElem sep xs) @?= xs prop "length . splitElem sep === succ . length . filter (== sep)" $ \sep -> \(fromSepList sep -> xs) -> olength (splitElem sep xs) @?= olength (filter (== sep) xs) + 1 prop "splitElem sep (replicate n sep) == replicate (n+1) mempty" $ \(NonNegative n) sep -> splitElem sep (fromList' (replicate n sep)) @?= replicate (n + 1) mempty prop "splitElem sep === splitWhen (== sep)" $ \sep -> \(fromSepList sep -> xs) -> splitElem sep xs @?= splitWhen (== sep) xs prop "splitElem sep === splitSeq (singleton sep)" $ \sep -> \(fromSepList sep -> xs) -> splitElem sep xs @?= splitSeq (singleton sep) xs test "List" ([] :: [Int]) test "Vector" (V.empty :: V.Vector Int) test "Storable Vector" (VS.empty :: VS.Vector Int) test "Unboxed Vector" (U.empty :: U.Vector Int) test "Strict ByteString" S.empty test "Lazy ByteString" L.empty test "Strict Text" T.empty test "Lazy Text" TL.empty describe "Other Issues" $ do it "#26 headEx on a list works" $ headEx (1 : filter Prelude.odd [2,4..]) @?= (1 :: Int) it "#31 find doesn't infinitely loop on NonEmpty" $ find (== "a") ("a" NE.:| ["d","fgf"]) @?= Just ("a" :: String) it "#83 head on Seq works correctly" $ do headEx (Seq.fromList [1 :: Int,2,3]) @?= (1 :: Int) headMay (Seq.fromList [] :: Seq.Seq Int) @?= Nothing