definitive-base-2.3: The base modules of the Definitive framework.

Safe HaskellNone
LanguageHaskell2010

Algebra.Core

Contents

Synopsis

Raw data

data Handle :: *

Haskell defines operations to read and write characters from and to files, represented by values of type Handle. Each value of this type is a handle: a record used by the Haskell run-time system to manage I/O with file system objects. A handle has at least the following properties:

  • whether it manages input or output or both;
  • whether it is open, closed or semi-closed;
  • whether the object is seekable;
  • whether buffering is disabled, or enabled on a line or block basis;
  • a buffer (whose length may be zero).

Most handles will also have a current I/O position indicating where the next input or output operation will occur. A handle is readable if it manages only input or both input and output; likewise, it is writable if it manages only output or both input and output. A handle is open when first allocated. Once it is closed it can no longer be used for either input or output, though an implementation cannot re-use its storage while references remain to it. Handles are in the Show and Eq classes. The string produced by showing a handle is system dependent; it should include enough information to identify the handle for debugging. A handle is equal according to == only to itself; no attempt is made to compare the internal state of different handles for equality.

stdin :: Handle

A handle managing input from the Haskell program's standard input channel.

stdout :: Handle

A handle managing output to the Haskell program's standard output channel.

stderr :: Handle

A handle managing output to the Haskell program's standard error channel.

Basic union and product types

type (:*:) a b = (a, b) Source

type (:+:) a b = Either a b Source

Basic group and ring structure

Classes

class Semigroup m where Source

The class of all types that have a binary operation. Note that the operation isn't necesarily commutative (in the case of lists, for example)

Minimal complete definition

Nothing

Methods

(+) :: m -> m -> m infixr 6 Source

Instances

