Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- data Timeline t a = Timeline {
- initialValue :: a
- values :: Map t a
- peek :: Ord t => Timeline t a -> t -> a
- prettyTimeline :: forall t a. (Ord t, Show t, Show a) => Timeline t a -> Text
- changes :: Timeline t a -> Set t
- data TimeRange t = TimeRange {}
- isTimeAfterRange :: Ord t => t -> TimeRange t -> Bool
- data Record t a
- makeRecord :: Ord t => t -> Maybe t -> a -> Maybe (Record t a)
- makeRecordTH :: (Ord t, Lift (Record t a)) => t -> Maybe t -> a -> SpliceQ (Record t a)
- recordFrom :: Record t a -> t
- recordTo :: Record t a -> Maybe t
- recordValue :: Record t a -> a
- prettyRecord :: (Show t, Show a) => Record t a -> Text
- fromRecords :: forall t a. Ord t => [Record t a] -> Either (Overlaps t a) (Timeline t (Maybe a))
- newtype Overlaps t a = Overlaps {
- groups :: NonEmpty (OverlapGroup t a)
- prettyOverlaps :: (Show t, Show a) => Overlaps t a -> Text
- data OverlapGroup t a = OverlapGroup (Record t a) (Record t a) [Record t a]
- unpackOverlapGroup :: OverlapGroup t a -> [Record t a]
Core types and functions
A unbounded discrete timeline for data type a
.
always has
a value for any time, but the value can only change for a finite number of
times.Timeline
a
Functor
,Foldable
andTraversable
instances are provided to traverse through the timeline;FunctorWithIndex
,Foldable
andTraversableWithIndex
instances are provided in case you need the current time range where each value holdsApplicative
instance can be used to merge multipleTimeline
s together
Timeline | |
|
Instances
Foldable (Timeline t) Source # | |
Defined in Data.Timeline 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 # | |
Traversable (Timeline t) Source # | |
Ord t => Applicative (Timeline t) Source # | |
Functor (Timeline t) Source # | |
Ord t => FoldableWithIndex (TimeRange t) (Timeline t) Source # | |
Defined in Data.Timeline 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 # | |
Ord t => TraversableWithIndex (TimeRange t) (Timeline t) Source # | |
Defined in Data.Timeline | |
Generic (Timeline t a) Source # | |
(Show a, Show t) => Show (Timeline t a) Source # | |
(Eq a, Eq t) => Eq (Timeline t a) Source # | |
type Rep (Timeline t a) Source # | |
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)))) |
Extract a single value from the timeline
A time range. Each bound is optional. Nothing
represents infinity.
Instances
isTimeAfterRange :: Ord t => t -> TimeRange t -> Bool Source #
If all time in TimeRange
is less than the given time
Upper bound effectiveness time handling
A value with effectiveFrom
and effectiveTo
attached. This is often the
type we get from inputs. A list of
can be converted to
Record
a
. See Timeline
(Maybe
a)fromRecords
.
Instances
Lift a => Lift (Record UTCTime a :: Type) Source # | Special support for |
Foldable (Record t) Source # | |
Defined in Data.Timeline 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 # elem :: Eq a => a -> Record t a -> Bool # maximum :: Ord a => Record t a -> a # minimum :: Ord a => Record t a -> a # | |
Traversable (Record t) Source # | |
Functor (Record t) Source # | |
(Lift t, Lift a) => Lift (Record t a :: Type) Source # | |
(Show t, Show a) => Show (Record t a) Source # | |
(Eq t, Eq a) => Eq (Record t a) Source # | |
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
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
, like Record
aprettyTimeline
.
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 Record
s.
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
can be used to convert
Timeline
a
to Timeline
(Maybe
a)Maybe
(Timeline
a)
An
consists of several groups. Within each group, all
records are connected. Definition of connectivity: two records are
"connected" if and only if they overlap.Overlaps
a
Overlaps | |
|
Instances
Semigroup (Overlaps t a) Source # | |
Generic (Overlaps t a) Source # | |
(Show t, Show a) => Show (Overlaps t a) Source # | |
(Eq t, Eq a) => Eq (Overlaps t a) Source # | |
type Rep (Overlaps t a) Source # | |
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
, like Overlaps
aprettyTimeline
.
data OverlapGroup t a Source #
A group of overlapping records. There must be at least two records within a group.
OverlapGroup (Record t a) (Record t a) [Record t a] |
Instances
unpackOverlapGroup :: OverlapGroup t a -> [Record t a] Source #
Unpack
as a list of records.OverlapGroup
a