classy-prelude-1.2.0.1/test/0000755000000000000000000000000012736421710013755 5ustar0000000000000000classy-prelude-1.2.0.1/ClassyPrelude.hs0000644000000000000000000004146013056054541016116 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 , module Control.Monad.Trans.Unlift , 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 -- ** STM Channels , module Control.Concurrent.STM.TBChan , module Control.Concurrent.STM.TBMChan , module Control.Concurrent.STM.TBMQueue , module Control.Concurrent.STM.TMChan , module Control.Concurrent.STM.TMQueue -- ** Primitive (exported since 0.9.4) , primToPrim , primToIO , primToST , module Data.Primitive.MutVar -- ** 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 , asks , 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.MonoTraversable.Unprefixed , module Data.Sequences , module Data.Containers , module Data.Builder , module Data.NonNull , toByteVector , fromByteVector -- * I\/O , Handle , stdin , stdout , stderr , module Say -- * Concurrency , module Control.Concurrent.Lifted , yieldThread , module Control.Concurrent.Async , module Control.Concurrent.Async.Lifted.Safe , waitAsync , pollAsync , waitCatchAsync , cancel , cancelWith , linkAsync , link2Async -- * Non-standard -- ** List-like classes , map --, split , readMay , zip, zip3, zip4, zip5, zip6, zip7 , unzip, unzip3, unzip4, unzip5, unzip6, unzip7 , zipWith, zipWith3, zipWith4, zipWith5, zipWith6, zipWith7 , hashNub , ordNub , ordNubBy , sortWith , Prelude.repeat -- ** Set-like , (\\) , intersect -- FIXME , mapSet -- ** Text-like , Show (..) , tshow , tlshow -- *** Case conversion , charToLower , charToUpper -- ** IO , readFile , readFileUtf8 , writeFile , writeFileUtf8 , hGetContents , hPut , hGetChunk , print , hClose -- ** Difference lists , DList , asDList , applyDList -- ** Exceptions , module Control.Exception.Safe , module Control.DeepSeq -- ** 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.Safe import Control.DeepSeq (deepseq, ($!!), force, NFData (..)) import Control.Monad (when, unless, void, liftM, ap, forever, join, replicateM_, guard, MonadPlus (..), (=<<), (>=>), (<=<), liftM2, liftM3, liftM4, liftM5) import Control.Concurrent.Lifted hiding (yield, throwTo) import qualified Control.Concurrent.Lifted as Conc (yield) 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 Data.Traversable (Traversable (..), for, forM) import Data.Foldable (Foldable) import Control.Monad.Base import Control.Monad.Trans.Unlift import qualified Control.Concurrent.Async as Async import Control.Concurrent.Async ( Async , waitSTM, pollSTM, waitCatchSTM ) import Control.Concurrent.Async.Lifted.Safe ( Pure, Forall , async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask , withAsync, withAsyncBound, withAsyncOn, withAsyncWithUnmask, withAsyncOnWithUnmask , asyncThreadId , race, race_, concurrently, mapConcurrently, Concurrently (..) ) import Data.Vector.Instances () import CorePrelude hiding ( print, undefined, (<>), catMaybes, first, second , try, throwIO, onException, mask, mask_ , handle, finally, catch, bracket, bracket_, bracketOnError , catchIOError , uninterruptibleMask, uninterruptibleMask_ #if MIN_VERSION_safe_exceptions(0,1,4) , catchJust, handleJust, tryJust #endif ) import Data.ChunkedZip import qualified Data.Char as Char import Data.Sequences import Data.MonoTraversable import Data.MonoTraversable.Unprefixed import Data.MonoTraversable.Instances () import Data.Containers import Data.Builder import Data.NonNull import qualified Data.ByteString import Data.ByteString.Internal (ByteString (PS)) import Data.ByteString.Lazy.Internal (defaultChunkSize) import Data.Vector.Storable (unsafeToForeignPtr, unsafeFromForeignPtr) 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 #if MIN_VERSION_time(1,5,0) , parseTimeM #endif , 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 GHC.Generics (Generic) import Control.Monad.Primitive (primToPrim, primToIO, primToST) import Data.Primitive.MutVar import Data.Functor.Identity (Identity (..)) import Control.Monad.Reader (MonadReader, ask, asks, ReaderT (..), Reader) import Data.Bifunctor import Data.DList (DList) import qualified Data.DList as DList import Say import Control.Concurrent.STM.TBChan import Control.Concurrent.STM.TBMChan import Control.Concurrent.STM.TBMQueue import Control.Concurrent.STM.TMChan import Control.Concurrent.STM.TMQueue #if MIN_VERSION_base(4,9,0) import GHC.Stack (HasCallStack) #endif 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 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 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 #-} 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 #if MIN_VERSION_base(4,9,0) undefined :: HasCallStack => a #else undefined :: a #endif 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 -- | Originally 'Conc.yield'. yieldThread :: MonadBase IO m => m () yieldThread = Conc.yield {-# INLINE yieldThread #-} -- 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 -- | 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 #-} infixr 3 <&&> -- | '&&' lifted to an Applicative. -- -- @since 0.12.8 (<&&>) :: Applicative a => a Bool -> a Bool -> a Bool (<&&>) = liftA2 (&&) {-# INLINE (<&&>) #-} infixr 2 <||> -- | '||' lifted to an Applicative. -- -- @since 0.12.8 (<||>) :: Applicative a => a Bool -> a Bool -> a Bool (<||>) = liftA2 (||) {-# INLINE (<||>) #-} -- | Convert a 'ByteString' into a storable 'Vector'. toByteVector :: ByteString -> SVector Word8 toByteVector (PS fptr offset idx) = unsafeFromForeignPtr fptr offset idx {-# INLINE toByteVector #-} -- | Convert a storable 'Vector' into a 'ByteString'. fromByteVector :: SVector Word8 -> ByteString fromByteVector v = PS fptr offset idx where (fptr, offset, idx) = unsafeToForeignPtr v {-# INLINE fromByteVector #-} -- | 'waitSTM' for any 'MonadIO' -- -- @since 1.0.0 waitAsync :: MonadIO m => Async a -> m a waitAsync = atomically . waitSTM -- | 'pollSTM' for any 'MonadIO' -- -- @since 1.0.0 pollAsync :: MonadIO m => Async a -> m (Maybe (Either SomeException a)) pollAsync = atomically . pollSTM -- | 'waitCatchSTM' for any 'MonadIO' -- -- @since 1.0.0 waitCatchAsync :: MonadIO m => Async a -> m (Either SomeException a) waitCatchAsync = atomically . waitCatchSTM -- | 'Async.cancel' generalized to any 'MonadIO' -- -- @since 1.0.0 cancel :: MonadIO m => Async a -> m () cancel = liftIO . Async.cancel -- | 'cancel' an 'Async' with the given exception. It is converted to -- an async exception via 'toAsyncException' first. -- -- @since 1.0.0 cancelWith :: (MonadIO m, Exception e) => Async a -> e -> m () cancelWith a e = liftIO (Async.cancelWith a (toAsyncException e)) -- | 'Async.link' generalized to any 'MonadIO' -- -- @since 1.0.0 linkAsync :: MonadIO m => Async a -> m () linkAsync = liftIO . Async.link -- | 'Async.link2' generalized to any 'MonadIO' -- -- @since 1.0.0 link2Async :: MonadIO m => Async a -> Async b -> m () link2Async a = liftIO . Async.link2 a -- | Strictly read a file into a 'ByteString'. -- -- @since 1.2.0 readFile :: MonadIO m => FilePath -> m ByteString readFile = liftIO . Data.ByteString.readFile -- | Strictly read a file into a 'Text' using a UTF-8 character -- encoding. In the event of a character encoding error, a Unicode -- replacement character will be used (a.k.a., @lenientDecode@). -- -- @since 1.2.0 readFileUtf8 :: MonadIO m => FilePath -> m Text readFileUtf8 = liftM decodeUtf8 . readFile -- | Write a 'ByteString' to a file. -- -- @since 1.2.0 writeFile :: MonadIO m => FilePath -> ByteString -> m () writeFile fp = liftIO . Data.ByteString.writeFile fp -- | Write a 'Text' to a file using a UTF-8 character encoding. -- -- @since 1.2.0 writeFileUtf8 :: MonadIO m => FilePath -> Text -> m () writeFileUtf8 fp = writeFile fp . encodeUtf8 -- | Strictly read the contents of the given 'Handle' into a -- 'ByteString'. -- -- @since 1.2.0 hGetContents :: MonadIO m => Handle -> m ByteString hGetContents = liftIO . Data.ByteString.hGetContents -- | Write a 'ByteString' to the given 'Handle'. -- -- @since 1.2.0 hPut :: MonadIO m => Handle -> ByteString -> m () hPut h = liftIO . Data.ByteString.hPut h -- | Read a single chunk of data as a 'ByteString' from the given -- 'Handle'. -- -- Under the surface, this uses 'Data.ByteString.hGetSome' with the -- default chunk size. -- -- @since 1.2.0 hGetChunk :: MonadIO m => Handle -> m ByteString hGetChunk = liftIO . flip Data.ByteString.hGetSome defaultChunkSize classy-prelude-1.2.0.1/test/main.hs0000644000000000000000000004621712736421710015247 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# 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 (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 , 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 , IsSequence c , Eq (Element 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 , IsSequence c , Eq (Element 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) {- This tests depend on timing and are unreliable. Instead, we're relying on the test suite in safe-exceptions itself. 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 <- tryAny $ return $!! impureThrow 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] describe "Data.ByteVector" $ do prop "toByteVector" $ \ws -> (otoList . toByteVector . fromList $ ws) `shouldBe` ws prop "fromByteVector" $ \ws -> (otoList . fromByteVector . fromList $ ws) `shouldBe` ws data DummyException = DummyException deriving (Show, Typeable) instance Exception DummyException 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 (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 #if !MIN_VERSION_QuickCheck(2,8,2) instance Arbitrary (Seq Int) where arbitrary = fromList <$> arbitrary instance Arbitrary (Set Int) where arbitrary = setFromList <$> arbitrary instance Arbitrary (Map Int Char) where arbitrary = mapFromList <$> arbitrary #endif classy-prelude-1.2.0.1/LICENSE0000644000000000000000000000207512736421710014007 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-1.2.0.1/Setup.hs0000644000000000000000000000005612736421710014433 0ustar0000000000000000import Distribution.Simple main = defaultMain classy-prelude-1.2.0.1/classy-prelude.cabal0000644000000000000000000000527413056054541016726 0ustar0000000000000000name: classy-prelude version: 1.2.0.1 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/mono-traversable 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: README.md ChangeLog.md library exposed-modules: ClassyPrelude build-depends: base >= 4 && < 5 , basic-prelude >= 0.4 && < 0.7 , transformers , containers >= 0.4.2 , text , bytestring , vector , unordered-containers , hashable , lifted-base >= 0.2 , lifted-async >= 0.3 , async , mono-traversable >= 1.0 , mono-traversable-instances , exceptions >= 0.5 , semigroups , vector-instances , time , time-locale-compat , chunked-data >= 0.3 , ghc-prim , stm , primitive , mtl , bifunctors , mutable-containers >= 0.3 && < 0.4 , dlist >= 0.7 , transformers-base , safe-exceptions >= 0.1.1 , deepseq , monad-unlift >= 0.2 , say , stm-chans >= 3 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: https://github.com/snoyberg/mono-traversable.git classy-prelude-1.2.0.1/README.md0000644000000000000000000000443113036673051014260 0ustar0000000000000000classy-prelude ============== A better Prelude. Haskell's Prelude needs to maintain backwards compatibility and has many aspects that no longer represents best practice. The goals of classy-prelude are: * remove all partial functions * modernize data structures * generally use Text instead of String * encourage the use of appropriate data structures such as Vectors or HashMaps instead of always using lists and associated lists * reduce import lists and the need for qualified imports classy-prelude [should only be used by application developers](http://www.yesodweb.com/blog/2013/10/prelude-replacements-libraries). Library authors should consider using [mono-traversable](https://github.com/snoyberg/mono-traversable/blob/master/README.md), which classy-prelude builds upon. It is worth noting that classy-prelude [largely front-ran changes that the community made to the base Prelude in GHC 7.10](http://www.yesodweb.com/blog/2014/10/classy-base-prelude). mono-traversable ================ Most of this functionality is provided by [mono-traversable](https://github.com/snoyberg/mono-traversable). Please read the README over there. classy-prelude gets rid of the `o` prefix from mono-traversable functions. Text ==== Lots of things use `Text` instead of `String`. Note that `show` returns a `String`. To get back `Text`, use `tshow`. other functionality =================== * exceptions package * system-filepath convenience functions * whenM, unlessM * hashNub and ordNub (efficient nub implementations). Using classy-prelude ==================== * use the NoImplicitPrelude extension (you can place this in your cabal file) and `import ClassyPrelude` * use [base-noprelude](https://github.com/hvr/base-noprelude) in your project and define a Prelude module that re-exports `ClassyPrelude`. Appendix ======== * The [mono-traversable](https://github.com/snoyberg/mono-traversable) README. * [The transition to the modern design of classy-prelude](http://www.yesodweb.com/blog/2013/09/classy-mono). These blog posts contain some out-dated information but might be helpful * [So many preludes!](http://www.yesodweb.com/blog/2013/01/so-many-preludes) (January 2013) * [ClassyPrelude: The good, the bad, and the ugly](http://www.yesodweb.com/blog/2012/08/classy-prelude-good-bad-ugly) (August 2012) classy-prelude-1.2.0.1/ChangeLog.md0000644000000000000000000000337713056054541015161 0ustar0000000000000000## 1.2.0.1 * Use `HasCallStack` in `undefined` ## 1.2.0 * Don't generalize I/O functions to `IOData`, instead specialize to `ByteString`. See: http://www.snoyman.com/blog/2016/12/beware-of-readfile#real-world-failures ## 1.0.2 * Export `parseTimeM` for `time >= 1.5` ## 1.0.1 * Add the `say` package reexports * Add the `stm-chans` package reexports ## 1.0.0.2 * Allow basic-prelude 0.6 ## 1.0.0.1 * Support for safe-exceptions-0.1.4.0 ## 1.0.0 * Support for mono-traversable-1.0.0 * Switch to safe-exceptions * Add monad-unlift and lifted-async ## 0.12.8 * Add (<&&>),(<||>) [#125](https://github.com/snoyberg/classy-prelude/pull/125) ## 0.12.7 * Concurrency: reexport `Control.Concurrent.Lifted` and provide `yieldThread` ## 0.12.6 * Regeneralize intercalate [#119](https://github.com/snoyberg/classy-prelude/pull/119) * Add missing exports for `traverse_` and `for_` * Generalize `mapM_` and `forM_` for GHC 7.10 ## 0.12.5.1 * Support for QuickCheck 2.8.2 ## 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).