classy-prelude-1.5.0/src/0000755000000000000000000000000013355411461013431 5ustar0000000000000000classy-prelude-1.5.0/test/0000755000000000000000000000000013235065674013631 5ustar0000000000000000classy-prelude-1.5.0/src/ClassyPrelude.hs0000644000000000000000000004043013355411461016545 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 -- ** UnliftIO reexports , module UnliftIO -- ** Mutable references , orElseSTM , 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 -- ** Time (since 0.6.1) , module Data.Time -- ** 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 , module Say -- * Concurrency , yieldThread , waitAsync , pollAsync , waitCatchAsync , 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 -- Prelude IO operations , putChar , putStr , putStrLn , getChar , getLine , getContents , interact -- ** Difference lists , DList , asDList , applyDList -- ** Exceptions , 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.DeepSeq (deepseq, ($!!), force, NFData (..)) import Control.Monad (when, unless, void, liftM, ap, forever, join, replicateM_, guard, MonadPlus (..), (=<<), (>=>), (<=<), liftM2, liftM3, liftM4, liftM5) import qualified Control.Concurrent.STM as STM import Data.Mutable import Data.Traversable (Traversable (..), for, forM) import Data.Foldable (Foldable) import UnliftIO import Data.Vector.Instances () import CorePrelude hiding ( putStr, putStrLn, print, undefined, (<>), catMaybes, first, second , catchIOError ) 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 qualified Data.Text.IO as TextIO import qualified Data.Text.Lazy.IO as LTextIO import Data.ByteString.Internal (ByteString (PS)) import Data.ByteString.Lazy.Internal (defaultChunkSize) import Data.Vector.Storable (unsafeToForeignPtr, unsafeFromForeignPtr) import qualified Debug.Trace as Trace import Data.Semigroup (Semigroup (..), WrappedMonoid (..)) import Prelude (Show (..)) import Data.Time ( UTCTime (..) , Day (..) , toGregorian , fromGregorian , formatTime , parseTime , parseTimeM , getCurrentTime , 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 import qualified Control.Concurrent #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" #-} -- | We define our own 'trace' (and also its variants) which provides a warning -- when used. So that tracing is available during development, but the compiler -- reminds you to not leave them in the code for production. {-# WARNING trace "Leaving traces in the code" #-} trace :: String -> a -> a trace = Trace.trace {-# WARNING traceShow "Leaving traces in the code" #-} traceShow :: Show a => a -> b -> b traceShow = Trace.traceShow -- | -- -- Since 0.5.9 {-# WARNING traceId "Leaving traces in the code" #-} traceId :: String -> String traceId a = Trace.trace a a -- | -- -- Since 0.5.9 {-# WARNING traceM "Leaving traces in the code" #-} traceM :: (Monad m) => String -> m () traceM string = Trace.trace string $ return () -- | -- -- Since 0.5.9 {-# WARNING traceShowId "Leaving traces in the code" #-} traceShowId :: (Show a) => a -> a traceShowId a = Trace.trace (show a) a -- | -- -- Since 0.5.9 {-# WARNING traceShowM "Leaving traces in the code" #-} traceShowM :: (Show a, Monad m) => a -> m () traceShowM = traceM . show -- | Originally 'Conc.yield'. yieldThread :: MonadIO m => m () yieldThread = liftIO Control.Concurrent.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 -- | Synonym for 'STM.orElse'. orElseSTM :: STM a -> STM a -> STM a orElseSTM = STM.orElse {-# INLINE orElseSTM #-} -- | 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 = waitCatch -- | 'Async.link' generalized to any 'MonadIO' -- -- @since 1.0.0 linkAsync :: MonadIO m => Async a -> m () linkAsync = UnliftIO.link -- | 'Async.link2' generalized to any 'MonadIO' -- -- @since 1.0.0 link2Async :: MonadIO m => Async a -> Async b -> m () link2Async a = UnliftIO.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 -- | Write a character to stdout -- -- Uses system locale settings -- -- @since 1.3.1 putChar :: MonadIO m => Char -> m () putChar = liftIO . Prelude.putChar -- | Write a Text to stdout -- -- Uses system locale settings -- -- @since 1.3.1 putStr :: MonadIO m => Text -> m () putStr = liftIO . TextIO.putStr -- | Write a Text followed by a newline to stdout -- -- Uses system locale settings -- -- @since 1.3.1 putStrLn :: MonadIO m => Text -> m () putStrLn = liftIO . TextIO.putStrLn -- | Read a character from stdin -- -- Uses system locale settings -- -- @since 1.3.1 getChar :: MonadIO m => m Char getChar = liftIO Prelude.getChar -- | Read a line from stdin -- -- Uses system locale settings -- -- @since 1.3.1 getLine :: MonadIO m => m Text getLine = liftIO TextIO.getLine -- | Read all input from stdin into a lazy Text ('LText') -- -- Uses system locale settings -- -- @since 1.3.1 getContents :: MonadIO m => m LText getContents = liftIO LTextIO.getContents -- | Takes a function of type 'LText -> LText' and passes all input on stdin -- to it, then prints result to stdout -- -- Uses lazy IO -- Uses system locale settings -- -- @since 1.3.1 interact :: MonadIO m => (LText -> LText) -> m () interact = liftIO . LTextIO.interact classy-prelude-1.5.0/test/main.hs0000644000000000000000000004735513235065674015127 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 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 suffixProps :: ( Eq c , Show c , Arbitrary c , IsSequence c , Eq (Element c) ) => c -> Spec suffixProps dummy = do prop "y `isSuffixOf` (x ++ y)" $ \x y -> (y `asTypeOf` dummy) `isSuffixOf` (x ++ y) 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) prop "dropSuffix y (x ++ y) == x" $ \x y -> dropSuffix y (x ++ y) == (x `asTypeOf` dummy) prop "dropSuffix x y == y || x `isSuffixOf` y" $ \x y -> dropSuffix x y == y || x `isSuffixOf` (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) prop "dropPrefix x (x ++ y) == y" $ \x y -> dropPrefix x (x ++ y) == (y `asTypeOf` dummy) prop "dropPrefix x y == y || x `isPrefixOf` y" $ \x y -> dropPrefix x y == y || 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 "Suffix" $ do describe "list" $ suffixProps (undefined :: [Int]) describe "Text" $ suffixProps (undefined :: Text) describe "LText" $ suffixProps (undefined :: LText) describe "ByteString" $ suffixProps (undefined :: ByteString) describe "LByteString" $ suffixProps (undefined :: LByteString) describe "Vector" $ suffixProps (undefined :: Vector Int) describe "UVector" $ suffixProps (undefined :: UVector Int) describe "Seq" $ suffixProps (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.5.0/LICENSE0000644000000000000000000000207512736421710013653 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.5.0/Setup.hs0000644000000000000000000000005612736421710014277 0ustar0000000000000000import Distribution.Simple main = defaultMain classy-prelude-1.5.0/classy-prelude.cabal0000644000000000000000000000361013355412607016565 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.30.0. -- -- see: https://github.com/sol/hpack -- -- hash: ed4a6b0e0086b4db58b2d21752faef28ac85000cdbd0a8397428671944432494 name: classy-prelude version: 1.5.0 synopsis: A typeclass-based Prelude. description: See docs and README at category: Control, Prelude homepage: https://github.com/snoyberg/mono-traversable#readme bug-reports: https://github.com/snoyberg/mono-traversable/issues author: Michael Snoyman maintainer: michael@snoyman.com license: MIT license-file: LICENSE build-type: Simple extra-source-files: README.md ChangeLog.md source-repository head type: git location: https://github.com/snoyberg/mono-traversable library hs-source-dirs: src ghc-options: -Wall -fno-warn-orphans build-depends: async , base >=4.9 && <5 , basic-prelude >=0.7 , bifunctors , bytestring , chunked-data >=0.3 , containers >=0.4.2 , deepseq , dlist >=0.7 , ghc-prim , hashable , mono-traversable >=1.0 , mono-traversable-instances , mtl , mutable-containers >=0.3 && <0.4 , primitive , say , semigroups , stm , stm-chans >=3 , text , time >=1.5 , transformers , unliftio >=0.2.1.0 , unordered-containers , vector , vector-instances exposed-modules: ClassyPrelude other-modules: Paths_classy_prelude default-language: Haskell2010 test-suite test type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: test ghc-options: -Wall build-depends: QuickCheck , base >=4.9 && <5 , classy-prelude , containers , hspec >=1.3 , transformers , unordered-containers other-modules: Paths_classy_prelude default-language: Haskell2010 classy-prelude-1.5.0/README.md0000644000000000000000000000443113036673051014124 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.5.0/ChangeLog.md0000644000000000000000000000377613355411461015030 0ustar0000000000000000## 1.5.0 * Removed `alwaysSTM` and `alwaysSucceedsSTM`. See ## 1.4.0 * Switch to `MonadUnliftIO` ## 1.3.1 * Add terminal IO functions ## 1.3.0 * Tracing functions leave warnings when used ## 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).