classy-prelude-0.10.1: A typeclass-based Prelude.

Safe HaskellNone

ClassyPrelude

Contents

Synopsis

CorePrelude

undefined :: aSource

Deprecated: It is highly recommended that you either avoid partial functions or provide meaningful error messages

We define our own undefined which is marked as deprecated. This makes it useful to use during development, but let's you more easily getting notification if you accidentally ship partial code in production.

The classy prelude recommendation for when you need to really have a partial function in production is to use error with a very descriptive message so that, in case an exception is thrown, you get more information than Prelude.undefined.

Since 0.5.5

Standard

Monoid

(++) :: Monoid m => m -> m -> mSource

Semigroup

class Semigroup a where

Methods

(<>) :: a -> a -> a

An associative operation.

 (a <> b) <> c = a <> (b <> c)

If a is also a Monoid we further require

 (<>) = mappend

sconcat :: NonEmpty a -> a

Reduce a non-empty list with <>

The default definition should be sufficient, but this can be overridden for efficiency.

times1p :: Whole n => n -> a -> a

Repeat a value (n + 1) times.

 times1p n a = a <> a <> ... <> a  -- using <> n times

The default definition uses peasant multiplication, exploiting associativity to only require O(log n) uses of <>.

See also timesN.

Instances

Semigroup Ordering 
Semigroup () 
Semigroup IntSet 
Semigroup Text 
Semigroup ByteString 
Semigroup Text 
Semigroup ByteString 
Semigroup Any 
Semigroup All 
Semigroup [a] 
Semigroup (Seq a) 
Semigroup (IntMap v) 
Ord a => Semigroup (Set a) 
Semigroup (Vector a) 
(Hashable a, Eq a) => Semigroup (HashSet a) 
Semigroup a => Semigroup (Maybe a) 
Semigroup (First a) 
Semigroup (Last a) 
Num a => Semigroup (Sum a) 
Num a => Semigroup (Product a) 
Semigroup (Endo a) 
Semigroup a => Semigroup (Dual a) 
Semigroup (DList a) 
Ord a => Semigroup (Min a) 
Ord a => Semigroup (Max a) 
Semigroup (First a) 
Semigroup (Last a) 
Monoid m => Semigroup (WrappedMonoid m) 
Semigroup a => Semigroup (Option a) 
Semigroup (NonEmpty a) 
Unbox a => Semigroup (Vector a) 
Storable a => Semigroup (Vector a) 
Prim a => Semigroup (Vector a) 
Semigroup b => Semigroup (a -> b) 
Semigroup (Either a b) 
(Semigroup a, Semigroup b) => Semigroup (a, b) 
Ord k => Semigroup (Map k v) 
(Hashable k, Eq k) => Semigroup (HashMap k a) 
Semigroup a => Semigroup (Const a b) 
Apply f => Semigroup (Act f a) 
GrowingAppend mono => Semigroup (MinLen nat mono) 
(Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) 
(Semigroup a, Semigroup b, Semigroup c, Semigroup d) => Semigroup (a, b, c, d) 
(Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) => Semigroup (a, b, c, d, e) 

data WrappedMonoid m

Provide a Semigroup for an arbitrary Monoid.

Instances

Typeable1 WrappedMonoid 
Bounded a => Bounded (WrappedMonoid a) 
Enum a => Enum (WrappedMonoid a) 
Eq m => Eq (WrappedMonoid m) 
Data m => Data (WrappedMonoid m) 
Ord m => Ord (WrappedMonoid m) 
Read m => Read (WrappedMonoid m) 
Show m => Show (WrappedMonoid m) 
Generic (WrappedMonoid m) 
Monoid m => Monoid (WrappedMonoid m) 
Hashable a => Hashable (WrappedMonoid a) 
Monoid m => Semigroup (WrappedMonoid m) 
NFData m => NFData (WrappedMonoid m) 

Monad

whenM :: Monad m => m Bool -> m () -> m ()Source

Only perform the action if the predicate returns True.

Since 0.9.2

