diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,9 @@ +## 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 --- a/ClassyPrelude.hs +++ b/ClassyPrelude.hs @@ -20,6 +20,7 @@ , (<||>) -- ** Monad , module Control.Monad + , module Control.Monad.Trans.Unlift , whenM , unlessM -- ** Mutable references @@ -56,6 +57,7 @@ , Identity (..) , MonadReader , ask + , asks , ReaderT (..) , Reader -- * Poly hierarchy @@ -65,13 +67,13 @@ , module Data.Bifunctor -- * Mono hierarchy , module Data.MonoTraversable + , module Data.MonoTraversable.Unprefixed , module Data.Sequences - , module Data.Sequences.Lazy - , module Data.Textual.Encoding , module Data.Containers , module Data.Builder - , module Data.MinLen - , module Data.ByteVector + , module Data.NonNull + , toByteVector + , fromByteVector -- * I\/O , Handle , stdin @@ -80,35 +82,20 @@ -- * 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 - , 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 @@ -118,14 +105,10 @@ , ordNubBy , sortWith - , compareLength - , sum - , product , Prelude.repeat -- ** Set-like , (\\) , intersect - , unions -- FIXME , mapSet -- ** Text-like , Show (..) @@ -138,22 +121,13 @@ , IOData (..) , print , hClose - -- ** FilePath - , fpToString - , fpFromString - , fpToText - , fpFromText - , fpToTextWarn - , fpToTextEx -- ** Difference lists , DList , asDList , applyDList -- ** Exceptions - , module Control.Exception.Enclosed - , MonadThrow (throwM) - , MonadCatch - , MonadMask + , module Control.Exception.Safe + , module Control.DeepSeq -- ** Force types -- | Helper functions for situations where type inferer gets confused. , asByteString @@ -178,9 +152,10 @@ import Control.Applicative ((<**>),liftA,liftA2,liftA3,Alternative (..), optional) import Data.Functor import Control.Exception (assert) -import Control.Exception.Enclosed +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) +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 @@ -188,24 +163,44 @@ 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 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) +import CorePrelude hiding + ( print, undefined, (<>), catMaybes, first, second + , try, throwIO, onException, mask, mask_ + , handle, finally, catch, bracket, bracket_, bracketOnError + , catchIOError + , uninterruptibleMask, uninterruptibleMask_ + ) import Data.ChunkedZip import qualified Data.Char as Char -import Data.Sequences hiding (elem, intercalate) -import qualified Data.Sequences (intercalate) +import Data.Sequences import Data.MonoTraversable +import Data.MonoTraversable.Unprefixed +import Data.MonoTraversable.Instances () import Data.Containers import Data.Builder -import Data.MinLen -import Data.ByteVector +import Data.NonNull +import Data.ByteString.Internal (ByteString (PS)) +import Data.Vector.Storable (unsafeToForeignPtr, unsafeFromForeignPtr) + import System.IO (Handle, stdin, stdout, stderr, hClose) import Debug.Trace (trace, traceShow) @@ -226,15 +221,13 @@ 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 Control.Monad.Reader (MonadReader, ask, asks, ReaderT (..), Reader) import Data.Bifunctor import Data.DList (DList) import qualified Data.DList as DList @@ -259,123 +252,12 @@ 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 @@ -395,34 +277,6 @@ 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 @@ -523,49 +377,6 @@ 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 @@ -652,10 +463,6 @@ 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 @@ -685,3 +492,59 @@ (<||>) :: 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 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 `ClassyPrelue`. + + +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,9 +1,9 @@ name: classy-prelude -version: 0.12.8 +version: 1.0.0 synopsis: A typeclass-based Prelude. description: Modern best practices without name collisions. No partial functions are exposed, but modern data structures are, without requiring import lists. Qualified modules also are not needed: instead operations are based on type-classes from the mono-traversable package. -homepage: https://github.com/snoyberg/classy-prelude +homepage: https://github.com/snoyberg/mono-traversable license: MIT license-file: LICENSE author: Michael Snoyman @@ -11,7 +11,7 @@ category: Control, Prelude build-type: Simple cabal-version: >=1.8 -extra-source-files: ChangeLog.md +extra-source-files: README.md ChangeLog.md library exposed-modules: ClassyPrelude @@ -25,14 +25,16 @@ , unordered-containers , hashable , lifted-base >= 0.2 - , mono-traversable >= 0.9.3 + , lifted-async >= 0.3 + , async + , mono-traversable >= 1.0 + , mono-traversable-instances , exceptions >= 0.5 , semigroups , vector-instances , time , time-locale-compat - , chunked-data - , enclosed-exceptions + , chunked-data >= 0.3 , ghc-prim , stm , primitive @@ -41,6 +43,9 @@ , mutable-containers >= 0.3 && < 0.4 , dlist >= 0.7 , transformers-base + , safe-exceptions >= 0.1.1 + , deepseq + , monad-unlift >= 0.2 ghc-options: -Wall -fno-warn-orphans test-suite test @@ -58,4 +63,4 @@ source-repository head type: git - location: git://github.com/snoyberg/classy-prelude.git + location: https://github.com/snoyberg/mono-traversable.git diff --git a/test/main.hs b/test/main.hs --- a/test/main.hs +++ b/test/main.hs @@ -13,7 +13,7 @@ import Test.QuickCheck.Arbitrary import Prelude (undefined) import Control.Monad.Trans.Writer (tell, Writer, runWriter) -import Control.Concurrent (throwTo, threadDelay, forkIO) +import Control.Concurrent (forkIO) import Control.Exception (throw) import qualified Data.Set as Set import qualified Data.HashSet as HashSet @@ -61,7 +61,6 @@ concatMapProps :: ( MonoFoldable c , IsSequence c , Eq c - , MonoFoldableMonoid c , Arbitrary c , Show c ) @@ -191,7 +190,8 @@ stripSuffixProps :: ( Eq c , Show c , Arbitrary c - , EqSequence c + , IsSequence c + , Eq (Element c) ) => c -> Spec @@ -238,7 +238,8 @@ compare (length c) i == compareLength (c `asTypeOf` dummy) i prefixProps :: ( Eq c - , EqSequence c + , IsSequence c + , Eq (Element c) , Arbitrary c , Show c ) @@ -373,36 +374,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 +414,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)