timeline-0.1.0.0: Data type representing a piecewise-constant function over time
Safe HaskellSafe-Inferred
LanguageHaskell2010

Data.Timeline

Synopsis

Core types and functions

data Timeline t a Source #

A unbounded discrete timeline for data type a. Timeline a always has a value for any time, but the value can only change for a finite number of times.

Constructors

Timeline 

Fields

Instances

Instances details
Foldable (Timeline t) Source # 
Instance details

Defined in Data.Timeline

Methods

fold :: Monoid m => Timeline t m -> m #

foldMap :: Monoid m => (a -> m) -> Timeline t a -> m #

foldMap' :: Monoid m => (a -> m) -> Timeline t a -> m #

foldr :: (a -> b -> b) -> b -> Timeline t a -> b #

foldr' :: (a -> b -> b) -> b -> Timeline t a -> b #

foldl :: (b -> a -> b) -> b -> Timeline t a -> b #

foldl' :: (b -> a -> b) -> b -> Timeline t a -> b #

foldr1 :: (a -> a -> a) -> Timeline t a -> a #

foldl1 :: (a -> a -> a) -> Timeline t a -> a #

toList :: Timeline t a -> [a] #

null :: Timeline t a -> Bool #

length :: Timeline t a -> Int #

elem :: Eq a => a -> Timeline t a -> Bool #

maximum :: Ord a => Timeline t a -> a #

minimum :: Ord a => Timeline t a -> a #

sum :: Num a => Timeline t a -> a #

product :: Num a => Timeline t a -> a #

Traversable (Timeline t) Source # 
Instance details

Defined in Data.Timeline

Methods

traverse :: Applicative f => (a -> f b) -> Timeline t a -> f (Timeline t b) #

sequenceA :: Applicative f => Timeline t (f a) -> f (Timeline t a) #

mapM :: Monad m => (a -> m b) -> Timeline t a -> m (Timeline t b) #

sequence :: Monad m => Timeline t (m a) -> m (Timeline t a) #

Ord t => Applicative (Timeline t) Source # 
Instance details

Defined in Data.Timeline

Methods

pure :: a -> Timeline t a #

(<*>) :: Timeline t (a -> b) -> Timeline t a -> Timeline t b #

liftA2 :: (a -> b -> c) -> Timeline t a -> Timeline t b -> Timeline t c #

(*>) :: Timeline t a -> Timeline t b -> Timeline t b #

(<*) :: Timeline t a -> Timeline t b -> Timeline t a #

Functor (Timeline t) Source # 
Instance details

Defined in Data.Timeline

Methods

fmap :: (a -> b) -> Timeline t a -> Timeline t b #

(<$) :: a -> Timeline t b -> Timeline t a #

Ord t => FoldableWithIndex (TimeRange t) (Timeline t) Source # 
Instance details

Defined in Data.Timeline

Methods

ifoldMap :: Monoid m => (TimeRange t -> a -> m) -> Timeline t a -> m #

ifoldMap' :: Monoid m => (TimeRange t -> a -> m) -> Timeline t a -> m #

ifoldr :: (TimeRange t -> a -> b -> b) -> b -> Timeline t a -> b #

ifoldl :: (TimeRange t -> b -> a -> b) -> b -> Timeline t a -> b #

ifoldr' :: (TimeRange t -> a -> b -> b) -> b -> Timeline t a -> b #

ifoldl' :: (TimeRange t -> b -> a -> b) -> b -> Timeline t a -> b #

Ord t => FunctorWithIndex (TimeRange t) (Timeline t) Source # 
Instance details

Defined in Data.Timeline

Methods

imap :: (TimeRange t -> a -> b) -> Timeline t a -> Timeline t b #

Ord t => TraversableWithIndex (TimeRange t) (Timeline t) Source # 
Instance details

Defined in Data.Timeline

Methods

itraverse :: Applicative f => (TimeRange t -> a -> f b) -> Timeline t a -> f (Timeline t b) #

Generic (Timeline t a) Source # 
Instance details

