mono-traversable-0.9.3: Type classes for mapping, folding, and traversing monomorphic containers

Safe HaskellNone
LanguageHaskell2010

Data.MinLen

Contents

Synopsis

Type level naturals

Peano numbers

Peano numbers are a simple way to represent natural numbers (0, 1, 2...) using only a Zero value and a successor function (Succ). Each application of Succ increases the number by 1, so Succ Zero is 1, Succ (Succ Zero) is 2, etc.

data Zero Source

Zero is the base value for the Peano numbers.

Constructors

Zero 

Instances

TypeNat Zero 
IsSequence mono => MonoComonad (MinLen (Succ Zero) mono)

oextract is head.

For oextend f, the new mono is populated by applying f to successive tails of the original mono.

For example, for MinLen (Succ Zero) [Int], or NonNull [Int]:

oextend f [1,2,3,4,5] = [ f [1, 2, 3, 4, 5]
                          , f [2, 3, 4, 5]
                          , f [3, 4, 5]
                          , f [4, 5]
                          , f [5]
                          ]

Meant to be a direct analogy to the instance for NonEmpty a.

MonoPointed mono => MonoPointed (MinLen (Succ Zero) mono) 
MonoPointed mono => MonoPointed (MinLen Zero mono) 
type MaxNat x Zero = x 
type MaxNat Zero y = y 
type AddNat Zero y = y 

data Succ nat Source

Succ represents the next number in the sequence of natural numbers.

It takes a nat (a natural number) as an argument.

Zero is a nat, allowing Succ Zero to represent 1.

Succ is also a nat, so it can be applied to itself, allowing Succ (Succ Zero) to represent 2, Succ (Succ (Succ Zero)) to represent 3, and so on.

Constructors

Succ nat 

Instances

TypeNat nat => TypeNat (Succ nat) 
IsSequence mono => MonoComonad (MinLen (Succ Zero) mono)

oextract is head.

For oextend f, the new mono is populated by applying f to successive tails of the original mono.

For example, for MinLen (Succ Zero) [Int], or NonNull [Int]:

oextend f [1,2,3,4,5] = [ f [1, 2, 3, 4, 5]
                          , f [2, 3, 4, 5]
                          , f [3, 4, 5]
                          , f [4, 5]
                          , f [5]
                          ]

Meant to be a direct analogy to the instance for NonEmpty a.

MonoPointed mono => MonoPointed (MinLen (Succ Zero) mono) 
type AddNat (Succ x) y = AddNat x (Succ y) 
type MaxNat (Succ x) (Succ y) = Succ (MaxNat x y) 

class TypeNat nat where Source

Type-level natural number utility typeclass

Methods

toValueNat :: Num i => nat -> i Source

Turn a type-level natural number into a number

> toValueNat Zero
0
> toValueNat (Succ (Succ (Succ Zero)))
3

typeNat :: nat Source

Get a data representation of a natural number type

> typeNat :: Succ (Succ Zero)
Succ (Succ Zero) -- Errors because Succ and Zero have no Show typeclass,
                 -- But this is what it would look like if it did.

Instances

TypeNat Zero 
TypeNat nat => TypeNat (Succ nat) 

type family AddNat x y Source

Adds two type-level naturals.

See the mlappend type signature for an example.

> :t typeNat :: AddNat (Succ (Succ Zero)) (Succ Zero)

typeNat :: AddNat (Succ (Succ Zero)) (Succ Zero)
  :: Succ (Succ (Succ Zero))

Instances

type AddNat Zero y = y 
type AddNat (Succ x) y = AddNat x (Succ y) 

type family MaxNat x y Source

Calculates the maximum of two type-level naturals.

See the mlunion type signature for an example.

> :t typeNat :: MaxNat (Succ (Succ Zero)) (Succ Zero)

typeNat :: MaxNat (Succ (Succ Zero)) (Succ Zero)
  :: Succ (Succ Zero)

Instances

type MaxNat x Zero = x 
type MaxNat Zero y = y 
type MaxNat (Succ x) (Succ y) = Succ (MaxNat x y) 

Minimum length newtype wrapper

data MinLen nat mono Source

A wrapper around a container which encodes its minimum length in the type system. This allows functions like head and maximum to be made safe without using Maybe.

The length, nat, is encoded as a Peano number, which starts with the Zero constructor and is made one larger with each application of Succ (Zero for 0, Succ Zero for 1, Succ (Succ Zero) for 2, etc.). Functions which require at least one element, then, are typed with Succ nat, where nat is either Zero or any number of applications of Succ:

head :: MonoTraversable mono => MinLen (Succ nat) mono -> Element mono

The length is also a phantom type, i.e. it is only used on the left hand side of the type and doesn't exist at runtime. Notice how Succ Zero isn't included in the printed output:

