mono-traversable-0.10.0.1/0000755000000000000000000000000012633224010013366 5ustar0000000000000000mono-traversable-0.10.0.1/ChangeLog.md0000644000000000000000000000246512633224010015546 0ustar0000000000000000## 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-0.10.0.1/LICENSE0000644000000000000000000000207712633224010014401 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-0.10.0.1/mono-traversable.cabal0000644000000000000000000000551212633224010017635 0ustar0000000000000000name: mono-traversable version: 0.10.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.Containers Data.Sequences Data.NonNull Data.MinLen Data.ByteVector other-modules: Data.GrowingAppend build-depends: base >= 4.5 && < 5 , containers >= 0.4 , unordered-containers >=0.2 , hashable , bytestring >= 0.9 , text >=0.11 , semigroups >= 0.10 , transformers >=0.3 , vector >=0.10 , semigroupoids >=3.0 , comonad >=3.0.3 , vector-instances , vector-algorithms >= 0.6 , dlist >= 0.6 && < 1.0 , dlist-instances == 0.1.* , split >= 0.2 hs-source-dirs: src default-language: Haskell2010 test-suite test main-is: main.hs type: exitcode-stdio-1.0 hs-source-dirs: test other-modules: Spec default-language: Haskell2010 build-depends: base , mono-traversable , bytestring , text , hspec , 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-0.10.0.1/README.md0000644000000000000000000003034012633224010014645 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 * `MinLen` for making partial functions (head, tail) total 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-0.10.0.1/Setup.hs0000644000000000000000000000005612633224010015023 0ustar0000000000000000import Distribution.Simple main = defaultMain mono-traversable-0.10.0.1/bench/0000755000000000000000000000000012633224010014445 5ustar0000000000000000mono-traversable-0.10.0.1/bench/sorting.hs0000644000000000000000000000204412633224010016466 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 inputV <- MWC.withSystemRandom . MWC.asGenST $ flip MWC.uniformVector 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-0.10.0.1/src/0000755000000000000000000000000012633224010014155 5ustar0000000000000000mono-traversable-0.10.0.1/src/Data/0000755000000000000000000000000012633224010015026 5ustar0000000000000000mono-traversable-0.10.0.1/src/Data/ByteVector.hs0000644000000000000000000000155312633224010017454 0ustar0000000000000000-- | Provides conversion functions between strict 'ByteString's and storable -- 'Vector's. module Data.ByteVector ( toByteVector , fromByteVector ) where import Data.ByteString.Internal (ByteString (PS)) import Data.Vector.Storable (Vector, unsafeFromForeignPtr, unsafeToForeignPtr) import Data.Word (Word8) -- | Convert a 'ByteString' into a storable 'Vector'. -- -- Since 0.6.1 toByteVector :: ByteString -> Vector Word8 toByteVector (PS fptr offset idx) = unsafeFromForeignPtr fptr offset idx {-# INLINE toByteVector #-} -- | Convert a storable 'Vector' into a 'ByteString'. -- -- Since 0.6.1 fromByteVector :: Vector Word8 -> ByteString fromByteVector v = PS fptr offset idx where (fptr, offset, idx) = unsafeToForeignPtr v {-# INLINE fromByteVector #-} mono-traversable-0.10.0.1/src/Data/Containers.hs0000644000000000000000000007114312633224010017475 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) 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 Data.GrowingAppend import GHC.Exts (Constraint) -- | A container whose values are stored in Key-Value pairs. class (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 -- | 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 #-} 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 #-} 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 #-} 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 #-} 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-0.10.0.1/src/Data/GrowingAppend.hs0000644000000000000000000000315612633224010020133 0ustar0000000000000000module Data.GrowingAppend where import Data.MonoTraversable import Data.Semigroup 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.Vector.Instances () 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.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.HashMap.Strict as HashMap import Data.Hashable (Hashable) import qualified Data.Set as Set import qualified Data.HashSet as HashSet import qualified Data.IntSet as IntSet import qualified Data.IntMap as IntMap import qualified Data.DList as DList import Data.DList.Instances () -- | olength (x <> y) >= olength x + olength y class (Semigroup mono, 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 (NE.NonEmpty a) instance Ord k => GrowingAppend (Map.Map k v) instance (Eq k, Hashable k) => GrowingAppend (HashMap.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.IntMap v) instance GrowingAppend (DList.DList a) mono-traversable-0.10.0.1/src/Data/MinLen.hs0000644000000000000000000003732212633224010016553 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.MinLen ( -- * Type level naturals -- ** Peano numbers -- $peanoNumbers Zero (..) , Succ (..) , TypeNat (..) , AddNat , MaxNat -- * Minimum length newtype wrapper , MinLen , unMinLen , toMinLenZero , toMinLen , unsafeToMinLen , mlcons , mlappend , mlunion , head , last , tailML , initML , GrowingAppend , ofoldMap1 , ofold1 , ofoldr1 , ofoldl1' , maximum , minimum , maximumBy , minimumBy ) where import Prelude (Num (..), Maybe (..), Int, Ordering (..), Eq, Ord (..), Read, Show, Functor (..), ($), flip, const, Bool (..), otherwise) import Data.Data (Data) import Data.Typeable (Typeable) import Control.Category import Data.MonoTraversable import Data.Sequences import Data.Monoid (Monoid (..)) import Data.Semigroup (Semigroup (..)) import Data.GrowingAppend import Control.Monad (liftM) import Control.Monad.Trans.State.Strict (evalState, state) -- $peanoNumbers -- are a simple way to -- represent natural numbers (0, 1, 2...) using only a 'Zero' value and a -- successor function ('Succ'). Each application of 'Succ' increases the number -- by 1, so @Succ Zero@ is 1, @Succ (Succ Zero)@ is 2, etc. -- | 'Zero' is the base value for the Peano numbers. data Zero = Zero -- | 'Succ' represents the next number in the sequence of natural numbers. -- -- It takes a @nat@ (a natural number) as an argument. -- -- 'Zero' is a @nat@, allowing @'Succ' 'Zero'@ to represent 1. -- -- 'Succ' is also a @nat@, so it can be applied to itself, allowing -- @'Succ' ('Succ' 'Zero')@ to represent 2, -- @'Succ' ('Succ' ('Succ' 'Zero'))@ to represent 3, and so on. data Succ nat = Succ nat -- | Type-level natural number utility typeclass class TypeNat nat where -- | Turn a type-level natural number into a number -- -- @ -- > 'toValueNat' 'Zero' -- 0 -- > 'toValueNat' ('Succ' ('Succ' ('Succ' 'Zero'))) -- 3 -- @ toValueNat :: Num i => nat -> i -- | Get a data representation of a natural number type -- -- @ -- > 'typeNat' :: 'Succ' ('Succ' 'Zero') -- Succ (Succ Zero) -- Errors because Succ and Zero have no Show typeclass, -- -- But this is what it would look like if it did. -- @ typeNat :: nat instance TypeNat Zero where toValueNat Zero = 0 typeNat = Zero instance TypeNat nat => TypeNat (Succ nat) where toValueNat (Succ nat) = 1 + toValueNat nat typeNat = Succ typeNat -- | Adds two type-level naturals. -- -- See the 'mlappend' type signature for an example. -- -- @ -- > :t 'typeNat' :: 'AddNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero') -- -- 'typeNat' :: 'AddNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero') -- :: 'Succ' ('Succ' ('Succ' 'Zero')) -- @ type family AddNat x y type instance AddNat Zero y = y type instance AddNat (Succ x) y = AddNat x (Succ y) -- | Calculates the maximum of two type-level naturals. -- -- See the 'mlunion' type signature for an example. -- -- @ -- > :t 'typeNat' :: 'MaxNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero') -- -- 'typeNat' :: 'MaxNat' ('Succ' ('Succ' 'Zero')) ('Succ' 'Zero') -- :: 'Succ' ('Succ' 'Zero') -- @ type family MaxNat x y type instance MaxNat Zero y = y type instance MaxNat x Zero = x type instance MaxNat (Succ x) (Succ y) = Succ (MaxNat x y) -- | A wrapper around a container which encodes its minimum length in the type system. -- This allows functions like 'head' and 'maximum' to be made safe without using 'Maybe'. -- -- The length, @nat@, is encoded as a , -- which starts with the 'Zero' constructor and is made one larger with each application -- of 'Succ' ('Zero' for 0, @'Succ' 'Zero'@ for 1, @'Succ' ('Succ' 'Zero')@ for 2, etc.). -- Functions which require at least one element, then, are typed with @Succ nat@, -- where @nat@ is either 'Zero' or any number of applications of 'Succ': -- -- @ -- 'head' :: 'MonoTraversable' mono => 'MinLen' ('Succ' nat) mono -> 'Element' mono -- @ -- -- The length is also a , -- i.e. it is only used on the left hand side of the type and doesn't exist at runtime. -- Notice how @'Succ' 'Zero'@ isn't included in the printed output: -- -- @ -- > 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) -- 'Just' ('MinLen' {unMinLen = [1,2,3]}) -- @ -- -- You can still use GHCI's @:i@ command to see the phantom type information: -- -- @ -- > let xs = 'mlcons' 1 $ 'toMinLenZero' [] -- > :i xs -- xs :: 'Num' t => 'MinLen' ('Succ' 'Zero') [t] -- @ newtype MinLen nat mono = MinLen { unMinLen :: mono -- ^ Get the monomorphic container out of a 'MinLen' wrapper. } deriving (Eq, Ord, Read, Show, Data, Typeable) type instance Element (MinLen nat mono) = Element mono deriving instance MonoFunctor mono => MonoFunctor (MinLen nat mono) deriving instance MonoFoldable mono => MonoFoldable (MinLen nat mono) deriving instance MonoFoldableEq mono => MonoFoldableEq (MinLen nat mono) deriving instance MonoFoldableOrd mono => MonoFoldableOrd (MinLen nat mono) instance MonoTraversable mono => MonoTraversable (MinLen nat mono) where otraverse f (MinLen x) = fmap MinLen (otraverse f x) {-# INLINE otraverse #-} omapM f (MinLen x) = liftM MinLen (omapM f x) {-# INLINE omapM #-} deriving instance GrowingAppend mono => GrowingAppend (MinLen nat mono) -- | This function is unsafe, and must not be exposed from this module. unsafeMap :: (mono -> mono) -> MinLen nat mono -> MinLen nat mono unsafeMap f (MinLen x) = MinLen (f x) instance GrowingAppend mono => Semigroup (MinLen nat mono) where MinLen x <> MinLen y = MinLen (x <> y) instance SemiSequence seq => SemiSequence (MinLen nat seq) where type Index (MinLen nat seq) = Index seq intersperse e = unsafeMap $ intersperse e reverse = unsafeMap reverse find f = find f . unMinLen cons x = unsafeMap $ cons x snoc xs x = unsafeMap (flip snoc x) xs sortBy f = unsafeMap $ sortBy f instance MonoPointed mono => MonoPointed (MinLen Zero mono) where opoint = MinLen . opoint {-# INLINE opoint #-} instance MonoPointed mono => MonoPointed (MinLen (Succ Zero) mono) where opoint = MinLen . opoint {-# INLINE opoint #-} -- | Get the 'typeNat' of a 'MinLen' container. natProxy :: TypeNat nat => MinLen nat mono -> nat natProxy _ = typeNat -- | Types a container as having a minimum length of zero. This is useful when combined with other 'MinLen' -- functions that increase the size of the container. -- -- ==== __Examples__ -- -- @ -- > 1 \`mlcons` 'toMinLenZero' [] -- 'MinLen' {unMinLen = [1]} -- @ toMinLenZero :: (MonoFoldable mono) => mono -> MinLen Zero mono toMinLenZero = MinLen -- | Attempts to add a 'MinLen' constraint to a monomorphic container. -- -- ==== __Examples__ -- -- @ -- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) -- > xs -- 'Just' ('MinLen' {unMinLen = [1,2,3]}) -- -- > :i xs -- xs :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) -- @ -- -- @ -- > 'toMinLen' [] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) -- 'Nothing' -- @ toMinLen :: (MonoFoldable mono, TypeNat nat) => mono -> Maybe (MinLen nat mono) toMinLen mono = case ocompareLength mono (toValueNat nat :: Int) of LT -> Nothing _ -> Just res' where nat = natProxy res' res' = MinLen mono -- | __Unsafe__ -- -- Although this function itself cannot cause a segfault, it breaks the -- safety guarantees of 'MinLen' and can lead to a segfault when using -- otherwise safe functions. -- -- ==== __Examples__ -- -- @ -- > let xs = 'unsafeToMinLen' [] :: 'MinLen' ('Succ' 'Zero') ['Int'] -- > 'olength' xs -- 0 -- > 'head' xs -- *** Exception: Data.MonoTraversable.headEx: empty -- @ unsafeToMinLen :: mono -> MinLen nat mono unsafeToMinLen = MinLen infixr 5 `mlcons` -- | Adds an element to the front of a list, increasing its minimum length by 1. -- -- ==== __Examples__ -- -- @ -- > let xs = 'unsafeToMinLen' [1,2,3] :: 'MinLen' ('Succ' 'Zero') ['Int'] -- > 0 \`mlcons` xs -- 'MinLen' {unMinLen = [0,1,2,3]} -- @ mlcons :: IsSequence seq => Element seq -> MinLen nat seq -> MinLen (Succ nat) seq mlcons e (MinLen seq) = MinLen (cons e seq) {-# INLINE mlcons #-} -- | Concatenate two sequences, adding their minimum lengths together. -- -- ==== __Examples__ -- -- @ -- > let xs = 'unsafeToMinLen' [1,2,3] :: 'MinLen' ('Succ' 'Zero') ['Int'] -- > xs \`mlappend` xs -- 'MinLen' {unMinLen = [1,2,3,1,2,3]} -- @ mlappend :: IsSequence seq => MinLen x seq -> MinLen y seq -> MinLen (AddNat x y) seq mlappend (MinLen x) (MinLen y) = MinLen (x `mappend` y) {-# INLINE mlappend #-} -- | Return the first element of a monomorphic container. -- -- Safe version of 'headEx', only works on monomorphic containers wrapped in a -- @'MinLen' ('Succ' nat)@. head :: MonoFoldable mono => MinLen (Succ nat) mono -> Element mono head = headEx . unMinLen {-# INLINE head #-} -- | Return the last element of a monomorphic container. -- -- Safe version of 'lastEx', only works on monomorphic containers wrapped in a -- @'MinLen' ('Succ' nat)@. last :: MonoFoldable mono => MinLen (Succ nat) mono -> Element mono last = lastEx . unMinLen {-# INLINE last #-} -- | Returns all but the first element of a sequence, reducing its 'MinLen' by 1. -- -- Safe, only works on sequences wrapped in a @'MinLen' ('Succ' nat)@. -- -- ==== __Examples__ -- -- @ -- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) -- > 'fmap' 'tailML' xs -- 'Just' ('MinLen' {unMinLen = [2,3]}) -- @ tailML :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq tailML = MinLen . tailEx . unMinLen -- | Returns all but the last element of a sequence, reducing its 'MinLen' by 1. -- -- Safe, only works on sequences wrapped in a @'MinLen' ('Succ' nat)@. -- -- ==== __Examples__ -- -- @ -- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) -- > 'fmap' 'initML' xs -- 'Just' ('MinLen' {unMinLen = [1,2]}) -- @ initML :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq initML = MinLen . initEx . unMinLen -- | Joins two semigroups, keeping the larger 'MinLen' of the two. -- -- ==== __Examples__ -- -- @ -- > let xs = 'unsafeToMinLen' [1] :: 'MinLen' ('Succ' 'Zero') ['Int'] -- > let ys = xs \`mlunion` xs -- > ys -- 'MinLen' {unMinLen = [1,1]} -- -- > :i ys -- ys :: 'MinLen' ('Succ' 'Zero') ['Int'] -- @ mlunion :: GrowingAppend mono => MinLen x mono -> MinLen y mono -> MinLen (MaxNat x y) mono mlunion (MinLen x) (MinLen y) = MinLen (x <> y) -- | 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 -- @'MinLen' ('Succ' nat)@. -- -- ==== __Examples__ -- -- @ -- > let xs = ("hello", 1 :: 'Integer') \`mlcons` (" world", 2) \`mlcons` ('toMinLenZero' []) -- > 'ofoldMap1' 'fst' xs -- "hello world" -- @ ofoldMap1 :: (MonoFoldable mono, Semigroup m) => (Element mono -> m) -> MinLen (Succ nat) mono -> m ofoldMap1 f = ofoldMap1Ex f . unMinLen {-# INLINE ofoldMap1 #-} -- | Join a monomorphic container, whose elements are 'Semigroup's, together. -- -- Safe, only works on monomorphic containers wrapped in a @'MinLen' ('Succ' nat)@. -- -- ==== __Examples__ -- -- @ -- > let xs = "a" \`mlcons` "b" \`mlcons` "c" \`mlcons` ('toMinLenZero' []) -- > xs -- 'MinLen' {unMinLen = ["a","b","c"]} -- -- > 'ofold1' xs -- "abc" -- @ ofold1 :: (MonoFoldable mono, Semigroup (Element mono)) => MinLen (Succ nat) 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 -- @'MinLen' ('Succ' nat)@. -- -- @'foldr1' f = "Prelude".'Prelude.foldr1' f . 'otoList'@ -- -- ==== __Examples__ -- -- @ -- > let xs = "a" \`mlcons` "b" \`mlcons` "c" \`mlcons` ('toMinLenZero' []) -- > 'ofoldr1' (++) xs -- "abc" -- @ ofoldr1 :: MonoFoldable mono => (Element mono -> Element mono -> Element mono) -> MinLen (Succ nat) mono -> Element mono ofoldr1 f = ofoldr1Ex f . unMinLen {-# 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 -- @'MinLen' ('Succ' nat)@. -- -- @'foldl1'' f = "Prelude".'Prelude.foldl1'' f . 'otoList'@ -- -- ==== __Examples__ -- -- @ -- > let xs = "a" \`mlcons` "b" \`mlcons` "c" \`mlcons` ('toMinLenZero' []) -- > 'ofoldl1'' (++) xs -- "abc" -- @ ofoldl1' :: MonoFoldable mono => (Element mono -> Element mono -> Element mono) -> MinLen (Succ nat) mono -> Element mono ofoldl1' f = ofoldl1Ex' f . unMinLen {-# INLINE ofoldl1' #-} -- | Get the maximum element of a monomorphic container. -- -- Safe version of 'maximumEx', only works on monomorphic containers wrapped in a -- @'MinLen' ('Succ' nat)@. -- -- ==== __Examples__ -- -- @ -- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) -- > 'fmap' 'maximum' xs -- 'Just' 3 -- @ maximum :: MonoFoldableOrd mono => MinLen (Succ nat) mono -> Element mono maximum = maximumEx . unMinLen {-# INLINE maximum #-} -- | Get the minimum element of a monomorphic container. -- -- Safe version of 'minimumEx', only works on monomorphic containers wrapped in a -- @'MinLen' ('Succ' nat)@. -- -- ==== __Examples__ -- -- @ -- > let xs = 'toMinLen' [1,2,3] :: 'Maybe' ('MinLen' ('Succ' 'Zero') ['Int']) -- > 'fmap' 'minimum' xs -- 'Just' 1 -- @ minimum :: MonoFoldableOrd mono => MinLen (Succ nat) mono -> Element mono minimum = minimumEx . unMinLen {-# 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 -- @'MinLen' ('Succ' nat)@. maximumBy :: MonoFoldable mono => (Element mono -> Element mono -> Ordering) -> MinLen (Succ nat) mono -> Element mono maximumBy cmp = maximumByEx cmp . unMinLen {-# 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 -- @'MinLen' ('Succ' nat)@. minimumBy :: MonoFoldable mono => (Element mono -> Element mono -> Ordering) -> MinLen (Succ nat) mono -> Element mono minimumBy cmp = minimumByEx cmp . unMinLen {-# INLINE minimumBy #-} -- | 'oextract' is 'head'. -- -- For @'oextend' f@, the new 'mono' is populated by applying @f@ to -- successive 'tail's of the original 'mono'. -- -- For example, for @'MinLen' ('Succ' 'Zero') ['Int']@, or -- @'NonNull' ['Int']@: -- -- @ -- 'oextend' f [1,2,3,4,5] = [ f [1, 2, 3, 4, 5] -- , f [2, 3, 4, 5] -- , f [3, 4, 5] -- , f [4, 5] -- , f [5] -- ] -- @ -- -- Meant to be a direct analogy to the instance for 'NonEmpty' @a@. -- instance IsSequence mono => MonoComonad (MinLen (Succ Zero) mono) where oextract = head oextend f (MinLen mono) = MinLen . flip evalState mono . ofor mono . const . state $ \mono' -> (f (MinLen mono'), tailEx mono') mono-traversable-0.10.0.1/src/Data/MonoTraversable.hs0000644000000000000000000013423312633224010020473 0ustar0000000000000000{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- | Type classes mirroring standard typeclasses, but working with monomorphic containers. -- -- The motivation is that some commonly used data types (i.e., 'ByteString' and -- 'Text') do not allow for instances of typeclasses like 'Functor' and -- 'Foldable', since they are monomorphic structures. This module allows both -- monomorphic and polymorphic data types to be instances of the same -- typeclasses. -- -- All of the laws for the polymorphic typeclasses apply to their monomorphic -- cousins. Thus, even though a 'MonoFunctor' instance for 'Set' could -- theoretically be defined, it is omitted since it could violate the functor -- law of @'omap' f . 'omap' g = 'omap' (f . g)@. -- -- Note that all typeclasses have been prefixed with @Mono@, and functions have -- been prefixed with @o@. The mnemonic for @o@ is "only one", or alternatively -- \"it's mono, but m is overused in Haskell, so we'll use the second letter -- instead.\" (Agreed, it's not a great mangling scheme, input is welcome!) module Data.MonoTraversable where import Control.Applicative import Control.Category import Control.Monad (Monad (..), liftM) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Foldable as F import Data.Functor import Data.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.Traversable.Instances () 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.Identity (IdentityT) import Data.Functor.Apply (MaybeApply (..), WrappedApplicative) import Control.Comonad (Cokleisli, Comonad, extract, extend) import Control.Comonad.Store (StoreT) import Control.Comonad.Env (EnvT) import Control.Comonad.Traced (TracedT) import Data.Functor.Coproduct (Coproduct) import Control.Monad.Trans.Writer (WriterT) import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT) import Control.Monad.Trans.State (StateT(..)) import qualified Control.Monad.Trans.State.Strict as Strict (StateT(..)) import Control.Monad.Trans.RWS (RWST(..)) import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST(..)) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Error (ErrorT(..)) import Control.Monad.Trans.Cont (ContT) import Data.Functor.Compose (Compose) import Data.Functor.Product (Product) import Data.Semigroupoid.Static (Static) import Data.Set (Set) import 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 Data.DList (DList) import qualified Data.DList as DL -- | 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 (DList a) = a type instance Element (ViewL a) = a type instance Element (ViewR a) = a type instance Element (IntMap a) = a type instance Element IntSet = Int type instance Element (Option a) = a type instance Element (NonEmpty a) = a type instance Element (Identity a) = a type instance Element (r -> a) = a type instance Element (Either a b) = b type instance Element (a, b) = b type instance Element (Const m a) = a type instance Element (WrappedMonad m a) = a type instance Element (Map k v) = v type instance Element (HashMap k v) = v type instance Element (Set e) = e type instance Element (HashSet e) = e type instance Element (Vector a) = a type instance Element (WrappedArrow a b c) = c type instance Element (MaybeApply f a) = a type instance Element (WrappedApplicative f a) = a type instance Element (Cokleisli w a b) = b type instance Element (MaybeT m a) = a type instance Element (ListT m a) = a type instance Element (IdentityT m a) = a type instance Element (WriterT w m a) = a type instance Element (Strict.WriterT w m a) = a type instance Element (StateT s m a) = a type instance Element (Strict.StateT s m a) = a type instance Element (RWST r w s m a) = a type instance Element (Strict.RWST r w s m a) = a type instance Element (ReaderT r m a) = a type instance Element (ErrorT e m a) = a type instance Element (ContT r m a) = a type instance Element (Compose f g a) = a type instance Element (Product f g a) = a type instance Element (Static f a b) = b type instance Element (U.Vector a) = a type instance Element (VS.Vector a) = a type instance Element (Arg a b) = b type instance Element (EnvT e w a) = a type instance Element (StoreT s w a) = a type instance Element (TracedT m w a) = a type instance Element (Coproduct f g a) = a -- | 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 (DList 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 Functor w => MonoFunctor (EnvT e w a) instance Functor w => MonoFunctor (StoreT s w a) instance Functor w => MonoFunctor (TracedT m w a) instance (Functor f, Functor g) => MonoFunctor (Coproduct f g a) instance Arrow a => MonoFunctor (WrappedArrow a b c) instance Functor f => MonoFunctor (MaybeApply f a) instance Functor f => MonoFunctor (WrappedApplicative f a) instance MonoFunctor (Cokleisli w a b) instance Functor m => MonoFunctor (MaybeT m a) instance Functor m => MonoFunctor (ListT m a) instance Functor m => MonoFunctor (IdentityT m a) instance Functor m => MonoFunctor (WriterT w m a) instance Functor m => MonoFunctor (Strict.WriterT w m a) instance Functor m => MonoFunctor (StateT s m a) instance Functor m => MonoFunctor (Strict.StateT s m a) instance Functor m => MonoFunctor (RWST r w s m a) instance Functor m => MonoFunctor (Strict.RWST r w s m a) instance Functor m => MonoFunctor (ReaderT r m a) instance Functor m => MonoFunctor (ErrorT e m a) instance Functor m => MonoFunctor (ContT r m a) instance (Functor f, Functor g) => MonoFunctor (Compose f g a) instance (Functor f, Functor g) => MonoFunctor (Product f g a) instance Functor f => MonoFunctor (Static f a b) instance U.Unbox a => MonoFunctor (U.Vector a) where omap = U.map {-# INLINE omap #-} instance VS.Storable a => MonoFunctor (VS.Vector a) where omap = VS.map {-# INLINE omap #-} -- | 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_ :: (MonoFoldable mono, Applicative f) => (Element mono -> f b) -> mono -> f () otraverse_ f = ofoldr ((*>) . f) (pure ()) {-# INLINE otraverse_ #-} -- | 'ofor_' is 'otraverse_' with its arguments flipped. ofor_ :: (MonoFoldable mono, 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. omapM_ :: (MonoFoldable mono, Monad m) => (Element mono -> m ()) -> mono -> m () omapM_ f = ofoldr ((>>) . f) (return ()) {-# INLINE omapM_ #-} -- | 'oforM_' is 'omapM_' with its arguments flipped. oforM_ :: (MonoFoldable mono, Monad m) => mono -> (Element mono -> m ()) -> m () oforM_ = flip omapM_ {-# INLINE oforM_ #-} -- | Monadic fold over the elements of a monomorphic container, associating to the left. ofoldlM :: (MonoFoldable mono, Monad m) => (a -> Element mono -> m a) -> a -> mono -> m a ofoldlM f z0 xs = ofoldr f' return xs z0 where f' x k z = f z x >>= k {-# 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.MinLen.ofoldMap1' from "Data.MinLen" 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.MinLen.ofoldr1Ex' from "Data.MinLen" 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.MinLen.ofoldl1Ex'' from "Data.MinLen" 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.MinLen.head' from "Data.MinLen" 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.MinLen.last from "Data.MinLen" 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.MinLen.maximiumBy' from "Data.MinLen" 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.MinLen.minimumBy' from "Data.MinLen" 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 = Unsafe.inlinePerformIO (touchForeignPtr fptr) `seq` return () | otherwise = do _ <- f (Unsafe.inlinePerformIO (peek ptr)) loop (ptr `plusPtr` 1) loop start 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 #-} 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 #-} {-# INLINE unsafeHead #-} 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 omapM_ #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-} 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 olength #-} {-# INLINE omapM_ #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-} 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 oall #-} {-# INLINE oany #-} {-# INLINE onull #-} {-# INLINE olength #-} {-# INLINE omapM_ #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-} 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 omapM_ _ Nothing = return () 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 omapM_ #-} {-# INLINE ofoldr1Ex #-} {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-} {-# INLINE maximumByEx #-} {-# INLINE minimumByEx #-} instance MonoFoldable (Set e) instance MonoFoldable (HashSet e) instance MonoFoldable (DList a) where otoList = DL.toList headEx = DL.head {-# INLINE otoList #-} {-# INLINE headEx #-} 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 omapM_ #-} {-# 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 omapM_ #-} {-# 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 omapM_ _ (Left _) = return () 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' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-} 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 => MonoFoldable (ErrorT e 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 #-} -- | A typeclass for monomorphic containers that are 'Monoid's. class (MonoFoldable mono, Monoid mono) => MonoFoldableMonoid mono where -- FIXME is this really just MonoMonad? -- | Map a function over a monomorphic container and combine the results. oconcatMap :: (Element mono -> mono) -> mono -> mono oconcatMap = ofoldMap {-# INLINE oconcatMap #-} instance (MonoFoldable (t a), Monoid (t a)) => MonoFoldableMonoid (t a) -- FIXME instance MonoFoldableMonoid S.ByteString where oconcatMap = S.concatMap {-# INLINE oconcatMap #-} instance MonoFoldableMonoid L.ByteString where oconcatMap = L.concatMap {-# INLINE oconcatMap #-} instance MonoFoldableMonoid T.Text where oconcatMap = T.concatMap {-# INLINE oconcatMap #-} instance MonoFoldableMonoid TL.Text where oconcatMap = TL.concatMap {-# INLINE oconcatMap #-} -- | A typeclass for monomorphic containers whose elements -- are an instance of 'Eq'. class (MonoFoldable mono, Eq (Element mono)) => MonoFoldableEq mono where -- | Checks if the monomorphic container includes the supplied element. oelem :: Element mono -> mono -> Bool oelem e = List.elem e . otoList -- | Checks if the monomorphic container does not include the supplied element. onotElem :: Element mono -> mono -> Bool onotElem e = List.notElem e . otoList {-# INLINE oelem #-} {-# INLINE onotElem #-} instance Eq a => MonoFoldableEq (Seq.Seq a) instance Eq a => MonoFoldableEq (V.Vector a) instance (Eq a, U.Unbox a) => MonoFoldableEq (U.Vector a) instance (Eq a, VS.Storable a) => MonoFoldableEq (VS.Vector a) instance Eq a => MonoFoldableEq (NonEmpty a) instance MonoFoldableEq T.Text instance MonoFoldableEq TL.Text instance MonoFoldableEq IntSet instance Eq a => MonoFoldableEq (Maybe a) instance Eq a => MonoFoldableEq (Tree a) instance Eq a => MonoFoldableEq (ViewL a) instance Eq a => MonoFoldableEq (ViewR a) instance Eq a => MonoFoldableEq (IntMap a) instance Eq a => MonoFoldableEq (Option a) instance Eq a => MonoFoldableEq (Identity a) instance Eq v => MonoFoldableEq (Map k v) instance Eq v => MonoFoldableEq (HashMap k v) instance Eq a => MonoFoldableEq (HashSet a) instance Eq a => MonoFoldableEq (DList a) instance Eq b => MonoFoldableEq (Either a b) instance Eq b => MonoFoldableEq (a, b) instance Eq a => MonoFoldableEq (Const m a) instance (Eq a, F.Foldable f) => MonoFoldableEq (MaybeT f a) instance (Eq a, F.Foldable f) => MonoFoldableEq (ListT f a) instance (Eq a, F.Foldable f) => MonoFoldableEq (IdentityT f a) instance (Eq a, F.Foldable f) => MonoFoldableEq (WriterT w f a) instance (Eq a, F.Foldable f) => MonoFoldableEq (Strict.WriterT w f a) instance (Eq a, F.Foldable f) => MonoFoldableEq (ErrorT e f a) instance (Eq a, F.Foldable f, F.Foldable g) => MonoFoldableEq (Compose f g a) instance (Eq a, F.Foldable f, F.Foldable g) => MonoFoldableEq (Product f g a) instance Eq a => MonoFoldableEq [a] where oelem = List.elem onotElem = List.notElem {-# INLINE oelem #-} {-# INLINE onotElem #-} instance MonoFoldableEq S.ByteString where oelem = S.elem onotElem = S.notElem {-# INLINE oelem #-} {-# INLINE onotElem #-} instance MonoFoldableEq L.ByteString where oelem = L.elem onotElem = L.notElem {-# INLINE oelem #-} {-# INLINE onotElem #-} instance (Eq a, Ord a) => MonoFoldableEq (Set a) where oelem = Set.member onotElem = Set.notMember {-# INLINE oelem #-} {-# INLINE onotElem #-} -- | A typeclass for monomorphic containers whose elements -- are an instance of 'Ord'. class (MonoFoldable mono, Ord (Element mono)) => MonoFoldableOrd mono where -- | 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.MinLen.maximum' from "Data.MinLen" for a total version of this function./ maximumEx :: mono -> Element mono maximumEx = maximumByEx compare {-# INLINE 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.MinLen.minimum' from "Data.MinLen" for a total version of this function./ minimumEx :: mono -> Element mono minimumEx = minimumByEx compare {-# INLINE minimumEx #-} instance MonoFoldableOrd S.ByteString where maximumEx = S.maximum {-# INLINE maximumEx #-} minimumEx = S.minimum {-# INLINE minimumEx #-} instance MonoFoldableOrd L.ByteString where maximumEx = L.maximum {-# INLINE maximumEx #-} minimumEx = L.minimum {-# INLINE minimumEx #-} instance MonoFoldableOrd T.Text where maximumEx = T.maximum {-# INLINE maximumEx #-} minimumEx = T.minimum {-# INLINE minimumEx #-} instance MonoFoldableOrd TL.Text where maximumEx = TL.maximum {-# INLINE maximumEx #-} minimumEx = TL.minimum {-# INLINE minimumEx #-} instance MonoFoldableOrd IntSet instance Ord a => MonoFoldableOrd [a] instance Ord a => MonoFoldableOrd (Maybe a) instance Ord a => MonoFoldableOrd (Tree a) instance Ord a => MonoFoldableOrd (Seq a) instance Ord a => MonoFoldableOrd (ViewL a) instance Ord a => MonoFoldableOrd (ViewR a) instance Ord a => MonoFoldableOrd (IntMap a) instance Ord a => MonoFoldableOrd (Option a) instance Ord a => MonoFoldableOrd (NonEmpty a) instance Ord a => MonoFoldableOrd (Identity a) instance Ord v => MonoFoldableOrd (Map k v) instance Ord v => MonoFoldableOrd (HashMap k v) instance Ord a => MonoFoldableOrd (Vector a) where maximumEx = V.maximum minimumEx = V.minimum {-# INLINE maximumEx #-} {-# INLINE minimumEx #-} instance Ord e => MonoFoldableOrd (Set e) instance Ord e => MonoFoldableOrd (HashSet e) instance (U.Unbox a, Ord a) => MonoFoldableOrd (U.Vector a) where maximumEx = U.maximum minimumEx = U.minimum {-# INLINE maximumEx #-} {-# INLINE minimumEx #-} instance (Ord a, VS.Storable a) => MonoFoldableOrd (VS.Vector a) where maximumEx = VS.maximum minimumEx = VS.minimum {-# INLINE maximumEx #-} {-# INLINE minimumEx #-} instance Ord b => MonoFoldableOrd (Either a b) where instance Ord a => MonoFoldableOrd (DList a) instance Ord b => MonoFoldableOrd (a, b) instance Ord a => MonoFoldableOrd (Const m a) instance (Ord a, F.Foldable f) => MonoFoldableOrd (MaybeT f a) instance (Ord a, F.Foldable f) => MonoFoldableOrd (ListT f a) instance (Ord a, F.Foldable f) => MonoFoldableOrd (IdentityT f a) instance (Ord a, F.Foldable f) => MonoFoldableOrd (WriterT w f a) instance (Ord a, F.Foldable f) => MonoFoldableOrd (Strict.WriterT w f a) instance (Ord a, F.Foldable f) => MonoFoldableOrd (ErrorT e f a) instance (Ord a, F.Foldable f, F.Foldable g) => MonoFoldableOrd (Compose f g a) instance (Ord a, F.Foldable f, F.Foldable g) => MonoFoldableOrd (Product f g a) -- | Safe version of 'maximumEx'. -- -- Returns 'Nothing' instead of throwing an exception when -- encountering an empty monomorphic container. maximumMay :: MonoFoldableOrd 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 :: MonoFoldableOrd 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. 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 {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable S.ByteString where otraverse f = fmap S.pack . traverse f . S.unpack omapM f = liftM S.pack . mapM f . S.unpack {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable L.ByteString where otraverse f = fmap L.pack . traverse f . L.unpack omapM f = liftM L.pack . mapM f . L.unpack {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable T.Text where otraverse f = fmap T.pack . traverse f . T.unpack omapM f = liftM T.pack . mapM f . T.unpack {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable TL.Text where otraverse f = fmap TL.pack . traverse f . TL.unpack omapM f = liftM TL.pack . mapM f . TL.unpack {-# INLINE otraverse #-} {-# INLINE omapM #-} 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 (DList a) where otraverse f = fmap DL.fromList . traverse f . DL.toList omapM f = liftM DL.fromList . mapM f . DL.toList instance MonoTraversable (Identity a) instance MonoTraversable (Map k v) instance MonoTraversable (HashMap k v) instance MonoTraversable (Vector a) instance U.Unbox a => MonoTraversable (U.Vector a) where otraverse f = fmap U.fromList . traverse f . U.toList omapM = U.mapM {-# INLINE otraverse #-} {-# INLINE omapM #-} instance VS.Storable a => MonoTraversable (VS.Vector a) where otraverse f = fmap VS.fromList . traverse f . VS.toList omapM = VS.mapM {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable (Either a b) where otraverse _ (Left a) = pure (Left a) otraverse f (Right b) = fmap Right (f b) omapM _ (Left a) = return (Left a) omapM f (Right b) = liftM Right (f b) {-# 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 => MonoTraversable (ErrorT e 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. oforM :: (MonoTraversable mono, Monad f) => mono -> (Element mono -> f (Element mono)) -> f mono 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 (DList 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 Applicative f => MonoPointed (WrappedApplicative f 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) instance MonoPointed (Cokleisli w a b) instance Applicative f => MonoPointed (Static f a b) -- 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 m => MonoPointed (ErrorT e m a) where opoint = ErrorT . pure . Right {-# INLINE opoint #-} instance MonoPointed (MaybeApply f a) where opoint = MaybeApply . Right {-# 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 default oextract :: (Comonad w, (w a) ~ mono, Element (w a) ~ a) => mono -> Element mono oextract = extract {-# INLINE oextract #-} default oextend :: (Comonad w, (w a) ~ mono, Element (w a) ~ a) => (mono -> Element mono) -> mono -> mono oextend = extend {-# INLINE oextend #-} -- Comonad instance MonoComonad (Tree a) instance MonoComonad (NonEmpty a) instance MonoComonad (Identity a) instance Monoid m => MonoComonad (m -> a) instance MonoComonad (e, a) instance MonoComonad (Arg a b) instance Comonad w => MonoComonad (IdentityT w a) instance Comonad w => MonoComonad (EnvT e w a) instance Comonad w => MonoComonad (StoreT s w a) instance (Comonad w, Monoid m) => MonoComonad (TracedT m w a) instance (Comonad f, Comonad g) => MonoComonad (Coproduct f g a) -- 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 mono-traversable-0.10.0.1/src/Data/NonNull.hs0000644000000000000000000001136212633224010016752 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} -- | Warning, this is Experimental! -- -- "Data.NonNull" attempts to extend the concepts from -- "Data.List.NonEmpty" to any 'MonoFoldable'. -- -- 'NonNull' is a typeclass for a container with 1 or more elements. -- "Data.List.NonEmpty" and 'NotEmpty a' are members of the typeclass module Data.NonNull ( NonNull , fromNullable , nonNull , toNullable , fromNonEmpty , ncons , nuncons , splitFirst , nfilter , nfilterM , nReplicate , head , tail , last , init , ofoldMap1 , ofold1 , ofoldr1 , ofoldl1' , maximum , maximumBy , minimum , minimumBy , (<|) , toMinList ) where import Prelude hiding (head, tail, init, last, reverse, seq, filter, replicate, maximum, minimum) import Control.Arrow (second) import Control.Exception.Base (Exception, throw) import Data.Data import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) import Data.MinLen import Data.MonoTraversable import Data.Sequences data NullError = NullError String deriving (Show, Typeable) instance Exception NullError -- | A monomorphic container that is not null. type NonNull mono = MinLen (Succ Zero) mono -- | __Safely__ convert from an __unsafe__ monomorphic container to a __safe__ -- non-null monomorphic container. fromNullable :: MonoFoldable mono => mono -> Maybe (NonNull mono) fromNullable = toMinLen -- | __Unsafely__ convert from an __unsafe__ monomorphic container to a __safe__ -- non-null monomorphic container. -- -- Throws an exception if the monomorphic container is empty. nonNull :: MonoFoldable mono => mono -> NonNull mono nonNull nullable = fromMaybe (throw $ NullError "Data.NonNull.nonNull (NonNull default): expected non-null") $ fromNullable nullable -- | __Safely__ convert from a non-null monomorphic container to a nullable monomorphic container. toNullable :: NonNull mono -> mono toNullable = unMinLen -- | __Safely__ convert from a 'NonEmpty' list to a non-null monomorphic container. fromNonEmpty :: IsSequence seq => NE.NonEmpty (Element seq) -> NonNull seq fromNonEmpty = nonNull . 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) mono-traversable-0.10.0.1/src/Data/Sequences.hs0000644000000000000000000013652212633224010017326 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ConstraintKinds #-} -- | Warning: This module should be considered highly experimental. module Data.Sequences where import Data.Maybe (fromJust, isJust) import Data.Monoid (Monoid, mappend, 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.DList as DList 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 Data.GrowingAppend import Data.Vector.Instances () import qualified Data.Vector.Generic as VG import qualified Data.Vector.Algorithms.Merge as VAM import Data.Ord (comparing) -- | 'SemiSequence' was created to share code between 'IsSequence' and 'MinLen'. -- -- @Semi@ means 'SemiGroup' -- A 'SemiSequence' can accomodate a 'SemiGroup' such as 'NonEmpty' or 'MinLen' -- 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' 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 -- | __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 -- | 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 -- | 'intercalate' @seq seqs@ inserts @seq@ in between @seqs@ and -- concatenates the result. -- -- Since 0.9.3 intercalate :: seq -> [seq] -> seq intercalate = defaultIntercalate -- | '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 #-} -- | Default 'intercalate' defaultIntercalate :: (IsSequence seq) => seq -> [seq] -> seq defaultIntercalate _ [] = mempty defaultIntercalate s (seq:seqs) = mconcat (seq : List.map (s `mappend`) seqs) {-# INLINE defaultIntercalate #-} -- | 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 _ [] = [] intercalate = List.intercalate splitWhen = List.splitWhen {-# 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 intercalate #-} {-# 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 intercalate = S.intercalate {-# 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 splitWhen #-} {-# INLINE intercalate #-} 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 intercalate = T.intercalate {-# 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 splitWhen #-} {-# INLINE intercalate #-} 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 intercalate = L.intercalate {-# 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 splitWhen #-} {-# INLINE intercalate #-} indexEx = L.index unsafeIndex = L.index {-# INLINE 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 intercalate = TL.intercalate {-# 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 splitWhen #-} {-# INLINE intercalate #-} indexEx = TL.index unsafeIndex = TL.index {-# INLINE 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 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 #-} 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 (DList.DList a) where type Index (DList.DList a) = Int cons = DList.cons snoc = DList.snoc reverse = defaultReverse sortBy = defaultSortBy intersperse = defaultIntersperse find = defaultFind {-# INLINE intersperse #-} {-# INLINE reverse #-} {-# INLINE find #-} {-# INLINE sortBy #-} {-# INLINE cons #-} {-# INLINE snoc #-} instance IsSequence (DList.DList a) where fromList = DList.fromList replicate = DList.replicate tailEx = DList.tail {-# INLINE fromList #-} {-# INLINE replicate #-} {-# INLINE tailEx #-} 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 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 #-} 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 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 #-} 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 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 #-} index v i | i >= VS.length v = Nothing | otherwise = Just (v VS.! i) indexEx = (VS.!) unsafeIndex = VS.unsafeIndex {-# INLINE index #-} {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} -- | A typeclass for sequences whose elements have the 'Eq' typeclass class (MonoFoldableEq seq, IsSequence seq, Eq (Element seq)) => EqSequence seq where -- | @'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 :: 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': -- -- > intercalate 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 :: seq -> seq -> [seq] splitSeq = defaultSplitOn -- | '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 :: seq -> seq -> Maybe seq stripPrefix x y = fmap fromList (otoList x `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 :: seq -> seq -> Maybe seq stripSuffix x y = fmap fromList (otoList x `stripSuffix` otoList y) -- | 'isPrefixOf' takes two sequences and returns 'True' if the first -- sequence is a prefix of the second. isPrefixOf :: seq -> seq -> Bool isPrefixOf x y = otoList x `isPrefixOf` otoList y -- | 'isSuffixOf' takes two sequences and returns 'True' if the first -- sequence is a suffix of the second. isSuffixOf :: seq -> seq -> Bool isSuffixOf x y = otoList x `isSuffixOf` otoList y -- | 'isInfixOf' takes two sequences and returns 'true' if the first -- sequence is contained, wholly and intact, anywhere within the second. isInfixOf :: seq -> seq -> Bool isInfixOf x y = otoList x `isInfixOf` otoList y -- | Equivalent to @'groupBy' (==)@ group :: seq -> [seq] group = groupBy (==) -- | Similar to standard 'group', but operates on the whole collection, -- not just the consecutive items. -- -- Equivalent to @'groupAllOn' id@ groupAll :: seq -> [seq] groupAll = groupAllOn id {-# INLINE splitElem #-} {-# INLINE splitSeq #-} {-# INLINE isPrefixOf #-} {-# INLINE isSuffixOf #-} {-# INLINE isInfixOf #-} {-# INLINE stripPrefix #-} {-# INLINE stripSuffix #-} {-# INLINE group #-} {-# INLINE groupAll #-} {-# DEPRECATED elem "use oelem" #-} elem :: EqSequence seq => Element seq -> seq -> Bool elem = oelem {-# DEPRECATED notElem "use onotElem" #-} notElem :: EqSequence seq => Element seq -> seq -> Bool notElem = onotElem -- | Use 'splitOn' from "Data.List.Split" defaultSplitOn :: EqSequence s => s -> s -> [s] defaultSplitOn sep = List.map fromList . List.splitOn (otoList sep) . otoList instance Eq a => EqSequence [a] where splitSeq = List.splitOn stripPrefix = List.stripPrefix stripSuffix x y = fmap reverse (List.stripPrefix (reverse x) (reverse y)) group = List.group isPrefixOf = List.isPrefixOf isSuffixOf x y = List.isPrefixOf (List.reverse x) (List.reverse y) isInfixOf = List.isInfixOf {-# INLINE splitSeq #-} {-# INLINE stripPrefix #-} {-# INLINE stripSuffix #-} {-# INLINE group #-} {-# INLINE groupAll #-} {-# INLINE isPrefixOf #-} {-# INLINE isSuffixOf #-} {-# INLINE isInfixOf #-} instance EqSequence S.ByteString where splitElem sep s | S.null s = [S.empty] | otherwise = S.split sep s stripPrefix x y | x `S.isPrefixOf` y = Just (S.drop (S.length x) y) | otherwise = Nothing stripSuffix x y | x `S.isSuffixOf` y = Just (S.take (S.length y - S.length x) y) | otherwise = Nothing group = S.group isPrefixOf = S.isPrefixOf isSuffixOf = S.isSuffixOf isInfixOf = S.isInfixOf {-# INLINE splitElem #-} {-# INLINE stripPrefix #-} {-# INLINE stripSuffix #-} {-# INLINE group #-} {-# INLINE groupAll #-} {-# INLINE isPrefixOf #-} {-# INLINE isSuffixOf #-} {-# INLINE isInfixOf #-} instance EqSequence L.ByteString where splitElem sep s | L.null s = [L.empty] | otherwise = L.split sep s stripPrefix x y | x `L.isPrefixOf` y = Just (L.drop (L.length x) y) | otherwise = Nothing stripSuffix x y | x `L.isSuffixOf` y = Just (L.take (L.length y - L.length x) y) | otherwise = Nothing group = L.group isPrefixOf = L.isPrefixOf isSuffixOf = L.isSuffixOf isInfixOf x y = L.unpack x `List.isInfixOf` L.unpack y {-# INLINE splitElem #-} {-# INLINE stripPrefix #-} {-# INLINE stripSuffix #-} {-# INLINE group #-} {-# INLINE groupAll #-} {-# INLINE isPrefixOf #-} {-# INLINE isSuffixOf #-} {-# INLINE isInfixOf #-} instance EqSequence T.Text where splitSeq sep | T.null sep = (:) T.empty . List.map singleton . T.unpack | otherwise = T.splitOn sep stripPrefix = T.stripPrefix stripSuffix = T.stripSuffix group = T.group isPrefixOf = T.isPrefixOf isSuffixOf = T.isSuffixOf isInfixOf = T.isInfixOf {-# INLINE splitSeq #-} {-# INLINE stripPrefix #-} {-# INLINE stripSuffix #-} {-# INLINE group #-} {-# INLINE groupAll #-} {-# INLINE isPrefixOf #-} {-# INLINE isSuffixOf #-} {-# INLINE isInfixOf #-} instance EqSequence TL.Text where splitSeq sep | TL.null sep = (:) TL.empty . List.map singleton . TL.unpack | otherwise = TL.splitOn sep stripPrefix = TL.stripPrefix stripSuffix = TL.stripSuffix group = TL.group isPrefixOf = TL.isPrefixOf isSuffixOf = TL.isSuffixOf isInfixOf = TL.isInfixOf {-# INLINE splitSeq #-} {-# INLINE stripPrefix #-} {-# INLINE stripSuffix #-} {-# INLINE group #-} {-# INLINE groupAll #-} {-# INLINE isPrefixOf #-} {-# INLINE isSuffixOf #-} {-# INLINE isInfixOf #-} instance Eq a => EqSequence (Seq.Seq a) instance Eq a => EqSequence (V.Vector a) instance (Eq a, U.Unbox a) => EqSequence (U.Vector a) instance (Eq a, VS.Storable a) => EqSequence (VS.Vector a) -- | A typeclass for sequences whose elements have the 'Ord' typeclass class (EqSequence seq, MonoFoldableOrd seq) => OrdSequence seq where -- | Sort a ordered sequence. -- -- @ -- > 'sort' [4,3,1,2] -- [1,2,3,4] -- @ sort :: seq -> seq sort = fromList . sort . otoList {-# INLINE sort #-} instance Ord a => OrdSequence [a] where sort = V.toList . sort . V.fromList {-# INLINE sort #-} instance OrdSequence S.ByteString where sort = S.sort {-# INLINE sort #-} instance OrdSequence L.ByteString instance OrdSequence T.Text instance OrdSequence TL.Text instance Ord a => OrdSequence (Seq.Seq a) instance Ord a => OrdSequence (V.Vector a) where sort = vectorSort {-# INLINE sort #-} instance (Ord a, U.Unbox a) => OrdSequence (U.Vector a) where sort = vectorSort {-# INLINE sort #-} instance (Ord a, VS.Storable a) => OrdSequence (VS.Vector a) where sort = vectorSort {-# INLINE sort #-} -- | 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 :: [t] -> 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 :: [t] -> 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 lines = List.lines unlines = List.unlines 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 lines = T.lines unlines = T.unlines 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 lines = TL.lines unlines = TL.unlines 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 #-} mono-traversable-0.10.0.1/test/0000755000000000000000000000000012633224010014345 5ustar0000000000000000mono-traversable-0.10.0.1/test/main.hs0000644000000000000000000000002312633224010015620 0ustar0000000000000000import Spec (main) mono-traversable-0.10.0.1/test/Spec.hs0000644000000000000000000005010212633224010015571 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} 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.ByteVector import Data.Monoid (mempty, mconcat) import Data.Maybe (fromMaybe) import Test.Hspec import Test.Hspec.QuickCheck import Test.HUnit ((@?=)) import Test.QuickCheck hiding (NonEmptyList(..)) import qualified Test.QuickCheck as QC 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.IntSet as IntSet import qualified Data.Set as Set import qualified Control.Foldl as Foldl import Control.Arrow (first, second) import Control.Applicative import Control.Monad.Trans.Writer import Prelude (Bool (..), ($), IO, min, abs, Eq (..), (&&), fromIntegral, Ord (..), String, mod, Int, Integer, show, return, asTypeOf, (.), Show, id, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, seq, maybe) import qualified Prelude instance Arbitrary a => Arbitrary (NE.NonEmpty a) where arbitrary = (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) 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" $ \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 :: (OrdSequence 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 "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 intercalate seq seqs @?= defaultIntercalate seq seqs 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) -> intercalate 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) -> intercalate (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 "Data.ByteVector" $ do prop "toByteVector" $ \ws -> (otoList . toByteVector . fromList $ ws) @?= ws prop "fromByteVector" $ \ws -> (otoList . fromByteVector . fromList $ ws) @?= ws 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" it "#83 head on Seq works correctly" $ do headEx (Seq.fromList [1 :: Int,2,3]) @?= (1 :: Int) headMay (Seq.fromList [] :: Seq.Seq Int) @?= Nothing