classy-prelude-0.12.5/0000755000000000000000000000000012614717545012735 5ustar0000000000000000classy-prelude-0.12.5/LICENSE0000644000000000000000000000207512614717545013746 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.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. classy-prelude-0.12.5/ClassyPrelude.hs0000644000000000000000000004045012614717545016053 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} module ClassyPrelude ( -- * CorePrelude module CorePrelude , undefined -- * Standard -- ** Monoid , (++) -- ** Semigroup , Semigroup (..) , WrappedMonoid -- ** Functor , module Data.Functor -- ** Applicative , module Control.Applicative -- ** Monad , module Control.Monad , whenM , unlessM -- ** Mutable references , module Control.Concurrent.MVar.Lifted , module Control.Concurrent.Chan.Lifted , module Control.Concurrent.STM , atomically , alwaysSTM , alwaysSucceedsSTM , retrySTM , orElseSTM , checkSTM , module Data.IORef.Lifted , module Data.Mutable -- ** Primitive (exported since 0.9.4) , PrimMonad , PrimState , primToPrim , primToIO , primToST , module Data.Primitive.MutVar , Prim -- ** Debugging , trace , traceShow , traceId , traceM , traceShowId , traceShowM , assert -- ** Time (since 0.6.1) , module Data.Time , defaultTimeLocale -- ** Generics (since 0.8.1) , Generic -- ** Transformers (since 0.9.4) , Identity (..) , MonadReader , ask , ReaderT (..) , Reader -- * Poly hierarchy , module Data.Foldable , module Data.Traversable -- ** Bifunctor (since 0.10.0) , module Data.Bifunctor -- * Mono hierarchy , module Data.MonoTraversable , module Data.Sequences , module Data.Sequences.Lazy , module Data.Textual.Encoding , module Data.Containers , module Data.Builder , module Data.MinLen , module Data.ByteVector -- * I\/O , Handle , stdin , stdout , stderr -- * Non-standard -- ** List-like classes , map , concat , concatMap , foldMap , fold , length , null , pack , unpack , repack , toList , mapM_ , sequence_ , forM_ , any , all , and , or , foldl' , foldr , foldM , elem --, split , readMay , intercalate , zip, zip3, zip4, zip5, zip6, zip7 , unzip, unzip3, unzip4, unzip5, unzip6, unzip7 , zipWith, zipWith3, zipWith4, zipWith5, zipWith6, zipWith7 , hashNub , ordNub , ordNubBy , sortWith , compareLength , sum , product , Prelude.repeat -- ** Set-like , (\\) , intersect , unions -- FIXME , mapSet -- ** Text-like , Show (..) , tshow , tlshow -- *** Case conversion , charToLower , charToUpper -- ** IO , IOData (..) , print , hClose -- ** FilePath , fpToString , fpFromString , fpToText , fpFromText , fpToTextWarn , fpToTextEx -- ** Difference lists , DList , asDList , applyDList -- ** Exceptions , module Control.Exception.Enclosed , MonadThrow (throwM) , MonadCatch , MonadMask -- ** Force types -- | Helper functions for situations where type inferer gets confused. , asByteString , asLByteString , asHashMap , asHashSet , asText , asLText , asList , asMap , asIntMap , asMaybe , asSet , asIntSet , asVector , asUVector , asSVector , asString ) where import qualified Prelude import Control.Applicative ((<**>),liftA,liftA2,liftA3,Alternative (..), optional) import Data.Functor import Control.Exception (assert) import Control.Exception.Enclosed import Control.Monad (when, unless, void, liftM, ap, forever, join, replicateM_, guard, MonadPlus (..), (=<<), (>=>), (<=<), liftM2, liftM3, liftM4, liftM5) import Control.Concurrent.MVar.Lifted import Control.Concurrent.Chan.Lifted import Control.Concurrent.STM hiding (atomically, always, alwaysSucceeds, retry, orElse, check) import qualified Control.Concurrent.STM as STM import Data.IORef.Lifted import Data.Mutable import qualified Data.Monoid as Monoid import Data.Traversable (Traversable (..), for, forM) import Data.Foldable (Foldable) import Data.IOData (IOData (..)) import Control.Monad.Catch (MonadThrow (throwM), MonadCatch, MonadMask) import Data.Vector.Instances () import CorePrelude hiding (print, undefined, (<>), catMaybes, first, second) import Data.ChunkedZip import qualified Data.Char as Char import Data.Sequences hiding (elem) import Data.MonoTraversable import Data.Containers import Data.Builder import Data.MinLen import Data.ByteVector import System.IO (Handle, stdin, stdout, stderr, hClose) import Debug.Trace (trace, traceShow) import Data.Semigroup (Semigroup (..), WrappedMonoid (..)) import Prelude (Show (..)) import Data.Time ( UTCTime (..) , Day (..) , toGregorian , fromGregorian , formatTime , parseTime , getCurrentTime ) import Data.Time.Locale.Compat (defaultTimeLocale) import qualified Data.Set as Set import qualified Data.Map as Map import qualified Data.HashSet as HashSet import Data.Textual.Encoding import Data.Sequences.Lazy import GHC.Generics (Generic) import Control.Monad.Primitive (PrimMonad, PrimState, primToPrim, primToIO, primToST) import Data.Primitive.MutVar import Data.Primitive.Types (Prim) import Data.Functor.Identity (Identity (..)) import Control.Monad.Reader (MonadReader, ask, ReaderT (..), Reader) import Data.Bifunctor import Data.DList (DList) import qualified Data.DList as DList tshow :: Show a => a -> Text tshow = fromList . Prelude.show tlshow :: Show a => a -> LText tlshow = fromList . Prelude.show -- | Convert a character to lower case. -- -- Character-based case conversion is lossy in comparison to string-based 'Data.MonoTraversable.toLower'. -- For instance, İ will be converted to i, instead of i̇. charToLower :: Char -> Char charToLower = Char.toLower -- | Convert a character to upper case. -- -- Character-based case conversion is lossy in comparison to string-based 'Data.MonoTraversable.toUpper'. -- For instance, ß won't be converted to SS. charToUpper :: Char -> Char charToUpper = Char.toUpper -- Renames from mono-traversable pack :: IsSequence c => [Element c] -> c pack = fromList unpack, toList :: MonoFoldable c => c -> [Element c] unpack = otoList toList = otoList null :: MonoFoldable c => c -> Bool null = onull compareLength :: (Integral i, MonoFoldable c) => c -> i -> Ordering compareLength = ocompareLength sum :: (MonoFoldable c, Num (Element c)) => c -> Element c sum = osum product :: (MonoFoldable c, Num (Element c)) => c -> Element c product = oproduct all :: MonoFoldable c => (Element c -> Bool) -> c -> Bool all = oall {-# INLINE all #-} any :: MonoFoldable c => (Element c -> Bool) -> c -> Bool any = oany {-# INLINE any #-} -- | -- -- Since 0.9.2 and :: (MonoFoldable mono, Element mono ~ Bool) => mono -> Bool and = oand {-# INLINE and #-} -- | -- -- Since 0.9.2 or :: (MonoFoldable mono, Element mono ~ Bool) => mono -> Bool or = oor {-# INLINE or #-} length :: MonoFoldable c => c -> Int length = olength mapM_ :: (Monad m, MonoFoldable c) => (Element c -> m ()) -> c -> m () mapM_ = omapM_ traverse_ :: (Applicative f, MonoFoldable c) => (Element c -> f ()) -> c -> f () traverse_ = otraverse_ for_ :: (Applicative f, MonoFoldable c) => c -> (Element c -> f ()) -> f () for_ = ofor_ forM_ :: (Monad m, MonoFoldable c) => c -> (Element c -> m ()) -> m () forM_ = oforM_ concatMap :: (Monoid m, MonoFoldable c) => (Element c -> m) -> c -> m concatMap = ofoldMap {-# INLINE concatMap #-} elem :: (MonoFoldableEq c) => Element c -> c -> Bool elem = oelem {-# INLINE elem #-} foldMap :: (Monoid m, MonoFoldable c) => (Element c -> m) -> c -> m foldMap = ofoldMap {-# INLINE foldMap #-} fold :: (Monoid (Element c), MonoFoldable c) => c -> Element c fold = ofoldMap id {-# INLINE fold #-} foldr :: MonoFoldable c => (Element c -> b -> b) -> b -> c -> b foldr = ofoldr foldl' :: MonoFoldable c => (a -> Element c -> a) -> a -> c -> a foldl' = ofoldl' foldM :: (Monad m, MonoFoldable c) => (a -> Element c -> m a) -> a -> c -> m a foldM = ofoldlM concat :: (MonoFoldable c, Monoid (Element c)) => c -> Element c concat = ofoldMap id readMay :: (Element c ~ Char, MonoFoldable c, Read a) => c -> Maybe a readMay a = -- FIXME replace with safe-failure stuff case [x | (x, t) <- Prelude.reads (otoList a :: String), onull t] of [x] -> Just x _ -> Nothing -- | Repack from one type to another, dropping to a list in the middle. -- -- @repack = pack . unpack@. repack :: (MonoFoldable a, IsSequence b, Element a ~ Element b) => a -> b repack = fromList . toList map :: Functor f => (a -> b) -> f a -> f b map = fmap infixr 5 ++ (++) :: Monoid m => m -> m -> m (++) = mappend {-# INLINE (++) #-} infixl 9 \\{-This comment teaches CPP correct behaviour -} -- | An alias for 'difference'. (\\) :: SetContainer a => a -> a -> a (\\) = difference {-# INLINE (\\) #-} -- | An alias for 'intersection'. intersect :: SetContainer a => a -> a -> a intersect = intersection {-# INLINE intersect #-} unions :: (MonoFoldable c, SetContainer (Element c)) => c -> Element c unions = ofoldl' union Monoid.mempty #if !MIN_VERSION_mono_traversable(0, 9, 3) intercalate :: (Monoid (Element c), IsSequence c) => Element c -> c -> Element c intercalate xs xss = concat (intersperse xs xss) #endif asByteString :: ByteString -> ByteString asByteString = id asLByteString :: LByteString -> LByteString asLByteString = id asHashMap :: HashMap k v -> HashMap k v asHashMap = id asHashSet :: HashSet a -> HashSet a asHashSet = id asText :: Text -> Text asText = id asLText :: LText -> LText asLText = id asList :: [a] -> [a] asList = id asMap :: Map k v -> Map k v asMap = id asIntMap :: IntMap v -> IntMap v asIntMap = id asMaybe :: Maybe a -> Maybe a asMaybe = id asSet :: Set a -> Set a asSet = id asIntSet :: IntSet -> IntSet asIntSet = id asVector :: Vector a -> Vector a asVector = id asUVector :: UVector a -> UVector a asUVector = id asSVector :: SVector a -> SVector a asSVector = id asString :: [Char] -> [Char] asString = id print :: (Show a, MonadIO m) => a -> m () print = liftIO . Prelude.print -- | Sort elements using the user supplied function to project something out of -- each element. -- Inspired by . sortWith :: (Ord a, IsSequence c) => (Element c -> a) -> c -> c sortWith f = sortBy $ comparing f -- | We define our own 'undefined' which is marked as deprecated. This makes it -- useful to use during development, but lets you more easily get -- notifications if you accidentally ship partial code in production. -- -- The classy prelude recommendation for when you need to really have a partial -- function in production is to use 'error' with a very descriptive message so -- that, in case an exception is thrown, you get more information than -- @"Prelude".'Prelude.undefined'@. -- -- Since 0.5.5 undefined :: a undefined = error "ClassyPrelude.undefined" {-# DEPRECATED undefined "It is highly recommended that you either avoid partial functions or provide meaningful error messages" #-} -- | -- -- Since 0.5.9 traceId :: String -> String traceId a = trace a a -- | -- -- Since 0.5.9 traceM :: (Monad m) => String -> m () traceM string = trace string $ return () -- | -- -- Since 0.5.9 traceShowId :: (Show a) => a -> a traceShowId a = trace (show a) a -- | -- -- Since 0.5.9 traceShowM :: (Show a, Monad m) => a -> m () traceShowM = traceM . show fpToString :: FilePath -> String fpToString = id {-# DEPRECATED fpToString "Now same as id" #-} fpFromString :: String -> FilePath fpFromString = id {-# DEPRECATED fpFromString "Now same as id" #-} -- | Translates a 'FilePath' to a 'Text' -- -- Warns if there are non-unicode sequences in the file name fpToTextWarn :: Monad m => FilePath -> m Text fpToTextWarn = return . pack {-# DEPRECATED fpToTextWarn "Use pack" #-} -- | Translates a 'FilePath' to a 'Text' -- -- Throws an exception if there are non-unicode -- sequences in the file name -- -- Use this to assert that you know -- a filename will translate properly into a 'Text'. -- If you created the filename, this should be the case. fpToTextEx :: FilePath -> Text fpToTextEx = pack {-# DEPRECATED fpToTextEx "Use pack" #-} -- | Translates a 'FilePath' to a 'Text' -- This translation is not correct for a (unix) filename -- which can contain arbitrary (non-unicode) bytes: those bytes will be discarded. -- -- This means you cannot translate the 'Text' back to the original file name. -- -- If you control or otherwise understand the filenames -- and believe them to be unicode valid consider using 'fpToTextEx' or 'fpToTextWarn' fpToText :: FilePath -> Text fpToText = pack {-# DEPRECATED fpToText "Use pack" #-} fpFromText :: Text -> FilePath fpFromText = unpack {-# DEPRECATED fpFromText "Use unpack" #-} -- Below is a lot of coding for classy-prelude! -- These functions are restricted to lists right now. -- Should eventually exist in mono-foldable and be extended to MonoFoldable -- when doing that should re-run the haskell-ordnub benchmarks -- | same behavior as 'Data.List.nub', but requires 'Hashable' & 'Eq' and is @O(n log n)@ -- -- hashNub :: (Hashable a, Eq a) => [a] -> [a] hashNub = go HashSet.empty where go _ [] = [] go s (x:xs) | x `HashSet.member` s = go s xs | otherwise = x : go (HashSet.insert x s) xs -- | same behavior as 'Data.List.nub', but requires 'Ord' and is @O(n log n)@ -- -- ordNub :: (Ord a) => [a] -> [a] ordNub = go Set.empty where go _ [] = [] go s (x:xs) | x `Set.member` s = go s xs | otherwise = x : go (Set.insert x s) xs -- | same behavior as 'Data.List.nubBy', but requires 'Ord' and is @O(n log n)@ -- -- ordNubBy :: (Ord b) => (a -> b) -> (a -> a -> Bool) -> [a] -> [a] ordNubBy p f = go Map.empty -- When removing duplicates, the first function assigns the input to a bucket, -- the second function checks whether it is already in the bucket (linear search). where go _ [] = [] go m (x:xs) = let b = p x in case b `Map.lookup` m of Nothing -> x : go (Map.insert b [x] m) xs Just bucket | elem_by f x bucket -> go m xs | otherwise -> x : go (Map.insert b (x:bucket) m) xs -- From the Data.List source code. elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool elem_by _ _ [] = False elem_by eq y (x:xs) = y `eq` x || elem_by eq y xs -- | Generalized version of 'STM.atomically'. atomically :: MonadIO m => STM a -> m a atomically = liftIO . STM.atomically -- | Synonym for 'STM.retry'. retrySTM :: STM a retrySTM = STM.retry {-# INLINE retrySTM #-} -- | Synonym for 'STM.always'. alwaysSTM :: STM Bool -> STM () alwaysSTM = STM.always {-# INLINE alwaysSTM #-} -- | Synonym for 'STM.alwaysSucceeds'. alwaysSucceedsSTM :: STM a -> STM () alwaysSucceedsSTM = STM.alwaysSucceeds {-# INLINE alwaysSucceedsSTM #-} -- | Synonym for 'STM.orElse'. orElseSTM :: STM a -> STM a -> STM a orElseSTM = STM.orElse {-# INLINE orElseSTM #-} -- | Synonym for 'STM.check'. checkSTM :: Bool -> STM () checkSTM = STM.check {-# INLINE checkSTM #-} -- | Only perform the action if the predicate returns 'True'. -- -- Since 0.9.2 whenM :: Monad m => m Bool -> m () -> m () whenM mbool action = mbool >>= flip when action -- | Only perform the action if the predicate returns 'False'. -- -- Since 0.9.2 unlessM :: Monad m => m Bool -> m () -> m () unlessM mbool action = mbool >>= flip unless action sequence_ :: (Monad m, MonoFoldable mono, Element mono ~ (m a)) => mono -> m () sequence_ = mapM_ (>> return ()) {-# INLINE sequence_ #-} -- | Force type to a 'DList' -- -- Since 0.11.0 asDList :: DList a -> DList a asDList = id {-# INLINE asDList #-} -- | Synonym for 'DList.apply' -- -- Since 0.11.0 applyDList :: DList a -> [a] -> [a] applyDList = DList.apply {-# INLINE applyDList #-} -- | Throw a monadic exception from a String -- -- > erroM = throwM . userError -- -- Since 0.12.1 errorM :: (MonadThrow m) => String -> m a errorM = throwM . userError -- | Throw a monadic exception from a Text -- -- > terroM = errorM . unpack -- -- Since 0.12.1 terrorM :: (MonadThrow m) => Text -> m a terrorM = errorM . unpack -- | Throw an error from a Text -- -- > terror = error . unpack -- -- Since 0.12.1 terror :: Text -> a terror = error . unpack classy-prelude-0.12.5/classy-prelude.cabal0000644000000000000000000000443612614717545016664 0ustar0000000000000000name: classy-prelude version: 0.12.5 synopsis: A typeclass-based Prelude. description: Modern best practices without name collisions. No partial functions are exposed, but modern data structures are, without requiring import lists. Qualified modules also are not needed: instead operations are based on type-classes from the mono-traversable package. homepage: https://github.com/snoyberg/classy-prelude license: MIT license-file: LICENSE author: Michael Snoyman maintainer: michael@snoyman.com category: Control, Prelude build-type: Simple cabal-version: >=1.8 extra-source-files: ChangeLog.md library exposed-modules: ClassyPrelude build-depends: base >= 4 && < 5 , basic-prelude >= 0.4 && < 0.6 , transformers , containers >= 0.4.2 , text , bytestring , vector , unordered-containers , hashable , lifted-base >= 0.2 , mono-traversable >= 0.9.3 , exceptions >= 0.5 , semigroups , vector-instances , time , time-locale-compat , chunked-data , enclosed-exceptions , ghc-prim , stm , primitive , mtl , bifunctors , mutable-containers >= 0.3 && < 0.4 , dlist >= 0.7 ghc-options: -Wall -fno-warn-orphans test-suite test hs-source-dirs: test main-is: main.hs type: exitcode-stdio-1.0 build-depends: classy-prelude , base , hspec >= 1.3 , QuickCheck , transformers , containers , unordered-containers ghc-options: -Wall source-repository head type: git location: git://github.com/snoyberg/classy-prelude.git classy-prelude-0.12.5/Setup.hs0000644000000000000000000000005612614717545014372 0ustar0000000000000000import Distribution.Simple main = defaultMain classy-prelude-0.12.5/ChangeLog.md0000644000000000000000000000144612614717545015113 0ustar0000000000000000## 0.12.5 * Expose `Alternative` and `optional` ## 0.12.4 * Expose `traverse_` and `for_` ## 0.12.3 * mono-traversable-0.9.3 support ## 0.12.2 add `errorM`, `terrorM`, and `terror` ## 0.12.0 * Drop system-filepath ## 0.11.1.1 * Compatibility with time >= 1.5 [#100](https://github.com/snoyberg/classy-prelude/pull/100) ## 0.11.1 * Fix deprecation warnings for `elem` ## 0.11.0 * Upgrade to mutable-containers 0.3 * Include dlist support ## 0.10.5 * Export `Data.Mutable` ## 0.10.4 * Expose all of Data.Functor ## 0.10.3 * Expose `liftA` functions and `<**>` [#94](https://github.com/snoyberg/classy-prelude/pull/94) ## 0.10.2 * Provide `foldMap` and `fold` as synonyms for `concatMap` and `concat`. * Switch to more general `Traversable`-based functions (`sequence_` in particular). classy-prelude-0.12.5/test/0000755000000000000000000000000012614717545013714 5ustar0000000000000000classy-prelude-0.12.5/test/main.hs0000644000000000000000000004530212614717545015200 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} import Test.Hspec import Test.Hspec.QuickCheck import ClassyPrelude hiding (undefined) import Test.QuickCheck.Arbitrary import Prelude (undefined) import Control.Monad.Trans.Writer (tell, Writer, runWriter) import Control.Concurrent (throwTo, threadDelay, forkIO) import Control.Exception (throw) import qualified Data.Set as Set import qualified Data.HashSet as HashSet dictionaryProps :: ( MapValue c ~ Char , ContainerKey c ~ Int , Arbitrary c , IsMap c , Eq c , Show c ) => c -> Spec dictionaryProps dummy = do prop "insert x y (insert x z c) == insert x y c" $ \x y z c -> insertMap x y (insertMap x z (c `asTypeOf` dummy)) == insertMap x y c prop "insertMap x y (deleteMap x c) == insertMap x y c" $ \x y c -> insertMap x y (deleteMap x (c `asTypeOf` dummy)) == insertMap x y c prop "deleteMap x (insertMap x y c) == deleteMap x c" $ \x y c -> mapFromList (mapToList $ deleteMap x (insertMap x y (c `asTypeOf` dummy))) == (mapFromList (mapToList ((deleteMap x c) `asTypeOf` dummy) :: [(Int, Char)]) `asTypeOf` dummy) prop "lookup k (insertMap k v empty) == Just v" $ \k v -> lookup k (insertMap k v mempty `asTypeOf` dummy) == Just v prop "lookup k (deleteMap k c) == Nothing" $ \k c -> lookup k (deleteMap k c`asTypeOf` dummy) == Nothing mapProps :: ( i ~ Element c , MonoFoldable c , Eq c , Arbitrary c , Show c ) => ((i -> i) -> c -> c) -> ([i] -> c) -> c -> (i -> i) -> (i -> i) -> Spec mapProps map' pack' dummy f g = do prop "map f c == pack (map f (unpack c))" $ \c -> map' f (c `asTypeOf` dummy) == pack' (fmap f (unpack c)) prop "map (f . g) c == map f (map g c)" $ \c -> map' (g . f) (c `asTypeOf` dummy) == map' g (map' f c) concatMapProps :: ( MonoFoldable c , IsSequence c , Eq c , MonoFoldableMonoid c , Arbitrary c , Show c ) => c -> (Element c -> c) -> Spec concatMapProps dummy f = do prop "concatMap f c == pack (concatMap (unpack . f) (unpack c))" $ \c -> concatMap f (c `asTypeOf` dummy) == pack (concatMap (unpack . f) (unpack c)) filterProps :: ( Eq c , Show c , IsSequence c , Arbitrary c ) => c -> (Element c -> Bool) -> Spec filterProps dummy f = do prop "filter f c == pack (filter f (unpack c))" $ \c -> (repack (filter f (c `asTypeOf` dummy)) `asTypeOf` dummy) == pack (filter f (unpack c)) filterMProps :: ( Eq c , Show c , IsSequence c , Arbitrary c ) => c -> (Element c -> Bool) -> Spec filterMProps dummy f' = do prop "filterM f c == fmap pack (filterM f (unpack c))" $ \c -> runIdentity (fmap repack (filterM f (c `asTypeOf` dummy))) `asTypeOf` dummy == runIdentity (fmap pack (filterM f (unpack c))) where f = return . f' lengthProps :: ( Show c , MonoFoldable c , Monoid c , Arbitrary c ) => c -> Spec lengthProps dummy = do prop "length c == fromIntegral (length (unpack c))" $ \c -> length (c `asTypeOf` dummy) == fromIntegral (length (unpack c)) prop "null c == (length c == 0)" $ \c -> null (c `asTypeOf` dummy) == (length c == 0) prop "length (x ++ y) <= length x + length y" $ \x y -> length (x ++ y `asTypeOf` dummy) <= length x + length y prop "length (x ++ y) >= max (length x) (length y)" $ \x y -> length (x ++ y `asTypeOf` dummy) >= max (length x) (length y) prop "length (x ++ empty) == length x" $ \x -> length (x ++ mempty `asTypeOf` dummy) == length x prop "null empty" $ null (mempty `asTypeOf` dummy) mapMProps :: ( Eq c , Show c , IsSequence c , Arbitrary c , Element c ~ Int ) => c -> Spec mapMProps dummy = do let f :: Int -> Writer [Int] Int f x = tell [x] >> return x prop "omapM f c == omapM f (toList c)" $ \c -> runWriter (omapM f (c `asTypeOf` dummy)) == let (x, y) = runWriter (omapM f (toList c)) in (pack x, y) mapM_Props :: ( Eq (Element c) , Show c , MonoFoldable c , Arbitrary c ) => c -> Spec mapM_Props dummy = do let f x = tell [x] prop "mapM_ f c == mapM_ f (toList c)" $ \c -> runWriter (mapM_ f (c `asTypeOf` dummy)) == runWriter (mapM_ f (toList c)) foldProps :: ( Eq a , Show c , MonoFoldable c , Arbitrary c ) => c -> (a -> Element c -> a) -> a -> Spec foldProps dummy f accum = prop "foldl' f accum c == foldl' f accum (toList c)" $ \c -> foldl' f accum (c `asTypeOf` dummy) == foldl' f accum (toList c) replicateProps :: ( Eq a , Show (Element c) , IsSequence a , IsSequence c , Arbitrary (Element c) , Element a ~ Element c ) => a -> (c -> a) -> Spec replicateProps dummy pack' = prop "replicate i a == pack (replicate i a)" $ \{- takes too long i-} a -> (replicate i a `asTypeOf` dummy) == pack' (replicate i a) where i = 3 chunkProps :: ( Eq a , Show a , Arbitrary a , LazySequence a s ) => a -> Spec chunkProps dummy = do prop "fromChunks . toChunks == id" $ \a -> fromChunks (toChunks (a `asTypeOf` dummy)) == a prop "fromChunks . return . concat . toChunks == id" $ \a -> fromChunks [concat $ toChunks (a `asTypeOf` dummy)] == a stripSuffixProps :: ( Eq c , Show c , Arbitrary c , EqSequence c ) => c -> Spec stripSuffixProps dummy = do prop "stripSuffix y (x ++ y) == Just x" $ \x y -> stripSuffix y (x ++ y) == Just (x `asTypeOf` dummy) prop "isJust (stripSuffix x y) == isSuffixOf x y" $ \x y -> isJust (stripSuffix x y) == isSuffixOf x (y `asTypeOf` dummy) replicateMProps :: ( Eq a , Show (Index a) , Show (Element a) , IsSequence a , Arbitrary (Index a) , Arbitrary (Element a) ) => a -> Spec replicateMProps dummy = do prop "runIdentity (replicateM i (return x)) == replicate i x" $ \i' x -> let i = i' `mod` 20 in runIdentity (replicateM i (return x)) == (replicate i x `asTypeOf` dummy) utf8Props :: ( Eq t , Show t , Arbitrary t , Textual t , Utf8 t b ) => t -> Spec utf8Props dummy = do prop "decodeUtf8 . encodeUtf8 == id" $ \t -> decodeUtf8 (encodeUtf8 t) == (t `asTypeOf` dummy) compareLengthProps :: ( MonoFoldable c , Arbitrary c , Show c ) => c -> Spec compareLengthProps dummy = do prop "compare (length c) i == compareLength c i" $ \i c -> compare (length c) i == compareLength (c `asTypeOf` dummy) i prefixProps :: ( Eq c , EqSequence c , Arbitrary c , Show c ) => c -> Spec prefixProps dummy = do prop "x `isPrefixOf` (x ++ y)" $ \x y -> (x `asTypeOf` dummy) `isPrefixOf` (x ++ y) prop "stripPrefix x (x ++ y) == Just y" $ \x y -> stripPrefix x (x ++ y) == Just (y `asTypeOf` dummy) prop "stripPrefix x y == Nothing || x `isPrefixOf` y" $ \x y -> stripPrefix x y == Nothing || x `isPrefixOf` (y `asTypeOf` dummy) main :: IO () main = hspec $ do describe "dictionary" $ do describe "Data.Map" $ dictionaryProps (undefined :: Map Int Char) describe "Data.HashMap" $ dictionaryProps (undefined :: HashMap Int Char) describe "assoc list" $ dictionaryProps (undefined :: [(Int, Char)]) describe "map" $ do describe "list" $ mapProps fmap pack (undefined :: [Int]) (+ 1) (+ 2) describe "Data.Vector" $ mapProps fmap pack (undefined :: Vector Int) (+ 1) (+ 2) describe "Data.Vector.Unboxed" $ mapProps omap pack (undefined :: UVector Int) (+ 1) (+ 2) describe "Data.Set" $ mapProps Set.map setFromList (undefined :: Set Int) (+ 1) (+ 2) describe "Data.HashSet" $ mapProps HashSet.map setFromList (undefined :: HashSet Int) (+ 1) (+ 2) describe "Data.ByteString" $ mapProps omap pack (undefined :: ByteString) (+ 1) (+ 2) describe "Data.ByteString.Lazy" $ mapProps omap pack (undefined :: LByteString) (+ 1) (+ 2) describe "Data.Text" $ mapProps omap pack (undefined :: Text) succ succ describe "Data.Text.Lazy" $ mapProps omap pack (undefined :: LText) succ succ describe "Data.Sequence" $ mapProps fmap pack (undefined :: Seq Int) succ succ describe "concatMap" $ do describe "list" $ concatMapProps (undefined :: [Int]) (\i -> [i + 1, i + 2]) describe "Data.Vector" $ concatMapProps (undefined :: Vector Int) (\i -> fromList [i + 1, i + 2]) describe "Data.Vector.Unboxed" $ concatMapProps (undefined :: UVector Int) (\i -> fromList [i + 1, i + 2]) describe "Data.ByteString" $ concatMapProps (undefined :: ByteString) (\i -> fromList [i + 1, i + 2]) describe "Data.ByteString.Lazy" $ concatMapProps (undefined :: LByteString) (\i -> fromList [i + 1, i + 2]) describe "Data.Text" $ concatMapProps (undefined :: Text) (\c -> pack [succ c, succ $ succ c]) describe "Data.Text.Lazy" $ concatMapProps (undefined :: LText) (\c -> pack [succ c, succ $ succ c]) describe "Data.Sequence" $ concatMapProps (undefined :: Seq Int) (\i -> pack [i + 1, i + 2]) describe "filter" $ do describe "list" $ filterProps (undefined :: [Int]) (< 20) describe "Data.Vector" $ filterProps (undefined :: Vector Int) (< 20) describe "Data.Vector.Unboxed" $ filterProps (undefined :: UVector Int) (< 20) describe "Data.ByteString" $ filterProps (undefined :: ByteString) (< 20) describe "Data.ByteString.Lazy" $ filterProps (undefined :: LByteString) (< 20) describe "Data.Text" $ filterProps (undefined :: Text) (< 'A') describe "Data.Text.Lazy" $ filterProps (undefined :: LText) (< 'A') {- FIXME describe "Data.Map" $ filterProps (undefined :: Map Int Char) (\(i, _) -> i < 20) describe "Data.HashMap" $ filterProps (undefined :: HashMap Int Char) (\(i, _) -> i < 20) describe "Data.Set" $ filterProps (undefined :: Set Int) (< 20) -} describe "Data.Sequence" $ filterProps (undefined :: Seq Int) (< 20) describe "filterM" $ do describe "list" $ filterMProps (undefined :: [Int]) (< 20) describe "Data.Vector" $ filterMProps (undefined :: Vector Int) (< 20) describe "Data.Vector.Unboxed" $ filterMProps (undefined :: Vector Int) (< 20) describe "Data.Sequence" $ filterMProps (undefined :: Seq Int) (< 20) describe "length" $ do describe "list" $ lengthProps (undefined :: [Int]) describe "Data.Vector" $ lengthProps (undefined :: Vector Int) describe "Data.Vector.Unboxed" $ lengthProps (undefined :: UVector Int) describe "Data.ByteString" $ lengthProps (undefined :: ByteString) describe "Data.ByteString.Lazy" $ lengthProps (undefined :: LByteString) describe "Data.Text" $ lengthProps (undefined :: Text) describe "Data.Text.Lazy" $ lengthProps (undefined :: LText) describe "Data.Map" $ lengthProps (undefined :: Map Int Char) describe "Data.HashMap" $ lengthProps (undefined :: HashMap Int Char) describe "Data.Set" $ lengthProps (undefined :: Set Int) describe "Data.HashSet" $ lengthProps (undefined :: HashSet Int) describe "Data.Sequence" $ lengthProps (undefined :: Seq Int) describe "mapM" $ do describe "list" $ mapMProps (undefined :: [Int]) describe "Data.Vector" $ mapMProps (undefined :: Vector Int) describe "Data.Vector.Unboxed" $ mapMProps (undefined :: UVector Int) describe "Seq" $ mapMProps (undefined :: Seq Int) describe "mapM_" $ do describe "list" $ mapM_Props (undefined :: [Int]) describe "Data.Vector" $ mapM_Props (undefined :: Vector Int) describe "Data.Vector.Unboxed" $ mapM_Props (undefined :: UVector Int) describe "Set" $ mapM_Props (undefined :: Set Int) describe "HashSet" $ mapM_Props (undefined :: HashSet Int) describe "Seq" $ mapM_Props (undefined :: Seq Int) describe "fold" $ do let f = flip (:) describe "list" $ foldProps (undefined :: [Int]) f [] describe "Data.Vector" $ foldProps (undefined :: Vector Int) f [] describe "Data.Vector.Unboxed" $ foldProps (undefined :: UVector Int) f [] describe "Data.ByteString" $ foldProps (undefined :: ByteString) f [] describe "Data.ByteString.Lazy" $ foldProps (undefined :: LByteString) f [] describe "Data.Text" $ foldProps (undefined :: Text) f [] describe "Data.Text.Lazy" $ foldProps (undefined :: LText) f [] describe "Data.Set" $ foldProps (undefined :: Set Int) f [] describe "Data.HashSet" $ foldProps (undefined :: HashSet Int) f [] describe "Data.Sequence" $ foldProps (undefined :: Seq Int) f [] describe "replicate" $ do describe "list" $ replicateProps (undefined :: [Int]) pack describe "Data.Vector" $ replicateProps (undefined :: Vector Int) pack describe "Data.Vector.Unboxed" $ replicateProps (undefined :: UVector Int) pack describe "Data.ByteString" $ replicateProps (undefined :: ByteString) pack describe "Data.ByteString.Lazy" $ replicateProps (undefined :: LByteString) pack describe "Data.Text" $ replicateProps (undefined :: Text) pack describe "Data.Text.Lazy" $ replicateProps (undefined :: LText) pack describe "Data.Sequence" $ replicateProps (undefined :: Seq Int) pack describe "chunks" $ do describe "ByteString" $ chunkProps (asLByteString undefined) describe "Text" $ chunkProps (asLText undefined) describe "stripSuffix" $ do describe "Text" $ stripSuffixProps (undefined :: Text) describe "LText" $ stripSuffixProps (undefined :: LText) describe "ByteString" $ stripSuffixProps (undefined :: ByteString) describe "LByteString" $ stripSuffixProps (undefined :: LByteString) describe "Seq" $ stripSuffixProps (undefined :: Seq Int) describe "replicateM" $ do describe "list" $ replicateMProps (undefined :: [Int]) describe "Vector" $ replicateMProps (undefined :: Vector Int) describe "UVector" $ replicateMProps (undefined :: UVector Int) describe "Seq" $ replicateMProps (undefined :: Seq Int) describe "encode/decode UTF8" $ do describe "Text" $ utf8Props (undefined :: Text) describe "LText" $ utf8Props (undefined :: LText) describe "compareLength" $ do describe "list" $ compareLengthProps (undefined :: [Int]) describe "Text" $ compareLengthProps (undefined :: Text) describe "LText" $ compareLengthProps (undefined :: LText) describe "Prefix" $ do describe "list" $ prefixProps (undefined :: [Int]) describe "Text" $ prefixProps (undefined :: Text) describe "LText" $ prefixProps (undefined :: LText) describe "ByteString" $ prefixProps (undefined :: ByteString) describe "LByteString" $ prefixProps (undefined :: LByteString) describe "Vector" $ prefixProps (undefined :: Vector Int) describe "UVector" $ prefixProps (undefined :: UVector Int) describe "Seq" $ prefixProps (undefined :: Seq Int) describe "any exceptions" $ do it "catchAny" $ do failed <- newIORef 0 tid <- forkIO $ do catchAny (threadDelay 20000) (const $ writeIORef failed 1) writeIORef failed 2 threadDelay 10000 throwTo tid DummyException threadDelay 50000 didFail <- readIORef failed liftIO $ didFail `shouldBe` (0 :: Int) it "tryAny" $ do failed <- newIORef False tid <- forkIO $ do _ <- tryAny $ threadDelay 20000 writeIORef failed True threadDelay 10000 throwTo tid DummyException threadDelay 50000 didFail <- readIORef failed liftIO $ didFail `shouldBe` False it "tryAnyDeep" $ do eres <- tryAnyDeep $ return $ throw DummyException case eres of Left e | Just DummyException <- fromException e -> return () | otherwise -> error "Expected a DummyException" Right () -> error "Expected an exception" :: IO () it "basic DList functionality" $ (toList $ asDList $ mconcat [ fromList [1, 2] , singleton 3 , cons 4 mempty , fromList $ applyDList (singleton 5 ++ singleton 6) [7, 8] ]) `shouldBe` [1..8 :: Int] data DummyException = DummyException deriving (Show, Typeable) instance Exception DummyException instance Arbitrary (Map Int Char) where arbitrary = mapFromList <$> arbitrary instance Arbitrary (HashMap Int Char) where arbitrary = mapFromList <$> arbitrary instance Arbitrary (Vector Int) where arbitrary = fromList <$> arbitrary instance Arbitrary (UVector Int) where arbitrary = fromList <$> arbitrary instance Arbitrary (Set Int) where arbitrary = setFromList <$> arbitrary instance Arbitrary (HashSet Int) where arbitrary = setFromList <$> arbitrary instance Arbitrary ByteString where arbitrary = fromList <$> arbitrary instance Arbitrary LByteString where arbitrary = fromList <$> arbitrary instance Arbitrary Text where arbitrary = fromList <$> arbitrary instance Arbitrary LText where arbitrary = fromList <$> arbitrary instance Arbitrary (Seq Int) where arbitrary = fromList <$> arbitrary