universum 0.1.8 → 0.1.12
raw patch · 16 files changed
+1008/−153 lines, 16 filesdep +exceptionsdep +hashabledep +text-format
Dependencies added: exceptions, hashable, text-format, utf8-string
Files
- CHANGES.md +61/−0
- LICENSE +1/−0
- src/Applicative.hs +13/−0
- src/Base.hs +5/−2
- src/Containers.hs +452/−0
- src/Conv.hs +78/−57
- src/Debug.hs +23/−9
- src/Exceptions.hs +29/−0
- src/Functor.hs +6/−3
- src/Lifted.hs +164/−0
- src/List.hs +6/−9
- src/Monad.hs +88/−5
- src/Semiring.hs +0/−19
- src/Show.hs +10/−0
- src/Universum.hs +58/−35
- universum.cabal +14/−14
+ CHANGES.md view
@@ -0,0 +1,61 @@+0.1.12+======++* Use custom classes instead of `Foldable`. Thanks to this, `length` and similar functions can't anymore be used on tuples or `Maybe`, but can be used on e.g. `Text`, `ByteString` and `IntSet`.++* Add `allM`, `anyM,` `andM`, `orM`.++* Reexport `fail` and `MonadFail`.++0.1.11+======++* Add specialized print functions for `ByteString`+* Export more stuff from `Semigroup` and use `(<>)` from `Monoid`+* Export `Hashable`++0.1.10+======++* Generalize most `IO` functions to `MonadIO`+* Make `die` available for older versions of base++0.1.9+=====++* Make `sum` and `product` strict++0.1.8+=====++* ``foreach`` for applicative traversals.+* ``hush`` function for error handling.+* ``tryIO`` function for error handling.+* ``pass`` function for noop applicative branches.+* Mask ``Handler`` typeclass export.+* Mask ``yield`` function export.++0.1.7+=====++* Exports monadic ``(>>)`` operator by default.+* Adds ``traceId`` and ``traceShowId`` functions.+* Exports``reader`` and ``state`` functions by default.+* Export lifted ``throwIO`` and ``throwTo`` functions.++0.1.6+=====++* Adds uncatchable panic exception throwing using Text message.+* Removes ``printf``+* Removes ``string-conv`` dependency so Stack build works without ``extra-deps``.+* Brings ``Callstack`` machinery in for GHC 8.x.+* Removes ``throw`` and ``assert`` from ``Control.Exception`` exports.+* Removes ``unsafeShiftL`` and ``unsafeShiftR`` from ``Data.Bits`` exports.+* Reexport ``throw`` as ``unsafeThrow`` via Unsafe module.+* Hides all Show class functions. Only the Class itself is exported. Forbids custom instances that are not GHC derived.+* Export`` encodeUtf8`` and ``decodeUtf8`` functions by default.+* Adds ``unsnoc`` function.++0.1.5+=====
LICENSE view
@@ -1,3 +1,4 @@+The MIT License (MIT) Copyright (c) 2016, Stephen Diehl Permission is hereby granted, free of charge, to any person obtaining a copy
src/Applicative.hs view
@@ -5,11 +5,15 @@ ( orAlt , orEmpty , eitherA+ , liftAA2+ , purer+ , (<<*>>) ) where import Control.Applicative import Data.Bool (Bool) import Data.Either (Either (..))+import Data.Function ((.)) import Data.Monoid (Monoid (..)) orAlt :: (Alternative f, Monoid a) => f a -> f a@@ -20,3 +24,12 @@ eitherA :: Alternative f => f a -> f b -> f (Either a b) eitherA a b = (Left <$> a) <|> (Right <$> b)++purer :: (Applicative f, Applicative g) => a -> f (g a)+purer = pure . pure++liftAA2 :: (Applicative f, Applicative g) => (a -> b -> c) -> f (g a) -> f (g b) -> f (g c)+liftAA2 = liftA2 . liftA2++(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b)+(<<*>>) = liftA2 (<*>)
src/Base.hs view
@@ -23,8 +23,11 @@ import GHC.Show as X (Show (..)) import System.IO as X (print, putStr, putStrLn) -import GHC.Types as X (Bool, Char, Coercible, IO, Int, Ordering,- Word)+import GHC.Types as X (Bool, Char, IO, Int, Ordering, Word)++#if ( __GLASGOW_HASKELL__ >= 710 )+import GHC.Types as X (Coercible)+#endif #if ( __GLASGOW_HASKELL__ >= 800 ) import GHC.OverloadedLabels as X (IsLabel (..))
+ src/Containers.hs view
@@ -0,0 +1,452 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}++module Containers+ ( Element+ , Container(..)+ , NontrivialContainer(..)++ , sum+ , product++ , mapM_+ , forM_+ , traverse_+ , for_+ , sequenceA_+ , sequence_+ , asum+ ) where++import Control.Applicative (Alternative (..))+import Control.Monad.Identity (Identity)+import Data.Coerce (Coercible, coerce)+import Data.Foldable (Foldable)+import qualified Data.Foldable as F+import Data.Maybe (fromMaybe)+import Data.Monoid (All(..), Any(..), First(..))+import Data.Word (Word8)+import Prelude hiding (all, any, Foldable (..), mapM_,+ sequence_)++#if __GLASGOW_HASKELL__ >= 800+import GHC.Err (errorWithoutStackTrace)+import GHC.TypeLits (ErrorMessage (..), TypeError)+#endif++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++import qualified Data.IntSet as IS+++----------------------------------------------------------------------------+-- Containers (e.g. tuples aren't containers)+----------------------------------------------------------------------------++type family Element t++type instance Element (f a) = a+type instance Element T.Text = Char+type instance Element TL.Text = Char+type instance Element BS.ByteString = Word8+type instance Element BSL.ByteString = Word8+type instance Element IS.IntSet = Int++class Container t where+ toList :: t -> [Element t]+ null :: t -> Bool++instance {-# OVERLAPPABLE #-} Foldable f => Container (f a) where+ toList = F.toList+ {-# INLINE toList #-}+ null = F.null+ {-# INLINE null #-}++instance Container T.Text where+ toList = T.unpack+ {-# INLINE toList #-}+ null = T.null+ {-# INLINE null #-}++instance Container TL.Text where+ toList = TL.unpack+ {-# INLINE toList #-}+ null = TL.null+ {-# INLINE null #-}++instance Container BS.ByteString where+ toList = BS.unpack+ {-# INLINE toList #-}+ null = BS.null+ {-# INLINE null #-}++instance Container BSL.ByteString where+ toList = BSL.unpack+ {-# INLINE toList #-}+ null = BSL.null+ {-# INLINE null #-}++instance Container IS.IntSet where+ toList = IS.toList+ {-# INLINE toList #-}+ null = IS.null+ {-# INLINE null #-}++----------------------------------------------------------------------------+-- Additional operations that don't make much sense for e.g. Maybe+----------------------------------------------------------------------------++-- | A class for 'Container's that aren't trivial like 'Maybe' (e.g. can hold+-- more than one value)+class Container t => NontrivialContainer t where+ foldMap :: Monoid m => (Element t -> m) -> t -> m+ foldMap f = foldr (mappend . f) mempty+ {-# INLINE foldMap #-}++ fold :: Monoid (Element t) => t -> Element t+ fold = foldMap id++ foldr :: (Element t -> b -> b) -> b -> t -> b+ foldr' :: (Element t -> b -> b) -> b -> t -> b+ foldr' f z0 xs = foldl f' id xs z0+ where f' k x z = k $! f x z+ foldl :: (b -> Element t -> b) -> b -> t -> b+ foldl' :: (b -> Element t -> b) -> b -> t -> b+ foldr1 :: (Element t -> Element t -> Element t) -> t -> Element t+ foldr1 f xs =+#if __GLASGOW_HASKELL__ >= 800+ fromMaybe (errorWithoutStackTrace "foldr1: empty structure")+ (foldr mf Nothing xs)+#else+ fromMaybe (error "foldr1: empty structure")+ (foldr mf Nothing xs)+#endif+ where+ mf x m = Just (case m of+ Nothing -> x+ Just y -> f x y)+ foldl1 :: (Element t -> Element t -> Element t) -> t -> Element t+ foldl1 f xs =+#if __GLASGOW_HASKELL__ >= 800+ fromMaybe (errorWithoutStackTrace "foldl1: empty structure")+ (foldl mf Nothing xs)+#else+ fromMaybe (error "foldl1: empty structure")+ (foldl mf Nothing xs)+#endif+ where+ mf m y = Just (case m of+ Nothing -> y+ Just x -> f x y)++ length :: t -> Int++ elem :: Eq (Element t) => Element t -> t -> Bool++ maximum :: Ord (Element t) => t -> Element t+ minimum :: Ord (Element t) => t -> Element t++ all :: (Element t -> Bool) -> t -> Bool+ all p = getAll #. foldMap (All #. p)+ any :: (Element t -> Bool) -> t -> Bool+ any p = getAny #. foldMap (Any #. p)++ and :: (Element t ~ Bool) => t -> Bool+ and = getAll #. foldMap All+ or :: (Element t ~ Bool) => t -> Bool+ or = getAny #. foldMap Any++ find :: (Element t -> Bool) -> t -> Maybe (Element t)+ find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing))++ head :: t -> Maybe (Element t)+ head = foldr (\x _ -> Just x) Nothing+ {-# INLINE head #-}++instance {-# OVERLAPPABLE #-} Foldable f => NontrivialContainer (f a) where+ foldMap = F.foldMap+ {-# INLINE foldMap #-}+ fold = F.fold+ {-# INLINE fold #-}+ foldr = F.foldr+ {-# INLINE foldr #-}+ foldr' = F.foldr'+ {-# INLINE foldr' #-}+ foldl = F.foldl+ {-# INLINE foldl #-}+ foldl' = F.foldl'+ {-# INLINE foldl' #-}+ foldr1 = F.foldr1+ {-# INLINE foldr1 #-}+ foldl1 = F.foldl1+ {-# INLINE foldl1 #-}+ length = F.length+ {-# INLINE length #-}+ elem = F.elem+ {-# INLINE elem #-}+ maximum = F.maximum+ {-# INLINE maximum #-}+ minimum = F.minimum+ {-# INLINE minimum #-}+ all = F.all+ {-# INLINE all #-}+ any = F.any+ {-# INLINE any #-}+ and = F.and+ {-# INLINE and #-}+ or = F.or+ {-# INLINE or #-}+ find = F.find+ {-# INLINE find #-}++instance NontrivialContainer T.Text where+ foldr = T.foldr+ {-# INLINE foldr #-}+ foldl = T.foldl+ {-# INLINE foldl #-}+ foldl' = T.foldl'+ {-# INLINE foldl' #-}+ foldr1 = T.foldr1+ {-# INLINE foldr1 #-}+ foldl1 = T.foldl1+ {-# INLINE foldl1 #-}+ length = T.length+ {-# INLINE length #-}+ elem c = T.isInfixOf (T.singleton c) -- there are rewrite rules for this+ {-# INLINE elem #-}+ maximum = T.maximum+ {-# INLINE maximum #-}+ minimum = T.minimum+ {-# INLINE minimum #-}+ all = T.all+ {-# INLINE all #-}+ any = T.any+ {-# INLINE any #-}+ find = T.find+ {-# INLINE find #-}+ head = fmap fst . T.uncons+ {-# INLINE head #-}++instance NontrivialContainer TL.Text where+ foldr = TL.foldr+ {-# INLINE foldr #-}+ foldl = TL.foldl+ {-# INLINE foldl #-}+ foldl' = TL.foldl'+ {-# INLINE foldl' #-}+ foldr1 = TL.foldr1+ {-# INLINE foldr1 #-}+ foldl1 = TL.foldl1+ {-# INLINE foldl1 #-}+ length = fromIntegral . TL.length+ {-# INLINE length #-}+ -- will be okay thanks to rewrite rules+ elem c s = TL.isInfixOf (TL.singleton c) s + {-# INLINE elem #-}+ maximum = TL.maximum+ {-# INLINE maximum #-}+ minimum = TL.minimum+ {-# INLINE minimum #-}+ all = TL.all+ {-# INLINE all #-}+ any = TL.any+ {-# INLINE any #-}+ find = TL.find+ {-# INLINE find #-}+ head = fmap fst . TL.uncons+ {-# INLINE head #-}++instance NontrivialContainer BS.ByteString where+ foldr = BS.foldr+ {-# INLINE foldr #-}+ foldl = BS.foldl+ {-# INLINE foldl #-}+ foldl' = BS.foldl'+ {-# INLINE foldl' #-}+ foldr1 = BS.foldr1+ {-# INLINE foldr1 #-}+ foldl1 = BS.foldl1+ {-# INLINE foldl1 #-}+ length = BS.length+ {-# INLINE length #-}+ elem = BS.elem+ {-# INLINE elem #-}+ maximum = BS.maximum+ {-# INLINE maximum #-}+ minimum = BS.minimum+ {-# INLINE minimum #-}+ all = BS.all+ {-# INLINE all #-}+ any = BS.any+ {-# INLINE any #-}+ find = BS.find+ {-# INLINE find #-}+ head = fmap fst . BS.uncons+ {-# INLINE head #-}++instance NontrivialContainer BSL.ByteString where+ foldr = BSL.foldr+ {-# INLINE foldr #-}+ foldl = BSL.foldl+ {-# INLINE foldl #-}+ foldl' = BSL.foldl'+ {-# INLINE foldl' #-}+ foldr1 = BSL.foldr1+ {-# INLINE foldr1 #-}+ foldl1 = BSL.foldl1+ {-# INLINE foldl1 #-}+ length = fromIntegral . BSL.length+ {-# INLINE length #-}+ elem = BSL.elem+ {-# INLINE elem #-}+ maximum = BSL.maximum+ {-# INLINE maximum #-}+ minimum = BSL.minimum+ {-# INLINE minimum #-}+ all = BSL.all+ {-# INLINE all #-}+ any = BSL.any+ {-# INLINE any #-}+ find = BSL.find+ {-# INLINE find #-}+ head = fmap fst . BSL.uncons+ {-# INLINE head #-}++instance NontrivialContainer IS.IntSet where+ foldr = IS.foldr+ {-# INLINE foldr #-}+ foldl = IS.foldl+ {-# INLINE foldl #-}+ foldl' = IS.foldl'+ {-# INLINE foldl' #-}+ length = IS.size+ {-# INLINE length #-}+ elem = IS.member+ {-# INLINE elem #-}+ maximum = IS.findMax+ {-# INLINE maximum #-}+ minimum = IS.findMin+ {-# INLINE minimum #-}+ head = fmap fst . IS.minView+ {-# INLINE head #-}++----------------------------------------------------------------------------+-- Derivative functions+----------------------------------------------------------------------------++sum :: (NontrivialContainer t, Num (Element t)) => t -> Element t+sum = foldl' (+) 0++product :: (NontrivialContainer t, Num (Element t)) => t -> Element t+product = foldl' (*) 1++traverse_+ :: (NontrivialContainer t, Applicative f)+ => (Element t -> f b) -> t -> f ()+traverse_ f = foldr ((*>) . f) (pure ())++for_+ :: (NontrivialContainer t, Applicative f)+ => t -> (Element t -> f b) -> f ()+for_ = flip traverse_+{-# INLINE for_ #-}++mapM_+ :: (NontrivialContainer t, Monad m)+ => (Element t -> m b) -> t -> m ()+mapM_ f= foldr ((>>) . f) (return ())++forM_+ :: (NontrivialContainer t, Monad m)+ => t -> (Element t -> m b) -> m ()+forM_ = flip mapM_+{-# INLINE forM_ #-}++sequenceA_+ :: (NontrivialContainer t, Applicative f, Element t ~ f a)+ => t -> f ()+sequenceA_ = foldr (*>) (pure ())++sequence_+ :: (NontrivialContainer t, Monad m, Element t ~ m a)+ => t -> m ()+sequence_ = foldr (>>) (return ())++asum+ :: (NontrivialContainer t, Alternative f, Element t ~ f a)+ => t -> f a+asum = foldr (<|>) empty+{-# INLINE asum #-}++----------------------------------------------------------------------------+-- Disallowed instances+----------------------------------------------------------------------------++#define DISALLOW_CONTAINER_8(t, z) \+ instance TypeError (Text "Do not use 'Foldable' methods on " :<>: Text z) => \+ Container (t) where { \+ toList = undefined; \+ null = undefined; } \++#define DISALLOW_NONTRIVIAL_CONTAINER_8(t, z) \+ instance TypeError (Text "Do not use 'Foldable' methods on " :<>: Text z) => \+ NontrivialContainer (t) where { \+ foldr = undefined; \+ foldl = undefined; \+ foldl' = undefined; \+ length = undefined; \+ elem = undefined; \+ maximum = undefined; \+ minimum = undefined; } \++#define DISALLOW_CONTAINER_7(t) \+ instance ForbiddenFoldable (t) => Container (t) where { \+ toList = undefined; \+ null = undefined; } \++#define DISALLOW_NONTRIVIAL_CONTAINER_7(t) \+ instance ForbiddenFoldable (t) => NontrivialContainer (t) where { \+ foldr = undefined; \+ foldl = undefined; \+ foldl' = undefined; \+ length = undefined; \+ elem = undefined; \+ maximum = undefined; \+ minimum = undefined; } \++#if __GLASGOW_HASKELL__ >= 800+DISALLOW_CONTAINER_8((a, b),"tuples")+DISALLOW_NONTRIVIAL_CONTAINER_8((a, b),"tuples")+DISALLOW_NONTRIVIAL_CONTAINER_8(Maybe a,"Maybe")+DISALLOW_NONTRIVIAL_CONTAINER_8(Identity a,"Identity")+DISALLOW_NONTRIVIAL_CONTAINER_8(Either a b,"Either")+#else+class ForbiddenFoldable a+DISALLOW_CONTAINER_7((a, b))+DISALLOW_NONTRIVIAL_CONTAINER_7((a, b))+DISALLOW_NONTRIVIAL_CONTAINER_7(Maybe a)+DISALLOW_NONTRIVIAL_CONTAINER_7(Identity a)+DISALLOW_NONTRIVIAL_CONTAINER_7(Either a b)+#endif++----------------------------------------------------------------------------+-- Utils+----------------------------------------------------------------------------++(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)+(#.) _f = coerce+{-# INLINE (#.) #-}
src/Conv.hs view
@@ -1,76 +1,97 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Safe #-} {-# LANGUAGE TypeSynonymInstances #-} module Conv- ( StringConv (..)- , toS- , toSL- , Leniency (..)+ ( ConvertUtf8 (..)+ , ToString (..)+ , ToLText (..)+ , ToText (..) ) where -import Data.ByteString.Char8 as B-import Data.ByteString.Lazy.Char8 as LB-import Data.Text as T-import Data.Text.Encoding as T-import Data.Text.Encoding.Error as T-import Data.Text.Lazy as LT-import Data.Text.Lazy.Encoding as LT+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Lazy.UTF8 as LBU+import qualified Data.ByteString.UTF8 as BU+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Encoding.Error as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT -import Base-import Control.Applicative (pure)-import Data.Eq (Eq (..))-import Data.Function (id, (.))-import Data.Ord (Ord (..))-import Data.String (String)+import Data.Either (Either)+import Data.Function (id, (.))+import Data.String (String)+import Functor ((<$>)) -data Leniency = Lenient | Strict- deriving (Eq,Show,Ord,Enum,Bounded)+class ConvertUtf8 a b where+ encodeUtf8 :: a -> b+ decodeUtf8 :: b -> a+ decodeUtf8Strict :: b -> Either T.UnicodeException a -class StringConv a b where- strConv :: Leniency -> a -> b+instance ConvertUtf8 String B.ByteString where+ encodeUtf8 = BU.fromString+ decodeUtf8 = BU.toString+ decodeUtf8Strict = (T.unpack <$>) . decodeUtf8Strict -toS :: StringConv a b => a -> b-toS = strConv Strict+instance ConvertUtf8 T.Text B.ByteString where+ encodeUtf8 = T.encodeUtf8+ decodeUtf8 = T.decodeUtf8With T.lenientDecode+ decodeUtf8Strict = T.decodeUtf8' -toSL :: StringConv a b => a -> b-toSL = strConv Lenient+instance ConvertUtf8 LT.Text B.ByteString where+ encodeUtf8 = LB.toStrict . encodeUtf8+ decodeUtf8 = LT.decodeUtf8With T.lenientDecode . LB.fromStrict+ decodeUtf8Strict = decodeUtf8Strict . LB.fromStrict -instance StringConv String String where strConv _ = id-instance StringConv String B.ByteString where strConv _ = B.pack-instance StringConv String LB.ByteString where strConv _ = LB.pack-instance StringConv String T.Text where strConv _ = T.pack-instance StringConv String LT.Text where strConv _ = LT.pack+instance ConvertUtf8 String LB.ByteString where+ encodeUtf8 = LBU.fromString+ decodeUtf8 = LBU.toString+ decodeUtf8Strict = (T.unpack <$>) . decodeUtf8Strict -instance StringConv B.ByteString String where strConv _ = B.unpack-instance StringConv B.ByteString B.ByteString where strConv _ = id-instance StringConv B.ByteString LB.ByteString where strConv _ = LB.fromChunks . pure-instance StringConv B.ByteString T.Text where strConv = decodeUtf8T-instance StringConv B.ByteString LT.Text where strConv l = strConv l . LB.fromChunks . pure+instance ConvertUtf8 T.Text LB.ByteString where+ encodeUtf8 = LB.fromStrict . T.encodeUtf8+ decodeUtf8 = decodeUtf8+ decodeUtf8Strict = T.decodeUtf8' . LB.toStrict -instance StringConv LB.ByteString String where strConv _ = LB.unpack-instance StringConv LB.ByteString B.ByteString where strConv _ = B.concat . LB.toChunks-instance StringConv LB.ByteString LB.ByteString where strConv _ = id-instance StringConv LB.ByteString T.Text where strConv l = decodeUtf8T l . strConv l-instance StringConv LB.ByteString LT.Text where strConv = decodeUtf8LT+instance ConvertUtf8 LT.Text LB.ByteString where+ encodeUtf8 = LT.encodeUtf8+ decodeUtf8 = LT.decodeUtf8With T.lenientDecode+ decodeUtf8Strict = LT.decodeUtf8' -instance StringConv T.Text String where strConv _ = T.unpack-instance StringConv T.Text B.ByteString where strConv _ = T.encodeUtf8-instance StringConv T.Text LB.ByteString where strConv l = strConv l . T.encodeUtf8-instance StringConv T.Text LT.Text where strConv _ = LT.fromStrict-instance StringConv T.Text T.Text where strConv _ = id+class ToText a where+ toText :: a -> T.Text -instance StringConv LT.Text String where strConv _ = LT.unpack-instance StringConv LT.Text T.Text where strConv _ = LT.toStrict-instance StringConv LT.Text LT.Text where strConv _ = id-instance StringConv LT.Text LB.ByteString where strConv _ = LT.encodeUtf8-instance StringConv LT.Text B.ByteString where strConv l = strConv l . LT.encodeUtf8+instance ToText String where+ toText = T.pack -decodeUtf8T :: Leniency -> B.ByteString -> T.Text-decodeUtf8T Lenient = T.decodeUtf8With T.lenientDecode-decodeUtf8T Strict = T.decodeUtf8With T.strictDecode+instance ToText T.Text where+ toText = id -decodeUtf8LT :: Leniency -> LB.ByteString -> LT.Text-decodeUtf8LT Lenient = LT.decodeUtf8With T.lenientDecode-decodeUtf8LT Strict = LT.decodeUtf8With T.strictDecode+instance ToText LT.Text where+ toText = LT.toStrict++class ToLText a where+ toLText :: a -> LT.Text++instance ToLText String where+ toLText = LT.pack++instance ToLText T.Text where+ toLText = LT.fromStrict++instance ToLText LT.Text where+ toLText = id++class ToString a where+ toString :: a -> String++instance ToString String where+ toString = id++instance ToString T.Text where+ toString = T.unpack++instance ToString LT.Text where+ toString = LT.unpack
src/Debug.hs view
@@ -1,5 +1,7 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-} module Debug ( undefined@@ -11,17 +13,25 @@ , traceShow , traceShowId , traceShowM- , notImplemented,+ , notImplemented+ , NotImplemented(..) ) where -import Control.Monad (Monad, return)-import Data.Text (Text, unpack)+import Control.Monad (Monad, return)+import Data.Text (Text, unpack) -import qualified Base as P-import Show (Print, putStrLn)+import Data.Data (Data)+import Data.Typeable (Typeable)+import GHC.Generics (Generic) -import System.IO.Unsafe (unsafePerformIO)+import Control.Monad.IO.Class (MonadIO) +import qualified Base as P+import qualified Prelude as P+import Show (Print, putStrLn)++import System.IO.Unsafe (unsafePerformIO)+ {-# WARNING trace "'trace' remains in code" #-} trace :: Print b => b -> a -> a trace string expr = unsafePerformIO (do@@ -29,7 +39,7 @@ return expr) {-# WARNING traceIO "'traceIO' remains in code" #-}-traceIO :: Print b => b -> a -> P.IO a+traceIO :: (Print b, MonadIO m) => b -> a -> m a traceIO string expr = do putStrLn string return expr@@ -61,6 +71,10 @@ {-# WARNING notImplemented "'notImplemented' remains in code" #-} notImplemented :: a notImplemented = P.error "Not implemented"++{-# 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')" #-} undefined :: a
+ src/Exceptions.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}++module Exceptions+ ( hush+ , 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 Data.Maybe (Maybe, maybe)++hush :: Alternative m => Either e a -> m a+hush (Left _) = empty+hush (Right x) = pure x++note :: (MonadError e m, Applicative m) => e -> Maybe a -> m a+note err = maybe (throwError err) pure++tryIO :: MonadIO m => IO a -> ExceptT IOException m a+tryIO = ExceptT . liftIO . Exception.try
src/Functor.hs view
@@ -4,22 +4,25 @@ module Functor ( Functor (..)+ , void , ($>) , (<$>)- , void ) where #if (__GLASGOW_HASKELL__ >= 710) import Data.Functor (Functor (..), void, ($>), (<$>)) #else+import Data.Function (flip, (.)) import Data.Functor (Functor (..), (<$>)) -import Data.Function (flip)- infixl 4 $> ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$)++-- TODO: define it properly to be able to export+(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)+(<<$>>) = fmap . fmap void :: Functor f => f a -> f () void x = () <$ x
+ src/Lifted.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Safe #-}++module Lifted+ ( -- * Text+ appendFile+ , getContents+ , getLine+ , interact+ , readFile+ , writeFile+ -- * IO+ , getArgs+ , openFile+ , exitWith+ , exitFailure+ , exitSuccess+ , 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 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+-- IO+import qualified System.Environment as XIO+import qualified System.Exit as XIO+import qualified System.IO as XIO (openFile)+-- ST+#if ( __GLASGOW_HASKELL__ >= 710 )+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+----------------------------------------------------------------------------++appendFile :: MonadIO m => FilePath -> Text -> m ()+appendFile a b = liftIO (XIO.appendFile a b)+{-# INLINABLE appendFile #-}++getContents :: MonadIO m => m Text+getContents = liftIO XIO.getContents+{-# INLINABLE getContents #-}++getLine :: MonadIO m => m Text+getLine = liftIO XIO.getLine+{-# INLINABLE getLine #-}++interact :: MonadIO m => (Text -> Text) -> m ()+interact a = liftIO (XIO.interact a)+{-# INLINABLE interact #-}++readFile :: MonadIO m => FilePath -> m Text+readFile a = liftIO (XIO.readFile a)+{-# INLINABLE readFile #-}++writeFile :: MonadIO m => FilePath -> Text -> m ()+writeFile a b = liftIO (XIO.writeFile a b)+{-# INLINABLE writeFile #-}++----------------------------------------------------------------------------+-- IO+----------------------------------------------------------------------------++getArgs :: MonadIO m => m [String]+getArgs = liftIO (XIO.getArgs)+{-# INLINABLE getArgs #-}++openFile :: MonadIO m => FilePath -> IOMode -> m Handle+openFile a b = liftIO (XIO.openFile a b)+{-# INLINABLE openFile #-}++-- 'withFile' can't be lifted into 'MonadIO', as it uses 'bracket'++exitWith :: MonadIO m => ExitCode -> m a+exitWith a = liftIO (XIO.exitWith a)+{-# INLINABLE exitWith #-}++exitFailure :: MonadIO m => m a+exitFailure = liftIO XIO.exitFailure+{-# INLINABLE exitFailure #-}++exitSuccess :: MonadIO m => m a+exitSuccess = liftIO XIO.exitSuccess+{-# INLINABLE exitSuccess #-}++-- 'die' is available since base-4.8, but it's more convenient to+-- redefine it instead of using CPP+die :: MonadIO m => String -> m ()+die err = liftIO (System.IO.hPutStrLn stderr err) >> exitFailure+{-# INLINABLE die #-}++----------------------------------------------------------------------------+-- ST+----------------------------------------------------------------------------++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 #-}+
src/List.hs view
@@ -2,23 +2,20 @@ {-# LANGUAGE Safe #-} module List- ( head- , ordNub+ ( ordNub , sortOn , list+ , unzip+ , unzip3+ , zip+ , zip3 ) where -import Control.Monad (return)-import Data.Foldable (Foldable, foldr) import Data.Function ((.)) import Data.Functor (fmap)-import Data.List (sortBy)-import Data.Maybe (Maybe (..))+import Data.List (sortBy, unzip, unzip3, zip, zip3) import Data.Ord (Ord, comparing) import qualified Data.Set as Set--head :: (Foldable f) => f a -> Maybe a-head = foldr (\x _ -> return x) Nothing sortOn :: (Ord o) => (a -> o) -> [a] -> [a] sortOn = sortBy . comparing
src/Monad.hs view
@@ -4,6 +4,7 @@ module Monad ( Monad ((>>=), return)+ , MonadFail (fail) , MonadPlus (..) , (=<<)@@ -28,6 +29,14 @@ , when , unless + , whenJust+ , whenJustM++ , allM+ , anyM+ , andM+ , orM+ , liftM , liftM2 , liftM3@@ -40,15 +49,28 @@ , (<$!>) ) where -import Base (seq)-import Data.List (concat)+import Base (IO, seq)+import Control.Applicative (Applicative)+import Data.Foldable (for_)+import Data.List (concat)+import Data.Maybe (Maybe (..), maybe)+import Prelude (Bool (..)) -#if (__GLASGOW_HASKELL__ >= 710)-import Control.Monad hiding ((<$!>))+#if __GLASGOW_HASKELL__ >= 710+import Control.Monad hiding (fail, (<$!>)) #else-import Control.Monad+import Control.Monad hiding (fail) #endif +#if __GLASGOW_HASKELL__ >= 800+import Control.Monad.Fail (MonadFail (..))+#else+import Prelude (String)+import qualified Prelude as P (fail)+import Text.ParserCombinators.ReadP+import Text.ParserCombinators.ReadPrec+#endif+ concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] concatMapM f xs = liftM concat (mapM f xs) @@ -70,3 +92,64 @@ let z = f x z `seq` return z {-# INLINE (<$!>) #-}++whenJust :: Applicative f => Maybe a -> (a -> f ()) -> f ()+whenJust = for_+{-# INLINE whenJust #-}++whenJustM :: Monad m => m (Maybe a) -> (a -> m ()) -> m ()+whenJustM mm f = maybe (return ()) f =<< mm+{-# INLINE whenJustM #-}++-- 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+ q <- p+ if q then andM ps else return False++orM :: (Monad m) => [m Bool] -> m Bool+orM [] = return False+orM (p:ps) = do+ q <- p+ if q then return True else orM ps++anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool+anyM _ [] = return False+anyM p (x:xs) = do+ q <- p x+ if q then return True else anyM p xs++allM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool+allM _ [] = return True+allM p (x:xs) = do+ q <- p x+ if q then allM p xs else return False++{-# SPECIALIZE andM :: [IO Bool] -> IO Bool #-}+{-# SPECIALIZE orM :: [IO Bool] -> IO Bool #-}+{-# SPECIALIZE anyM :: (a -> IO Bool) -> [a] -> IO Bool #-}+{-# SPECIALIZE allM :: (a -> IO Bool) -> [a] -> IO Bool #-}++-- Copied from 'fail' by Herbert Valerio Riedel (the library is under BSD3)++#if __GLASGOW_HASKELL__ < 800+class Monad m => MonadFail m where+ fail :: String -> m a++instance MonadFail Maybe where+ fail _ = Nothing++instance MonadFail [] where+ fail _ = []++instance MonadFail IO where+ fail = P.fail++instance MonadFail ReadPrec where+ fail = P.fail -- = P (\_ -> fail s)++instance MonadFail ReadP where+ fail = P.fail+#endif
− src/Semiring.hs
@@ -1,19 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE Safe #-}--module Semiring- ( Semiring(..)- , zero- ) where--import Data.Monoid---- | Alias for 'mempty'-zero :: Monoid m => m-zero = mempty--class Monoid m => Semiring m where- {-# MINIMAL one, (<.>) #-}-- one :: m- (<.>) :: m -> m -> m
src/Show.hs view
@@ -9,6 +9,8 @@ ( Print (..) , putText , putLText+ , putByteString+ , putLByteString ) where import qualified Base@@ -57,3 +59,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 () #-}
src/Universum.hs view
@@ -11,6 +11,9 @@ module X , module Base + -- * Useful classes+ , Buildable+ -- * Useful standard unclassifed functions , identity , map@@ -18,10 +21,13 @@ , uncons , unsnoc , applyN+ , pretty+ , prettyL , print- , throwIO- , throwTo , foreach+ , pass+ , guarded+ , guardedA , show -- * Convenient type aliases@@ -31,10 +37,12 @@ import Applicative as X import Bool as X+import Containers as X import Conv as X import Debug as X import Either as X import Functor as X+import Lifted as X import List as X import Monad as X import Panic as X@@ -47,7 +55,7 @@ -- Used for 'show', not exported. import Data.String (String)-import Data.String as X (IsString)+import Data.String as X (IsString (..)) -- Maybe'ized version of partial functions import Safe as X (atDef, atMay, foldl1May, foldr1May,@@ -62,15 +70,18 @@ -- Base typeclasses import Data.Eq as X-import Data.Foldable as X hiding (foldl1, foldr1)+import Data.Foldable as X (Foldable, concat, concatMap, foldlM,+ foldrM, maximumBy, minimumBy) import Data.Functor.Identity as X import Data.Ord as X import Data.Traversable as X hiding (for)-import Semiring as X #if ( __GLASGOW_HASKELL__ >= 800 )-import Data.Monoid as X hiding ((<>))-import Data.Semigroup as X (Semigroup (..))+import Data.Monoid as X+import Data.Semigroup as X (Option (..), Semigroup (sconcat, stimes),+ WrappedMonoid, cycle1, mtimesDefault,+ stimesIdempotent, stimesIdempotentMonoid,+ stimesMonoid) #else import Data.Monoid as X #endif@@ -94,6 +105,7 @@ zipWith) import Data.Tuple as X +import Data.Hashable as X (Hashable) import Data.HashMap.Strict as X (HashMap) import Data.HashSet as X (HashSet) import Data.IntMap.Strict as X (IntMap)@@ -109,6 +121,9 @@ #endif -- Monad transformers+import Control.Monad.Catch as X (MonadCatch (catch), MonadMask (..),+ MonadThrow (throwM), bracket, bracket_,+ catchAll, finally) import Control.Monad.State as X (MonadState, State, StateT, evalState, evalStateT, execState, execStateT, gets, modify, runState, runStateT, state,@@ -117,9 +132,6 @@ import Control.Monad.Reader as X (MonadReader, Reader, ReaderT, ask, asks, local, reader, runReader, runReaderT) -import Control.Monad.Except as X (Except, ExceptT, MonadError, catchError,- runExcept, runExceptT, throwError)- import Control.Monad.Trans as X (MonadIO, lift, liftIO) -- Base types@@ -137,40 +149,41 @@ -- Generics import GHC.Generics as X (Generic) +-- Buildable+import Data.Text.Buildable (Buildable (build))+import Data.Text.Lazy.Builder (toLazyText)+ -- ByteString import Data.ByteString as X (ByteString) import qualified Data.ByteString.Lazy -- Text-import Data.Text as X (Text)+import Data.Text as X (Text, lines, unlines, unwords, words) import qualified Data.Text.Lazy -import Data.Text.IO as X (appendFile, getContents, getLine,- interact, readFile, writeFile)- import Data.Text.Lazy as X (fromStrict, toStrict) -import Data.Text.Encoding as X (decodeUtf8, decodeUtf8', decodeUtf8With,- encodeUtf8)+import Data.Text.Encoding as X (decodeUtf8', decodeUtf8With) -- IO-import System.Environment as X (getArgs)-import System.Exit as X-import System.IO as X (FilePath, Handle, IOMode (..), openFile,- stderr, stdin, stdout, withFile)+import System.Exit as X hiding (die, exitFailure, exitSuccess,+ exitWith)+import System.IO as X (FilePath, Handle, IOMode (..), stderr,+ stdin, stdout, withFile) -- ST-import Control.Monad.ST as X+import Control.Monad.ST as X hiding (stToIO) -- Concurrency and Parallelism-import Control.Exception as X hiding (assert, displayException, throw,- throwIO, throwTo)--import qualified Control.Exception+import Control.Exception as X (Exception, SomeException (..)) -import Control.Concurrent as X hiding (throwTo)+import Control.Concurrent as X hiding (ThreadId, getNumCapabilities,+ isCurrentThreadBound, killThread,+ mkWeakThreadId, myThreadId,+ setNumCapabilities, threadCapability,+ throwTo) import Control.Concurrent.Async as X hiding (wait)-import Control.Monad.STM as X+import Control.Monad.STM as X hiding (atomically) import Foreign.Storable as X (Storable) @@ -209,19 +222,29 @@ print :: (X.MonadIO m, PBase.Show a) => a -> m () print = liftIO . PBase.print -throwIO :: (X.MonadIO m, Exception e) => e -> m a-throwIO = liftIO . Control.Exception.throwIO--throwTo :: (X.MonadIO m, Exception e) => ThreadId -> e -> m ()-throwTo tid e = liftIO (Control.Exception.throwTo tid e)- foreach :: Functor f => f a -> (a -> b) -> f b foreach = flip fmap -show :: (Show a, StringConv String b) => a -> b-show x = toS (PBase.show x)+pass :: Applicative f => f ()+pass = pure ()++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 #-} {-# SPECIALIZE show :: Show a => a -> LText #-} {-# SPECIALIZE show :: Show a => a -> ByteString #-} {-# SPECIALIZE show :: Show a => a -> LByteString #-} {-# SPECIALIZE show :: Show a => a -> String #-}++-- | Functions to show pretty output for buildable data types.+pretty :: Buildable a => a -> Text+pretty = X.toStrict . prettyL++prettyL :: Buildable a => a -> LText+prettyL = toLazyText . build
universum.cabal view
@@ -1,7 +1,7 @@ name: universum-version: 0.1.8-synopsis: A sensible set of defaults for writing custom Preludes.-description: A sensible set of defaults for writing custom Preludes.+version: 0.1.12+synopsis: Custom prelude used in Serokell+description: Custom prelude used in Serokell homepage: https://github.com/serokell/universum license: MIT license-file: LICENSE@@ -10,22 +10,16 @@ copyright: 2016-2016 Stephen Diehl, 2016-2016 Serokell category: Prelude build-type: Simple+extra-source-files:+ CHANGES.md cabal-version: >=1.10 tested-with:- GHC == 7.6.1,- GHC == 7.6.2,- GHC == 7.6.3,- GHC == 7.8.1,- GHC == 7.8.2,- GHC == 7.8.3,- GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2,- GHC == 7.10.3+ GHC == 7.10.3,+ GHC == 8.0.1 Bug-Reports: https://github.com/serokell/universum/issues -description:- A sensible set of defaults for writing custom Preludes. Source-Repository head type: git location: git@github.com:serokell/universum.git@@ -44,9 +38,11 @@ Conv Either Functor- Semiring Bifunctor+ Containers+ Exceptions Panic+ Lifted default-extensions: NoImplicitPrelude@@ -62,11 +58,15 @@ bytestring >= 0.10 && <0.11, containers >= 0.5 && <0.6, deepseq >= 1.3 && <1.5,+ exceptions, ghc-prim >= 0.3 && <0.6,+ hashable, mtl >= 2.1 && <2.3, safe >= 0.3 && <0.4, stm >= 2.4 && <2.5, text >= 1.2 && <1.3,+ utf8-string >= 1.0 && <1.1,+ text-format, transformers >= 0.4 && <0.6, unordered-containers