unlessM :: Monad m => m Bool -> m () -> m ()Source

Only perform the action if the predicate returns False.

Since 0.9.2

Mutable references

atomically :: MonadIO m => STM a -> m aSource

Generalized version of atomically.

alwaysSTM :: STM Bool -> STM ()Source

Synonym for always.

retrySTM :: STM aSource

Synonym for retry.

orElseSTM :: STM a -> STM a -> STM aSource

Synonym for orElse.

checkSTM :: Bool -> STM ()Source

Synonym for check.

Primitive (exported since 0.9.4)

class Monad m => PrimMonad m

Class of primitive state-transformer monads

Associated Types

type PrimState m1 :: *

State token type

Instances

type family PrimState m1 :: *

State token type

primToPrim :: (PrimMonad m1, PrimMonad m2, ~ * (PrimState m1) (PrimState m2)) => m1 a -> m2 a

Convert a PrimMonad to another monad with the same state token.

primToIO :: (PrimMonad m, ~ * (PrimState m) RealWorld) => m a -> IO a

Convert a PrimMonad with a RealWorld state token to IO

primToST :: PrimMonad m => m a -> ST (PrimState m) a

Convert a PrimMonad to ST

class Prim a

Class of types supporting primitive array operations

Debugging

trace :: String -> a -> a

traceShow :: Show a => a -> b -> b

traceId :: String -> StringSource

Since 0.5.9

traceM :: Monad m => String -> m ()Source

Since 0.5.9

traceShowId :: Show a => a -> aSource

Since 0.5.9

traceShowM :: (Show a, Monad m) => a -> m ()Source

Since 0.5.9

assert :: Bool -> a -> a

Time (since 0.6.1)

defaultTimeLocale :: TimeLocale

Generics (since 0.8.1)

class Generic a

Instances

Generic Bool 
Generic Char 
Generic Double 
Generic Float 
Generic Int 
Generic Ordering 
Generic () 
Generic [a] 
Generic (Maybe a) 
Generic (Min a) 
Generic (Max a) 
Generic (First a) 
Generic (Last a) 
Generic (WrappedMonoid m) 
Generic (Option a) 
Generic (NonEmpty a) 
Generic (Either a b) 
Generic (a, b) 
Generic (a, b, c) 
Generic (a, b, c, d) 
Generic (a, b, c, d, e) 
Generic (a, b, c, d, e, f) 
Generic (a, b, c, d, e, f, g) 

Transformers (since 0.9.4)

class Monad m => MonadReader r m | m -> r where

See examples in Control.Monad.Reader. Note, the partially applied function type (->) r is a simple reader monad. See the instance declaration below.

Methods

ask :: m r

Retrieves the monad environment.

Instances

MonadReader r m => MonadReader r (MaybeT m) 
MonadReader r m => MonadReader r (ListT m) 
MonadReader r m => MonadReader r (IdentityT m) 
MonadReader r ((->) r) 
(Monoid w, MonadReader r m) => MonadReader r (WriterT w m) 
(Monoid w, MonadReader r m) => MonadReader r (WriterT w m) 
MonadReader r m => MonadReader r (StateT s m) 
MonadReader r m => MonadReader r (StateT s m) 
Monad m => MonadReader r (ReaderT r m) 
MonadReader r m => MonadReader r (ExceptT e m) 
(Error e, MonadReader r m) => MonadReader r (ErrorT e m) 
MonadReader r' m => MonadReader r' (ContT r m) 
(Monad m, Monoid w) => MonadReader r (RWST r w s m) 
(Monad m, Monoid w) => MonadReader r (RWST r w s m) 

ask :: MonadReader r m => m r

Retrieves the monad environment.

newtype ReaderT r m a

The reader monad transformer, which adds a read-only environment to the given monad.

The return function ignores the environment, while >>= passes the inherited environment to both subcomputations.

Constructors

ReaderT 

Fields

runReaderT :: r -> m a
 

Instances

