{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

module Data.Timeline
  ( -- * Core types and functions
    Timeline (..),
    peek,
    prettyTimeline,
    changes,
    TimeRange (..),
    isTimeAfterRange,

    -- * Upper bound effectiveness time handling
    Record,
    makeRecord,
    makeRecordTH,
    recordFrom,
    recordTo,
    recordValue,
    prettyRecord,
    fromRecords,
    Overlaps (..),
    prettyOverlaps,
    OverlapGroup (..),
    unpackOverlapGroup,
  )
where

import Data.Foldable.WithIndex (FoldableWithIndex (..))
import Data.Foldable1 (fold1)
import Data.Functor.Contravariant (Contravariant, contramap)
import Data.Functor.WithIndex (FunctorWithIndex (..))
import Data.List (intercalate, sortOn)
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (mapMaybe, maybeToList)
import Data.Set (Set)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time
  ( UTCTime (..),
    diffTimeToPicoseconds,
    picosecondsToDiffTime,
  )
import Data.Time.Calendar.OrdinalDate (fromOrdinalDate, toOrdinalDate)
import Data.Traversable.WithIndex (TraversableWithIndex (..))
import GHC.Generics (Generic)
import GHC.Records (HasField (getField))
import Language.Haskell.TH.Syntax qualified as TH (Lift (liftTyped))
import Language.Haskell.TH.Syntax.Compat qualified as TH
import Prelude

-- | 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.
--
-- * 'Functor', 'Foldable' and 'Traversable' instances are provided to traverse
--   through the timeline;
-- * 'FunctorWithIndex', 'Foldable' and 'TraversableWithIndex' instances are
-- provided in case you need the current time range where each value holds
-- * 'Applicative' instance can be used to merge multiple 'Timeline's together
data Timeline t a = Timeline
  { -- | the value from negative infinity time to the first time in 'values'
    forall t a. Timeline t a -> a
initialValue :: a,
    -- | changes are keyed by their "effective from" time, for easier lookup
    forall t a. Timeline t a -> Map t a
values :: Map t a
  }
  deriving stock (Int -> Timeline t a -> ShowS
[Timeline t a] -> ShowS
Timeline t a -> String
(Int -> Timeline t a -> ShowS)
-> (Timeline t a -> String)
-> ([Timeline t a] -> ShowS)
-> Show (Timeline t a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t a. (Show a, Show t) => Int -> Timeline t a -> ShowS
forall t a. (Show a, Show t) => [Timeline t a] -> ShowS
forall t a. (Show a, Show t) => Timeline t a -> String
$cshowsPrec :: forall t a. (Show a, Show t) => Int -> Timeline t a -> ShowS
showsPrec :: Int -> Timeline t a -> ShowS
$cshow :: forall t a. (Show a, Show t) => Timeline t a -> String
show :: Timeline t a -> String
$cshowList :: forall t a. (Show a, Show t) => [Timeline t a] -> ShowS
showList :: [Timeline t a] -> ShowS
Show, Timeline t a -> Timeline t a -> Bool
(Timeline t a -> Timeline t a -> Bool)
-> (Timeline t a -> Timeline t a -> Bool) -> Eq (Timeline t a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t a. (Eq a, Eq t) => Timeline t a -> Timeline t a -> Bool
$c== :: forall t a. (Eq a, Eq t) => Timeline t a -> Timeline t a -> Bool
== :: Timeline t a -> Timeline t a -> Bool
$c/= :: forall t a. (Eq a, Eq t) => Timeline t a -> Timeline t a -> Bool
/= :: Timeline t a -> Timeline t a -> Bool
Eq, (forall x. Timeline t a -> Rep (Timeline t a) x)
-> (forall x. Rep (Timeline t a) x -> Timeline t a)
-> Generic (Timeline t a)
forall x. Rep (Timeline t a) x -> Timeline t a
forall x. Timeline t a -> Rep (Timeline t a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t a x. Rep (Timeline t a) x -> Timeline t a
forall t a x. Timeline t a -> Rep (Timeline t a) x
$cfrom :: forall t a x. Timeline t a -> Rep (Timeline t a) x
from :: forall x. Timeline t a -> Rep (Timeline t a) x
$cto :: forall t a x. Rep (Timeline t a) x -> Timeline t a
to :: forall x. Rep (Timeline t a) x -> Timeline t a
Generic, (forall a b. (a -> b) -> Timeline t a -> Timeline t b)
-> (forall a b. a -> Timeline t b -> Timeline t a)
-> Functor (Timeline t)
forall a b. a -> Timeline t b -> Timeline t a
forall a b. (a -> b) -> Timeline t a -> Timeline t b
forall t a b. a -> Timeline t b -> Timeline t a
forall t a b. (a -> b) -> Timeline t a -> Timeline t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall t a b. (a -> b) -> Timeline t a -> Timeline t b
fmap :: forall a b. (a -> b) -> Timeline t a -> Timeline t b
$c<$ :: forall t a b. a -> Timeline t b -> Timeline t a
<$ :: forall a b. a -> Timeline t b -> Timeline t a
Functor, (forall m. Monoid m => Timeline t m -> m)
-> (forall m a. Monoid m => (a -> m) -> Timeline t a -> m)
-> (forall m a. Monoid m => (a -> m) -> Timeline t a -> m)
-> (forall a b. (a -> b -> b) -> b -> Timeline t a -> b)
-> (forall a b. (a -> b -> b) -> b -> Timeline t a -> b)
-> (forall b a. (b -> a -> b) -> b -> Timeline t a -> b)
-> (forall b a. (b -> a -> b) -> b -> Timeline t a -> b)
-> (forall a. (a -> a -> a) -> Timeline t a -> a)
-> (forall a. (a -> a -> a) -> Timeline t a -> a)
-> (forall a. Timeline t a -> [a])
-> (forall a. Timeline t a -> Bool)
-> (forall a. Timeline t a -> Int)
-> (forall a. Eq a => a -> Timeline t a -> Bool)
-> (forall a. Ord a => Timeline t a -> a)
-> (forall a. Ord a => Timeline t a -> a)
-> (forall a. Num a => Timeline t a -> a)
-> (forall a. Num a => Timeline t a -> a)
-> Foldable (Timeline t)
forall a. Eq a => a -> Timeline t a -> Bool
forall a. Num a => Timeline t a -> a
forall a. Ord a => Timeline t a -> a
forall m. Monoid m => Timeline t m -> m
forall a. Timeline t a -> Bool
forall a. Timeline t a -> Int
forall a. Timeline t a -> [a]
forall a. (a -> a -> a) -> Timeline t a -> a
forall t a. Eq a => a -> Timeline t a -> Bool
forall t a. Num a => Timeline t a -> a
forall t a. Ord a => Timeline t a -> a
forall m a. Monoid m => (a -> m) -> Timeline t a -> m
forall t m. Monoid m => Timeline t m -> m
forall t a. Timeline t a -> Bool
forall t a. Timeline t a -> Int
forall t a. Timeline t a -> [a]
forall b a. (b -> a -> b) -> b -> Timeline t a -> b
forall a b. (a -> b -> b) -> b -> Timeline t a -> b
forall t a. (a -> a -> a) -> Timeline t a -> a
forall t m a. Monoid m => (a -> m) -> Timeline t a -> m
forall t b a. (b -> a -> b) -> b -> Timeline t a -> b
forall t a b. (a -> b -> b) -> b -> Timeline t a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall t m. Monoid m => Timeline t m -> m
fold :: forall m. Monoid m => Timeline t m -> m
$cfoldMap :: forall t m a. Monoid m => (a -> m) -> Timeline t a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Timeline t a -> m
$cfoldMap' :: forall t m a. Monoid m => (a -> m) -> Timeline t a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Timeline t a -> m
$cfoldr :: forall t a b. (a -> b -> b) -> b -> Timeline t a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Timeline t a -> b
$cfoldr' :: forall t a b. (a -> b -> b) -> b -> Timeline t a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Timeline t a -> b
$cfoldl :: forall t b a. (b -> a -> b) -> b -> Timeline t a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Timeline t a -> b
$cfoldl' :: forall t b a. (b -> a -> b) -> b -> Timeline t a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Timeline t a -> b
$cfoldr1 :: forall t a. (a -> a -> a) -> Timeline t a -> a
foldr1 :: forall a. (a -> a -> a) -> Timeline t a -> a
$cfoldl1 :: forall t a. (a -> a -> a) -> Timeline t a -> a
foldl1 :: forall a. (a -> a -> a) -> Timeline t a -> a
$ctoList :: forall t a. Timeline t a -> [a]
toList :: forall a. Timeline t a -> [a]
$cnull :: forall t a. Timeline t a -> Bool
null :: forall a. Timeline t a -> Bool
$clength :: forall t a. Timeline t a -> Int
length :: forall a. Timeline t a -> Int
$celem :: forall t a. Eq a => a -> Timeline t a -> Bool
elem :: forall a. Eq a => a -> Timeline t a -> Bool
$cmaximum :: forall t a. Ord a => Timeline t a -> a
maximum :: forall a. Ord a => Timeline t a -> a
$cminimum :: forall t a. Ord a => Timeline t a -> a
minimum :: forall a. Ord a => Timeline t a -> a
$csum :: forall t a. Num a => Timeline t a -> a
sum :: forall a. Num a => Timeline t a -> a
$cproduct :: forall t a. Num a => Timeline t a -> a
product :: forall a. Num a => Timeline t a -> a
Foldable, Functor (Timeline t)
Foldable (Timeline t)
(Functor (Timeline t), Foldable (Timeline t)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Timeline t a -> f (Timeline t b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Timeline t (f a) -> f (Timeline t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Timeline t a -> m (Timeline t b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Timeline t (m a) -> m (Timeline t a))
-> Traversable (Timeline t)
forall t. Functor (Timeline t)
forall t. Foldable (Timeline t)
forall t (m :: * -> *) a.
Monad m =>
Timeline t (m a) -> m (Timeline t a)
forall t (f :: * -> *) a.
Applicative f =>
Timeline t (f a) -> f (Timeline t a)
forall t (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Timeline t a -> m (Timeline t b)
forall t (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Timeline t a -> f (Timeline t b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Timeline t (m a) -> m (Timeline t a)
forall (f :: * -> *) a.
Applicative f =>
Timeline t (f a) -> f (Timeline t a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Timeline t a -> m (Timeline t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Timeline t a -> f (Timeline t b)
$ctraverse :: forall t (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Timeline t a -> f (Timeline t b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Timeline t a -> f (Timeline t b)
$csequenceA :: forall t (f :: * -> *) a.
Applicative f =>
Timeline t (f a) -> f (Timeline t a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Timeline t (f a) -> f (Timeline t a)
$cmapM :: forall t (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Timeline t a -> m (Timeline t b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Timeline t a -> m (Timeline t b)
$csequence :: forall t (m :: * -> *) a.
Monad m =>
Timeline t (m a) -> m (Timeline t a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Timeline t (m a) -> m (Timeline t a)
Traversable)

instance (Ord t) => Applicative (Timeline t) where
  pure :: a -> Timeline t a
  pure :: forall a. a -> Timeline t a
pure a
a = Timeline {$sel:initialValue:Timeline :: a
initialValue = a
a, values :: Map t a
values = Map t a
forall a. Monoid a => a
mempty}

  (<*>) :: forall a b. Timeline t (a -> b) -> Timeline t a -> Timeline t b
  fs :: Timeline t (a -> b)
fs@Timeline {$sel:initialValue:Timeline :: forall t a. Timeline t a -> a
initialValue = a -> b
initialFunc, values :: forall t a. Timeline t a -> Map t a
values = Map t (a -> b)
funcs} <*> :: forall a b. Timeline t (a -> b) -> Timeline t a -> Timeline t b
<*> xs :: Timeline t a
xs@Timeline {a
$sel:initialValue:Timeline :: forall t a. Timeline t a -> a
initialValue :: a
initialValue, Map t a
values :: forall t a. Timeline t a -> Map t a
values :: Map t a
values} =
    Timeline
      { $sel:initialValue:Timeline :: b
initialValue = a -> b
initialFunc a
initialValue,
        values :: Map t b
values = Map t b
mergedValues
      }
    where
      mergedValues :: Map t b
      mergedValues :: Map t b
mergedValues =
        SimpleWhenMissing t (a -> b) b
-> SimpleWhenMissing t a b
-> SimpleWhenMatched t (a -> b) a b
-> Map t (a -> b)
-> Map t a
-> Map t b
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
          ((t -> (a -> b) -> b) -> SimpleWhenMissing t (a -> b) b
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing ((t -> (a -> b) -> b) -> SimpleWhenMissing t (a -> b) b)
-> (t -> (a -> b) -> b) -> SimpleWhenMissing t (a -> b) b
forall a b. (a -> b) -> a -> b
$ \t
t a -> b
f -> a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Timeline t a -> t -> a
forall t a. Ord t => Timeline t a -> t -> a
peek Timeline t a
xs t
t)
          ((t -> a -> b) -> SimpleWhenMissing t a b
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing ((t -> a -> b) -> SimpleWhenMissing t a b)
-> (t -> a -> b) -> SimpleWhenMissing t a b
forall a b. (a -> b) -> a -> b
$ \t
t a
x -> Timeline t (a -> b) -> t -> a -> b
forall t a. Ord t => Timeline t a -> t -> a
peek Timeline t (a -> b)
fs t
t a
x)
          ((t -> (a -> b) -> a -> b) -> SimpleWhenMatched t (a -> b) a b
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (((a -> b) -> a -> b) -> t -> (a -> b) -> a -> b
forall a b. a -> b -> a
const (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)))
          Map t (a -> b)
funcs
          Map t a
values

tshow :: (Show a) => a -> Text
tshow :: forall a. Show a => a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | 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.
prettyTimeline :: forall t a. (Ord t, Show t, Show a) => Timeline t a -> Text
prettyTimeline :: forall t a. (Ord t, Show t, Show a) => Timeline t a -> Text
prettyTimeline Timeline {a
$sel:initialValue:Timeline :: forall t a. Timeline t a -> a
initialValue :: a
initialValue, Map t a
values :: forall t a. Timeline t a -> Map t a
values :: Map t a
values} =
  [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    Text
"\n----------Timeline--Start-------------"
      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text
"initial value:                 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
initialValue)
      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((t, a) -> Text) -> [(t, a)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t, a) -> Text
showOneChange (Map t a -> [(t, a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map t a
values)
      [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"----------Timeline--End---------------"]
  where
    showOneChange :: (t, a) -> Text
    showOneChange :: (t, a) -> Text
showOneChange (t
t, a
x) = Text
"since " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> t -> Text
forall a. Show a => a -> Text
tshow t
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
x

-- | Extract a single value from the timeline
peek ::
  (Ord t) =>
  Timeline t a ->
  -- | the time to peek
  t ->
  a
peek :: forall t a. Ord t => Timeline t a -> t -> a
peek Timeline {a
Map t a
values :: forall t a. Timeline t a -> Map t a
$sel:initialValue:Timeline :: forall t a. Timeline t a -> a
initialValue :: a
values :: Map t a
..} t
time = a -> ((t, a) -> a) -> Maybe (t, a) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
initialValue (t, a) -> a
forall a b. (a, b) -> b
snd (Maybe (t, a) -> a) -> Maybe (t, a) -> a
forall a b. (a -> b) -> a -> b
$ t -> Map t a -> Maybe (t, a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE t
time Map t a
values

-- | A time range. Each bound is optional. 'Nothing' represents infinity.
data TimeRange t = TimeRange
  { -- | inclusive
    forall t. TimeRange t -> Maybe t
from :: Maybe t,
    -- | exclusive
    forall t. TimeRange t -> Maybe t
to :: Maybe t
  }
  deriving stock (Int -> TimeRange t -> ShowS
[TimeRange t] -> ShowS
TimeRange t -> String
(Int -> TimeRange t -> ShowS)
-> (TimeRange t -> String)
-> ([TimeRange t] -> ShowS)
-> Show (TimeRange t)
forall t. Show t => Int -> TimeRange t -> ShowS
forall t. Show t => [TimeRange t] -> ShowS
forall t. Show t => TimeRange t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> TimeRange t -> ShowS
showsPrec :: Int -> TimeRange t -> ShowS
$cshow :: forall t. Show t => TimeRange t -> String
show :: TimeRange t -> String
$cshowList :: forall t. Show t => [TimeRange t] -> ShowS
showList :: [TimeRange t] -> ShowS
Show, TimeRange t -> TimeRange t -> Bool
(TimeRange t -> TimeRange t -> Bool)
-> (TimeRange t -> TimeRange t -> Bool) -> Eq (TimeRange t)
forall t. Eq t => TimeRange t -> TimeRange t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => TimeRange t -> TimeRange t -> Bool
== :: TimeRange t -> TimeRange t -> Bool
$c/= :: forall t. Eq t => TimeRange t -> TimeRange t -> Bool
/= :: TimeRange t -> TimeRange t -> Bool
Eq, Eq (TimeRange t)
Eq (TimeRange t) =>
(TimeRange t -> TimeRange t -> Ordering)
-> (TimeRange t -> TimeRange t -> Bool)
-> (TimeRange t -> TimeRange t -> Bool)
-> (TimeRange t -> TimeRange t -> Bool)
-> (TimeRange t -> TimeRange t -> Bool)
-> (TimeRange t -> TimeRange t -> TimeRange t)
-> (TimeRange t -> TimeRange t -> TimeRange t)
-> Ord (TimeRange t)
TimeRange t -> TimeRange t -> Bool
TimeRange t -> TimeRange t -> Ordering
TimeRange t -> TimeRange t -> TimeRange t
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t. Ord t => Eq (TimeRange t)
forall t. Ord t => TimeRange t -> TimeRange t -> Bool
forall t. Ord t => TimeRange t -> TimeRange t -> Ordering
forall t. Ord t => TimeRange t -> TimeRange t -> TimeRange t
$ccompare :: forall t. Ord t => TimeRange t -> TimeRange t -> Ordering
compare :: TimeRange t -> TimeRange t -> Ordering
$c< :: forall t. Ord t => TimeRange t -> TimeRange t -> Bool
< :: TimeRange t -> TimeRange t -> Bool
$c<= :: forall t. Ord t => TimeRange t -> TimeRange t -> Bool
<= :: TimeRange t -> TimeRange t -> Bool
$c> :: forall t. Ord t => TimeRange t -> TimeRange t -> Bool
> :: TimeRange t -> TimeRange t -> Bool
$c>= :: forall t. Ord t => TimeRange t -> TimeRange t -> Bool
>= :: TimeRange t -> TimeRange t -> Bool
$cmax :: forall t. Ord t => TimeRange t -> TimeRange t -> TimeRange t
max :: TimeRange t -> TimeRange t -> TimeRange t
$cmin :: forall t. Ord t => TimeRange t -> TimeRange t -> TimeRange t
min :: TimeRange t -> TimeRange t -> TimeRange t
Ord, (forall x. TimeRange t -> Rep (TimeRange t) x)
-> (forall x. Rep (TimeRange t) x -> TimeRange t)
-> Generic (TimeRange t)
forall x. Rep (TimeRange t) x -> TimeRange t
forall x. TimeRange t -> Rep (TimeRange t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x. Rep (TimeRange t) x -> TimeRange t
forall t x. TimeRange t -> Rep (TimeRange t) x
$cfrom :: forall t x. TimeRange t -> Rep (TimeRange t) x
from :: forall x. TimeRange t -> Rep (TimeRange t) x
$cto :: forall t x. Rep (TimeRange t) x -> TimeRange t
to :: forall x. Rep (TimeRange t) x -> TimeRange t
Generic)

-- | If all time in 'TimeRange' is less than the given time
isTimeAfterRange :: (Ord t) => t -> TimeRange t -> Bool
isTimeAfterRange :: forall t. Ord t => t -> TimeRange t -> Bool
isTimeAfterRange t
t TimeRange {Maybe t
$sel:to:TimeRange :: forall t. TimeRange t -> Maybe t
to :: Maybe t
to} = Bool -> (t -> Bool) -> Maybe t -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (t
t t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe t
to

instance (Ord t) => FunctorWithIndex (TimeRange t) (Timeline t) where
  imap :: (TimeRange t -> a -> b) -> Timeline t a -> Timeline t b
  imap :: forall a b. (TimeRange t -> a -> b) -> Timeline t a -> Timeline t b
imap TimeRange t -> a -> b
f Timeline {a
Map t a
values :: forall t a. Timeline t a -> Map t a
$sel:initialValue:Timeline :: forall t a. Timeline t a -> a
initialValue :: a
values :: Map t a
..} =
    Timeline
      { $sel:initialValue:Timeline :: b
initialValue = TimeRange t -> a -> b
f TimeRange t
initialRange a
initialValue,
        values :: Map t b
values = ((t -> a -> b) -> Map t a -> Map t b)
-> Map t a -> (t -> a -> b) -> Map t b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (t -> a -> b) -> Map t a -> Map t b
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Map t a
values ((t -> a -> b) -> Map t b) -> (t -> a -> b) -> Map t b
forall a b. (a -> b) -> a -> b
$ \t
from a
value ->
          let timeRange :: TimeRange t
timeRange = Maybe t -> Maybe t -> TimeRange t
forall t. Maybe t -> Maybe t -> TimeRange t
TimeRange (t -> Maybe t
forall a. a -> Maybe a
Just t
from) ((t, a) -> t
forall a b. (a, b) -> a
fst ((t, a) -> t) -> Maybe (t, a) -> Maybe t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Map t a -> Maybe (t, a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT t
from Map t a
values)
           in TimeRange t -> a -> b
f TimeRange t
timeRange a
value
      }
    where
      initialRange :: TimeRange t
initialRange = Maybe t -> Maybe t -> TimeRange t
forall t. Maybe t -> Maybe t -> TimeRange t
TimeRange Maybe t
forall a. Maybe a
Nothing (Maybe t -> TimeRange t) -> Maybe t -> TimeRange t
forall a b. (a -> b) -> a -> b
$ (t, a) -> t
forall a b. (a, b) -> a
fst ((t, a) -> t) -> Maybe (t, a) -> Maybe t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map t a -> Maybe (t, a)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMin Map t a
values

instance (Ord t) => FoldableWithIndex (TimeRange t) (Timeline t)

instance (Ord t) => TraversableWithIndex (TimeRange t) (Timeline t) where
  itraverse :: (Applicative f) => (TimeRange t -> a -> f b) -> Timeline t a -> f (Timeline t b)
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(TimeRange t -> a -> f b) -> Timeline t a -> f (Timeline t b)
itraverse TimeRange t -> a -> f b
f = Timeline t (f b) -> f (Timeline t b)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Timeline t (f a) -> f (Timeline t a)
sequenceA (Timeline t (f b) -> f (Timeline t b))
-> (Timeline t a -> Timeline t (f b))
-> Timeline t a
-> f (Timeline t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeRange t -> a -> f b) -> Timeline t a -> Timeline t (f b)
forall a b. (TimeRange t -> a -> b) -> Timeline t a -> Timeline t b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap TimeRange t -> a -> f b
f

-- | Return the set of time when the value changes
changes :: Timeline t a -> Set t
changes :: forall t a. Timeline t a -> Set t
changes Timeline {Map t a
values :: forall t a. Timeline t a -> Map t a
values :: Map t a
values} = Map t a -> Set t
forall k a. Map k a -> Set k
Map.keysSet Map t a
values

-- | 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'.
data Record t a = Record
  { -- | inclusive
    forall t a. Record t a -> t
from :: t,
    -- | exclusive. When 'Nothing', the record never expires, until there is
    -- another record with a newer 'effectiveFrom' time.
    forall t a. Record t a -> Maybe t
to :: Maybe t,
    forall t a. Record t a -> a
value :: a
  }
  deriving stock (Int -> Record t a -> ShowS
[Record t a] -> ShowS
Record t a -> String
(Int -> Record t a -> ShowS)
-> (Record t a -> String)
-> ([Record t a] -> ShowS)
-> Show (Record t a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t a. (Show t, Show a) => Int -> Record t a -> ShowS
forall t a. (Show t, Show a) => [Record t a] -> ShowS
forall t a. (Show t, Show a) => Record t a -> String
$cshowsPrec :: forall t a. (Show t, Show a) => Int -> Record t a -> ShowS
showsPrec :: Int -> Record t a -> ShowS
$cshow :: forall t a. (Show t, Show a) => Record t a -> String
show :: Record t a -> String
$cshowList :: forall t a. (Show t, Show a) => [Record t a] -> ShowS
showList :: [Record t a] -> ShowS
Show, Record t a -> Record t a -> Bool
(Record t a -> Record t a -> Bool)
-> (Record t a -> Record t a -> Bool) -> Eq (Record t a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t a. (Eq t, Eq a) => Record t a -> Record t a -> Bool
$c== :: forall t a. (Eq t, Eq a) => Record t a -> Record t a -> Bool
== :: Record t a -> Record t a -> Bool
$c/= :: forall t a. (Eq t, Eq a) => Record t a -> Record t a -> Bool
/= :: Record t a -> Record t a -> Bool
Eq, (forall a b. (a -> b) -> Record t a -> Record t b)
-> (forall a b. a -> Record t b -> Record t a)
-> Functor (Record t)
forall a b. a -> Record t b -> Record t a
forall a b. (a -> b) -> Record t a -> Record t b
forall t a b. a -> Record t b -> Record t a
forall t a b. (a -> b) -> Record t a -> Record t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall t a b. (a -> b) -> Record t a -> Record t b
fmap :: forall a b. (a -> b) -> Record t a -> Record t b
$c<$ :: forall t a b. a -> Record t b -> Record t a
<$ :: forall a b. a -> Record t b -> Record t a
Functor, (forall m. Monoid m => Record t m -> m)
-> (forall m a. Monoid m => (a -> m) -> Record t a -> m)
-> (forall m a. Monoid m => (a -> m) -> Record t a -> m)
-> (forall a b. (a -> b -> b) -> b -> Record t a -> b)
-> (forall a b. (a -> b -> b) -> b -> Record t a -> b)
-> (forall b a. (b -> a -> b) -> b -> Record t a -> b)
-> (forall b a. (b -> a -> b) -> b -> Record t a -> b)
-> (forall a. (a -> a -> a) -> Record t a -> a)
-> (forall a. (a -> a -> a) -> Record t a -> a)
-> (forall a. Record t a -> [a])
-> (forall a. Record t a -> Bool)
-> (forall a. Record t a -> Int)
-> (forall a. Eq a => a -> Record t a -> Bool)
-> (forall a. Ord a => Record t a -> a)
-> (forall a. Ord a => Record t a -> a)
-> (forall a. Num a => Record t a -> a)
-> (forall a. Num a => Record t a -> a)
-> Foldable (Record t)
forall a. Eq a => a -> Record t a -> Bool
forall a. Num a => Record t a -> a
forall a. Ord a => Record t a -> a
forall m. Monoid m => Record t m -> m
forall a. Record t a -> Bool
forall a. Record t a -> Int
forall a. Record t a -> [a]
forall a. (a -> a -> a) -> Record t a -> a
forall t a. Eq a => a -> Record t a -> Bool
forall t a. Num a => Record t a -> a
forall t a. Ord a => Record t a -> a
forall m a. Monoid m => (a -> m) -> Record t a -> m
forall t m. Monoid m => Record t m -> m
forall t a. Record t a -> Bool
forall t a. Record t a -> Int
forall t a. Record t a -> [a]
forall b a. (b -> a -> b) -> b -> Record t a -> b
forall a b. (a -> b -> b) -> b -> Record t a -> b
forall t a. (a -> a -> a) -> Record t a -> a
forall t m a. Monoid m => (a -> m) -> Record t a -> m
forall t b a. (b -> a -> b) -> b -> Record t a -> b
forall t a b. (a -> b -> b) -> b -> Record t a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall t m. Monoid m => Record t m -> m
fold :: forall m. Monoid m => Record t m -> m
$cfoldMap :: forall t m a. Monoid m => (a -> m) -> Record t a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Record t a -> m
$cfoldMap' :: forall t m a. Monoid m => (a -> m) -> Record t a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Record t a -> m
$cfoldr :: forall t a b. (a -> b -> b) -> b -> Record t a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Record t a -> b
$cfoldr' :: forall t a b. (a -> b -> b) -> b -> Record t a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Record t a -> b
$cfoldl :: forall t b a. (b -> a -> b) -> b -> Record t a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Record t a -> b
$cfoldl' :: forall t b a. (b -> a -> b) -> b -> Record t a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Record t a -> b
$cfoldr1 :: forall t a. (a -> a -> a) -> Record t a -> a
foldr1 :: forall a. (a -> a -> a) -> Record t a -> a
$cfoldl1 :: forall t a. (a -> a -> a) -> Record t a -> a
foldl1 :: forall a. (a -> a -> a) -> Record t a -> a
$ctoList :: forall t a. Record t a -> [a]
toList :: forall a. Record t a -> [a]
$cnull :: forall t a. Record t a -> Bool
null :: forall a. Record t a -> Bool
$clength :: forall t a. Record t a -> Int
length :: forall a. Record t a -> Int
$celem :: forall t a. Eq a => a -> Record t a -> Bool
elem :: forall a. Eq a => a -> Record t a -> Bool
$cmaximum :: forall t a. Ord a => Record t a -> a
maximum :: forall a. Ord a => Record t a -> a
$cminimum :: forall t a. Ord a => Record t a -> a
minimum :: forall a. Ord a => Record t a -> a
$csum :: forall t a. Num a => Record t a -> a
sum :: forall a. Num a => Record t a -> a
$cproduct :: forall t a. Num a => Record t a -> a
product :: forall a. Num a => Record t a -> a
Foldable, Functor (Record t)
Foldable (Record t)
(Functor (Record t), Foldable (Record t)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Record t a -> f (Record t b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Record t (f a) -> f (Record t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Record t a -> m (Record t b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Record t (m a) -> m (Record t a))
-> Traversable (Record t)
forall t. Functor (Record t)
forall t. Foldable (Record t)
forall t (m :: * -> *) a.
Monad m =>
Record t (m a) -> m (Record t a)
forall t (f :: * -> *) a.
Applicative f =>
Record t (f a) -> f (Record t a)
forall t (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Record t a -> m (Record t b)
forall t (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Record t a -> f (Record t b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Record t (m a) -> m (Record t a)
forall (f :: * -> *) a.
Applicative f =>
Record t (f a) -> f (Record t a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Record t a -> m (Record t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Record t a -> f (Record t b)
$ctraverse :: forall t (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Record t a -> f (Record t b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Record t a -> f (Record t b)
$csequenceA :: forall t (f :: * -> *) a.
Applicative f =>
Record t (f a) -> f (Record t a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Record t (f a) -> f (Record t a)
$cmapM :: forall t (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Record t a -> m (Record t b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Record t a -> m (Record t b)
$csequence :: forall t (m :: * -> *) a.
Monad m =>
Record t (m a) -> m (Record t a)
sequence :: forall (m :: * -> *) a. Monad m => Record t (m a) -> m (Record t a)
Traversable, (forall (m :: * -> *). Quote m => Record t a -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Record t a -> Code m (Record t a))
-> Lift (Record t a)
forall t a (m :: * -> *).
(Lift t, Lift a, Quote m) =>
Record t a -> m Exp
forall t a (m :: * -> *).
(Lift t, Lift a, Quote m) =>
Record t a -> Code m (Record t a)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Record t a -> m Exp
forall (m :: * -> *). Quote m => Record t a -> Code m (Record t a)
$clift :: forall t a (m :: * -> *).
(Lift t, Lift a, Quote m) =>
Record t a -> m Exp
lift :: forall (m :: * -> *). Quote m => Record t a -> m Exp
$cliftTyped :: forall t a (m :: * -> *).
(Lift t, Lift a, Quote m) =>
Record t a -> Code m (Record t a)
liftTyped :: forall (m :: * -> *). Quote m => Record t a -> Code m (Record t a)
TH.Lift)

-- | Get the "effective from" time
recordFrom :: Record t a -> t
recordFrom :: forall t a. Record t a -> t
recordFrom Record {t
$sel:from:Record :: forall t a. Record t a -> t
from :: t
from} = t
from

-- | Get the "effective to" time
recordTo :: Record t a -> Maybe t
recordTo :: forall t a. Record t a -> Maybe t
recordTo Record {Maybe t
$sel:to:Record :: forall t a. Record t a -> Maybe t
to :: Maybe t
to} = Maybe t
to

-- | Get the value wrapped in a @'Record' a@
recordValue :: Record t a -> a
recordValue :: forall t a. Record t a -> a
recordValue = Record t a -> a
forall t a. Record t a -> a
value

-- | A smart constructor for @'Record' a@.
-- Returns 'Nothing' if @effectiveTo@ is not greater than @effectiveFrom@
makeRecord ::
  (Ord t) =>
  -- | effective from
  t ->
  -- | optional effective to
  Maybe t ->
  -- | value
  a ->
  Maybe (Record t a)
makeRecord :: forall t a. Ord t => t -> Maybe t -> a -> Maybe (Record t a)
makeRecord t
from Maybe t
to a
value =
  if Bool -> (t -> Bool) -> Maybe t -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (t
from t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe t
to
    then Maybe (Record t a)
forall a. Maybe a
Nothing
    else Record t a -> Maybe (Record t a)
forall a. a -> Maybe a
Just Record {t
a
Maybe t
$sel:from:Record :: t
$sel:to:Record :: Maybe t
$sel:value:Record :: a
from :: t
to :: Maybe t
value :: a
..}

-- | Template Haskell counterpart of 'makeRecord'.
makeRecordTH ::
  (Ord t, TH.Lift (Record t a)) =>
  t ->
  Maybe t ->
  a ->
  TH.SpliceQ (Record t a)
makeRecordTH :: forall t a.
(Ord t, Lift (Record t a)) =>
t -> Maybe t -> a -> SpliceQ (Record t a)
makeRecordTH t
effectiveFrom Maybe t
effectiveTo a
value =
  Q (Record t a)
-> (Record t a -> Splice Q (Record t a)) -> Splice Q (Record t a)
forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> Splice m b) -> Splice m b
TH.bindSplice
    ( Q (Record t a)
-> (Record t a -> Q (Record t a))
-> Maybe (Record t a)
-> Q (Record t a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Q (Record t a)
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"effective to is no greater than effective from") Record t a -> Q (Record t a)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Record t a) -> Q (Record t a))
-> Maybe (Record t a) -> Q (Record t a)
forall a b. (a -> b) -> a -> b
$
        t -> Maybe t -> a -> Maybe (Record t a)
forall t a. Ord t => t -> Maybe t -> a -> Maybe (Record t a)
makeRecord t
effectiveFrom Maybe t
effectiveTo a
value
    )
    Record t a -> Splice Q (Record t a)
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => Record t a -> Code m (Record t a)
TH.liftTyped

-- | Special support for 'UTCTime'. This will be removed when 'TH.Lift'
-- instances are provided by the @time@ package directly.
instance {-# OVERLAPPING #-} (TH.Lift a) => TH.Lift (Record UTCTime a) where
  liftTyped :: forall (m :: * -> *).
Quote m =>
Record UTCTime a -> Code m (Record UTCTime a)
liftTyped Record {a
Maybe UTCTime
UTCTime
$sel:from:Record :: forall t a. Record t a -> t
$sel:to:Record :: forall t a. Record t a -> Maybe t
$sel:value:Record :: forall t a. Record t a -> a
from :: UTCTime
to :: Maybe UTCTime
value :: a
..} =
    [||
    t -> Maybe t -> a -> Record t a
forall t a. t -> Maybe t -> a -> Record t a
Record
      (LiftUTCTime -> UTCTime
unLiftUTCTime $$(LiftUTCTime -> Code m LiftUTCTime
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => LiftUTCTime -> Code m LiftUTCTime
TH.liftTyped (LiftUTCTime -> Code m LiftUTCTime)
-> LiftUTCTime -> Code m LiftUTCTime
forall a b. (a -> b) -> a -> b
$ UTCTime -> LiftUTCTime
LiftUTCTime UTCTime
from))
      ((a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LiftUTCTime -> UTCTime
unLiftUTCTime $$(Maybe LiftUTCTime -> Code m (Maybe LiftUTCTime)
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *).
Quote m =>
Maybe LiftUTCTime -> Code m (Maybe LiftUTCTime)
TH.liftTyped (Maybe LiftUTCTime -> Code m (Maybe LiftUTCTime))
-> Maybe LiftUTCTime -> Code m (Maybe LiftUTCTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> LiftUTCTime
LiftUTCTime (UTCTime -> LiftUTCTime) -> Maybe UTCTime -> Maybe LiftUTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
to))
      $$(a -> Code m a
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => a -> Code m a
TH.liftTyped a
value)
    ||]

newtype LiftUTCTime = LiftUTCTime UTCTime
  deriving stock ((forall x. LiftUTCTime -> Rep LiftUTCTime x)
-> (forall x. Rep LiftUTCTime x -> LiftUTCTime)
-> Generic LiftUTCTime
forall x. Rep LiftUTCTime x -> LiftUTCTime
forall x. LiftUTCTime -> Rep LiftUTCTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LiftUTCTime -> Rep LiftUTCTime x
from :: forall x. LiftUTCTime -> Rep LiftUTCTime x
$cto :: forall x. Rep LiftUTCTime x -> LiftUTCTime
to :: forall x. Rep LiftUTCTime x -> LiftUTCTime
Generic)

unLiftUTCTime :: LiftUTCTime -> UTCTime
unLiftUTCTime :: LiftUTCTime -> UTCTime
unLiftUTCTime (LiftUTCTime UTCTime
t) = UTCTime
t

instance TH.Lift LiftUTCTime where
  liftTyped :: forall (m :: * -> *). Quote m => LiftUTCTime -> Code m LiftUTCTime
liftTyped (LiftUTCTime (UTCTime (Day -> (Year, Int)
toOrdinalDate -> (Year
year, Int
day)) DiffTime
diffTime)) =
    [||
    UTCTime -> LiftUTCTime
LiftUTCTime (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$
      Day -> DiffTime -> UTCTime
UTCTime
        (Year -> Int -> Day
fromOrdinalDate $$(Year -> Code m Year
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => Year -> Code m Year
TH.liftTyped Year
year) $$(Int -> Code m Int
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => Int -> Code m Int
TH.liftTyped Int
day))
        (Year -> DiffTime
picosecondsToDiffTime $$(Year -> Code m Year
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => Year -> Code m Year
TH.liftTyped (DiffTime -> Year
diffTimeToPicoseconds DiffTime
diffTime)))
    ||]

-- | Pretty-print @'Record' a@, like 'prettyTimeline'.
prettyRecord :: (Show t, Show a) => Record t a -> Text
prettyRecord :: forall t a. (Show t, Show a) => Record t a -> Text
prettyRecord Record {t
a
Maybe t
$sel:from:Record :: forall t a. Record t a -> t
$sel:to:Record :: forall t a. Record t a -> Maybe t
$sel:value:Record :: forall t a. Record t a -> a
from :: t
to :: Maybe t
value :: a
..} = t -> Text
forall a. Show a => a -> Text
tshow t
from Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ~ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe t -> Text
forall a. Show a => a -> Text
tshow Maybe t
to Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
tshow a
value

-- | 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.
newtype Overlaps t a = Overlaps {forall t a. Overlaps t a -> NonEmpty (OverlapGroup t a)
groups :: NonEmpty (OverlapGroup t a)}
  deriving newtype (NonEmpty (Overlaps t a) -> Overlaps t a
Overlaps t a -> Overlaps t a -> Overlaps t a
(Overlaps t a -> Overlaps t a -> Overlaps t a)
-> (NonEmpty (Overlaps t a) -> Overlaps t a)
-> (forall b. Integral b => b -> Overlaps t a -> Overlaps t a)
-> Semigroup (Overlaps t a)
forall b. Integral b => b -> Overlaps t a -> Overlaps t a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall t a. NonEmpty (Overlaps t a) -> Overlaps t a
forall t a. Overlaps t a -> Overlaps t a -> Overlaps t a
forall t a b. Integral b => b -> Overlaps t a -> Overlaps t a
$c<> :: forall t a. Overlaps t a -> Overlaps t a -> Overlaps t a
<> :: Overlaps t a -> Overlaps t a -> Overlaps t a
$csconcat :: forall t a. NonEmpty (Overlaps t a) -> Overlaps t a
sconcat :: NonEmpty (Overlaps t a) -> Overlaps t a
$cstimes :: forall t a b. Integral b => b -> Overlaps t a -> Overlaps t a
stimes :: forall b. Integral b => b -> Overlaps t a -> Overlaps t a
Semigroup)
  deriving stock (Int -> Overlaps t a -> ShowS
[Overlaps t a] -> ShowS
Overlaps t a -> String
(Int -> Overlaps t a -> ShowS)
-> (Overlaps t a -> String)
-> ([Overlaps t a] -> ShowS)
-> Show (Overlaps t a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t a. (Show t, Show a) => Int -> Overlaps t a -> ShowS
forall t a. (Show t, Show a) => [Overlaps t a] -> ShowS
forall t a. (Show t, Show a) => Overlaps t a -> String
$cshowsPrec :: forall t a. (Show t, Show a) => Int -> Overlaps t a -> ShowS
showsPrec :: Int -> Overlaps t a -> ShowS
$cshow :: forall t a. (Show t, Show a) => Overlaps t a -> String
show :: Overlaps t a -> String
$cshowList :: forall t a. (Show t, Show a) => [Overlaps t a] -> ShowS
showList :: [Overlaps t a] -> ShowS
Show, Overlaps t a -> Overlaps t a -> Bool
(Overlaps t a -> Overlaps t a -> Bool)
-> (Overlaps t a -> Overlaps t a -> Bool) -> Eq (Overlaps t a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t a. (Eq t, Eq a) => Overlaps t a -> Overlaps t a -> Bool
$c== :: forall t a. (Eq t, Eq a) => Overlaps t a -> Overlaps t a -> Bool
== :: Overlaps t a -> Overlaps t a -> Bool
$c/= :: forall t a. (Eq t, Eq a) => Overlaps t a -> Overlaps t a -> Bool
/= :: Overlaps t a -> Overlaps t a -> Bool
Eq, (forall x. Overlaps t a -> Rep (Overlaps t a) x)
-> (forall x. Rep (Overlaps t a) x -> Overlaps t a)
-> Generic (Overlaps t a)
forall x. Rep (Overlaps t a) x -> Overlaps t a
forall x. Overlaps t a -> Rep (Overlaps t a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t a x. Rep (Overlaps t a) x -> Overlaps t a
forall t a x. Overlaps t a -> Rep (Overlaps t a) x
$cfrom :: forall t a x. Overlaps t a -> Rep (Overlaps t a) x
from :: forall x. Overlaps t a -> Rep (Overlaps t a) x
$cto :: forall t a x. Rep (Overlaps t a) x -> Overlaps t a
to :: forall x. Rep (Overlaps t a) x -> Overlaps t a
Generic)

-- | Pretty-print @'Overlaps' a@, like 'prettyTimeline'.
prettyOverlaps :: (Show t, Show a) => Overlaps t a -> Text
prettyOverlaps :: forall t a. (Show t, Show a) => Overlaps t a -> Text
prettyOverlaps Overlaps {NonEmpty (OverlapGroup t a)
$sel:groups:Overlaps :: forall t a. Overlaps t a -> NonEmpty (OverlapGroup t a)
groups :: NonEmpty (OverlapGroup t a)
groups} =
  Text
"Here are "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (NonEmpty (OverlapGroup t a) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (OverlapGroup t a)
groups)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" group(s) of overlapping records\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
sep (OverlapGroup t a -> Text
forall t a. (Show t, Show a) => OverlapGroup t a -> Text
prettyOverlapGroup (OverlapGroup t a -> Text) -> [OverlapGroup t a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (OverlapGroup t a) -> [OverlapGroup t a]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (OverlapGroup t a)
groups)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep
  where
    sep :: Text
sep = Text
"--------------------\n"

-- | A group of overlapping records. There must be at least two records within a group.
data OverlapGroup t a = OverlapGroup (Record t a) (Record t a) [Record t a]
  deriving stock (Int -> OverlapGroup t a -> ShowS
[OverlapGroup t a] -> ShowS
OverlapGroup t a -> String
(Int -> OverlapGroup t a -> ShowS)
-> (OverlapGroup t a -> String)
-> ([OverlapGroup t a] -> ShowS)
-> Show (OverlapGroup t a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t a. (Show t, Show a) => Int -> OverlapGroup t a -> ShowS
forall t a. (Show t, Show a) => [OverlapGroup t a] -> ShowS
forall t a. (Show t, Show a) => OverlapGroup t a -> String
$cshowsPrec :: forall t a. (Show t, Show a) => Int -> OverlapGroup t a -> ShowS
showsPrec :: Int -> OverlapGroup t a -> ShowS
$cshow :: forall t a. (Show t, Show a) => OverlapGroup t a -> String
show :: OverlapGroup t a -> String
$cshowList :: forall t a. (Show t, Show a) => [OverlapGroup t a] -> ShowS
showList :: [OverlapGroup t a] -> ShowS
Show, OverlapGroup t a -> OverlapGroup t a -> Bool
(OverlapGroup t a -> OverlapGroup t a -> Bool)
-> (OverlapGroup t a -> OverlapGroup t a -> Bool)
-> Eq (OverlapGroup t a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t a.
(Eq t, Eq a) =>
OverlapGroup t a -> OverlapGroup t a -> Bool
$c== :: forall t a.
(Eq t, Eq a) =>
OverlapGroup t a -> OverlapGroup t a -> Bool
== :: OverlapGroup t a -> OverlapGroup t a -> Bool
$c/= :: forall t a.
(Eq t, Eq a) =>
OverlapGroup t a -> OverlapGroup t a -> Bool
/= :: OverlapGroup t a -> OverlapGroup t a -> Bool
Eq, (forall x. OverlapGroup t a -> Rep (OverlapGroup t a) x)
-> (forall x. Rep (OverlapGroup t a) x -> OverlapGroup t a)
-> Generic (OverlapGroup t a)
forall x. Rep (OverlapGroup t a) x -> OverlapGroup t a
forall x. OverlapGroup t a -> Rep (OverlapGroup t a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t a x. Rep (OverlapGroup t a) x -> OverlapGroup t a
forall t a x. OverlapGroup t a -> Rep (OverlapGroup t a) x
$cfrom :: forall t a x. OverlapGroup t a -> Rep (OverlapGroup t a) x
from :: forall x. OverlapGroup t a -> Rep (OverlapGroup t a) x
$cto :: forall t a x. Rep (OverlapGroup t a) x -> OverlapGroup t a
to :: forall x. Rep (OverlapGroup t a) x -> OverlapGroup t a
Generic)

prettyOverlapGroup :: (Show t, Show a) => OverlapGroup t a -> Text
prettyOverlapGroup :: forall t a. (Show t, Show a) => OverlapGroup t a -> Text
prettyOverlapGroup = [Text] -> Text
T.unlines ([Text] -> Text)
-> (OverlapGroup t a -> [Text]) -> OverlapGroup t a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Record t a -> Text) -> [Record t a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Record t a -> Text
forall t a. (Show t, Show a) => Record t a -> Text
prettyRecord ([Record t a] -> [Text])
-> (OverlapGroup t a -> [Record t a]) -> OverlapGroup t a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OverlapGroup t a -> [Record t a]
forall t a. OverlapGroup t a -> [Record t a]
unpackOverlapGroup

-- | Unpack @'OverlapGroup' a@ as a list of records.
unpackOverlapGroup :: OverlapGroup t a -> [Record t a]
unpackOverlapGroup :: forall t a. OverlapGroup t a -> [Record t a]
unpackOverlapGroup (OverlapGroup Record t a
r1 Record t a
r2 [Record t a]
records) = Record t a
r1 Record t a -> [Record t a] -> [Record t a]
forall a. a -> [a] -> [a]
: Record t a
r2 Record t a -> [Record t a] -> [Record t a]
forall a. a -> [a] -> [a]
: [Record t a]
records

-- | 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 @'Timeline' a@ can be used to convert
-- @'Timeline' ('Maybe' a)@ to @'Maybe' ('Timeline' a)@
fromRecords :: forall t a. (Ord t) => [Record t a] -> Either (Overlaps t a) (Timeline t (Maybe a))
fromRecords :: forall t a.
Ord t =>
[Record t a] -> Either (Overlaps t a) (Timeline t (Maybe a))
fromRecords [Record t a]
records =
  Either (Overlaps t a) (Timeline t (Maybe a))
-> (Overlaps t a -> Either (Overlaps t a) (Timeline t (Maybe a)))
-> Maybe (Overlaps t a)
-> Either (Overlaps t a) (Timeline t (Maybe a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Timeline t (Maybe a)
-> Either (Overlaps t a) (Timeline t (Maybe a))
forall a b. b -> Either a b
Right Timeline t (Maybe a)
timeline) Overlaps t a -> Either (Overlaps t a) (Timeline t (Maybe a))
forall a b. a -> Either a b
Left Maybe (Overlaps t a)
overlaps
  where
    sortedRecords :: [Record t a]
sortedRecords = (Record t a -> t) -> [Record t a] -> [Record t a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Record t a -> t
forall t a. Record t a -> t
recordFrom [Record t a]
records

    -- overlap detection
    overlaps :: Maybe (Overlaps t a)
overlaps =
      (NonEmpty (Overlaps t a) -> Overlaps t a)
-> Maybe (NonEmpty (Overlaps t a)) -> Maybe (Overlaps t a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (Overlaps t a) -> Overlaps t a
forall m. Semigroup m => NonEmpty m -> m
forall (t :: * -> *) m. (Foldable1 t, Semigroup m) => t m -> m
fold1
        (Maybe (NonEmpty (Overlaps t a)) -> Maybe (Overlaps t a))
-> ([Record t a] -> Maybe (NonEmpty (Overlaps t a)))
-> [Record t a]
-> Maybe (Overlaps t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Overlaps t a] -> Maybe (NonEmpty (Overlaps t a))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
        ([Overlaps t a] -> Maybe (NonEmpty (Overlaps t a)))
-> ([Record t a] -> [Overlaps t a])
-> [Record t a]
-> Maybe (NonEmpty (Overlaps t a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Record t a) -> Maybe (Overlaps t a))
-> [NonEmpty (Record t a)] -> [Overlaps t a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NonEmpty (Record t a) -> Maybe (Overlaps t a)
checkForOverlap
        ([NonEmpty (Record t a)] -> [Overlaps t a])
-> ([Record t a] -> [NonEmpty (Record t a)])
-> [Record t a]
-> [Overlaps t a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Record t a -> [NonEmpty (Record t a)] -> [NonEmpty (Record t a)])
-> [NonEmpty (Record t a)]
-> [Record t a]
-> [NonEmpty (Record t a)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Record t a -> [NonEmpty (Record t a)] -> [NonEmpty (Record t a)]
mergeOverlappingNeighbours []
        ([Record t a] -> Maybe (Overlaps t a))
-> [Record t a] -> Maybe (Overlaps t a)
forall a b. (a -> b) -> a -> b
$ [Record t a]
sortedRecords

    mergeOverlappingNeighbours ::
      Record t a ->
      [NonEmpty (Record t a)] ->
      [NonEmpty (Record t a)]
    mergeOverlappingNeighbours :: Record t a -> [NonEmpty (Record t a)] -> [NonEmpty (Record t a)]
mergeOverlappingNeighbours Record t a
current ((Record t a
next :| [Record t a]
group) : [NonEmpty (Record t a)]
groups)
      -- Be aware that this is called in 'foldr', so it traverse the list from
      -- right to left. If the current record overlaps with the top (left-most)
      -- record in the next group, we add it to the group. Otherwise, create a
      -- new group for it.
      | Bool
isOverlapping = (Record t a
current Record t a -> NonEmpty (Record t a) -> NonEmpty (Record t a)
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.<| Record t a
next Record t a -> [Record t a] -> NonEmpty (Record t a)
forall a. a -> [a] -> NonEmpty a
:| [Record t a]
group) NonEmpty (Record t a)
-> [NonEmpty (Record t a)] -> [NonEmpty (Record t a)]
forall a. a -> [a] -> [a]
: [NonEmpty (Record t a)]
groups
      | Bool
otherwise = (Record t a
current Record t a -> [Record t a] -> NonEmpty (Record t a)
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty (Record t a)
-> [NonEmpty (Record t a)] -> [NonEmpty (Record t a)]
forall a. a -> [a] -> [a]
: (Record t a
next Record t a -> [Record t a] -> NonEmpty (Record t a)
forall a. a -> [a] -> NonEmpty a
:| [Record t a]
group) NonEmpty (Record t a)
-> [NonEmpty (Record t a)] -> [NonEmpty (Record t a)]
forall a. a -> [a] -> [a]
: [NonEmpty (Record t a)]
groups
      where
        isOverlapping :: Bool
isOverlapping = Bool -> (t -> Bool) -> Maybe t -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Record t a -> t
forall t a. Record t a -> t
recordFrom Record t a
next t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<) (Record t a -> Maybe t
forall t a. Record t a -> Maybe t
recordTo Record t a
current)
    mergeOverlappingNeighbours Record t a
current [] = [Record t a
current Record t a -> [Record t a] -> NonEmpty (Record t a)
forall a. a -> [a] -> NonEmpty a
:| []]

    checkForOverlap :: NonEmpty (Record t a) -> Maybe (Overlaps t a)
    checkForOverlap :: NonEmpty (Record t a) -> Maybe (Overlaps t a)
checkForOverlap (Record t a
_ :| []) = Maybe (Overlaps t a)
forall a. Maybe a
Nothing
    checkForOverlap (Record t a
x1 :| Record t a
x2 : [Record t a]
xs) = Overlaps t a -> Maybe (Overlaps t a)
forall a. a -> Maybe a
Just (Overlaps t a -> Maybe (Overlaps t a))
-> (OverlapGroup t a -> Overlaps t a)
-> OverlapGroup t a
-> Maybe (Overlaps t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (OverlapGroup t a) -> Overlaps t a
forall t a. NonEmpty (OverlapGroup t a) -> Overlaps t a
Overlaps (NonEmpty (OverlapGroup t a) -> Overlaps t a)
-> (OverlapGroup t a -> NonEmpty (OverlapGroup t a))
-> OverlapGroup t a
-> Overlaps t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OverlapGroup t a
-> [OverlapGroup t a] -> NonEmpty (OverlapGroup t a)
forall a. a -> [a] -> NonEmpty a
:| []) (OverlapGroup t a -> Maybe (Overlaps t a))
-> OverlapGroup t a -> Maybe (Overlaps t a)
forall a b. (a -> b) -> a -> b
$ Record t a -> Record t a -> [Record t a] -> OverlapGroup t a
forall t a.
Record t a -> Record t a -> [Record t a] -> OverlapGroup t a
OverlapGroup Record t a
x1 Record t a
x2 [Record t a]
xs

    -- build the timeline assuming all elements of `sortedRecords` cover
    -- distinct (non-overlapping) time-periods
    timeline :: Timeline t (Maybe a)
    timeline :: Timeline t (Maybe a)
timeline =
      case [Record t a] -> Maybe (NonEmpty (Record t a))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Record t a]
sortedRecords of
        Maybe (NonEmpty (Record t a))
Nothing -> Maybe a -> Timeline t (Maybe a)
forall a. a -> Timeline t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        Just NonEmpty (Record t a)
records' ->
          Timeline
            { $sel:initialValue:Timeline :: Maybe a
initialValue = Maybe a
forall a. Maybe a
Nothing,
              values :: Map t (Maybe a)
values =
                [(t, Maybe a)] -> Map t (Maybe a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(t, Maybe a)] -> Map t (Maybe a))
-> ([[(t, Maybe a)]] -> [(t, Maybe a)])
-> [[(t, Maybe a)]]
-> Map t (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(t, Maybe a)]] -> [(t, Maybe a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(t, Maybe a)]] -> Map t (Maybe a))
-> [[(t, Maybe a)]] -> Map t (Maybe a)
forall a b. (a -> b) -> a -> b
$
                  (Record t a -> Maybe (Record t a) -> [(t, Maybe a)])
-> [Record t a] -> [Maybe (Record t a)] -> [[(t, Maybe a)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                    Record t a -> Maybe (Record t a) -> [(t, Maybe a)]
connectAdjacentRecords
                    (NonEmpty (Record t a) -> [Record t a]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Record t a)
records')
                    ((Record t a -> Maybe (Record t a)
forall a. a -> Maybe a
Just (Record t a -> Maybe (Record t a))
-> [Record t a] -> [Maybe (Record t a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Record t a) -> [Record t a]
forall a. NonEmpty a -> [a]
NonEmpty.tail NonEmpty (Record t a)
records') [Maybe (Record t a)]
-> [Maybe (Record t a)] -> [Maybe (Record t a)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (Record t a)
forall a. Maybe a
Nothing])
            }
    connectAdjacentRecords :: Record t a -> Maybe (Record t a) -> [(t, Maybe a)]
    connectAdjacentRecords :: Record t a -> Maybe (Record t a) -> [(t, Maybe a)]
connectAdjacentRecords Record t a
current Maybe (Record t a)
next =
      (Record t a -> t
forall t a. Record t a -> t
recordFrom Record t a
current, a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Record t a -> a
forall t a. Record t a -> a
value Record t a
current)
        (t, Maybe a) -> [(t, Maybe a)] -> [(t, Maybe a)]
forall a. a -> [a] -> [a]
: Maybe (t, Maybe a) -> [(t, Maybe a)]
forall a. Maybe a -> [a]
maybeToList Maybe (t, Maybe a)
gap
      where
        gap :: Maybe (t, Maybe a)
gap = do
          t
effectiveTo' <- Record t a -> Maybe t
forall t a. Record t a -> Maybe t
recordTo Record t a
current
          if Bool -> (Record t a -> Bool) -> Maybe (Record t a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\Record t a
next' -> t
effectiveTo' t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< Record t a -> t
forall t a. Record t a -> t
recordFrom Record t a
next') Maybe (Record t a)
next
            then (t, Maybe a) -> Maybe (t, Maybe a)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
effectiveTo', Maybe a
forall a. Maybe a
Nothing)
            else Maybe (t, Maybe a)
forall a. Maybe a
Nothing