garden
Maintainergatlin@niltag.net
Safe HaskellSafe-Inferred
LanguageHaskell2010

Sheet

Description

A Sheet is a multi-dimensional convolutional computational space. The fabric of the universe comes in sheets like this but with a higher thread- count.

Re-implementation of Kenneth Foner's ComonadSheet library. Some bug fixes and packaging upgrades have been made; additionally, for idiosyncratic reasons, where possible functional dependencies have been replaced with associated type families.

Synopsis

Defining and executing sheets.

evaluate :: ComonadApply w => w (w a -> a) -> w a Source #

evaluateF :: (ComonadApply w, Functor f) => w (f (w (f a) -> a)) -> w (f a) Source #

cell :: (Comonad w, Go r w) => RefList r -> w a -> a Source #

cells :: (Traversable t, Comonad w, Go r w) => t (RefList r) -> w a -> t a Source #

sheet :: (InsertNested l t, Applicative t, DimensionalAs x (t a), AsDimensionalAs x (t a) ~ l a) => a -> x -> t a Source #

Construct a sheet of values from a default value and an insertable container of values.

change :: (InsertNested l w, ComonadApply w, DimensionalAs x (w (w a -> a)), AsDimensionalAs x (w (w a -> a)) ~ l (w a -> a)) => x -> w a -> w a Source #

indexedSheet :: (InsertNested l (Nested ts), Applicative (Nested ts), DimensionalAs x (Nested ts a), AsDimensionalAs x (Nested ts a) ~ l a) => Coordinate (NestedCount ts) -> a -> x -> Indexed ts a Source #

Construct an indexed sheet from an origin index, a default value, and an insertable container of values.

Inexhaustible streams

data Stream t Source #

A 'Stream t' is an inexhaustible source of values of type t. Unlike the ordinary builtin list type '[]' a Stream cannot ever be empty or exhausted.

Constructors

Cons t (Stream t) 

Instances

Instances details
Applicative Stream Source # 
Instance details

Defined in Sheet

Methods

pure :: a -> Stream a Source #

(<*>) :: Stream (a -> b) -> Stream a -> Stream b Source #

liftA2 :: (a -> b -> c) -> Stream a -> Stream b -> Stream c Source #

(*>) :: Stream a -> Stream b -> Stream b Source #

(<*) :: Stream a -> Stream b -> Stream a Source #

Functor Stream Source # 
Instance details

Defined in Sheet

Methods

fmap :: (a -> b) -> Stream a -> Stream b Source #

(<$) :: a -> Stream b -> Stream a Source #

Monad Stream Source # 
Instance details

Defined in Sheet

Methods

(>>=) :: Stream a -> (a -> Stream b) -> Stream b Source #

(>>) :: Stream a -> Stream b -> Stream b Source #

return :: a -> Stream a Source #

Comonad Stream Source # 
Instance details

Defined in Sheet

Methods

extract :: Stream a -> a

duplicate :: Stream a -> Stream (Stream a)

extend :: (Stream a -> b) -> Stream a -> Stream b

ComonadApply Stream Source # 
Instance details

Defined in Sheet

Methods

(<@>) :: Stream (a -> b) -> Stream a -> Stream b

(@>) :: Stream a -> Stream b -> Stream b

(<@) :: Stream a -> Stream b -> Stream a

InsertBase Stream Source # 
Instance details

Defined in Sheet

Methods

insertBase :: Stream a -> Tape a -> Tape a Source #

Show t => Show (Stream t) Source # 
Instance details

Defined in Sheet

InsertBase (Signed Stream) Source # 
Instance details

Defined in Sheet

Methods

insertBase :: Signed Stream a -> Tape a -> Tape a Source #

(<:>) :: t -> Stream t -> Stream t Source #

repeat :: t -> Stream t Source #

Construct an infinite 'Stream a' from a value of type a.

zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c Source #

Combines two infinite streams element-wise using the provided function.

unzip :: Stream (a, b) -> (Stream a, Stream b) Source #

iterateStream :: (value -> value) -> value -> Stream value Source #

Repeatedly apply a step function to an initial value to generate the next value

unfoldStream :: (state -> (value, state)) -> state -> Stream value Source #

takeStream :: Int -> Stream value -> [value] Source #

Capture n values from an infinite 'Stream value'.

takeStreamNat :: Z < S n => Natural n -> Stream value -> [value] Source #