MonadBaseControl b m => MonadBaseControl b (ReaderT r m) 
Monad m => MonadReader r (ReaderT r m) 
MonadTrans (ReaderT r) 
MonadTransControl (ReaderT r) 
Monad m => Monad (ReaderT r m) 
Functor m => Functor (ReaderT r m) 
MonadFix m => MonadFix (ReaderT r m) 
MonadPlus m => MonadPlus (ReaderT r m) 
Applicative m => Applicative (ReaderT r m) 
MonadIO m => MonadIO (ReaderT r m) 
Zip m => Zip (ReaderT e m) 
MonadThrow m => MonadThrow (ReaderT r m) 
MonadCatch m => MonadCatch (ReaderT r m) 
MonadMask m => MonadMask (ReaderT r m) 
Alternative m => Alternative (ReaderT r m) 
Keyed m => Keyed (ReaderT e m) 
Zip m => Zip (ReaderT e m) 
ZipWithKey m => ZipWithKey (ReaderT e m) 
Indexable m => Indexable (ReaderT e m) 
Lookup m => Lookup (ReaderT e m) 
Functor m => MonoFunctor (ReaderT r m a) 

type Reader r = ReaderT r Identity

The parameterizable reader monad.

Computations are functions of a shared environment.

The return function ignores the environment, while >>= passes the inherited environment to both subcomputations.

Poly hierarchy

Bifunctor (since 0.10.0)

Mono hierarchy

I/O

Non-standard

List-like classes

map :: Functor f => (a -> b) -> f a -> f bSource

concatMap :: (Monoid m, MonoFoldable c) => (Element c -> m) -> c -> mSource

pack :: IsSequence c => [Element c] -> cSource

repack :: (MonoFoldable a, IsSequence b, Element a ~ Element b) => a -> bSource

Repack from one type to another, dropping to a list in the middle.

repack = pack . unpack.

mapM :: Traversable t => forall a m b. Monad m => (a -> m b) -> t a -> m (t b)

mapM_ :: (Monad m, MonoFoldable c) => (Element c -> m ()) -> c -> m ()Source

forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)

forM_ :: (Monad m, MonoFoldable c) => c -> (Element c -> m ()) -> m ()Source

any :: MonoFoldable c => (Element c -> Bool) -> c -> BoolSource

all :: MonoFoldable c => (Element c -> Bool) -> c -> BoolSource

and :: (MonoFoldable mono, Element mono ~ Bool) => mono -> BoolSource

Since 0.9.2

or :: (MonoFoldable mono, Element mono ~ Bool) => mono -> BoolSource

Since 0.9.2

foldl' :: MonoFoldable c => (a -> Element c -> a) -> a -> c -> aSource

foldr :: MonoFoldable c => (Element c -> b -> b) -> b -> c -> bSource

foldM :: (Monad m, MonoFoldable c) => (a -> Element c -> m a) -> a -> c -> m aSource

readMay :: (Element c ~ Char, MonoFoldable c, Read a) => c -> Maybe aSource

zip :: Zip f => forall a b. f a -> f b -> f (a, b)

zip3 :: Zip3 f => forall a b c. f a -> f b -> f c -> f (a, b, c)

zip4 :: Zip4 f => forall a b c d. f a -> f b -> f c -> f d -> f (a, b, c, d)

zip5 :: Zip5 f => forall a b c d e. f a -> f b -> f c -> f d -> f e -> f (a, b, c, d, e)

zip6 :: Zip6 f => forall a b c d e g. f a -> f b -> f c -> f d -> f e -> f g -> f (a, b, c, d, e, g)

zip7 :: Zip7 f => forall a b c d e g h. f a -> f b -> f c -> f d -> f e -> f g -> f h -> f (a, b, c, d, e, g, h)

unzip :: Zip f => forall a b. f (a, b) -> (f a, f b)

unzip3 :: Zip3 f => forall a b c. f (a, b, c) -> (f a, f b, f c)

unzip4 :: Zip4 f => forall a b c d. f (a, b, c, d) -> (f a, f b, f c, f d)