> toMinLen [1,2,3] :: Maybe (MinLen (Succ Zero) [Int])
Just (MinLen {unMinLen = [1,2,3]})

You can still use GHCI's :i command to see the phantom type information:

> let xs = mlcons 1 $ toMinLenZero []
> :i xs
xs :: Num t => MinLen (Succ Zero) [t]

Instances

Functor (MinLen nat) 
Eq mono => Eq (MinLen nat mono) 
(Data nat, Data mono) => Data (MinLen nat mono) 
Ord mono => Ord (MinLen nat mono) 
Read mono => Read (MinLen nat mono) 
Show mono => Show (MinLen nat mono) 
GrowingAppend mono => Semigroup (MinLen nat mono) 
IsSequence mono => MonoComonad (MinLen (Succ Zero) mono)

oextract is head.

For oextend f, the new mono is populated by applying f to successive tails of the original mono.

For example, for MinLen (Succ Zero) [Int], or NonNull [Int]:

oextend f [1,2,3,4,5] = [ f [1, 2, 3, 4, 5]
                          , f [2, 3, 4, 5]
                          , f [3, 4, 5]
                          , f [4, 5]
                          , f [5]
                          ]

Meant to be a direct analogy to the instance for NonEmpty a.

MonoPointed mono => MonoPointed (MinLen (Succ Zero) mono) 
MonoPointed mono => MonoPointed (MinLen Zero mono) 
MonoTraversable mono => MonoTraversable (MinLen nat mono) 
MonoFoldableOrd mono => MonoFoldableOrd (MinLen nat mono) 
MonoFoldableEq mono => MonoFoldableEq (MinLen nat mono) 
MonoFoldable mono => MonoFoldable (MinLen nat mono) 
MonoFunctor mono => MonoFunctor (MinLen nat mono) 
GrowingAppend mono => GrowingAppend (MinLen nat mono) 
SemiSequence seq => SemiSequence (MinLen nat seq) 
Typeable (* -> * -> *) MinLen 
type Element (MinLen nat mono) = Element mono 
type Index (MinLen nat seq) = Index seq 

unMinLen :: MinLen nat mono -> mono Source

Get the monomorphic container out of a MinLen wrapper.

toMinLenZero :: MonoFoldable mono => mono -> MinLen Zero mono Source

Types a container as having a minimum length of zero. This is useful when combined with other MinLen functions that increase the size of the container.

Examples

> 1 `mlcons` toMinLenZero []
MinLen {unMinLen = [1]}

toMinLen :: (MonoFoldable mono, TypeNat nat) => mono -> Maybe (MinLen nat mono) Source

Attempts to add a MinLen constraint to a monomorphic container.

Examples

> let xs = toMinLen [1,2,3] :: Maybe (MinLen (Succ Zero) [Int])
> xs
Just (MinLen {unMinLen = [1,2,3]})

> :i xs
xs :: Maybe (MinLen (Succ Zero) [Int])
> toMinLen [] :: Maybe (MinLen (Succ Zero) [Int])
Nothing

unsafeToMinLen :: mono -> MinLen nat mono Source

Unsafe

Although this function itself cannot cause a segfault, it breaks the safety guarantees of MinLen and can lead to a segfault when using otherwise safe functions.

Examples

> let xs = unsafeToMinLen [] :: MinLen (Succ Zero) [Int]
> olength xs
0
> head xs
*** Exception: Data.MonoTraversable.headEx: empty

mlcons :: IsSequence seq => Element seq -> MinLen nat seq -> MinLen (Succ nat) seq infixr 5 Source

Adds an element to the front of a list, increasing its minimum length by 1.

Examples

> let xs = unsafeToMinLen [1,2,3] :: MinLen (Succ Zero) [Int]
> 0 `mlcons` xs
MinLen {unMinLen = [0,1,2,3]}

mlappend :: IsSequence seq => MinLen x seq -> MinLen y seq -> MinLen (AddNat x y) seq Source

Concatenate two sequences, adding their minimum lengths together.

Examples

> let xs = unsafeToMinLen [1,2,3] :: MinLen (Succ Zero) [Int]
> xs `mlappend` xs
MinLen {unMinLen = [1,2,3,1,2,3]}

mlunion :: GrowingAppend mono => MinLen x mono -> MinLen y mono -> MinLen (MaxNat x y) mono Source

Joins two semigroups, keeping the larger MinLen of the two.

Examples

> let xs = unsafeToMinLen [1] :: MinLen (Succ Zero) [Int]
> let ys = xs `mlunion` xs
> ys
MinLen {unMinLen = [1,1]}

> :i ys
ys :: MinLen (Succ Zero) [Int]