Alternate implementation of takeStream which trades the inelegance but convenience of error for the type safety and inconvenience of requiring some kind of evil type witness to convey how many items to grab from the 'Stream value'.

Tapes: bidirectional streams with a focus

data Tape a Source #

Two infinite Streams of type a joined with a center value in focus. A Tape is named for tape in a Turing machine.

Constructors

Tape 

Fields

Instances

Instances details
Representable Tape Source # 
Instance details

Defined in Sheet

Associated Types

type Rep Tape

Methods

tabulate :: (Rep Tape -> a) -> Tape a

index :: Tape a -> Rep Tape -> a

Applicative Tape Source # 
Instance details

Defined in Sheet

Methods

pure :: a -> Tape a Source #

(<*>) :: Tape (a -> b) -> Tape a -> Tape b Source #

liftA2 :: (a -> b -> c) -> Tape a -> Tape b -> Tape c Source #

(*>) :: Tape a -> Tape b -> Tape b Source #

(<*) :: Tape a -> Tape b -> Tape a Source #

Functor Tape Source # 
Instance details

Defined in Sheet

Methods

fmap :: (a -> b) -> Tape a -> Tape b Source #

(<$) :: a -> Tape b -> Tape a Source #

Comonad Tape Source # 
Instance details

Defined in Sheet

Methods

extract :: Tape a -> a

duplicate :: Tape a -> Tape (Tape a)

extend :: (Tape a -> b) -> Tape a -> Tape b

ComonadApply Tape Source # 
Instance details

Defined in Sheet

Methods

(<@>) :: Tape (a -> b) -> Tape a -> Tape b

(@>) :: Tape a -> Tape b -> Tape b

(<@) :: Tape a -> Tape b -> Tape a

Distributive Tape Source # 
Instance details

Defined in Sheet

Methods

distribute :: Functor f => f (Tape a) -> Tape (f a)

collect :: Functor f => (a -> Tape b) -> f a -> Tape (f b)

distributeM :: Monad m => m (Tape a) -> Tape (m a)

collectM :: Monad m => (a -> Tape b) -> m a -> Tape (m b)

InsertBase Tape Source # 
Instance details

Defined in Sheet

Methods

insertBase :: Tape a -> Tape a -> Tape a Source #