unzip5 :: Zip5 f => forall a b c d e. f (a, b, c, d, e) -> (f a, f b, f c, f d, f e)

unzip6 :: Zip6 f => forall a b c d e g. f (a, b, c, d, e, g) -> (f a, f b, f c, f d, f e, f g)

unzip7 :: Zip7 f => forall a b c d e g h. f (a, b, c, d, e, g, h) -> (f a, f b, f c, f d, f e, f g, f h)

zipWith :: Zip f => forall a b c. (a -> b -> c) -> f a -> f b -> f c

zipWith3 :: Zip3 f => forall a b c d. (a -> b -> c -> d) -> f a -> f b -> f c -> f d

zipWith4 :: Zip4 f => forall a b c d e. (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e

zipWith5 :: Zip5 f => forall a b c d e g. (a -> b -> c -> d -> e -> g) -> f a -> f b -> f c -> f d -> f e -> f g

zipWith6 :: Zip6 f => forall a b c d e g h. (a -> b -> c -> d -> e -> g -> h) -> f a -> f b -> f c -> f d -> f e -> f g -> f h

zipWith7 :: Zip7 f => forall a b c d e g h i. (a -> b -> c -> d -> e -> g -> h -> i) -> f a -> f b -> f c -> f d -> f e -> f g -> f h -> f i

hashNub :: (Hashable a, Eq a) => [a] -> [a]Source

same behavior as nub, but requires Hashable & Eq and is O(n log n) https:github.comnh2haskell-ordnub

ordNub :: Ord a => [a] -> [a]Source

same behavior as nub, but requires Ord and is O(n log n) https:github.comnh2haskell-ordnub

ordNubBy :: Ord b => (a -> b) -> (a -> a -> Bool) -> [a] -> [a]Source

same behavior as nubBy, but requires Ord and is O(n log n) https:github.comnh2haskell-ordnub

sortWith :: (Ord a, IsSequence c) => (Element c -> a) -> c -> cSource

Sort elements using the user supplied function to project something out of each element. Inspired by http://hackage.haskell.org/packages/archive/base/latest/doc/html/GHC-Exts.html#v:sortWith.

sum :: (MonoFoldable c, Num (Element c)) => c -> Element cSource

repeat :: a -> [a]

Set-like

(\\) :: SetContainer a => a -> a -> aSource

An alias for difference.

intersect :: SetContainer a => a -> a -> aSource

An alias for intersection.

Text-like

class Show a where

Methods

showsPrec :: Int -> a -> ShowS

show :: a -> String

showList :: [a] -> ShowS

Instances

Show Bool 
Show Char 
Show Double 
Show Float 
Show Int 
Show Int8 
Show Int16 
Show Int32 
Show Int64 
Show Integer 
Show Ordering 
Show Word 
Show Word8 
Show Word16 
Show Word32 
Show Word64 
Show () 
Show ThreadId 
Show IntSet 
Show FilePath 
Show Text 
Show ByteString 
Show Text 
Show ByteString 
Show Any 
Show All 
Show Root 
Show Handle 
Show GeneralCategory 
Show NewlineMode 
Show Newline 
Show BufferMode 
Show HandlePosn 
Show ZonedTime 
Show LocalTime 
Show UTCTime 
Show Day 
Show TimeLocale 
Show Fixity 
Show Associativity 
Show Arity 
Show Padding 
Show DateFormatSpec 
Show TypeRep 
Show TyCon 
Show ThreadStatus 
Show BlockReason 
Show HandleType 
Show a => Show [a] 
(Integral a, Show a) => Show (Ratio a) 
Show a => Show (IntMap a) 
Show a => Show (Set a) 
Show a => Show (Vector a) 
Show a => Show (HashSet a) 
Show a => Show (Maybe a) 
Show a => Show (First a) 
Show a => Show (Last a) 
Show a => Show (Sum a) 
Show a => Show (Product a) 
Show a => Show (Dual a) 
Show a => Show (Identity a) 
Show a => Show (Min a) 
Show a => Show (Max a) 
Show a => Show (First a) 
Show a => Show (Last a) 
Show m => Show (WrappedMonoid m) 
Show a => Show (Option a) 
Show a => Show (NonEmpty a) 
Show (Rules a) 
(Show a, Unbox a) => Show (Vector a) 
(Show a, Storable a) => Show (Vector a) 
(Show a, Prim a) => Show (Vector a) 
(Show a, Show b) => Show (Either a b) 
(Show a, Show b) => Show (a, b) 
(Show k, Show a) => Show (Map k a) 
(Show k, Show v) => Show (HashMap k v) 
(Show1 f, Show a) => Show (IdentityT f a) 
Show mono => Show (MinLen nat mono) 
(Show1 m, Show a) => Show (ListT m a) 
Show (ST s a) 
(Show1 m, Show a) => Show (MaybeT m a) 
(Show a, Show b, Show c) => Show (a, b, c) 
(Show e, Show1 m, Show a) => Show (ExceptT e m a) 
(Show e, Show1 m, Show a) => Show (ErrorT e m a) 
(Show w, Show1 m, Show a) => Show (WriterT w m a) 
(Show w, Show1 m, Show a) => Show (WriterT w m a) 
(Show a, Show b, Show c, Show d) => Show (a, b, c, d) 
(Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) 
(Show a, Show b, Show c, Show d, Show e, Show f) => Show (a, b, c, d, e, f) 
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) => Show (a, b, c, d, e, f, g) 
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) => Show (a, b, c, d, e, f, g, h) 
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i) => Show (a, b, c, d, e, f, g, h, i) 
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j) => Show (a, b, c, d, e, f, g, h, i, j) 
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k) => Show (a, b, c, d, e, f, g, h, i, j, k) 
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l) => Show (a, b, c, d, e, f, g, h, i, j, k, l) 
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m) => Show (a, b, c, d, e, f, g, h, i, j, k, l, m) 
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n) => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n) 
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, Show l, Show m, Show n, Show o) => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) 

