mirror of
https://github.com/kowainik/relude.git
synced 2024-09-19 08:37:29 +03:00
Merge branch 'feature/32-cleaning'
Also closes #35, closes #32, closes #29, closes #28, closes #20, closes #7
This commit is contained in:
commit
9edb5d374e
17
CHANGES.md
17
CHANGES.md
@ -1,3 +1,20 @@
|
||||
0.3
|
||||
=====
|
||||
|
||||
* [#28](https://github.com/serokell/universum/issues/28):
|
||||
Remove `putByteString` and `putLByteString`.
|
||||
* [#29](https://github.com/serokell/universum/issues/29):
|
||||
Remove `panic`, `FatalError` and `notImplemented`.
|
||||
Rename `NotImplemented` into `Undefined`.
|
||||
* [#32](https://github.com/serokell/universum/issues/32):
|
||||
Remove `orAlt`, `orEmpty`, `liftAA2`, `eitherA`, `purer`, `<<*>>`,
|
||||
`traceIO`, `guardM`, `hush`, `tryIO`, `liftM'`, `liftM2'`,
|
||||
`applyN`, `guardedA`,
|
||||
Bifunctor instances for tuples of length higher than 2.
|
||||
Generalize `concatMapM`, add `concatForM` and operator versions.
|
||||
* [#35](https://github.com/serokell/universum/issues/35):
|
||||
Generalize `andM`, `orM`, `allM`, `anyM` over container type.
|
||||
|
||||
0.2.2
|
||||
=====
|
||||
|
||||
|
@ -2,24 +2,15 @@
|
||||
{-# LANGUAGE Safe #-}
|
||||
|
||||
module Applicative
|
||||
( orAlt
|
||||
, orEmpty
|
||||
, eitherA
|
||||
, liftAA2
|
||||
, pass
|
||||
, purer
|
||||
, (<<*>>)
|
||||
( pass
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Bool (Bool)
|
||||
import Data.Either (Either (..))
|
||||
import Data.Function ((.))
|
||||
import Data.Monoid (Monoid (..))
|
||||
import Control.Applicative (Applicative (pure))
|
||||
|
||||
pass :: Applicative f => f ()
|
||||
pass = pure ()
|
||||
|
||||
{-
|
||||
orAlt :: (Alternative f, Monoid a) => f a -> f a
|
||||
orAlt f = f <|> pure mempty
|
||||
|
||||
@ -37,3 +28,4 @@ liftAA2 = liftA2 . liftA2
|
||||
|
||||
(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b)
|
||||
(<<*>>) = liftA2 (<*>)
|
||||
-}
|
||||
|
@ -24,21 +24,6 @@ class Bifunctor p where
|
||||
instance Bifunctor (,) where
|
||||
bimap f g ~(a, b) = (f a, g b)
|
||||
|
||||
instance Bifunctor ((,,) x1) where
|
||||
bimap f g ~(x1, a, b) = (x1, f a, g b)
|
||||
|
||||
instance Bifunctor ((,,,) x1 x2) where
|
||||
bimap f g ~(x1, x2, a, b) = (x1, x2, f a, g b)
|
||||
|
||||
instance Bifunctor ((,,,,) x1 x2 x3) where
|
||||
bimap f g ~(x1, x2, x3, a, b) = (x1, x2, x3, f a, g b)
|
||||
|
||||
instance Bifunctor ((,,,,,) x1 x2 x3 x4) where
|
||||
bimap f g ~(x1, x2, x3, x4, a, b) = (x1, x2, x3, x4, f a, g b)
|
||||
|
||||
instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where
|
||||
bimap f g ~(x1, x2, x3, x4, x5, a, b) = (x1, x2, x3, x4, x5, f a, g b)
|
||||
|
||||
instance Bifunctor Either where
|
||||
bimap f _ (Left a) = Left (f a)
|
||||
bimap _ g (Right b) = Right (g b)
|
||||
|
@ -5,11 +5,10 @@ module Bool
|
||||
( whenM
|
||||
, unlessM
|
||||
, ifM
|
||||
, guardM
|
||||
, bool
|
||||
) where
|
||||
|
||||
import Control.Monad (Monad, MonadPlus, guard, unless, when, (=<<), (>>=))
|
||||
import Control.Monad (Monad, unless, when, (>>=))
|
||||
import Data.Bool (Bool)
|
||||
import Data.Function (flip)
|
||||
|
||||
@ -27,5 +26,7 @@ unlessM p m =
|
||||
ifM :: Monad m => m Bool -> m a -> m a -> m a
|
||||
ifM p x y = p >>= \b -> if b then x else y
|
||||
|
||||
{-
|
||||
guardM :: MonadPlus m => m Bool -> m ()
|
||||
guardM f = guard =<< f
|
||||
-}
|
||||
|
106
src/Concurrent.hs
Normal file
106
src/Concurrent.hs
Normal file
@ -0,0 +1,106 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE Safe #-}
|
||||
|
||||
-- | Concurrency useful and common functions.
|
||||
module Concurrent
|
||||
( -- * MVar
|
||||
MVar
|
||||
, newEmptyMVar
|
||||
, newMVar
|
||||
, putMVar
|
||||
, readMVar
|
||||
, swapMVar
|
||||
, takeMVar
|
||||
, tryPutMVar
|
||||
, tryReadMVar
|
||||
, tryTakeMVar
|
||||
|
||||
-- * STM
|
||||
, STM
|
||||
, TVar
|
||||
, atomically
|
||||
, newTVarIO
|
||||
, STM.modifyTVar'
|
||||
, STM.newTVar
|
||||
, STM.readTVar
|
||||
, STM.writeTVar
|
||||
) where
|
||||
|
||||
|
||||
import qualified Control.Concurrent.MVar as CCM (newEmptyMVar, newMVar, putMVar,
|
||||
readMVar, swapMVar, takeMVar,
|
||||
tryPutMVar, tryReadMVar, tryTakeMVar)
|
||||
import qualified Control.Concurrent.STM.TVar as STM (modifyTVar', newTVar, newTVarIO,
|
||||
readTVar, writeTVar)
|
||||
import qualified Control.Monad.STM as STM (atomically)
|
||||
|
||||
import Control.Concurrent.MVar (MVar)
|
||||
import Control.Concurrent.STM.TVar (TVar)
|
||||
import Control.Monad.STM (STM)
|
||||
import Control.Monad.Trans (MonadIO, liftIO)
|
||||
import Data.Bool (Bool)
|
||||
import Data.Function (($), (.))
|
||||
import Data.Maybe (Maybe)
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Lifted Control.Concurrent.MVar
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'CCM.newEmptyMVar'.
|
||||
newEmptyMVar :: MonadIO m => m (MVar a)
|
||||
newEmptyMVar = liftIO CCM.newEmptyMVar
|
||||
{-# INLINABLE newEmptyMVar #-}
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'CCM.newMVar'.
|
||||
newMVar :: MonadIO m => a -> m (MVar a)
|
||||
newMVar = liftIO . CCM.newMVar
|
||||
{-# INLINABLE newMVar #-}
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'CCM.putMVar'.
|
||||
putMVar :: MonadIO m => MVar a -> a -> m ()
|
||||
putMVar m a = liftIO $ CCM.putMVar m a
|
||||
{-# INLINABLE putMVar #-}
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'CCM.readMVar'.
|
||||
readMVar :: MonadIO m => MVar a -> m a
|
||||
readMVar = liftIO . CCM.readMVar
|
||||
{-# INLINABLE readMVar #-}
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'CCM.swapMVar'.
|
||||
swapMVar :: MonadIO m => MVar a -> a -> m a
|
||||
swapMVar m v = liftIO $ CCM.swapMVar m v
|
||||
{-# INLINABLE swapMVar #-}
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'CCM.takeMVar'.
|
||||
takeMVar :: MonadIO m => MVar a -> m a
|
||||
takeMVar = liftIO . CCM.takeMVar
|
||||
{-# INLINABLE takeMVar #-}
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'CCM.tryPutMVar'.
|
||||
tryPutMVar :: MonadIO m => MVar a -> a -> m Bool
|
||||
tryPutMVar m v = liftIO $ CCM.tryPutMVar m v
|
||||
{-# INLINABLE tryPutMVar #-}
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'CCM.tryReadMVar'.
|
||||
tryReadMVar :: MonadIO m => MVar a -> m (Maybe a)
|
||||
tryReadMVar = liftIO . CCM.tryReadMVar
|
||||
{-# INLINABLE tryReadMVar #-}
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'CCM.tryTakeMVar'.
|
||||
tryTakeMVar :: MonadIO m => MVar a -> m (Maybe a)
|
||||
tryTakeMVar = liftIO . CCM.tryTakeMVar
|
||||
{-# INLINABLE tryTakeMVar #-}
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Lifted STM
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'STM.atomically'.
|
||||
atomically :: MonadIO m => STM a -> m a
|
||||
atomically = liftIO . STM.atomically
|
||||
{-# INLINABLE atomically #-}
|
||||
|
||||
-- | Lifted to 'MonadIO' version of 'STM.newTVarIO'.
|
||||
newTVarIO :: MonadIO m => a -> m (TVar a)
|
||||
newTVarIO = liftIO . STM.newTVarIO
|
||||
{-# INLINABLE newTVarIO #-}
|
24
src/Debug.hs
24
src/Debug.hs
@ -9,16 +9,13 @@ module Debug
|
||||
, trace
|
||||
, traceM
|
||||
, traceId
|
||||
, traceIO
|
||||
, traceShow
|
||||
, traceShowId
|
||||
, traceShowM
|
||||
, notImplemented
|
||||
, NotImplemented(..)
|
||||
, Undefined (..)
|
||||
) where
|
||||
|
||||
import Control.Monad (Monad, return)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Data.Data (Data)
|
||||
import Data.Text (Text, unpack)
|
||||
import Data.Typeable (Typeable)
|
||||
@ -37,13 +34,6 @@ trace string expr = unsafePerformIO (do
|
||||
putStrLn string
|
||||
return expr)
|
||||
|
||||
{-# WARNING traceIO "'traceIO' remains in code" #-}
|
||||
traceIO :: (Print b, MonadIO m) => b -> a -> m a
|
||||
traceIO string expr = do
|
||||
putStrLn string
|
||||
return expr
|
||||
|
||||
{-# WARNING error "'error' remains in code (or use 'panic')" #-}
|
||||
error :: Text -> a
|
||||
error s = P.error (unpack s)
|
||||
|
||||
@ -67,14 +57,10 @@ traceM s = trace (unpack s) pass
|
||||
traceId :: Text -> Text
|
||||
traceId s = trace s s
|
||||
|
||||
{-# WARNING notImplemented "'notImplemented' remains in code" #-}
|
||||
notImplemented :: a
|
||||
notImplemented = P.error "Not implemented"
|
||||
{-# WARNING Undefined "'Undefined' type remains in code" #-}
|
||||
data Undefined = Undefined
|
||||
deriving (P.Eq, P.Ord, P.Show, P.Read, P.Enum, P.Bounded, Data, Typeable, Generic)
|
||||
|
||||
{-# WARNING NotImplemented "'NotImplemented' remains in code" #-}
|
||||
data NotImplemented = NotImplemented
|
||||
deriving (P.Eq, P.Ord, P.Show, Data, Typeable, Generic)
|
||||
|
||||
{-# WARNING undefined "'undefined' remains in code (or use 'panic')" #-}
|
||||
{-# WARNING undefined "'undefined' function remains in code (or use 'error')" #-}
|
||||
undefined :: a
|
||||
undefined = P.undefined
|
||||
|
@ -1,28 +1,19 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# LANGUAGE Safe #-}
|
||||
|
||||
module Exceptions
|
||||
( hush
|
||||
( Exception
|
||||
, SomeException (..)
|
||||
, note
|
||||
, tryIO
|
||||
) where
|
||||
|
||||
import Base (IO)
|
||||
import Control.Applicative
|
||||
import Control.Exception as Exception
|
||||
import Control.Monad.Except (ExceptT (..), MonadError, throwError)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Monad.Trans (liftIO)
|
||||
import Data.Either (Either (..))
|
||||
import Data.Function ((.))
|
||||
import Control.Applicative (Applicative (pure))
|
||||
import Control.Exception (Exception, SomeException (..))
|
||||
import Control.Monad.Except (MonadError, throwError)
|
||||
import Data.Maybe (Maybe, maybe)
|
||||
|
||||
hush :: Alternative m => Either e a -> m a
|
||||
hush (Left _) = empty
|
||||
hush (Right x) = pure x
|
||||
|
||||
-- To suppress redundenet applicative constraint warning on GHC 8.0
|
||||
-- To suppress redundant applicative constraint warning on GHC 8.0
|
||||
#if ( __GLASGOW_HASKELL__ >= 800 )
|
||||
note :: (MonadError e m) => e -> Maybe a -> m a
|
||||
note err = maybe (throwError err) pure
|
||||
@ -30,6 +21,3 @@ note err = maybe (throwError err) pure
|
||||
note :: (MonadError e m, Applicative m) => e -> Maybe a -> m a
|
||||
note err = maybe (throwError err) pure
|
||||
#endif
|
||||
|
||||
tryIO :: MonadIO m => IO a -> ExceptT IOException m a
|
||||
tryIO = ExceptT . liftIO . Exception.try
|
||||
|
@ -20,31 +20,20 @@ module Lifted
|
||||
, die
|
||||
-- * ST
|
||||
, stToIO
|
||||
-- * Concurrency and parallelism
|
||||
, myThreadId
|
||||
, getNumCapabilities
|
||||
, setNumCapabilities
|
||||
, threadCapability
|
||||
, isCurrentThreadBound
|
||||
, mkWeakThreadId
|
||||
, atomically
|
||||
) where
|
||||
|
||||
import Control.Concurrent (ThreadId)
|
||||
#if ( __GLASGOW_HASKELL__ >= 710 )
|
||||
import Control.Monad.ST (RealWorld, ST)
|
||||
#else
|
||||
import Control.Monad.ST.Safe (RealWorld, ST)
|
||||
#endif
|
||||
import Control.Monad.STM (STM)
|
||||
import Control.Monad.Trans (MonadIO, liftIO)
|
||||
import Data.String (String)
|
||||
import Data.Text (Text)
|
||||
import Prelude (Bool, FilePath, Int, (>>))
|
||||
import Prelude (FilePath, (>>))
|
||||
import System.Exit (ExitCode)
|
||||
import System.IO (Handle, IOMode, stderr)
|
||||
import qualified System.IO (hPutStrLn)
|
||||
import System.Mem.Weak (Weak)
|
||||
|
||||
-- Text
|
||||
import qualified Data.Text.IO as XIO
|
||||
@ -58,9 +47,6 @@ import qualified Control.Monad.ST as XIO
|
||||
#else
|
||||
import qualified Control.Monad.ST.Safe as XIO
|
||||
#endif
|
||||
-- Concurrency and parallelism
|
||||
import qualified Control.Concurrent as XIO
|
||||
import qualified Control.Monad.STM as XIO
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Text
|
||||
@ -129,36 +115,3 @@ die err = liftIO (System.IO.hPutStrLn stderr err) >> exitFailure
|
||||
stToIO :: MonadIO m => ST RealWorld a -> m a
|
||||
stToIO a = liftIO (XIO.stToIO a)
|
||||
{-# INLINABLE stToIO #-}
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Concurrency and parallelism
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
myThreadId :: MonadIO m => m ThreadId
|
||||
myThreadId = liftIO XIO.myThreadId
|
||||
{-# INLINABLE myThreadId #-}
|
||||
|
||||
getNumCapabilities :: MonadIO m => m Int
|
||||
getNumCapabilities = liftIO XIO.getNumCapabilities
|
||||
{-# INLINABLE getNumCapabilities #-}
|
||||
|
||||
setNumCapabilities :: MonadIO m => Int -> m ()
|
||||
setNumCapabilities a = liftIO (XIO.setNumCapabilities a)
|
||||
{-# INLINABLE setNumCapabilities #-}
|
||||
|
||||
threadCapability :: MonadIO m => ThreadId -> m (Int, Bool)
|
||||
threadCapability a = liftIO (XIO.threadCapability a)
|
||||
{-# INLINABLE threadCapability #-}
|
||||
|
||||
isCurrentThreadBound :: MonadIO m => m Bool
|
||||
isCurrentThreadBound = liftIO XIO.isCurrentThreadBound
|
||||
{-# INLINABLE isCurrentThreadBound #-}
|
||||
|
||||
mkWeakThreadId :: MonadIO m => ThreadId -> m (Weak ThreadId)
|
||||
mkWeakThreadId a = liftIO (XIO.mkWeakThreadId a)
|
||||
{-# INLINABLE mkWeakThreadId #-}
|
||||
|
||||
atomically :: MonadIO m => STM a -> m a
|
||||
atomically a = liftIO (XIO.atomically a)
|
||||
{-# INLINABLE atomically #-}
|
||||
|
||||
|
86
src/Monad.hs
86
src/Monad.hs
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Monad
|
||||
( module Export
|
||||
@ -25,7 +26,9 @@ module Monad
|
||||
, foldM_
|
||||
, replicateM
|
||||
, replicateM_
|
||||
|
||||
, concatMapM
|
||||
, concatForM
|
||||
|
||||
, guard
|
||||
, when
|
||||
@ -41,8 +44,6 @@ module Monad
|
||||
, liftM3
|
||||
, liftM4
|
||||
, liftM5
|
||||
, liftM'
|
||||
, liftM2'
|
||||
, ap
|
||||
|
||||
, (<$!>)
|
||||
@ -53,8 +54,11 @@ import Monad.Maybe as Export
|
||||
import Monad.Trans as Export
|
||||
|
||||
import Base (IO, seq)
|
||||
import Data.List (concat)
|
||||
import Prelude (Bool (..))
|
||||
import Control.Applicative (Applicative (pure))
|
||||
import Data.Function ((.))
|
||||
import Data.Functor (fmap)
|
||||
import Data.Traversable (Traversable (traverse))
|
||||
import Prelude (Bool (..), flip)
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 710
|
||||
import Control.Monad hiding (fail, (<$!>))
|
||||
@ -71,20 +75,27 @@ import Text.ParserCombinators.ReadP (ReadP)
|
||||
import Text.ParserCombinators.ReadPrec (ReadPrec)
|
||||
#endif
|
||||
|
||||
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
|
||||
concatMapM f xs = liftM concat (mapM f xs)
|
||||
import Containers (Element, NontrivialContainer, toList)
|
||||
|
||||
liftM' :: Monad m => (a -> b) -> m a -> m b
|
||||
liftM' = (<$!>)
|
||||
{-# INLINE liftM' #-}
|
||||
-- old specialized to list version
|
||||
-- concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
|
||||
-- | Lifting bind into a monad. Generalized version of @concatMap@
|
||||
-- that works with a monadic predicate.
|
||||
concatMapM :: (Applicative q, Monad m, Traversable m)
|
||||
=> (a -> q (m b))
|
||||
-> m a
|
||||
-> q (m b)
|
||||
concatMapM f = fmap join . traverse f
|
||||
{-# INLINE concatMapM #-}
|
||||
|
||||
liftM2' :: Monad m => (a -> b -> c) -> m a -> m b -> m c
|
||||
liftM2' f a b = do
|
||||
x <- a
|
||||
y <- b
|
||||
let z = f x y
|
||||
z `seq` return z
|
||||
{-# INLINE liftM2' #-}
|
||||
-- | Like 'concatMapM', but has its arguments flipped, so can be used
|
||||
-- instead of the common @fmap concat $ forM@ pattern.
|
||||
concatForM :: (Applicative q, Monad m, Traversable m)
|
||||
=> m a
|
||||
-> (a -> q (m b))
|
||||
-> q (m b)
|
||||
concatForM = flip concatMapM
|
||||
{-# INLINE concatForM #-}
|
||||
|
||||
(<$!>) :: Monad m => (a -> b) -> m a -> m b
|
||||
f <$!> m = do
|
||||
@ -93,32 +104,37 @@ f <$!> m = do
|
||||
z `seq` return z
|
||||
{-# INLINE (<$!>) #-}
|
||||
|
||||
|
||||
-- Copied from 'monad-loops' by James Cook (the library is in public domain)
|
||||
|
||||
andM :: (Monad m) => [m Bool] -> m Bool
|
||||
andM [] = return True
|
||||
andM (p:ps) = do
|
||||
andM :: (NontrivialContainer f, Element f ~ m Bool, Monad m) => f -> m Bool
|
||||
andM = go . toList
|
||||
where
|
||||
go [] = pure True
|
||||
go (p:ps) = do
|
||||
q <- p
|
||||
if q then andM ps else return False
|
||||
if q then go ps else pure False
|
||||
|
||||
orM :: (Monad m) => [m Bool] -> m Bool
|
||||
orM [] = return False
|
||||
orM (p:ps) = do
|
||||
orM :: (NontrivialContainer f, Element f ~ m Bool, Monad m) => f -> m Bool
|
||||
orM = go . toList
|
||||
where
|
||||
go [] = pure False
|
||||
go (p:ps) = do
|
||||
q <- p
|
||||
if q then return True else orM ps
|
||||
if q then pure True else go ps
|
||||
|
||||
anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
|
||||
anyM _ [] = return False
|
||||
anyM p (x:xs) = do
|
||||
allM :: (NontrivialContainer f, Monad m) => (Element f -> m Bool) -> f -> m Bool
|
||||
allM p = go . toList
|
||||
where
|
||||
go [] = pure True
|
||||
go (x:xs) = do
|
||||
q <- p x
|
||||
if q then return True else anyM p xs
|
||||
if q then go xs else pure False
|
||||
|
||||
allM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
|
||||
allM _ [] = return True
|
||||
allM p (x:xs) = do
|
||||
anyM :: (NontrivialContainer f, Monad m) => (Element f -> m Bool) -> f -> m Bool
|
||||
anyM p = go . toList
|
||||
where
|
||||
go [] = pure False
|
||||
go (x:xs) = do
|
||||
q <- p x
|
||||
if q then allM p xs else return False
|
||||
if q then pure True else go xs
|
||||
|
||||
{-# SPECIALIZE andM :: [IO Bool] -> IO Bool #-}
|
||||
{-# SPECIALIZE orM :: [IO Bool] -> IO Bool #-}
|
||||
|
21
src/Panic.hs
21
src/Panic.hs
@ -1,21 +0,0 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
|
||||
module Panic
|
||||
( FatalError (..)
|
||||
, panic
|
||||
) where
|
||||
|
||||
import Base (Show)
|
||||
import Control.Exception as X
|
||||
import Data.Text (Text)
|
||||
import Data.Typeable (Typeable)
|
||||
|
||||
-- | Uncatchable exceptions thrown and never caught.
|
||||
data FatalError = FatalError { fatalErrorMessage :: Text }
|
||||
deriving (Show, Typeable)
|
||||
|
||||
instance Exception FatalError
|
||||
|
||||
panic :: Text -> a
|
||||
panic a = throw (FatalError a)
|
10
src/Show.hs
10
src/Show.hs
@ -9,8 +9,6 @@ module Show
|
||||
( Print (..)
|
||||
, putText
|
||||
, putLText
|
||||
, putByteString
|
||||
, putLByteString
|
||||
) where
|
||||
|
||||
import qualified Base
|
||||
@ -59,11 +57,3 @@ putText = putStrLn
|
||||
putLText :: MonadIO m => TL.Text -> m ()
|
||||
putLText = putStrLn
|
||||
{-# SPECIALIZE putLText :: TL.Text -> Base.IO () #-}
|
||||
|
||||
putByteString :: MonadIO m => BS.ByteString -> m ()
|
||||
putByteString = putStrLn
|
||||
{-# SPECIALIZE putByteString :: BS.ByteString -> Base.IO () #-}
|
||||
|
||||
putLByteString :: MonadIO m => BL.ByteString -> m ()
|
||||
putLByteString = putStrLn
|
||||
{-# SPECIALIZE putLByteString :: BL.ByteString -> Base.IO () #-}
|
||||
|
@ -4,7 +4,6 @@
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
||||
|
||||
module Universum
|
||||
( -- * Reexports from base and from modules in this repo
|
||||
@ -19,13 +18,11 @@ module Universum
|
||||
, map
|
||||
, uncons
|
||||
, unsnoc
|
||||
, applyN
|
||||
, pretty
|
||||
, prettyL
|
||||
, print
|
||||
, foreach
|
||||
, guarded
|
||||
, guardedA
|
||||
, show
|
||||
|
||||
-- * Convenient type aliases
|
||||
@ -35,6 +32,7 @@ module Universum
|
||||
|
||||
import Applicative as X
|
||||
import Bool as X
|
||||
import Concurrent as X
|
||||
import Containers as X
|
||||
import Conv as X
|
||||
import Debug as X
|
||||
@ -43,7 +41,6 @@ import Functor as X
|
||||
import Lifted as X
|
||||
import List as X
|
||||
import Monad as X
|
||||
import Panic as X
|
||||
import Show as X
|
||||
import TypeOps as X
|
||||
|
||||
@ -72,7 +69,9 @@ import Data.Foldable as X (Foldable, concat, concatMap, fol
|
||||
import Data.Functor.Identity as X (Identity (..))
|
||||
import Data.Ord as X (Down (..), Ord (..), Ordering (..),
|
||||
comparing)
|
||||
import Data.Traversable as X hiding (for)
|
||||
import Data.Traversable as X (Traversable (..), fmapDefault,
|
||||
foldMapDefault, forM, mapAccumL,
|
||||
mapAccumR)
|
||||
|
||||
#if ( __GLASGOW_HASKELL__ >= 800 )
|
||||
import Data.List.NonEmpty as X (NonEmpty (..), nonEmpty)
|
||||
@ -121,11 +120,12 @@ import Data.Void as X (Void, absurd, vacuous)
|
||||
#endif
|
||||
|
||||
-- Base types
|
||||
import Data.Bits as X hiding (unsafeShiftL, unsafeShiftR)
|
||||
import Data.Bool as X hiding (bool)
|
||||
import Data.Bits as X (xor)
|
||||
import Data.Bool as X (Bool (..), not, otherwise, (&&), (||))
|
||||
import Data.Char as X (chr)
|
||||
import Data.Int as X (Int, Int16, Int32, Int64, Int8)
|
||||
import Data.Maybe as X hiding (fromJust)
|
||||
import Data.Maybe as X (Maybe (..), catMaybes, fromMaybe, isJust,
|
||||
isNothing, mapMaybe, maybe, maybeToList)
|
||||
import Data.Word as X (Word, Word16, Word32, Word64, Word8,
|
||||
byteSwap16, byteSwap32, byteSwap64)
|
||||
|
||||
@ -157,40 +157,12 @@ import Data.Text.Lazy as X (fromStrict, toStrict)
|
||||
import Data.Text.Encoding as X (decodeUtf8', decodeUtf8With)
|
||||
import Data.Text.Encoding.Error as X (OnDecodeError, OnError, UnicodeException,
|
||||
lenientDecode, strictDecode)
|
||||
import Text.Read as X (Read, readEither, readMaybe, reads)
|
||||
|
||||
-- IO
|
||||
import System.IO as X (FilePath, Handle, IOMode (..), stderr,
|
||||
stdin, stdout, withFile)
|
||||
|
||||
-- ST
|
||||
import Control.Monad.ST as X (ST, fixST, runST)
|
||||
|
||||
-- Concurrency and Parallelism
|
||||
import Control.Exception as X (Exception, SomeException (..))
|
||||
|
||||
import Control.Concurrent as X hiding (ThreadId, getNumCapabilities,
|
||||
isCurrentThreadBound, killThread,
|
||||
mkWeakThreadId, myThreadId,
|
||||
setNumCapabilities, threadCapability,
|
||||
throwTo)
|
||||
import Control.Concurrent.Async as X (Async (..), Concurrently (..), async,
|
||||
asyncBound, asyncOn, asyncThreadId,
|
||||
cancel, cancelWith, concurrently, link,
|
||||
link2, poll, race, race_, waitAny,
|
||||
waitAnyCancel, waitAnyCatch,
|
||||
waitAnyCatchCancel, waitBoth, waitCatch,
|
||||
waitEither, waitEitherCancel,
|
||||
waitEitherCatch, waitEitherCatchCancel,
|
||||
waitEither_, withAsync, withAsyncBound,
|
||||
withAsyncOn)
|
||||
import Control.Monad.STM as X (STM, always, alwaysSucceeds, catchSTM,
|
||||
check, orElse, retry, throwSTM)
|
||||
|
||||
import Foreign.Storable as X (Storable)
|
||||
|
||||
-- Read instances hiding unsafe builtins (read)
|
||||
import Text.Read as X (Read, readEither, readMaybe, reads)
|
||||
|
||||
-- Lenses
|
||||
import Lens.Micro as X (Lens, Lens', Traversal, Traversal', over,
|
||||
set, (%~), (&), (.~), (<&>), (^.), (^..),
|
||||
@ -218,9 +190,6 @@ unsnoc = foldr go Nothing
|
||||
Nothing -> ([], x)
|
||||
Just (xs, e) -> (x:xs, e))
|
||||
|
||||
applyN :: Int -> (a -> a) -> a -> a
|
||||
applyN n f = X.foldr (.) identity (X.replicate n f)
|
||||
|
||||
print :: (X.MonadIO m, PBase.Show a) => a -> m ()
|
||||
print = liftIO . PBase.print
|
||||
|
||||
@ -230,9 +199,6 @@ foreach = flip fmap
|
||||
guarded :: (Alternative f) => (a -> Bool) -> a -> f a
|
||||
guarded p x = X.bool empty (pure x) (p x)
|
||||
|
||||
guardedA :: (Functor f, Alternative t) => (a -> f Bool) -> a -> f (t a)
|
||||
guardedA p x = X.bool empty (pure x) <$> p x
|
||||
|
||||
show :: (Show a, IsString b) => a -> b
|
||||
show x = X.fromString (PBase.show x)
|
||||
{-# SPECIALIZE show :: Show a => a -> Text #-}
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: universum
|
||||
version: 0.2.2
|
||||
version: 0.3
|
||||
synopsis: Custom prelude used in Serokell
|
||||
description: Custom prelude used in Serokell
|
||||
homepage: https://github.com/serokell/universum
|
||||
@ -30,6 +30,7 @@ library
|
||||
Base
|
||||
Bifunctor
|
||||
Bool
|
||||
Concurrent
|
||||
Containers
|
||||
Conv
|
||||
Debug
|
||||
@ -37,7 +38,6 @@ library
|
||||
Functor
|
||||
Lifted
|
||||
List
|
||||
Panic
|
||||
Show
|
||||
TypeOps
|
||||
Unsafe
|
||||
@ -56,7 +56,6 @@ library
|
||||
-fwarn-implicit-prelude
|
||||
|
||||
build-depends:
|
||||
async >= 2.1 && <2.2,
|
||||
base >= 4.7 && <4.10,
|
||||
bytestring >= 0.10 && <0.11,
|
||||
containers >= 0.5 && <0.6,
|
||||
|
Loading…
Reference in New Issue
Block a user