diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,68 @@ +# ChangeLog for classy-prelude + +## 1.5.0.3 + +* Don't import Data.Functor.unzip [#215](https://github.com/snoyberg/mono-traversable/pull/215) + +## 1.5.0.2 + +* Fix building with time >= 1.10 [#207](https://github.com/snoyberg/mono-traversable/pull/207). + +## 1.5.0.1 + +* Export a compatibility shim for `parseTime` as it has been removed in `time-1.10`. + See + +## 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) diff --git a/ClassyPrelude.hs b/ClassyPrelude.hs deleted file mode 100644 --- a/ClassyPrelude.hs +++ /dev/null @@ -1,687 +0,0 @@ -{-# 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) - , 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 - , 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 - -- * Concurrency - , module Control.Concurrent.Lifted - , yieldThread - -- * Non-standard - -- ** List-like classes - , map - , concat - , concatMap - , foldMap - , fold - , length - , null - , pack - , unpack - , repack - , toList - , mapM_ - , traverse_ - , for_ - , 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.Lifted hiding (yield) -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 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 Control.Monad.Base - -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, intercalate) -import qualified Data.Sequences (intercalate) -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 (primToPrim, primToIO, primToST) -import Data.Primitive.MutVar - -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 - --- Due to the Applicative-Monad-Proposal, from GHC 7.10 (base 4.8) we can --- generalize some Monad constraints to Applicative constraints -#if MIN_VERSION_base(4,8,0) - -mapM_ :: (Applicative f, MonoFoldable c) => (Element c -> f ()) -> c -> f () -mapM_ = traverse_ - -forM_ :: (Applicative f, MonoFoldable c) => c -> (Element c -> f ()) -> f () -forM_ = ofor_ - -#else - -mapM_ :: (Monad m, MonoFoldable c) => (Element c -> m ()) -> c -> m () -mapM_ = omapM_ - -forM_ :: (Monad m, MonoFoldable c) => c -> (Element c -> m ()) -> m () -forM_ = oforM_ - -#endif - -{-# INLINE mapM_ #-} -{-# INLINE forM_ #-} - -traverse_ :: (Applicative f, MonoFoldable c) => (Element c -> f ()) -> c -> f () -traverse_ = otraverse_ -{-# INLINE traverse_ #-} - -for_ :: (Applicative f, MonoFoldable c) => c -> (Element c -> f ()) -> f () -for_ = ofor_ -{-# INLINE for_ #-} - -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 - -intercalate :: (MonoFoldable mono, Monoid (Element mono)) - => Element mono - -> mono - -> Element mono -intercalate x = mconcat . intersperse x . otoList -{-# INLINE [0] intercalate #-} -{-# RULES "intercalate list" forall (x :: [a]). - intercalate x = Data.Sequences.intercalate x . toList #-} -{-# RULES "intercalate ByteString" forall (x :: ByteString). - intercalate x = Data.Sequences.intercalate x . toList #-} -{-# RULES "intercalate LByteString" forall (x :: LByteString). - intercalate x = Data.Sequences.intercalate x . toList #-} -{-# RULES "intercalate Text" forall (x :: Text). - intercalate x = Data.Sequences.intercalate x . toList #-} -{-# RULES "intercalate LText" forall (x :: LText). - intercalate x = Data.Sequences.intercalate x . toList #-} -{-# RULES "intercalate Seq" forall (x :: Seq a). - intercalate x = Data.Sequences.intercalate x . toList #-} -{-# RULES "intercalate Vector" forall (x :: Vector a). - intercalate x = Data.Sequences.intercalate x . toList #-} -{-# RULES "intercalate UVector" forall (x :: Unbox a => UVector a). - intercalate x = Data.Sequences.intercalate x . toList #-} -{-# RULES "intercalate SVector" forall (x :: Storable a => SVector a). - intercalate x = Data.Sequences.intercalate x . toList #-} - -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 - --- | Originally 'Conc.yield'. -yieldThread :: MonadBase IO m => m () -yieldThread = Conc.yield -{-# INLINE yieldThread #-} - -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 #-} - -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 (<||>) #-} diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,57 @@ +classy-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) + + + diff --git a/classy-prelude.cabal b/classy-prelude.cabal --- a/classy-prelude.cabal +++ b/classy-prelude.cabal @@ -1,61 +1,80 @@ -name: classy-prelude -version: 0.12.8 -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. +cabal-version: 1.12 -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 +-- This file has been generated from package.yaml by hpack version 0.35.1. +-- +-- see: https://github.com/sol/hpack +name: classy-prelude +version: 1.5.0.3 +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 - 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 - , transformers-base - ghc-options: -Wall -fno-warn-orphans + exposed-modules: + ClassyPrelude + other-modules: + Paths_classy_prelude + hs-source-dirs: + src + ghc-options: -Wall -fno-warn-orphans + build-depends: + async + , base >=4.13 && <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.* + , primitive + , say + , stm + , stm-chans >=3 + , text + , time >=1.5 + , transformers + , unliftio >=0.2.1.0 + , unordered-containers + , vector + , vector-instances + default-language: Haskell2010 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 + type: exitcode-stdio-1.0 + main-is: main.hs + other-modules: + Paths_classy_prelude + hs-source-dirs: + test + ghc-options: -Wall + build-depends: + QuickCheck + , base >=4.13 && <5 + , classy-prelude + , containers + , hspec >=1.3 + , transformers + , unordered-containers + default-language: Haskell2010 diff --git a/src/ClassyPrelude.hs b/src/ClassyPrelude.hs new file mode 100644 --- /dev/null +++ b/src/ClassyPrelude.hs @@ -0,0 +1,641 @@ +{-# 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 +#if MIN_VERSION_time(1,10,0) + , parseTime +#endif + -- ** 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 hiding (unzip) +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 +#if !MIN_VERSION_time(1,10,0) + , parseTime +#endif + , parseTimeM + , getCurrentTime + , defaultTimeLocale + ) +import qualified Data.Time as Time + +import qualified Data.Set as Set +import qualified Data.Map as Map +import qualified Data.HashSet as HashSet + +import GHC.Generics (Generic) +import GHC.Stack (HasCallStack) + +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 + +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 +undefined :: HasCallStack => a +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 + + +#if MIN_VERSION_time(1,10,0) +parseTime + :: Time.ParseTime t + => Time.TimeLocale -- ^ Time locale. + -> String -- ^ Format string. + -> String -- ^ Input string. + -> Maybe t -- ^ The time value, or 'Nothing' if the input could not be parsed using the given format. +parseTime = parseTimeM True +#endif + + diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -13,8 +13,6 @@ 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 @@ -61,7 +59,6 @@ concatMapProps :: ( MonoFoldable c , IsSequence c , Eq c - , MonoFoldableMonoid c , Arbitrary c , Show c ) @@ -188,18 +185,25 @@ 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 +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) @@ -238,7 +242,8 @@ compare (length c) i == compareLength (c `asTypeOf` dummy) i prefixProps :: ( Eq c - , EqSequence c + , IsSequence c + , Eq (Element c) , Arbitrary c , Show c ) @@ -251,6 +256,10 @@ 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 @@ -346,12 +355,15 @@ 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 "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) @@ -373,36 +385,39 @@ 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 - (Control.Concurrent.threadDelay 20000) + (threadDelay 20000) (const $ writeIORef failed 1) writeIORef failed 2 - Control.Concurrent.threadDelay 10000 - Control.Concurrent.throwTo tid DummyException - Control.Concurrent.threadDelay 50000 + 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 $ Control.Concurrent.threadDelay 20000 + _ <- tryAny $ threadDelay 20000 writeIORef failed True - Control.Concurrent.threadDelay 10000 - Control.Concurrent.throwTo tid DummyException - Control.Concurrent.threadDelay 50000 + threadDelay 10000 + throwTo tid DummyException + threadDelay 50000 didFail <- readIORef failed liftIO $ didFail `shouldBe` False it "tryAnyDeep" $ do - eres <- tryAnyDeep $ return $ throw DummyException + 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] @@ -410,6 +425,13 @@ , 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)