tshow :: Show a => a -> TextSource

tlshow :: Show a => a -> LTextSource

Case conversion

charToLower :: Char -> CharSource

Convert a character to lower case.

Character-based case conversion is lossy in comparison to string-based toLower. For instance, 'İ' will be converted to 'i', instead of "i̇".

charToUpper :: Char -> CharSource

Convert a character to upper case.

Character-based case conversion is lossy in comparison to string-based toUpper. For instance, 'ß' won't be converted to "SS".

IO

class IsSequence a => IOData a where

Data which can be read to and from files and handles.

Note that, for lazy sequences, these operations may perform lazy I/O.

Methods

readFile :: MonadIO m => FilePath -> m a

writeFile :: MonadIO m => FilePath -> a -> m ()

getLine :: MonadIO m => m a

hGetContents :: MonadIO m => Handle -> m a

hGetLine :: MonadIO m => Handle -> m a

hPut :: MonadIO m => Handle -> a -> m ()

hPutStrLn :: MonadIO m => Handle -> a -> m ()

hGetChunk :: MonadIO m => Handle -> m a

Instances

IOData Text 
IOData ByteString 
IOData Text 
IOData ByteString 
~ * Char c => IOData [c] 

print :: (Show a, MonadIO m) => a -> m ()Source

hClose :: Handle -> IO ()

FilePath

fpToText :: FilePath -> TextSource

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

fpToTextWarn :: MonadIO m => FilePath -> m TextSource

Translates a FilePath to a Text Warns if there are non-unicode sequences in the file name

fpToTextEx :: FilePath -> TextSource

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.

Exceptions

class Monad m => MonadThrow m where

A class for monads in which exceptions may be thrown.

Instances should obey the following law:

 throwM e >> x = throwM e

In other words, throwing an exception short-circuits the rest of the monadic computation.

Methods

throwM :: Exception e => e -> m a