Semigroup Bool 
Semigroup Double 
Semigroup Float 
Semigroup Int 
Semigroup Integer 
Semigroup Rational 
Semigroup () 
Semigroup Void 
Semigroup Bytes 
Semigroup Chunk 
Semigroup [a] 
Semigroup (Maybe a) 
Ord a => Semigroup (Set a) 
Storable a => Semigroup (Vector a) 
Semigroup (Interleave a) 
Ord a => Semigroup (OrdList a) 
Semigroup m => Semigroup (Dual m) 
Ord a => Semigroup (Min a) 
Ord a => Semigroup (Max a) 
Semigroup (Id a) 
Monoid a => Semigroup (Accum a) 
Semigroup (StrictEndo a) 
Ring a => Semigroup (Product a) 
Semigroup (Slices a) 
Semigroup (DeQue a) 
Semigroup b => Semigroup (a -> b) 
Ord k => Semigroup (Map k a) 
Category k => Semigroup (Endo k a) 
SubSemi b a => Semigroup ((:+:) a b) 
(Semigroup a, Semigroup b) => Semigroup ((:*:) a b) 
Ord k => Semigroup (Increasing k a) 
Semigroup a => Semigroup (Const a b) 
Semigroup (f a) => Semigroup (Backwards f a) 
(Applicative (Zip f), Semigroup a) => Semigroup (Zip f a) 
Applicative m => Semigroup (ListT m a) 
Semigroup (LogicT m a) 
(Ord a, Ord b) => Semigroup (Relation a b) 
(Ord a, Ord b) => Semigroup (Bimap a b) 
(Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) 
(Applicative f, Semigroup (g a)) => Semigroup ((:.:) f g a) 
Semigroup (f b a) => Semigroup (Flip f a b) 
(Semigroup (f a), Applicative g) => Semigroup (Compose' f g a) 
Semigroup (m (a, s, Void)) => Semigroup (StateT s m a) 
Semigroup (m (a, Void, Void)) => Semigroup (ReaderT r m a) 
Semigroup (m (a, Void, w)) => Semigroup (WriterT w m a) 
Semigroup (Queue push pop a) 
Applicative m => Semigroup (ProbT t m a) 
Semigroup (m (a, s, w)) => Semigroup (RWST r w s m a) 

class Semigroup m => Monoid m where Source

A monoid is a semigroup with a null element such that zero + a == a + zero == a

Minimal complete definition

Nothing

Methods

zero :: m Source

Instances

Monoid Bool 
Monoid Double 
Monoid Float 
Monoid Int 
Monoid Integer 
Monoid Rational 
Monoid () 
Monoid Void 
Monoid Bytes 
Monoid Chunk 
Monoid [a] 
Monoid (Maybe a) 
Ord a => Monoid (Set a) 
Storable a => Monoid (Vector a) 
Monoid (Interleave a) 
Ord a => Monoid (OrdList a) 
Monoid m => Monoid (Dual m) 
(Ord a, Bounded a) => Monoid (Min a) 
(Ord a, Bounded a) => Monoid (Max a) 
Monoid a => Monoid (Accum a) 
Ring a => Monoid (Product a) 
Monoid (Slices a) 
Monoid (DeQue a) 
Monoid b => Monoid (a -> b) 
Ord k => Monoid (Map k a) 
Category k => Monoid (Endo k a) 
(SubSemi b a, Monoid a) => Monoid ((:+:) a b) 
(Monoid a, Monoid b) => Monoid ((:*:) a b) 
Ord k => Monoid (Increasing k a) 
Monoid a => Monoid (Const a b) 
Monoid (f a) => Monoid (Backwards f a) 
(Applicative (Zip f), Monoid a) => Monoid (Zip f a) 
Applicative m => Monoid (ListT m a) 
Monoid (LogicT m a) 
(Ord a, Ord b) => Monoid (Relation a b) 
(Ord a, Ord b) => Monoid (Bimap a b) 
(Monoid a, Monoid b, Monoid c) => Monoid (a, b, c) 
(Applicative f, Monoid (g a)) => Monoid ((:.:) f g a) 
Monoid (f b a) => Monoid (Flip f a b) 
(Monoid (f a), Applicative g) => Monoid (Compose' f g a) 
Monoid (m (a, s, Void)) => Monoid (StateT s m a) 
Monoid (m (a, Void, Void)) => Monoid (ReaderT r m a) 
Monoid (m (a, Void, w)) => Monoid (WriterT w m a) 
Monoid (Queue push pop a) 
Applicative m => Monoid (ProbT t m a) 
Monoid (m (a, s, w)) => Monoid (RWST r w s m a) 

class Monoid m => Disjonctive m where Source

Minimal complete definition

Nothing

Methods

negate :: m -> m Source

(-) :: m -> m -> m Source

class Monoid m => Semiring m where Source

Minimal complete definition

Nothing

Methods

(*) :: m -> m -> m infixl 7 Source

Instances

Semiring Bool 
Semiring Double 
Semiring Float 
Semiring Int 
Semiring Integer 
Semiring Rational 
Monoid a => Semiring [a] 
Ord a => Semiring (Set a) 
Semiring m => Semiring (Dual m) 
(Ord a, Bounded a) => Semiring (Min a) 
(Ord a, Bounded a) => Semiring (Max a) 
Semiring b => Semiring (a -> b) 
(Ord k, Semigroup a) => Semiring (Map k a) 
(Semiring a, Semiring b) => Semiring ((:*:) a b) 
Semiring (f a) => Semiring (Backwards f a) 
Semigroup a => Semiring (LogicT m a) 
(Ord a, Ord b) => Semiring (Relation a b) 
(Ord a, Ord b, Semigroup a, Semigroup b) => Semiring (Bimap a b) 
Semiring (m (a, s, Void)) => Semiring (StateT s m a) 
Semiring (m (a, Void, Void)) => Semiring (ReaderT r m a) 
Semiring (m (a, Void, w)) => Semiring (WriterT w m a) 
Semiring (m (a, s, w)) => Semiring (RWST r w s m a) 

class Semiring m => Ring m where Source

Minimal complete definition

Nothing

Methods

one :: m Source

Instances

Ring Bool 
Ring Double 
Ring Float 
Ring Int 
Ring Integer 
Ring Rational 
Monoid a => Ring [a] 
Ring m => Ring (Dual m) 
(Ord a, Bounded a) => Ring (Min a) 
(Ord a, Bounded a) => Ring (Max a) 
Ring b => Ring (a -> b) 
(Ring a, Ring b) => Ring ((:*:) a b) 
Ring (f a) => Ring (Backwards f a) 
Monoid a => Ring (LogicT m a) 
Ring (m (a, s, Void)) => Ring (StateT s m a) 
Ring (m (a, Void, Void)) => Ring (ReaderT r m a) 
Ring (m (a, Void, w)) => Ring (WriterT w m a) 
Ring (m (a, s, w)) => Ring (RWST r w s m a) 

class (Ring m, Disjonctive m) => Invertible m where Source

Minimal complete definition

Nothing

Methods

recip :: m -> m Source

(/) :: m -> m -> m Source

class (Semigroup a, Semigroup b) => SubSemi a b where Source

Methods

cast :: b -> a Source

Instances

Semigroup a => SubSemi a a 
Monoid a => SubSemi a Void 
Monoid a => SubSemi a () 
(Foldable f, Semigroup (f a), Ring n) => SubSemi n (f a) 

class Unit f where Source

Methods

pure :: a -> f a Source

Instances

Unit [] 
Unit IO 
Unit Maybe 
Unit Tree 
Unit Interleave 
Unit Range 
Unit OrdList 
Unit Id 
Unit Accum 
Unit Strict 
Unit TimeVal 
Unit ((->) b) 
Unit (Either a) 
Monoid w => Unit ((,) w) 
Monoid k => Unit (Assoc k) 
Monoid k => Unit (Increasing k) 
Monoid a => Unit (Const a) 
Unit f => Unit (Backwards f) 
Unit (Zip []) 
Ord k => Unit (Zip (Map k)) 
Unit (Zip Tree) 
Unit (ContT m) 
Unit m => Unit (StrictT m) 
Unit m => Unit (MaybeT m) 
Unit m => Unit (TreeT m) 
Unit m => Unit (ListT m) 
Unit m => Unit (Cofree m) 
Unit (Free f) 
Unit (LogicT m) 
(Unit f, Unit g) => Unit ((:**:) f g) 
(Unit f, Unit g) => Unit ((:.:) f g) 
(Unit f, Unit g) => Unit (Compose' f g) 
Unit m => Unit (StateT s m) 
Unit m => Unit (ReaderT r m) 
(Unit m, Monoid w) => Unit (WriterT w m) 
Unit m => Unit (EitherT e m) 
(Unit m, Ring t) => Unit (ProbT t m) 
(Unit m, Monoid w) => Unit (CounterT w acc m) 
(Unit f, Monoid w) => Unit (RWST r w s f) 

Common monoids

Control monoids

newtype Endo k a Source

A monoid on category endomorphisms under composition

Constructors

Endo 

Fields

runEndo :: k a a
 

Instances

Category k => Monoid (Endo k a) 
Category k => Semigroup (Endo k a) 
Isomorphic (k a a) (k b b) (Endo k a) (Endo k b) 

newtype StrictEndo a Source

Constructors

StrictEndo 

Fields

runStrictEndo :: a -> a
 

Instances

Meta-monoids

newtype Dual m Source

The dual of a monoid is the same as the original, with arguments reversed

Constructors

Dual 

Fields

getDual :: m
 

Instances

Isomorphic a b (Dual a) (Dual b) 
Ring m => Ring (Dual m) 
Semiring m => Semiring (Dual m) 
Monoid m => Monoid (Dual m) 
Semigroup m => Semigroup (Dual m) 

newtype Product a Source

The Product monoid

Constructors

Product 

Fields

getProduct :: a
 

Instances

Isomorphic a b (Product a) (Product b) 
Eq a => Eq (Product a) 
Ord a => Ord (Product a) 
Show a => Show (Product a) 
Ring a => Monoid (Product a) 
Ring a => Semigroup (Product a) 
(Ring t, Monad m) => MonadWriter (Product t) (ProbT t m) 

Accumulating monoids

newtype OrdList a Source

An ordered list. The semigroup instance merges two lists so that the result remains in ascending order.

Constructors

OrdList 

Fields

getOrdList :: [a]
 

Instances

newtype Accum a Source

A monoid on Maybes, where the sum is the leftmost non-Nothing value.

Constructors

Accum 

Fields

getAccum :: Maybe a
 

Instances

newtype Max a Source

The Max monoid, where (+) =~ max

Constructors

Max 

Fields

getMax :: a
 

Instances

Isomorphic a b (Max a) (Max b) 
Bounded a => Bounded (Max a) 
Eq a => Eq (Max a) 
Ord a => Ord (Max a) 
Show a => Show (Max a) 
(Ord a, Bounded a) => Ring (Max a) 
(Ord a, Bounded a) => Semiring (Max a) 
(Ord a, Bounded a) => Monoid (Max a) 
Ord a => Semigroup (Max a) 

newtype Min a Source

The Min monoid, where (+) =~ min

Constructors

Min 

Fields

getMin :: a
 

Instances

Bounded a => Bounded (Min a) 
Eq a => Eq (Min a) 
Ord a => Ord (Min a) 
Show a => Show (Min a) 
(Ord a, Bounded a) => Ring (Min a) 
(Ord a, Bounded a) => Semiring (Min a) 
(Ord a, Bounded a) => Monoid (Min a) 
Ord a => Semigroup (Min a) 

newtype Id a Source

The Identity Functor

Constructors

Id 

Fields

getId :: a
 

Fundamental control operations

class Deductive k where Source

Methods

(.) :: k b c -> k a b -> k a c infixr 9 Source

Instances

class Deductive k => Category k where Source

Methods

id :: k a a Source

Instances

(<<<) :: Category k => k b c -> k a b -> k a c infixr 1 Source

(>>>) :: Category k => k a b -> k b c -> k a c infixr 1 Source

(+++) :: Split k => (a -> k c c) -> (b -> k d d) -> (a :+: b) -> k (c, d) (c, d) infixr 1 Source

Splitting and Choosing

class Category k => Choice k where Source

Methods

(<|>) :: k a c -> k b c -> k (a :+: b) c infixr 1 Source

Instances

Choice (->) 
Monad m => Choice (Kleisli m) 
Monad m => Choice (StateA m) 
Arrow k => Choice (ListA k) 

class Category k => Split k where Source

Methods

(<#>) :: k a c -> k b d -> k (a, b) (c, d) infixr 2 Source

Instances

Split (->) 
Monad m => Split (Kleisli m) 
Monad m => Split (StateA m) 
Arrow k => Split (ListA k) 

Expression-level type constraints

type Constraint a = a -> a Source

Miscellaneous functions

const :: Unit m => a -> m a Source

(&) :: a -> (a -> b) -> b infixl 0 Source

($^) :: (a -> b -> c) -> b -> a -> c Source

is :: a -> (a -> Bool) -> Bool Source

fix :: (a -> a) -> a Source

first :: Split k => k a b -> k (a, c) (b, c) Source

second :: Split k => k a b -> k (c, a) (c, b) Source

ifThenElse :: Bool -> a -> a -> a Source

bool :: a -> a -> Bool -> a Source

extreme :: Bounded a => Bool -> a Source

guard :: (Unit m, Monoid (m ())) => Bool -> m () Source

unit :: Unit m => m () Source

when :: Unit m => Bool -> m () -> m () Source

unless :: Unit m => Bool -> m () -> m () Source

tailSafe :: [a] -> [a] Source

headDef :: a -> [a] -> a Source

fromMaybe :: a -> Maybe a -> a Source

rmod :: (RealFloat m, Invertible m) => m -> m -> m infixl 7 Source

inside :: Ord t => t -> t -> t -> Bool Source

swap :: (a, b) -> (b, a) Source

Lazily ordering values

comparing :: Ord a => (b -> a) -> b -> b -> Ordering

comparing p x y = compare (p x) (p y)

Useful combinator for use in conjunction with the xxxBy family of functions from Data.List, for example:

  ... sortBy (comparing fst) ...

inOrder :: Ord t => t -> t -> (t, t, Bool) Source

insertOrd :: Ord t => t -> [t] -> [t] Source

data Assoc k a Source

Constructors

Assoc k a 

Instances

Monoid k => Unit (Assoc k) 
Traversable (Assoc k) 
Foldable (Assoc k) 
Functor (Assoc k) 
Ord k => Eq (Assoc k a) 
Ord k => Ord (Assoc k a) 
(Show k, Show a) => Show (Assoc k a) 

assoc :: a -> Assoc a a Source

Ranges

newtype Range a Source

A range of shape (min,max) of ordered values.

Such ranges may be multiplied to create n-dimensional ranges for which equivalence means sharing an n-dimensional subrange. They may be very useful in creating Maps that partition an n-dimensional space in which we may query for subrange membership with logarithmic complexity for any point P (a point is a subrange of volume 0, or `(pure x0,...,pure xn) where (x0,..,xn) = p`).

Indeed, a point is equivalent to a range iff it belongs to that range.

Constructors

Range (a, a) 

Instances

Unit Range 
Ord a => Eq (Range a)

Range equivalence. Two ranges are equivalent iff they share a common subrange (equivalence in this case is not transitive, so beware of unintended consequences)

Ord a => Ord (Range a)

r < r' iff all values of r are below any value of r'

Parallel short-circuit evaluation

amb :: IO a -> IO a -> IO a Source

unamb :: a -> a -> a Source

The rest is imported from the Prelude

module Prelude

class IsString a where

Class for string-like datastructures; used by the overloaded string extension (-XOverloadedStrings in GHC).

Methods

fromString :: String -> a