fixed-list-0.1.6: A fixed length list type

Safe HaskellSafe-Inferred
LanguageHaskell98

Data.FixedList

Contents

Description

A fixed length list library.

The length of a list is encoded into its type in a natural way. This allows you to do things like specify that two list parameters have the same type, which also forces them to have the same length. This can be a handy property. It's not as flexible as the standard haskell list, but the added type safety is sometimes worth it.

The entire library is Haskell98 except for the Append typeclass. (which could be easily removed if needed).

Most of your usual list functions (foldr, fmap, sum, sequence, etc..) are accessed via the Functor, Applicative, Foldable, and Traversable type classes.

The Equivalent of zipWith can be had via the Applicative instance:

zipWith f xs ys = pure f <*> xs <*> ys

Also, sequenceA transposes a FixedList of FixedLists.

The monad instance is also interesting. return fills the list with the given element (remember that list size is dependent on the type) You can think of bind as operating like this:

m >>= k = diagonal $ fmap k m

This takes the FixedList m and maps k accross it, (which must return a FixedList) which results in a FixedList of FixedLists the diagonal of which is returned. The actually implementation is more elegant, but works essentialy the same.

This also means that join gets the diagonal of a FixedList of FixedLists.

You can construct FixedLists like so:

t1 :: Cons (Cons (Cons Nil)) Integer -- this is the same as FixedList3 Integer
t1 = 1 :. 3 :. 5 :. Nil

t2 :: FixedList3 Integer  -- type signature needed! and must be correct!
t2 = fromFoldable' [4, 1, 0]

t3 :: FixedList3 Integer -- type signature needed!
t3 :: fromFoldable' [1..]

t4 :: FixedList3 (FixedList3 Integer)
t4 = t1 :. t2 :. t3 :. Nil

-- get the sum of the diagonal of the transpose of t4
test :: FixedList3 Integer
test = sum $ join $ sequenceA $ t4

If you want to restrict a type to be a FixedList, but don't want to specify the size of the list, use the FixedList typeclass:

myFunction :: (FixedList f) => f a -> Float

On a side note... I think that if Haskell supported infinite types my Append typeclass would only have one parameter and I wouldn't need all those nasty extensions.

I think I could also implement direct, typesafe, versions of last, init, reverse and length that don't depend on Foldable. *sigh* Maybe Haskell will one day support such things.

This library is hosted on github (click on the Contents (if you are viewing this on hackage) link above and you should see the Homepage link) so it should be very easy to forked it, patch it, and send patches back to me.

Synopsis

Types and Classes

data FixedList f => Cons f a Source

Constructors

(:.) infixr 5 

Fields

head :: a
 
tail :: f a
 

Instances

FixedList f => Monad (Cons f) 
FixedList f => Functor (Cons f) 
FixedList f => Applicative (Cons f) 
FixedList f => Foldable (Cons f) 
FixedList f => Traversable (Cons f) 
FixedList f => FixedList (Cons f) 
(FixedList f, FixedList c, Append f b c) => Append (Cons f) b (Cons c) 
(Eq a, Eq (f a), FixedList f) => Eq (Cons f a) 
(Fractional a, FixedList f, Eq (f a), Show (f a)) => Fractional (Cons f a) 
(Num a, FixedList f, Eq (f a), Show (f a)) => Num (Cons f a) 
(Ord a, Ord (f a), FixedList f) => Ord (Cons f a) 
(FixedList f, Show a) => Show (Cons f a) 

data Nil a Source

Constructors

Nil 

class (Applicative f, Traversable f, Monad f) => FixedList f Source

Just a restrictive typeclass. It makes sure :. only takes FixedLists as it's second parameter and makes sure the use of fromFoldable's in reverse, and init is safe.

Instances

class Append f g h | f g -> h, f h -> g where Source

Methods

append :: f a -> g a -> h a Source

Instances

Append Nil a a 
(FixedList f, FixedList c, Append f b c) => Append (Cons f) b (Cons c) 

Baisc Functions that are not found in Traversable or Foldable

reverse :: FixedList t => t a -> t a Source

length :: Foldable t => t a -> Int Source

last :: Foldable t => t a -> a Source

Returns the last element of the list

init :: FixedList f => Cons f a -> f a Source

Returns all but the last element of the list

unit :: a -> Cons Nil a Source

Constructs a FixedList containing a single element. Normally I would just use pure or return for this, but you'd have to specify a type signature in that case.

subLists :: FixedList f => Cons f a -> Cons f (f a) Source

Given a list, returns a list of copies of that list but each with an element removed. for example:

subLists (1:. 2:. 3:. Nil)

gives:

|[|[2,3]|,|[1,3]|,|[1,2]|]|

fromFoldable :: (Foldable f, Applicative g, Traversable g) => f a -> Maybe (g a) Source

Converts any Foldable to any Applicative Traversable. However, this will only do what you want if pure gives you the shape of structure you are expecting.

fromFoldable' :: (Foldable f, Applicative g, Traversable g) => f a -> g a Source

This can crash if the foldable is smaller than the new structure.

Type synonyms for larger lists