Throw an exception. Note that this throws when this action is run in the monad m, not when it is applied. It is a generalization of Control.Exception's throwIO.

Should satisfy the law:

 throwM e >> f = throwM e

Instances

MonadThrow [] 
MonadThrow IO 
MonadThrow Maybe 
~ * e SomeException => MonadThrow (Either e) 
MonadThrow m => MonadThrow (IdentityT m) 
MonadThrow m => MonadThrow (ListT m) 
MonadThrow m => MonadThrow (MaybeT m)

Throws exceptions into the base monad.

MonadThrow m => MonadThrow (ContT r m) 
MonadThrow m => MonadThrow (ReaderT r m) 
MonadThrow m => MonadThrow (StateT s m) 
MonadThrow m => MonadThrow (StateT s m) 
MonadThrow m => MonadThrow (ExceptT e m)

Throws exceptions into the base monad.

(Error e, MonadThrow m) => MonadThrow (ErrorT e m)

Throws exceptions into the base monad.

(MonadThrow m, Monoid w) => MonadThrow (WriterT w m) 
(MonadThrow m, Monoid w) => MonadThrow (WriterT w m) 
(MonadThrow m, Monoid w) => MonadThrow (RWST r w s m) 
(MonadThrow m, Monoid w) => MonadThrow (RWST r w s m) 

class MonadThrow m => MonadCatch m

A class for monads which allow exceptions to be caught, in particular exceptions which were thrown by throwM.

Instances should obey the following law:

 catch (throwM e) f = f e

Note that the ability to catch an exception does not guarantee that we can deal with all possible exit points from a computation. Some monads, such as continuation-based stacks, allow for more than just a success/failure strategy, and therefore catch cannot be used by those monads to properly implement a function such as finally. For more information, see MonadMask.

Instances

MonadCatch IO 
MonadCatch m => MonadCatch (IdentityT m) 
MonadCatch m => MonadCatch (ListT m) 
MonadCatch m => MonadCatch (MaybeT m)

Catches exceptions from the base monad.

MonadCatch m => MonadCatch (ReaderT r m) 
MonadCatch m => MonadCatch (StateT s m) 
MonadCatch m => MonadCatch (StateT s m) 
MonadCatch m => MonadCatch (ExceptT e m)

Catches exceptions from the base monad.

(Error e, MonadCatch m) => MonadCatch (ErrorT e m)

Catches exceptions from the base monad.

(MonadCatch m, Monoid w) => MonadCatch (WriterT w m) 
(MonadCatch m, Monoid w) => MonadCatch (WriterT w m) 
(MonadCatch m, Monoid w) => MonadCatch (RWST r w s m) 
(MonadCatch m, Monoid w) => MonadCatch (RWST r w s m) 

class MonadCatch m => MonadMask m

A class for monads which provide for the ability to account for all possible exit points from a computation, and to mask asynchronous exceptions. Continuation-based monads, and stacks such as ErrorT e IO which provide for multiple failure modes, are invalid instances of this class.

Note that this package does provide a MonadMask instance for CatchT. This instance is only valid if the base monad provides no ability to provide multiple exit. For example, IO or Either would be invalid base monads, but Reader or State would be acceptable.

Instances should ensure that, in the following code:

 f `finally` g

The action g is called regardless of what occurs within f, including async exceptions.

Instances

MonadMask IO 
MonadMask m => MonadMask (IdentityT m) 
MonadMask m => MonadMask (ReaderT r m) 
MonadMask m => MonadMask (StateT s m) 
MonadMask m => MonadMask (StateT s m) 
(MonadMask m, Monoid w) => MonadMask (WriterT w m) 
(MonadMask m, Monoid w) => MonadMask (WriterT w m) 
(MonadMask m, Monoid w) => MonadMask (RWST r w s m) 
(MonadMask m, Monoid w) => MonadMask (RWST r w s m) 

Force types

Helper functions for situations where type inferer gets confused.

asList :: [a] -> [a]Source

asMap :: Map k v -> Map k vSource

asSet :: Set a -> Set aSource