Defined in Data.Timeline

Associated Types

type Rep (Timeline t a) :: Type -> Type #

Methods

from :: Timeline t a -> Rep (Timeline t a) x #

to :: Rep (Timeline t a) x -> Timeline t a #

(Show a, Show t) => Show (Timeline t a) Source # 
Instance details

Defined in Data.Timeline

Methods

showsPrec :: Int -> Timeline t a -> ShowS #

show :: Timeline t a -> String #

showList :: [Timeline t a] -> ShowS #

(Eq a, Eq t) => Eq (Timeline t a) Source # 
Instance details

Defined in Data.Timeline

Methods

(==) :: Timeline t a -> Timeline t a -> Bool #

(/=) :: Timeline t a -> Timeline t a -> Bool #

type Rep (Timeline t a) Source # 
Instance details

Defined in Data.Timeline

type Rep (Timeline t a) = D1 ('MetaData "Timeline" "Data.Timeline" "timeline-0.1.0.0-Els8rI9h1Gu6CrwyQ0J0wq" 'False) (C1 ('MetaCons "Timeline" 'PrefixI 'True) (S1 ('MetaSel ('Just "initialValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Just "values") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map t a))))

peek Source #

Arguments

:: Ord t 
=> Timeline t a 
-> t

the time to peek

-> a 

Extract a single value from the timeline

prettyTimeline :: forall t a. (Ord t, Show t, Show a) => Timeline t a -> Text Source #

Pretty-print Timeline a. It's provided so that you can investigate the value of Timeline more easily. If you need to show a timeline to the end user, write your own function. We don't gurantee the result to be stable across different versions of this library.

changes :: Timeline t a -> Set t Source #

Return the set of time when the value changes

data TimeRange t Source #

A time range. Each bound is optional. Nothing represents infinity.

Constructors

TimeRange 

Fields

Instances

Instances details
Generic (TimeRange t) Source # 
Instance details

Defined in Data.Timeline

Associated Types

type Rep (TimeRange t) :: Type -> Type #

Methods

from :: TimeRange t -> Rep (TimeRange t) x #

to :: Rep (TimeRange t) x -> TimeRange t #

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

Defined in Data.Timeline

Eq t => Eq (TimeRange t) Source # 
Instance details

Defined in Data.Timeline

Methods

(==) :: TimeRange t -> TimeRange t -> Bool #

(/=) :: TimeRange t -> TimeRange t -> Bool #

Ord t => Ord (TimeRange t) Source # 
Instance details

Defined in Data.Timeline

Ord t => FoldableWithIndex (TimeRange t) (Timeline t) Source # 
Instance details

Defined in Data.Timeline

Methods

ifoldMap :: Monoid m => (TimeRange t -> a -> m) -> Timeline t a -> m #

ifoldMap' :: Monoid m => (TimeRange t -> a -> m) -> Timeline t a -> m #

ifoldr :: (TimeRange t -> a -> b -> b) -> b -> Timeline t a -> b #

ifoldl :: (TimeRange t -> b -> a -> b) -> b -> Timeline t a -> b #

ifoldr' :: (TimeRange t -> a -> b -> b) -> b -> Timeline t a -> b #

ifoldl' :: (TimeRange t -> b -> a -> b) -> b -> Timeline t a -> b #

Ord t => FunctorWithIndex (TimeRange t) (Timeline t) Source # 
Instance details

Defined in Data.Timeline

Methods

imap :: (TimeRange t -> a -> b) -> Timeline t a -> Timeline t b #

Ord t => TraversableWithIndex (TimeRange t) (Timeline t) Source # 
Instance details

Defined in Data.Timeline

Methods

itraverse :: Applicative f => (TimeRange t -> a -> f b) -> Timeline t a -> f (Timeline t b) #

type Rep (TimeRange t) Source # 
Instance details

Defined in Data.Timeline

type Rep (TimeRange t) = D1 ('MetaData "TimeRange" "Data.Timeline" "timeline-0.1.0.0-Els8rI9h1Gu6CrwyQ0J0wq" 'False) (C1 ('MetaCons "TimeRange" 'PrefixI 'True) (S1 ('MetaSel ('Just "from") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe t)) :*: S1 ('MetaSel ('Just "to") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe t))))

isTimeAfterRange :: Ord t => t -> TimeRange t -> Bool Source #

If all time in TimeRange is less than the given time

Upper bound effectiveness time handling

data Record t a Source #

A value with effectiveFrom and effectiveTo attached. This is often the type we get from inputs. A list of Record a can be converted to Timeline (Maybe a). See fromRecords.

Instances

Instances details
Lift a => Lift (Record UTCTime a :: Type) Source #

Special support for UTCTime. This will be removed when Lift instances are provided by the time package directly.

Instance details

Defined in Data.Timeline

Methods

lift :: Quote m => Record UTCTime a -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => Record UTCTime a -> Code m (Record UTCTime a) #

Foldable (Record t) Source # 
Instance details

Defined in Data.Timeline

Methods

fold :: Monoid m => Record t m -> m #

foldMap :: Monoid m => (a -> m) -> Record t a -> m #

foldMap' :: Monoid m => (a -> m) -> Record t a -> m #

foldr :: (a -> b -> b) -> b -> Record t a -> b #

foldr' :: (a -> b -> b) -> b -> Record t a -> b #

foldl :: (b -> a -> b) -> b -> Record t a -> b #

foldl' :: (b -> a -> b) -> b -> Record t a -> b #

foldr1 :: (a -> a -> a) -> Record t a -> a #

foldl1 :: (a -> a -> a) -> Record t a -> a #

toList :: Record t a -> [a] #

null :: Record t a -> Bool #

length :: Record t a -> Int #

elem :: Eq a => a -> Record t a -> Bool #

maximum :: Ord a => Record t a -> a #

minimum :: Ord a => Record t a -> a #

sum :: Num a => Record t a -> a #

product :: Num a => Record t a -> a #

Traversable (Record t) Source # 
Instance details

Defined in Data.Timeline

Methods

traverse :: Applicative f => (a -> f b) -> Record t a -> f (Record t b) #

sequenceA :: Applicative f => Record t (f a) -> f (Record t a) #

mapM :: Monad m => (a -> m b) -> Record t a -> m (Record t b) #

sequence :: Monad m => Record t (m a) -> m (Record t a) #

Functor (Record t) Source # 
Instance details

Defined in Data.Timeline

Methods

fmap :: (a -> b) -> Record t a -> Record t b #

(<$) :: a -> Record t b -> Record t a #

(Lift t, Lift a) => Lift (Record t a :: Type) Source # 
Instance details

Defined in Data.Timeline

Methods

lift :: Quote m => Record t a -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => Record t a -> Code m (Record t a) #

(Show t, Show a) => Show (Record t a) Source # 
Instance details

Defined in Data.Timeline

Methods

showsPrec :: Int -> Record t a -> ShowS #

show :: Record t a -> String #

showList :: [Record t a] -> ShowS #

(Eq t, Eq a) => Eq (Record t a) Source # 
Instance details

Defined in Data.Timeline

Methods

(==) :: Record t a -> Record t a -> Bool #

(/=) :: Record t a -> Record t a -> Bool #

makeRecord Source #

Arguments

:: Ord t 
=> t

effective from

-> Maybe t

optional effective to

-> a

value

-> Maybe (Record t a) 

A smart constructor for Record a. Returns Nothing if effectiveTo is not greater than effectiveFrom

makeRecordTH :: (Ord t, Lift (Record t a)) => t -> Maybe t -> a -> SpliceQ (Record t a) Source #

Template Haskell counterpart of makeRecord.

recordFrom :: Record t a -> t Source #

Get the "effective from" time

recordTo :: Record t a -> Maybe t Source #

Get the "effective to" time

recordValue :: Record t a -> a Source #

Get the value wrapped in a Record a

prettyRecord :: (Show t, Show a) => Record t a -> Text Source #

Pretty-print Record a, like prettyTimeline.

fromRecords :: forall t a. Ord t => [Record t a] -> Either (Overlaps t a) (Timeline t (Maybe a)) Source #

Build a Timeline from a list of Records.

For any time, there could be zero, one, or more values, according to the input. No other condition is possible. We have taken account the "zero" case by wrapping the result in Maybe, so the only possible error is Overlaps. The Traversable instance of Timeline a can be used to convert Timeline (Maybe a) to Maybe (Timeline a)

newtype Overlaps t a Source #

An Overlaps a consists of several groups. Within each group, all records are connected. Definition of connectivity: two records are "connected" if and only if they overlap.

Constructors

Overlaps 

Fields

Instances

Instances details
Semigroup (Overlaps t a) Source # 
Instance details

Defined in Data.Timeline

Methods

(<>) :: Overlaps t a -> Overlaps t a -> Overlaps t a #

sconcat :: NonEmpty (Overlaps t a) -> Overlaps t a #

stimes :: Integral b => b -> Overlaps t a -> Overlaps t a #

Generic (Overlaps t a) Source # 
Instance details

Defined in Data.Timeline

Associated Types

type Rep (Overlaps t a) :: Type -> Type #

Methods

from :: Overlaps t a -> Rep (Overlaps t a) x #

to :: Rep (Overlaps t a) x -> Overlaps t a #

(Show t, Show a) => Show (Overlaps t a) Source # 
Instance details

Defined in Data.Timeline

Methods

showsPrec :: Int -> Overlaps t a -> ShowS #

show :: Overlaps t a -> String #

showList :: [Overlaps t a] -> ShowS #

(Eq t, Eq a) => Eq (Overlaps t a) Source # 
Instance details

Defined in Data.Timeline

Methods

(==) :: Overlaps t a -> Overlaps t a -> Bool #

(/=) :: Overlaps t a -> Overlaps t a -> Bool #

type Rep (Overlaps t a) Source # 
Instance details

Defined in Data.Timeline

type Rep (Overlaps t a) = D1 ('MetaData "Overlaps" "Data.Timeline" "timeline-0.1.0.0-Els8rI9h1Gu6CrwyQ0J0wq" 'True) (C1 ('MetaCons "Overlaps" 'PrefixI 'True) (S1 ('MetaSel ('Just "groups") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty (OverlapGroup t a)))))

prettyOverlaps :: (Show t, Show a) => Overlaps t a -> Text Source #

Pretty-print Overlaps a, like prettyTimeline.

data OverlapGroup t a Source #

A group of overlapping records. There must be at least two records within a group.

Constructors

OverlapGroup (Record t a) (Record t a) [Record t a] 

Instances

Instances details
Generic (OverlapGroup t a) Source # 
Instance details

Defined in Data.Timeline

Associated Types

type Rep (OverlapGroup t a) :: Type -> Type #

Methods

from :: OverlapGroup t a -> Rep (OverlapGroup t a) x #

to :: Rep (OverlapGroup t a) x -> OverlapGroup t a #

(Show t, Show a) => Show (OverlapGroup t a) Source # 
Instance details

Defined in Data.Timeline

(Eq t, Eq a) => Eq (OverlapGroup t a) Source # 
Instance details

Defined in Data.Timeline

Methods

(==) :: OverlapGroup t a -> OverlapGroup t a -> Bool #

(/=) :: OverlapGroup t a -> OverlapGroup t a -> Bool #

type Rep (OverlapGroup t a) Source # 
Instance details

Defined in Data.Timeline

type Rep (OverlapGroup t a) = D1 ('MetaData "OverlapGroup" "Data.Timeline" "timeline-0.1.0.0-Els8rI9h1Gu6CrwyQ0J0wq" 'False) (C1 ('MetaCons "OverlapGroup" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Record t a)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Record t a)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Record t a]))))

unpackOverlapGroup :: OverlapGroup t a -> [Record t a] Source #

Unpack OverlapGroup a as a list of records.