protolude 0.1.10 → 0.2
raw patch · 15 files changed
+467/−95 lines, 15 filesdep +arraydep +hashabledep +mtl-compatdep ~asyncdep ~basedep ~safe
Dependencies added: array, hashable, mtl-compat
Dependency ranges changed: async, base, safe, transformers
Files
- LICENSE +1/−1
- protolude.cabal +26/−13
- src/Base.hs +49/−9
- src/Bool.hs +35/−2
- src/CallStack.hs +18/−0
- src/Debug.hs +8/−11
- src/Either.hs +7/−2
- src/Error.hs +45/−0
- src/Exceptions.hs +7/−0
- src/Functor.hs +9/−5
- src/List.hs +2/−2
- src/Monad.hs +2/−5
- src/Panic.hs +8/−2
- src/Protolude.hs +223/−33
- src/Show.hs +27/−10
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2016, Stephen Diehl+Copyright (c) 2016-2017, Stephen Diehl Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to
protolude.cabal view
@@ -1,13 +1,13 @@ name: protolude-version: 0.1.10-synopsis: A sensible set of defaults for writing custom Preludes.+version: 0.2+synopsis: A small prelude. description: A sensible set of defaults for writing custom Preludes. homepage: https://github.com/sdiehl/protolude license: MIT license-file: LICENSE author: Stephen Diehl maintainer: stephen.m.diehl@gmail.com-copyright: 2016 Stephen Diehl+copyright: 2016-2017 Stephen Diehl category: Prelude build-type: Simple cabal-version: >=1.10@@ -21,7 +21,9 @@ GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2,- GHC == 7.10.3+ GHC == 7.10.3,+ GHC == 8.0.1,+ GHC == 8.2.1 Bug-Reports: https://github.com/sdiehl/protolude/issues description:@@ -34,6 +36,9 @@ exposed-modules: Protolude Unsafe++ other-modules:+ Exceptions Base Applicative Bool@@ -46,11 +51,10 @@ Functor Semiring Bifunctor- Exceptions+ CallStack+ Error Panic - other-modules:- default-extensions: NoImplicitPrelude OverloadedStrings@@ -62,17 +66,26 @@ -fwarn-implicit-prelude build-depends: - base >= 4.6 && <4.10,+ base >= 4.6 && <4.11,+ array >= 0.4 && <0.6, ghc-prim >= 0.3 && <0.6,- safe >= 0.3 && <0.4,- async >= 2.1 && <2.2,+ async >= 2.0 && <2.2, deepseq >= 1.3 && <1.5, containers >= 0.5 && <0.6,- mtl >= 2.1 && <2.3,- transformers >= 0.4 && <0.6,+ hashable >= 1.2 && <1.3,+ transformers >= 0.2 && <0.6, text >= 1.2 && <1.3, stm >= 2.4 && <2.5,- bytestring >= 0.10 && <0.11+ bytestring >= 0.10 && <0.11,+ mtl >= 2.1 && <2.3,+ mtl-compat >= 0.2 && <0.3++ if impl(ghc >= 7.8.0)+ build-depends:+ safe >= 0.3 && <0.3.16+ else+ build-depends:+ safe >= 0.3 && <0.3.10 hs-source-dirs: src default-language: Haskell2010
src/Base.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Unsafe #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ExplicitNamespaces #-} module Base ( module X,@@ -13,13 +13,25 @@ #if defined(__GLASGOW_HASKELL__) && ( __GLASGOW_HASKELL__ >= 600 ) -- Base GHC types-import GHC.Num as X-import GHC.Enum as X+import GHC.Num as X (+ Num(..)+ , Integer+ , subtract+ )+import GHC.Enum as X (+ Bounded(..)+ , Enum(..)+ , boundedEnumFrom+ , boundedEnumFromThen+ ) import GHC.Real as X-import GHC.Float as X-import GHC.Err as X (- undefined- , error+import GHC.Float as X (+ Float(..)+ , Double(..)+ , Floating (..)+ , RealFloat(..)+ , showFloat+ , showSignedFloat ) import GHC.Show as X ( Show(..)@@ -36,7 +48,10 @@ , ord , maxInt , minInt+ , until )++-- Exported for lifting into new functions. import System.IO as X ( print , putStr@@ -55,6 +70,10 @@ #endif ) +#if ( __GLASGOW_HASKELL__ >= 710 )+import GHC.StaticPtr as X (StaticPtr)+#endif+ #if ( __GLASGOW_HASKELL__ >= 800 ) import GHC.OverloadedLabels as X ( IsLabel(..)@@ -69,26 +88,47 @@ import GHC.Stack as X ( CallStack- , HasCallStack+ , type HasCallStack , callStack , prettySrcLoc , currentCallStack , getCallStack , prettyCallStack+ , withFrozenCallStack ) +#if ( __GLASGOW_HASKELL__ >= 710 )+import GHC.TypeLits as X (+ Symbol+ , SomeSymbol(..)+ , Nat+ , SomeNat(..)+ , CmpNat+ , KnownSymbol+ , KnownNat+ , natVal+ , someNatVal+ , symbolVal+ , someSymbolVal+ )+#endif++-- Pending GHC 8.2 we'll expose these.+ {- import GHC.Records as X ( HasField(..) )--} import Data.Kind as X ( type (*) , type Type )+-}+ #endif +-- Default Prelude defines this at the toplevel module, so we do as well. infixr 0 $! ($!) :: (a -> b) -> a -> b
src/Bool.hs view
@@ -7,11 +7,16 @@ , ifM , guardM , bool+, (&&^)+, (||^)+, (<&&>)+, (<||>) ) where -import Data.Bool (Bool)+import Data.Bool (Bool(..), (&&), (||)) import Data.Function (flip)-import Control.Monad (Monad, MonadPlus, when, unless, guard, (>>=), (=<<))+import Control.Applicative(Applicative, liftA2)+import Control.Monad (Monad, MonadPlus, return, when, unless, guard, (>>=), (=<<)) bool :: a -> a -> Bool -> a bool f t p = if p then t else f@@ -29,3 +34,31 @@ guardM :: MonadPlus m => m Bool -> m () guardM f = guard =<< f++-- | The '||' operator lifted to a monad. If the first+-- argument evaluates to 'True' the second argument will not+-- be evaluated.+infixr 2 ||^ -- same as (||)+(||^) :: Monad m => m Bool -> m Bool -> m Bool+(||^) a b = ifM a (return True) b++infixr 2 <||>+-- | '||' lifted to an Applicative.+-- Unlike '||^' the operator is __not__ short-circuiting.+(<||>) :: Applicative a => a Bool -> a Bool -> a Bool+(<||>) = liftA2 (||)+{-# INLINE (<||>) #-}++-- | The '&&' operator lifted to a monad. If the first+-- argument evaluates to 'False' the second argument will not+-- be evaluated.+infixr 3 &&^ -- same as (&&)+(&&^) :: Monad m => m Bool -> m Bool -> m Bool+(&&^) a b = ifM a b (return False)++infixr 3 <&&>+-- | '&&' lifted to an Applicative.+-- Unlike '&&^' the operator is __not__ short-circuiting.+(<&&>) :: Applicative a => a Bool -> a Bool -> a Bool+(<&&>) = liftA2 (&&)+{-# INLINE (<&&>) #-}
+ src/CallStack.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE ConstraintKinds #-}++module CallStack+( HasCallStack+) where++#if MIN_VERSION_base(4,9,0)+import GHC.Stack (HasCallStack)+#elif MIN_VERSION_base(4,8,1)+import qualified GHC.Stack+type HasCallStack = (?callStack :: GHC.Stack.CallStack)+#else+import GHC.Exts (Constraint)+type HasCallStack = (() :: Constraint)+#endif
src/Debug.hs view
@@ -3,7 +3,6 @@ module Debug ( undefined,- error, trace, traceM, traceId,@@ -18,26 +17,24 @@ import Control.Monad (Monad, return) import qualified Base as P-import Show (Print, putStrLn)+import Error (error)+import Show (Print, hPutStrLn) +import System.IO(stderr) import System.IO.Unsafe (unsafePerformIO) {-# WARNING trace "'trace' remains in code" #-} trace :: Print b => b -> a -> a trace string expr = unsafePerformIO (do- putStrLn string+ hPutStrLn stderr string return expr) {-# WARNING traceIO "'traceIO' remains in code" #-} traceIO :: Print b => b -> a -> P.IO a traceIO string expr = do- putStrLn string+ hPutStrLn stderr string return expr -{-# WARNING error "'error' remains in code" #-}-error :: Text -> a-error s = P.error (unpack s)- {-# WARNING traceShow "'traceShow' remains in code" #-} traceShow :: P.Show a => a -> b -> b traceShow a b = trace (P.show a) b@@ -54,12 +51,12 @@ traceM :: (Monad m) => Text -> m () traceM s = trace (unpack s) (return ()) -{-# WARNING traceId "'traceM' remains in code" #-}+{-# WARNING traceId "'traceId' remains in code" #-} traceId :: Text -> Text traceId s = trace s s notImplemented :: a-notImplemented = P.error "Not implemented"+notImplemented = error "Not implemented" undefined :: a-undefined = P.undefined+undefined = error "Prelude.undefined"
src/Either.hs view
@@ -6,6 +6,7 @@ , maybeToRight , leftToMaybe , rightToMaybe+, maybeEmpty , maybeToEither ) where @@ -26,5 +27,9 @@ maybeToLeft :: r -> Maybe l -> Either l r maybeToLeft r = maybe (Right r) Left -maybeToEither :: Monoid b => (a -> b) -> Maybe a -> b-maybeToEither = maybe mempty+maybeEmpty :: Monoid b => (a -> b) -> Maybe a -> b+maybeEmpty = maybe mempty++maybeToEither :: e -> Maybe a -> Either e a+maybeToEither e Nothing = Left e+maybeToEither _ (Just a) = Right a
+ src/Error.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE ExistentialQuantification #-}++#if MIN_VERSION_base(4,9,0)+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+#endif++module Error+( error+) where++import GHC.Prim+import Data.Text (Text, unpack)++#if MIN_VERSION_base(4,9,0)+-- Full stack trace.++import GHC.Types (RuntimeRep)+import CallStack (HasCallStack)+import GHC.Exception (errorCallWithCallStackException)++error :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack => Text -> a+error s = raise# (errorCallWithCallStackException (unpack s) ?callstack)++#elif MIN_VERSION_base(4,7,0)+-- Basic Call Stack with callsite.++import GHC.Exception (errorCallException)++error :: Text -> a+error s = raise# (errorCallException (unpack s))++#else++-- No exception tracing.+import GHC.Types+import GHC.Exception++error :: Text -> a+error s = throw (ErrorCall (unpack s))++#endif
src/Exceptions.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -21,8 +22,14 @@ hush (Left _) = empty hush (Right x) = pure x +-- To suppress redundenet 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+#else 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
src/Functor.hs view
@@ -6,10 +6,13 @@ Functor(..), ($>), (<$>),+ (<<$>>), void, ) where -#if (__GLASGOW_HASKELL__ >= 710)+import Data.Function ((.))++#if MIN_VERSION_base(4,7,0) import Data.Functor ( Functor(..) , ($>)@@ -23,16 +26,17 @@ ) import Data.Function (flip)-import Data.Function ((.)) infixl 4 $> ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) -(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)-(<<$>>) = fmap . fmap- void :: Functor f => f a -> f () void x = () <$ x #endif++infixl 4 <<$>>++(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)+(<<$>>) = fmap . fmap
src/List.hs view
@@ -16,12 +16,12 @@ import Data.Foldable (Foldable, foldr, foldl') import Data.Function ((.)) import Data.Functor (fmap)-import Control.Monad (return)+import Control.Applicative (pure) import qualified Data.Set as Set import GHC.Num (Num, (+), (*)) head :: (Foldable f) => f a -> Maybe a-head = foldr (\x _ -> return x) Nothing+head = foldr (\x _ -> pure x) Nothing sortOn :: (Ord o) => (a -> o) -> [a] -> [a] sortOn = sortBy . comparing
src/Monad.hs view
@@ -42,12 +42,7 @@ import Base (seq) import Data.List (concat)--#if (__GLASGOW_HASKELL__ >= 710)-import Control.Monad hiding ((<$!>))-#else import Control.Monad-#endif concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] concatMapM f xs = liftM concat (mapM f xs)@@ -64,9 +59,11 @@ z `seq` return z {-# INLINE liftM2' #-} +#if !MIN_VERSION_base(4,8,0) (<$!>) :: Monad m => (a -> b) -> m a -> m b f <$!> m = do x <- m let z = f x z `seq` return z {-# INLINE (<$!>) #-}+#endif
src/Panic.hs view
@@ -1,5 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-}+#if MIN_VERSION_base(4,9,0)+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+#endif module Panic ( FatalError(..),@@ -9,13 +14,14 @@ import Base (Show) import Data.Text (Text) import Data.Typeable (Typeable)+import CallStack (HasCallStack) import Control.Exception as X -- | Uncatchable exceptions thrown and never caught.-data FatalError = FatalError { msg :: Text }+data FatalError = FatalError { fatalErrorMessage :: Text } deriving (Show, Typeable) instance Exception FatalError -panic :: Text -> a+panic :: HasCallStack => Text -> a panic a = throw (FatalError a)
src/Protolude.hs view
@@ -10,22 +10,28 @@ module Base, identity, map,- (&), uncons, unsnoc, applyN, print, throwIO, throwTo,- foreach,+ foreach, (<&>), show, pass, guarded, guardedA, LText, LByteString,+ liftIO1,+ liftIO2,+#if !MIN_VERSION_base(4,8,0)+ (&),+#endif+ die, ) where +-- Protolude module exports. import List as X import Show as X import Bool as X@@ -37,13 +43,12 @@ import Conv as X import Panic as X import Exceptions as X+import Semiring as X import Base as Base hiding ( putStr -- Overriden by Show.putStr , putStrLn -- Overriden by Show.putStrLn , print -- Overriden by Protolude.print- , error -- Overriden by Debug.error- , undefined -- Overriden by Debug.undefined , show -- Overriden by Protolude.show , showFloat -- Custom Show instances deprecated. , showList -- Custom Show instances deprecated.@@ -71,6 +76,8 @@ , lastMay , foldr1May , foldl1May+ , maximumMay+ , minimumMay , atMay , atDef )@@ -89,8 +96,15 @@ ) -- Base typeclasses-import Data.Eq as X-import Data.Ord as X+import Data.Eq as X (+ Eq(..)+ )+import Data.Ord as X (+ Ord(..)+ , Ordering(..)+ , Down(..)+ , comparing+ ) import Data.Traversable as X import Data.Foldable as X hiding ( foldr1@@ -98,20 +112,35 @@ , product , sum )-import Semiring as X-import Data.Functor.Identity as X+import Data.Functor.Identity as X (+ Identity(..)+ ) -#if ( __GLASGOW_HASKELL__ >= 800 )-import Data.Monoid as X hiding ((<>))-import Data.Semigroup as X ( Semigroup(..) )-#else-import Data.Monoid as X+#if MIN_VERSION_base(4,9,0)+import Data.List.NonEmpty as X (+ NonEmpty(..)+ , nonEmpty+ )+import Data.Semigroup as X (+ Semigroup(sconcat, stimes)+ , WrappedMonoid+ , Option(..)+ , option+ , diff+ , cycle1+ , stimesMonoid+ , stimesIdempotent+ , stimesIdempotentMonoid+ , mtimesDefault+ ) #endif -#if (__GLASGOW_HASKELL__ >= 710)-import Data.Bifunctor as X (Bifunctor(..))-#else+import Data.Monoid as X++#if !MIN_VERSION_base(4,8,0) import Bifunctor as X (Bifunctor(..))+#else+import Data.Bifunctor as X (Bifunctor(..)) #endif -- Deepseq@@ -123,7 +152,14 @@ ) -- Data structures-import Data.Tuple as X+import Data.Tuple as X (+ fst+ , snd+ , curry + , uncurry+ , swap+ ) + import Data.List as X ( splitAt , break@@ -153,15 +189,29 @@ , tails , zipWith , zip+ , unzip+ , genericLength+ , genericTake+ , genericDrop+ , genericSplitAt+ , genericReplicate ) +-- Hashing+import Data.Hashable as X (+ Hashable+ , hash+ , hashWithSalt+ , hashUsing+ )+ import Data.Map as X (Map) import Data.Set as X (Set) import Data.Sequence as X (Seq) import Data.IntMap as X (IntMap) import Data.IntSet as X (IntSet) -#if ( __GLASGOW_HASKELL__ >= 710 )+#if MIN_VERSION_base(4,7,0) import Data.Proxy as X ( Proxy(..) )@@ -177,6 +227,7 @@ import Data.Type.Coercion as X ( Coercion(..) , coerceWith+ , repr ) import Data.Type.Equality as X (@@ -188,6 +239,9 @@ , gcastWith ) +#endif++#if MIN_VERSION_base(4,8,0) import Data.Void as X ( Void , absurd@@ -199,7 +253,7 @@ import Control.Monad.State as X ( MonadState , State- , StateT+ , StateT(StateT) , put , get , gets@@ -219,7 +273,7 @@ import Control.Monad.Reader as X ( MonadReader , Reader- , ReaderT+ , ReaderT(ReaderT) , ask , asks , local@@ -231,7 +285,7 @@ import Control.Monad.Except as X ( MonadError , Except- , ExceptT+ , ExceptT(ExceptT) , throwError , catchError , runExcept@@ -245,14 +299,53 @@ ) -- Base types-import Data.Int as X+import Data.Int as X (+ Int+ , Int8+ , Int16+ , Int32+ , Int64+ ) import Data.Bits as X hiding ( unsafeShiftL , unsafeShiftR )-import Data.Word as X-import Data.Either as X-import Data.Complex as X+import Data.Word as X (+ Word+ , Word8+ , Word16+ , Word32+ , Word64+#if MIN_VERSION_base(4,7,0)+ , byteSwap16+ , byteSwap32+ , byteSwap64+#endif+ )++import Data.Either as X (+ Either(..)+ , either + , lefts+ , rights+ , partitionEithers+#if MIN_VERSION_base(4,7,0)+ , isLeft+ , isRight+#endif+ )++import Data.Complex as X (+ Complex(..)+ , realPart+ , imagPart+ , mkPolar+ , cis+ , polar+ , magnitude+ , phase+ , conjugate+ ) import Data.Char as X (chr) import Data.Bool as X hiding (bool) import Data.Maybe as X hiding (fromJust)@@ -264,11 +357,15 @@ , flip , fix , on+#if MIN_VERSION_base(4,8,0)+ , (&)+#endif ) -- Genericss import GHC.Generics as X ( Generic(..)+ , Generic1 , Rep , K1(..) , M1(..)@@ -277,14 +374,19 @@ , D1 , C1 , S1- , (:+:)- , (:*:)+ , (:+:)(..)+ , (:*:)(..)+ , (:.:)(..) , Rec0 , Constructor(..)+ , Datatype(..) , Selector(..) , Fixity(..)+ , Associativity(..) #if ( __GLASGOW_HASKELL__ >= 800 ) , Meta(..)+ , FixityI(..)+ , URec #endif ) @@ -317,9 +419,25 @@ , decodeUtf8With ) +import Data.Text.Encoding.Error as X (+ OnDecodeError+ , OnError+ , UnicodeException+ , lenientDecode+ , strictDecode+ , ignore+ , replace+ )+ -- IO-import System.Exit as X import System.Environment as X (getArgs)+import qualified System.Exit +import System.Exit as X (+ ExitCode(..)+ , exitWith+ , exitFailure+ , exitSuccess+ ) import System.IO as X ( Handle , FilePath@@ -332,7 +450,11 @@ ) -- ST-import Control.Monad.ST as X+import Control.Monad.ST as X (+ ST+ , runST+ , fixST+ ) -- Concurrency and Parallelism import Control.Exception as X hiding (@@ -340,20 +462,61 @@ , throwIO , throwTo , assert- , displayException , Handler(..) ) import qualified Control.Exception -import Control.Monad.STM as X+import Control.Monad.STM as X (+ STM+ , atomically+ , always+ , alwaysSucceeds+ , retry+ , orElse+ , check+ , throwSTM + , catchSTM+ ) import Control.Concurrent as X hiding ( throwTo , yield )-import Control.Concurrent.Async as X+import Control.Concurrent.Async as X (+ Async(..)+ , Concurrently(..)+ , async+ , asyncBound+ , asyncOn+ , withAsync+ , withAsyncBound+ , withAsyncOn+ , wait+ , poll+ , waitCatch+ , cancel + , cancelWith+ , asyncThreadId+ , waitAny+ , waitAnyCatch+ , waitAnyCancel+ , waitAnyCatchCancel+ , waitEither+ , waitEitherCatch+ , waitEitherCancel+ , waitEitherCatchCancel+ , waitEither_+ , waitBoth+ , link+ , link2+ , race+ , race_+ , concurrently+ ) +import Foreign.Ptr as X (IntPtr, WordPtr) import Foreign.Storable as X (Storable)+import Foreign.StablePtr as X (StablePtr) -- Read instances hiding unsafe builtins (read) import Text.Read as X (@@ -367,10 +530,13 @@ type LText = Data.Text.Lazy.Text type LByteString = Data.ByteString.Lazy.ByteString ++#if !MIN_VERSION_base(4,8,0) infixl 1 & (&) :: a -> (a -> b) -> b x & f = f x+#endif identity :: a -> a identity x = x@@ -379,7 +545,7 @@ map = fmap uncons :: [a] -> Maybe (a, [a])-uncons [] = Nothing+uncons [] = Nothing uncons (x:xs) = Just (x, xs) unsnoc :: [x] -> Maybe ([x],x)@@ -404,6 +570,14 @@ foreach :: Functor f => f a -> (a -> b) -> f b foreach = flip fmap +-- | Infix version of foreach.+--+-- @<&>@ is to '<$>' what '&' is to '$'.+infixl 4 <&>+(<&>) :: Functor f => f a -> (a -> b) -> f b+(<&>) = foreach++-- | Do nothing returning unit inside applicative. pass :: Applicative f => f () pass = pure () @@ -413,6 +587,14 @@ guardedA :: (Functor f, Alternative t) => (a -> f Bool) -> a -> f (t a) guardedA p x = X.bool empty (pure x) <$> p x +-- | Lift an 'IO' operation with 1 argument into another monad+liftIO1 :: MonadIO m => (a -> IO b) -> a -> m b+liftIO1 = (.) liftIO++-- | Lift an 'IO' operation with 2 arguments into another monad+liftIO2 :: MonadIO m => (a -> b -> IO c) -> a -> b -> m c+liftIO2 = ((.).(.)) liftIO+ show :: (Show a, StringConv String b) => a -> b show x = toS (PBase.show x) {-# SPECIALIZE show :: Show a => a -> Text #-}@@ -420,3 +602,11 @@ {-# SPECIALIZE show :: Show a => a -> ByteString #-} {-# SPECIALIZE show :: Show a => a -> LByteString #-} {-# SPECIALIZE show :: Show a => a -> String #-}++#if MIN_VERSION_base(4,8,0)+die :: Text -> IO a+die err = System.Exit.die (toS err)+#else+die :: Text -> IO a+die err = hPutStrLn stderr err >> exitFailure+#endif
src/Show.hs view
@@ -9,9 +9,12 @@ Print(..), putText, putLText,+ putByteString,+ putLByteString, ) where import qualified Base+import qualified System.IO as Base import Data.Function ((.)) import Control.Monad.IO.Class (MonadIO, liftIO)@@ -24,30 +27,36 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL +import System.IO (Handle, stdout) + class Print a where+ hPutStr :: MonadIO m => Handle -> a -> m () putStr :: MonadIO m => a -> m ()+ putStr = hPutStr stdout+ hPutStrLn :: MonadIO m => Handle -> a -> m () putStrLn :: MonadIO m => a -> m ()+ putStrLn = hPutStrLn stdout instance Print T.Text where- putStr = liftIO . T.putStr- putStrLn = liftIO . T.putStrLn+ hPutStr = \h -> liftIO . T.hPutStr h+ hPutStrLn = \h -> liftIO . T.hPutStrLn h instance Print TL.Text where- putStr = liftIO . TL.putStr- putStrLn = liftIO . TL.putStrLn+ hPutStr = \h -> liftIO . TL.hPutStr h+ hPutStrLn = \h -> liftIO . TL.hPutStrLn h instance Print BS.ByteString where- putStr = liftIO . BS.putStr- putStrLn = liftIO . BS.putStrLn+ hPutStr = \h -> liftIO . BS.hPutStr h+ hPutStrLn = \h -> liftIO . BS.hPutStrLn h instance Print BL.ByteString where- putStr = liftIO . BL.putStr- putStrLn = liftIO . BL.putStrLn+ hPutStr = \h -> liftIO . BL.hPutStr h+ hPutStrLn = \h -> liftIO . BL.hPutStrLn h instance Print [Base.Char] where- putStr = liftIO . Base.putStr- putStrLn = liftIO . Base.putStrLn+ hPutStr = \h -> liftIO . Base.hPutStr h+ hPutStrLn = \h -> liftIO . Base.hPutStrLn h -- For forcing type inference putText :: MonadIO m => T.Text -> m ()@@ -57,3 +66,11 @@ 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 () #-}