(Take Nil (Nested ts), Functor (Nested ts)) => Take Nil (Nested (N ts Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type ListFrom (Nested (N ts Tape)) a Source #

Methods

take :: RefList Nil -> Nested (N ts Tape) a -> ListFrom (Nested (N ts Tape)) a Source #

View Nil (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Nested (F Tape)) a Source #

Methods

view :: RefList Nil -> Nested (F Tape) a -> StreamFrom (Nested (F Tape)) a Source #

(View Nil (Nested ts), Functor (Nested ts)) => View Nil (Nested (N ts Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Nested (N ts Tape)) a Source #

Methods

view :: RefList Nil -> Nested (N ts Tape) a -> StreamFrom (Nested (N ts Tape)) a Source #

InsertBase l => InsertNested (Nested (F l) :: Type -> Type) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Methods

insertNested :: forall (a :: k). Nested (F l) a -> Nested (F Tape) a -> Nested (F Tape) a Source #

(InsertBase l, InsertNested (Nested ls) (Nested ts), Functor (Nested ls), Applicative (Nested ts)) => InsertNested (Nested (N ls l) :: Type -> Type) (Nested (N ts Tape) :: Type -> Type) Source # 
Instance details

Defined in Sheet

Methods

insertNested :: forall (a :: k). Nested (N ls l) a -> Nested (N ts Tape) a -> Nested (N ts Tape) a Source #

Go ('Relative :-: Nil) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Methods

go :: forall (a :: k). RefList ('Relative :-: Nil) -> Nested (F Tape) a -> Nested (F Tape) a Source #

(Go rs (Nested ts), Functor (Nested ts)) => Go ('Relative :-: rs) (Nested (N ts Tape) :: Type -> Type) Source # 
Instance details

Defined in Sheet

Methods

go :: forall (a :: k). RefList ('Relative :-: rs) -> Nested (N ts Tape) a -> Nested (N ts Tape) a Source #

Take ('Relative :-: Nil) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type ListFrom (Nested (F Tape)) a Source #

Methods

take :: RefList ('Relative :-: Nil) -> Nested (F Tape) a -> ListFrom (Nested (F Tape)) a Source #

(Functor (Nested ts), Take rs (Nested ts)) => Take ('Relative :-: rs) (Nested (N ts Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type ListFrom (Nested (N ts Tape)) a Source #

Methods

take :: RefList ('Relative :-: rs) -> Nested (N ts Tape) a -> ListFrom (Nested (N ts Tape)) a Source #

View ('Relative :-: Nil) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Nested (F Tape)) a Source #

(Functor (Nested ts), View rs (Nested ts)) => View ('Relative :-: rs) (Nested (N ts Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Nested (N ts Tape)) a Source #

Methods

view :: RefList ('Relative :-: rs) -> Nested (N ts Tape) a -> StreamFrom (Nested (N ts Tape)) a Source #

type Rep Tape Source # 
Instance details

Defined in Sheet

type Rep Tape = Int
type ListFrom (Nested (F Tape)) a Source # 
Instance details

Defined in Sheet

type ListFrom (Nested (F Tape)) a = [a]
type ListFrom (Nested (N ts Tape)) a Source # 
Instance details

Defined in Sheet

type ListFrom (Nested (N ts Tape)) a = ListFrom (Nested ts) [a]
type ListFrom (Nested (N ts Tape)) a Source # 
Instance details

Defined in Sheet

type ListFrom (Nested (N ts Tape)) a = ListFrom (Nested ts) [a]
type StreamFrom (Nested (F Tape)) a Source # 
Instance details

Defined in Sheet

type StreamFrom (Nested (F Tape)) a = Stream a
type StreamFrom (Nested (F Tape)) a Source # 
Instance details

Defined in Sheet

type StreamFrom (Nested (F Tape)) a = Stream a
type StreamFrom (Nested (N ts Tape)) a Source # 
Instance details

Defined in Sheet

type StreamFrom (Nested (N ts Tape)) a = StreamFrom (Nested ts) (Stream a)
type StreamFrom (Nested (N ts Tape)) a Source # 
Instance details

Defined in Sheet

type StreamFrom (Nested (N ts Tape)) a = StreamFrom (Nested ts) (Stream a)

tapeOf :: a -> Tape a Source #

Tape unit.

moveL :: Tape a -> Tape a Source #

Utilities to move a Tape one cell to the left or right.

moveR :: Tape a -> Tape a Source #

Utilities to move a Tape one cell to the left or right.

iterate :: (t -> t) -> (t -> t) -> t -> Tape t Source #

Builds a Tape out of two generator functions and an initial seed value. prev will generate the left-hand Stream while next will generate the right-hand Stream.

enumerate :: Enum a => a -> Tape a Source #

Constructs a Tape from any Enumerable type.

unfold :: (c -> (a, c)) -> (c -> a) -> (c -> (a, c)) -> c -> Tape a Source #

Unfolds a Tape from two Stream unfold functions, a function to generate the initial focus, and a seed value.

References, indices, and coordinates

data Ref (t :: RefType) Source #

A Ref is indexed by a RefType kind (confusing name, to be sure) and represents some unique value. Here that unique value is carried by an Int property. An absolute reference denotes a coordinate in a fixed frame of reference. A relative reference denotes some distance to be applied to another anchor reference (relative or absolute).

Constructors

t ~ 'Relative => Rel Int 
t ~ 'Absolute => Abs Int 

Instances

Instances details
Enum (Ref 'Absolute) Source # 
Instance details

Defined in Sheet

Enum (Ref 'Relative) Source # 
Instance details

Defined in Sheet

Num (Ref 'Absolute) Source # 
Instance details

Defined in Sheet

Num (Ref 'Relative) Source # 
Instance details

Defined in Sheet

Show (Ref t) Source # 
Instance details

Defined in Sheet

Methods

showsPrec :: Int -> Ref t -> ShowS Source #

show :: Ref t -> String Source #

showList :: [Ref t] -> ShowS Source #

Eq (Ref t) Source # 
Instance details

Defined in Sheet

Methods

(==) :: Ref t -> Ref t -> Bool Source #

(/=) :: Ref t -> Ref t -> Bool Source #

Ord (Ref t) Source # 
Instance details

Defined in Sheet

Methods

compare :: Ref t -> Ref t -> Ordering Source #

(<) :: Ref t -> Ref t -> Bool Source #

(<=) :: Ref t -> Ref t -> Bool Source #

(>) :: Ref t -> Ref t -> Bool Source #

(>=) :: Ref t -> Ref t -> Bool Source #

max :: Ref t -> Ref t -> Ref t Source #

min :: Ref t -> Ref t -> Ref t Source #

getRef :: Ref t -> Int Source #

For when we want to throw away the type information and access the raw Int value beneath the Ref.

class CombineRefTypes (a :: RefType) (b :: RefType) where Source #

Associated Types

type Combine a b :: RefType Source #

Methods

combine :: Ref a -> Ref b -> Ref (Combine a b) Source #

Instances

Instances details
CombineRefTypes 'Absolute 'Relative Source # 
Instance details

Defined in Sheet

Associated Types

type Combine 'Absolute 'Relative :: RefType Source #

CombineRefTypes 'Relative 'Absolute Source # 
Instance details

Defined in Sheet

Associated Types

type Combine 'Relative 'Absolute :: RefType Source #

CombineRefTypes 'Relative 'Relative Source # 
Instance details

Defined in Sheet

Associated Types

type Combine 'Relative 'Relative :: RefType Source #

data RefType Source #

There are two kinds reference types: Relative and Absolute.

Constructors

Relative 
Absolute 

Instances

Instances details
Go ('Relative :-: Nil) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Methods

go :: forall (a :: k). RefList ('Relative :-: Nil) -> Nested (F Tape) a -> Nested (F Tape) a Source #

(Go rs (Nested ts), Functor (Nested ts)) => Go ('Relative :-: rs) (Nested (N ts Tape) :: Type -> Type) Source # 
Instance details

Defined in Sheet

Methods

go :: forall (a :: k). RefList ('Relative :-: rs) -> Nested (N ts Tape) a -> Nested (N ts Tape) a Source #

Take ('Relative :-: Nil) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type ListFrom (Nested (F Tape)) a Source #

Methods

take :: RefList ('Relative :-: Nil) -> Nested (F Tape) a -> ListFrom (Nested (F Tape)) a Source #

(Functor (Nested ts), Take rs (Nested ts)) => Take ('Relative :-: rs) (Nested (N ts Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type ListFrom (Nested (N ts Tape)) a Source #

Methods

take :: RefList ('Relative :-: rs) -> Nested (N ts Tape) a -> ListFrom (Nested (N ts Tape)) a Source #

View ('Relative :-: Nil) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Nested (F Tape)) a Source #

(Functor (Nested ts), View rs (Nested ts)) => View ('Relative :-: rs) (Nested (N ts Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Nested (N ts Tape)) a Source #

Methods

view :: RefList ('Relative :-: rs) -> Nested (N ts Tape) a -> StreamFrom (Nested (N ts Tape)) a Source #

(CombineRefTypes a b, CombineRefLists as bs) => CombineRefLists (a :-: as) (b :-: bs) Source # 
Instance details

Defined in Sheet

Methods

(&) :: RefList (a :-: as) -> RefList (b :-: bs) -> RefList ((a :-: as) & (b :-: bs)) Source #

Reference lists

type RefList = Conic Ref Source #

A RefList is a Conic list of references.

class CombineRefLists as bs where Source #

We can combine lists of references if their corresponding elements can be combined. When combining two lists of references, any trailing elements from the longer list will be preserved at the end.

Methods

(&) :: RefList as -> RefList bs -> RefList (as & bs) infixr 4 Source #

Instances

Instances details
CombineRefLists Nil Nil Source # 
Instance details

Defined in Sheet

Methods

(&) :: RefList Nil -> RefList Nil -> RefList (Nil & Nil) Source #

CombineRefLists Nil (b :-: bs) Source # 
Instance details

Defined in Sheet

Methods

(&) :: RefList Nil -> RefList (b :-: bs) -> RefList (Nil & (b :-: bs)) Source #

CombineRefLists (a :-: as) Nil Source # 
Instance details

Defined in Sheet

Methods

(&) :: RefList (a :-: as) -> RefList Nil -> RefList ((a :-: as) & Nil) Source #

(CombineRefTypes a b, CombineRefLists as bs) => CombineRefLists (a :-: as) (b :-: bs) Source # 
Instance details

Defined in Sheet

Methods

(&) :: RefList (a :-: as) -> RefList (b :-: bs) -> RefList ((a :-: as) & (b :-: bs)) Source #

merge :: ReifyNatural n => Counted n (Ref 'Relative) -> Counted n (Ref 'Absolute) -> Counted n (Ref 'Absolute) Source #

Given a homogenous list of length n containing relative references, we can merge those relative positions with a homogenous list of absolute references.

diff :: Counted n (Either (Ref 'Relative) (Ref 'Absolute)) -> Counted n (Ref 'Absolute) -> Counted n (Ref 'Relative) Source #

Finds the relative movement necessary to move from a given absolute coordinate to the location specified by a list of a relative and absolute coordinates.

eitherFromRef :: Ref t -> Either (Ref 'Relative) (Ref 'Absolute) Source #

Given a Ref, forget the type-level information about whether it's absolute or relative by casting it into an Either type, with the left branch holding relative reference and the right branch absolute.

getMovement :: (Length ts <= n, ((n - Length ts) + Length ts) ~ n) => RefList ts -> Counted n (Ref 'Absolute) -> Counted n (Ref 'Relative) Source #

Given a list of relative and absolute references (an n-dimensional reference) and an n-dimensional coordinate, we can obtain the relative movement necessary to get from the coordinate to the location specified by the references given.

dimensional :: Tackable t (Replicate n 'Relative) => Natural (S n) -> Ref t -> RefList (Tack t (Replicate n 'Relative)) Source #

Given a number n greater than zero and some reference, prepend (n - 1) relative references of value zero to the reference given, thus creating an n-dimensional reference where the references refers to the nth dimension.

Coordinates

data Indexed ts a Source #

A Nested functor paired with a valid index to one of its members.

Constructors

Indexed 

Fields

Instances

Instances details
(Go (Replicate (NestedCount ts) 'Relative) (Nested ts), Length r <= NestedCount ts, ((NestedCount ts - Length r) + Length r) ~ NestedCount ts, ReifyNatural (NestedCount ts)) => Go r (Indexed ts :: Type -> Type) Source # 
Instance details

Defined in Sheet

Methods

go :: forall (a :: k). RefList r -> Indexed ts a -> Indexed ts a Source #

InsertNested l (Nested ts) => InsertNested (l :: Type -> Type) (Indexed ts :: Type -> Type) Source # 
Instance details

Defined in Sheet

Methods

insertNested :: forall (a :: k). l a -> Indexed ts a -> Indexed ts a Source #

(Take (Replicate (NestedCount ts) 'Relative) (Nested ts), Length r <= NestedCount ts, ((NestedCount ts - Length r) + Length r) ~ NestedCount ts) => Take r (Indexed ts) Source # 
Instance details

Defined in Sheet

Associated Types

type ListFrom (Indexed ts) a Source #

Methods

take :: RefList r -> Indexed ts a -> ListFrom (Indexed ts) a Source #

(View (Replicate (NestedCount ts) 'Relative) (Nested ts), Length r <= NestedCount ts, ((NestedCount ts - Length r) + Length r) ~ NestedCount ts) => View r (Indexed ts) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Indexed ts) a Source #

Methods

view :: RefList r -> Indexed ts a -> StreamFrom (Indexed ts) a Source #

NestedAs x (Nested ts y) => DimensionalAs x (Indexed ts y) Source # 
Instance details

Defined in Sheet

Associated Types

type AsDimensionalAs x (Indexed ts y) Source #

Methods

asDimensionalAs :: x -> Indexed ts y -> AsDimensionalAs x (Indexed ts y) Source #

(ComonadApply (Nested ts), ReifyNatural (NestedCount ts), Cross (NestedCount ts) Tape, ts ~ NestedNTimes (NestedCount ts) Tape, Go (Replicate (NestedCount ts) 'Relative) (Nested ts)) => Representable (Indexed ts) Source # 
Instance details

Defined in Sheet

Associated Types

type Rep (Indexed ts)

Methods

tabulate :: (Rep (Indexed ts) -> a) -> Indexed ts a

index :: Indexed ts a -> Rep (Indexed ts) -> a

Functor (Nested ts) => Functor (Indexed ts) Source # 
Instance details

Defined in Sheet

Methods

fmap :: (a -> b) -> Indexed ts a -> Indexed ts b Source #

(<$) :: a -> Indexed ts b -> Indexed ts a Source #

(ComonadApply (Nested ts), Indexable ts) => Comonad (Indexed ts) Source # 
Instance details

Defined in Sheet

Methods

extract :: Indexed ts a -> a

duplicate :: Indexed ts a -> Indexed ts (Indexed ts a)

extend :: (Indexed ts a -> b) -> Indexed ts a -> Indexed ts b

(ComonadApply (Nested ts), Indexable ts) => ComonadApply (Indexed ts) Source # 
Instance details

Defined in Sheet

Methods

(<@>) :: Indexed ts (a -> b) -> Indexed ts a -> Indexed ts b

(@>) :: Indexed ts a -> Indexed ts b -> Indexed ts b

(<@) :: Indexed ts a -> Indexed ts b -> Indexed ts a

(ComonadApply (Nested ts), ReifyNatural (NestedCount ts), Cross (NestedCount ts) Tape, ts ~ NestedNTimes (NestedCount ts) Tape, Go (Replicate (NestedCount ts) 'Relative) (Nested ts)) => Distributive (Indexed ts) Source # 
Instance details

Defined in Sheet

Methods

distribute :: Functor f => f (Indexed ts a) -> Indexed ts (f a)

collect :: Functor f => (a -> Indexed ts b) -> f a -> Indexed ts (f b)

distributeM :: Monad m => m (Indexed ts a) -> Indexed ts (m a)

collectM :: Monad m => (a -> Indexed ts b) -> m a -> Indexed ts (m b)

type AsDimensionalAs x (Indexed ts y) Source # 
Instance details

Defined in Sheet

type AsDimensionalAs x (Indexed ts y) = AsNestedAs x (Nested ts y)
type Rep (Indexed ts) Source # 
Instance details

Defined in Sheet

type Rep (Indexed ts) = Counted (NestedCount ts) Int
type ListFrom (Indexed ts) a Source # 
Instance details

Defined in Sheet

type ListFrom (Indexed ts) a = ListFrom (Nested ts) a
type StreamFrom (Indexed ts) a Source # 
Instance details

Defined in Sheet

type StreamFrom (Indexed ts) a = StreamFrom (Nested ts) a

class Cross n t where Source #

Methods

cross :: Counted n (t a) -> Nested (NestedNTimes n t) (Counted n a) Source #

Instances

Instances details
(Cross (S n) t, Functor t, Functor (Nested (NestedNTimes (S n) t))) => Cross (S (S n)) t Source # 
Instance details

Defined in Sheet

Methods

cross :: Counted (S (S n)) (t a) -> Nested (NestedNTimes (S (S n)) t) (Counted (S (S n)) a) Source #

Functor t => Cross (S Z) t Source # 
Instance details

Defined in Sheet

Methods

cross :: Counted (S Z) (t a) -> Nested (NestedNTimes (S Z) t) (Counted (S Z) a) Source #

Indexed

Type-level Tape manipulation with Coordinates and Refs.

Take

class Take r t where Source #

Associated Types

type ListFrom t a Source #

Methods

take :: RefList r -> t a -> ListFrom t a Source #

Instances

Instances details
(Take Nil (Nested ts), Functor (Nested ts)) => Take Nil (Nested (N ts Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type ListFrom (Nested (N ts Tape)) a Source #

Methods

take :: RefList Nil -> Nested (N ts Tape) a -> ListFrom (Nested (N ts Tape)) a Source #

(Take (Replicate (NestedCount ts) 'Relative) (Nested ts), Length r <= NestedCount ts, ((NestedCount ts - Length r) + Length r) ~ NestedCount ts) => Take r (Indexed ts) Source # 
Instance details

Defined in Sheet

Associated Types

type ListFrom (Indexed ts) a Source #

Methods

take :: RefList r -> Indexed ts a -> ListFrom (Indexed ts) a Source #

Take ('Relative :-: Nil) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type ListFrom (Nested (F Tape)) a Source #

Methods

take :: RefList ('Relative :-: Nil) -> Nested (F Tape) a -> ListFrom (Nested (F Tape)) a Source #

(Functor (Nested ts), Take rs (Nested ts)) => Take ('Relative :-: rs) (Nested (N ts Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type ListFrom (Nested (N ts Tape)) a Source #

Methods

take :: RefList ('Relative :-: rs) -> Nested (N ts Tape) a -> ListFrom (Nested (N ts Tape)) a Source #

tapeTake :: Ref 'Relative -> Tape a -> [a] Source #

Take all the items between the current focus and the item specified by the Relative Reference and return them as a list '[a]'.

View

class View r t where Source #

Associated Types

type StreamFrom t a Source #

Type of an n-dimensional stream extracted from an n-dimensional sheet.

Methods

view :: RefList r -> t a -> StreamFrom t a Source #

Instances

Instances details
View Nil (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Nested (F Tape)) a Source #

Methods

view :: RefList Nil -> Nested (F Tape) a -> StreamFrom (Nested (F Tape)) a Source #

(View Nil (Nested ts), Functor (Nested ts)) => View Nil (Nested (N ts Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Nested (N ts Tape)) a Source #

Methods

view :: RefList Nil -> Nested (N ts Tape) a -> StreamFrom (Nested (N ts Tape)) a Source #

(View (Replicate (NestedCount ts) 'Relative) (Nested ts), Length r <= NestedCount ts, ((NestedCount ts - Length r) + Length r) ~ NestedCount ts) => View r (Indexed ts) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Indexed ts) a Source #

Methods

view :: RefList r -> Indexed ts a -> StreamFrom (Indexed ts) a Source #

View ('Relative :-: Nil) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Nested (F Tape)) a Source #

(Functor (Nested ts), View rs (Nested ts)) => View ('Relative :-: rs) (Nested (N ts Tape)) Source # 
Instance details

Defined in Sheet

Associated Types

type StreamFrom (Nested (N ts Tape)) a Source #

Methods

view :: RefList ('Relative :-: rs) -> Nested (N ts Tape) a -> StreamFrom (Nested (N ts Tape)) a Source #

Go

class Go r t where Source #

Methods

go :: RefList r -> t a -> t a Source #

Move to the location specified by the given RefList.

Instances

Instances details
Go Nil (Nested ts :: Type -> Type) Source # 
Instance details

Defined in Sheet

Methods

go :: forall (a :: k). RefList Nil -> Nested ts a -> Nested ts a Source #

(Go (Replicate (NestedCount ts) 'Relative) (Nested ts), Length r <= NestedCount ts, ((NestedCount ts - Length r) + Length r) ~ NestedCount ts, ReifyNatural (NestedCount ts)) => Go r (Indexed ts :: Type -> Type) Source # 
Instance details

Defined in Sheet

Methods

go :: forall (a :: k). RefList r -> Indexed ts a -> Indexed ts a Source #

Go ('Relative :-: Nil) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Methods

go :: forall (a :: k). RefList ('Relative :-: Nil) -> Nested (F Tape) a -> Nested (F Tape) a Source #

(Go rs (Nested ts), Functor (Nested ts)) => Go ('Relative :-: rs) (Nested (N ts Tape) :: Type -> Type) Source # 
Instance details

Defined in Sheet

Methods

go :: forall (a :: k). RefList ('Relative :-: rs) -> Nested (N ts Tape) a -> Nested (N ts Tape) a Source #

data Signed f a Source #

A Signed f is an 'f a' annotated with a sign: either Positive or Negative. This is a useful type for specifying direction when inserting into sheets. By wrapping a list or stream in Negative and then inserting it into a sheet, you insert it in the opposite direction of the usual one.

Constructors

Positive (f a) 
Negative (f a) 

Instances

Instances details
InsertBase (Signed Stream) Source # 
Instance details

Defined in Sheet

Methods

insertBase :: Signed Stream a -> Tape a -> Tape a Source #

InsertBase (Signed []) Source # 
Instance details

Defined in Sheet

Methods

insertBase :: Signed [] a -> Tape a -> Tape a Source #

Show (f a) => Show (Signed f a) Source # 
Instance details

Defined in Sheet

Methods

showsPrec :: Int -> Signed f a -> ShowS Source #

show :: Signed f a -> String Source #

showList :: [Signed f a] -> ShowS Source #

Eq (f a) => Eq (Signed f a) Source # 
Instance details

Defined in Sheet

Methods

(==) :: Signed f a -> Signed f a -> Bool Source #

(/=) :: Signed f a -> Signed f a -> Bool Source #

Ord (f a) => Ord (Signed f a) Source # 
Instance details

Defined in Sheet

Methods

compare :: Signed f a -> Signed f a -> Ordering Source #

(<) :: Signed f a -> Signed f a -> Bool Source #

(<=) :: Signed f a -> Signed f a -> Bool Source #

(>) :: Signed f a -> Signed f a -> Bool Source #

(>=) :: Signed f a -> Signed f a -> Bool Source #

max :: Signed f a -> Signed f a -> Signed f a Source #

min :: Signed f a -> Signed f a -> Signed f a Source #

Insertion

class InsertBase l where Source #

Methods

insertBase :: l a -> Tape a -> Tape a Source #

Instances

Instances details
InsertBase Stream Source # 
Instance details

Defined in Sheet

Methods

insertBase :: Stream a -> Tape a -> Tape a Source #

InsertBase Tape Source # 
Instance details

Defined in Sheet

Methods

insertBase :: Tape a -> Tape a -> Tape a Source #

InsertBase [] Source # 
Instance details

Defined in Sheet

Methods

insertBase :: [a] -> Tape a -> Tape a Source #

InsertBase (Signed Stream) Source # 
Instance details

Defined in Sheet

Methods

insertBase :: Signed Stream a -> Tape a -> Tape a Source #

InsertBase (Signed []) Source # 
Instance details

Defined in Sheet

Methods

insertBase :: Signed [] a -> Tape a -> Tape a Source #

class InsertNested l t where Source #

Methods

insertNested :: l a -> t a -> t a Source #

Instances

Instances details
InsertNested l (Nested ts) => InsertNested (l :: Type -> Type) (Indexed ts :: Type -> Type) Source # 
Instance details

Defined in Sheet

Methods

insertNested :: forall (a :: k). l a -> Indexed ts a -> Indexed ts a Source #

InsertBase l => InsertNested (Nested (F l) :: Type -> Type) (Nested (F Tape)) Source # 
Instance details

Defined in Sheet

Methods

insertNested :: forall (a :: k). Nested (F l) a -> Nested (F Tape) a -> Nested (F Tape) a Source #

(InsertBase l, InsertNested (Nested ls) (Nested ts), Functor (Nested ls), Applicative (Nested ts)) => InsertNested (Nested (N ls l) :: Type -> Type) (Nested (N ts Tape) :: Type -> Type) Source # 
Instance details

Defined in Sheet

Methods

insertNested :: forall (a :: k). Nested (N ls l) a -> Nested (N ts Tape) a -> Nested (N ts Tape) a Source #

type family AddNest x where ... Source #

Equations

AddNest (Nested fs (f x)) = Nested (N fs f) x 

type family AsNestedAs x y where ... Source #

Equations

AsNestedAs (f x) (Nested (F g) b) = Nested (F f) x 
AsNestedAs x y = AddNest (x `AsNestedAs` UnNest y) 

Dimensions

class DimensionalAs (x :: Type) (y :: Type) where Source #

DimensionalAs provides a mechanism to "lift" an n-deep nested structure into an explicit Nested type. This is the way in which raw lists-of-lists-of-lists-, etc. can be inserted (without manual annotation of nesting depth) into a sheet.

Associated Types

type AsDimensionalAs x y Source #

Methods

asDimensionalAs :: x -> y -> x `AsDimensionalAs` y Source #

Instances

Instances details
(NestedAs x (Nested ts y), AsDimensionalAs x (Nested ts y) ~ AsNestedAs x (Nested ts y)) => DimensionalAs x (Nested ts y) Source # 
Instance details

Defined in Sheet

Associated Types

type AsDimensionalAs x (Nested ts y) Source #

Methods

asDimensionalAs :: x -> Nested ts y -> AsDimensionalAs x (Nested ts y) Source #

NestedAs x (Nested ts y) => DimensionalAs x (Indexed ts y) Source # 
Instance details

Defined in Sheet

Associated Types

type AsDimensionalAs x (Indexed ts y) Source #

Methods

asDimensionalAs :: x -> Indexed ts y -> AsDimensionalAs x (Indexed ts y) Source #

slice :: (Take r' t, Go r t) => RefList r -> RefList r' -> t a -> ListFrom t a Source #

Combination of go and take: moves to the location specified by the first argument, then takes the amount specified by the second argument.

insert :: (DimensionalAs x (t a), InsertNested l t, AsDimensionalAs x (t a) ~ l a) => x -> t a -> t a Source #

Insert a (possibly nested) list-like structure into a (possibly many-dimensional) sheet. The depth of the nesting structure being inserted must match the number of dimensions of the sheet into which it is being inserted. The structure being inserted need not be a Nested type: it need only have enough levels of structure (ie, number of nested lists) to match the dimensionality of the sheet.

First Dimension

type Nat1 = S Z Source #

column :: Z < NestedCount ts => Indexed ts x -> Int Source #

Second Dimension

type Nat2 = S Nat1 Source #

row :: Nat1 < NestedCount ts => Indexed ts x -> Int Source #

Third Dimension

type Nat3 = S Nat2 Source #

Fourth Dimension

type Nat4 = S Nat3 Source #

Utilities

(&&&) :: (t -> a) -> (t -> b) -> t -> (a, b) Source #