head :: MonoFoldable mono => MinLen (Succ nat) mono -> Element mono Source

Return the first element of a monomorphic container.

Safe version of headEx, only works on monomorphic containers wrapped in a MinLen (Succ nat).

last :: MonoFoldable mono => MinLen (Succ nat) mono -> Element mono Source

Return the last element of a monomorphic container.

Safe version of lastEx, only works on monomorphic containers wrapped in a MinLen (Succ nat).

tailML :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq Source

Returns all but the first element of a sequence, reducing its MinLen by 1.

Safe, only works on sequences wrapped in a MinLen (Succ nat).

Examples

> let xs = toMinLen [1,2,3] :: Maybe (MinLen (Succ Zero) [Int])
> fmap tailML xs
Just (MinLen {unMinLen = [2,3]})

initML :: IsSequence seq => MinLen (Succ nat) seq -> MinLen nat seq Source

Returns all but the last element of a sequence, reducing its MinLen by 1.

Safe, only works on sequences wrapped in a MinLen (Succ nat).

Examples

> let xs = toMinLen [1,2,3] :: Maybe (MinLen (Succ Zero) [Int])
> fmap initML xs
Just (MinLen {unMinLen = [1,2]})

ofoldMap1 :: (MonoFoldable mono, Semigroup m) => (Element mono -> m) -> MinLen (Succ nat) mono -> m Source

Map each element of a monomorphic container to a semigroup, and combine the results.

Safe version of ofoldMap1Ex, only works on monomorphic containers wrapped in a MinLen (Succ nat).

Examples

> let xs = ("hello", 1 :: Integer) `mlcons` (" world", 2) `mlcons` (toMinLenZero [])
> ofoldMap1 fst xs
"hello world"

ofold1 :: (MonoFoldable mono, Semigroup (Element mono)) => MinLen (Succ nat) mono -> Element mono Source

Join a monomorphic container, whose elements are Semigroups, together.

Safe, only works on monomorphic containers wrapped in a MinLen (Succ nat).

Examples

> let xs = "a" `mlcons` "b" `mlcons` "c" `mlcons` (toMinLenZero [])
> xs
MinLen {unMinLen = ["a","b","c"]}

> ofold1 xs
"abc"

ofoldr1 :: MonoFoldable mono => (Element mono -> Element mono -> Element mono) -> MinLen (Succ nat) mono -> Element mono Source

Right-associative fold of a monomorphic container with no base element.

Safe version of ofoldr1Ex, only works on monomorphic containers wrapped in a MinLen (Succ nat).

foldr1 f = Prelude.foldr1 f . otoList

Examples

> let xs = "a" `mlcons` "b" `mlcons` "c" `mlcons` (toMinLenZero [])
> ofoldr1 (++) xs
"abc"

ofoldl1' :: MonoFoldable mono => (Element mono -> Element mono -> Element mono) -> MinLen (Succ nat) mono -> Element mono Source

Strict left-associative fold of a monomorphic container with no base element.

Safe version of ofoldl1Ex', only works on monomorphic containers wrapped in a MinLen (Succ nat).

foldl1' f = Prelude.foldl1' f . otoList

Examples

> let xs = "a" `mlcons` "b" `mlcons` "c" `mlcons` (toMinLenZero [])
> ofoldl1' (++) xs
"abc"

maximum :: MonoFoldableOrd mono => MinLen (Succ nat) mono -> Element mono Source

Get the maximum element of a monomorphic container.

Safe version of maximumEx, only works on monomorphic containers wrapped in a MinLen (Succ nat).

Examples

> let xs = toMinLen [1,2,3] :: Maybe (MinLen (Succ Zero) [Int])
> fmap maximum xs
Just 3

minimum :: MonoFoldableOrd mono => MinLen (Succ nat) mono -> Element mono Source

Get the minimum element of a monomorphic container.

Safe version of minimumEx, only works on monomorphic containers wrapped in a MinLen (Succ nat).

Examples

> let xs = toMinLen [1,2,3] :: Maybe (MinLen (Succ Zero) [Int])
> fmap minimum xs
Just 1

maximumBy :: MonoFoldable mono => (Element mono -> Element mono -> Ordering) -> MinLen (Succ nat) mono -> Element mono Source

Get the maximum element of a monomorphic container, using a supplied element ordering function.

Safe version of maximumByEx, only works on monomorphic containers wrapped in a MinLen (Succ nat).

minimumBy :: MonoFoldable mono => (Element mono -> Element mono -> Ordering) -> MinLen (Succ nat) mono -> Element mono Source

Get the minimum element of a monomorphic container, using a supplied element ordering function.

Safe version of minimumByEx, only works on monomorphic containers wrapped in a MinLen (Succ nat).