{-# 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
(
Timeline (..),
peek,
prettyTimeline,
changes,
TimeRange (..),
isTimeAfterRange,
Record,
makeRecord,
makeRecordTH,
recordFrom,
recordTo,
recordValue,
prettyRecord,
fromRecords,
Overlaps (..),
prettyOverlaps,
OverlapGroup (..),
unpackOverlapGroup,
)
where
import Data.Foldable.WithIndex (FoldableWithIndex (..))
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.Semigroup.Foldable.Class (fold1)
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
data Timeline t a = Timeline
{
forall t a. Timeline t a -> a
initialValue :: a,
forall t a. Timeline t a -> Map t a
values :: Map t a
}
deriving stock (Int -> Timeline t a -> ShowS
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
showList :: [Timeline t a] -> ShowS
$cshowList :: forall t a. (Show a, Show t) => [Timeline t a] -> ShowS
show :: Timeline t a -> String
$cshow :: forall t a. (Show a, Show t) => Timeline t a -> String
showsPrec :: Int -> Timeline t a -> ShowS
$cshowsPrec :: forall t a. (Show a, Show t) => Int -> Timeline t a -> ShowS
Show, Timeline t a -> Timeline t a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall t a. (Eq a, Eq t) => Timeline t a -> Timeline t a -> Bool
Eq, 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
$cto :: forall t a x. Rep (Timeline t a) x -> Timeline t a
$cfrom :: forall t a x. Timeline t a -> Rep (Timeline t a) x
Generic, 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
<$ :: forall a b. a -> Timeline t b -> Timeline t a
$c<$ :: forall t a b. a -> Timeline t b -> Timeline t a
fmap :: forall a b. (a -> b) -> Timeline t a -> Timeline t b
$cfmap :: forall t a b. (a -> b) -> Timeline t a -> Timeline t b
Functor, forall a. Timeline t a -> Bool
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 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
product :: forall a. Num a => Timeline t a -> a
$cproduct :: forall t a. Num a => Timeline t a -> a
sum :: forall a. Num a => Timeline t a -> a
$csum :: forall t a. Num a => Timeline t a -> a
minimum :: forall a. Ord a => Timeline t a -> a
$cminimum :: forall t a. Ord a => Timeline t a -> a
maximum :: forall a. Ord a => Timeline t a -> a
$cmaximum :: forall t a. Ord a => Timeline t a -> a
elem :: forall a. Eq a => a -> Timeline t a -> Bool
$celem :: forall t a. Eq a => a -> Timeline t a -> Bool
length :: forall a. Timeline t a -> Int
$clength :: forall t a. Timeline t a -> Int
null :: forall a. Timeline t a -> Bool
$cnull :: forall t a. Timeline t a -> Bool
toList :: forall a. Timeline t a -> [a]
$ctoList :: forall t a. Timeline t a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Timeline t a -> a
$cfoldl1 :: forall t a. (a -> a -> a) -> Timeline t a -> a
foldr1 :: forall a. (a -> a -> a) -> Timeline t a -> a
$cfoldr1 :: forall t a. (a -> a -> a) -> Timeline t a -> a
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
$cfoldl :: forall t b a. (b -> a -> 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
$cfoldr :: forall t a b. (a -> b -> b) -> b -> Timeline t a -> b
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
$cfoldMap :: forall t m a. Monoid m => (a -> m) -> Timeline t a -> m
fold :: forall m. Monoid m => Timeline t m -> m
$cfold :: forall t m. Monoid m => Timeline t m -> m
Foldable, 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Timeline t a -> f (Timeline t b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Timeline t (m a) -> m (Timeline t a)
$csequence :: forall t (m :: * -> *) a.
Monad m =>
Timeline t (m a) -> m (Timeline t a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Timeline t a -> m (Timeline t b)
$cmapM :: forall t (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Timeline t a -> m (Timeline t b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Timeline t (f a) -> f (Timeline t a)
$csequenceA :: forall t (f :: * -> *) a.
Applicative f =>
Timeline t (f a) -> f (Timeline t a)
traverse :: 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)
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, $sel:values:Timeline :: Map t a
values = 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, $sel:values:Timeline :: 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
initialValue :: a
$sel:initialValue:Timeline :: forall t a. Timeline t a -> a
initialValue, Map t a
values :: Map t a
$sel:values:Timeline :: forall t a. Timeline t a -> Map t a
values} =
Timeline
{ $sel:initialValue:Timeline :: b
initialValue = a -> b
initialFunc a
initialValue,
$sel:values:Timeline :: Map t b
values = Map t b
mergedValues
}
where
mergedValues :: Map t b
mergedValues :: Map t b
mergedValues =
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
(forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing forall a b. (a -> b) -> a -> b
$ \t
t a -> b
f -> a -> b
f forall a b. (a -> b) -> a -> b
$ forall t a. Ord t => Timeline t a -> t -> a
peek Timeline t a
xs t
t)
(forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing forall a b. (a -> b) -> a -> b
$ \t
t a
x -> forall t a. Ord t => Timeline t a -> t -> a
peek Timeline t (a -> b)
fs t
t a
x)
(forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (forall a b. a -> b -> a
const 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
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
initialValue :: a
$sel:initialValue:Timeline :: forall t a. Timeline t a -> a
initialValue, Map t a
values :: Map t a
$sel:values:Timeline :: forall t a. Timeline t a -> Map t a
values} =
[Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$
Text
"\n----------Timeline--Start-------------"
forall a. a -> [a] -> [a]
: (Text
"initial value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow a
initialValue)
forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t, a) -> Text
showOneChange (forall k a. Map k a -> [(k, a)]
Map.toAscList Map t a
values)
forall a. [a] -> [a] -> [a]
++ [Text
"----------Timeline--End---------------"]
where
showOneChange :: (t, a) -> Text
showOneChange :: (t, a) -> Text
showOneChange (t
t, a
x) = Text
"since " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow t
t forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow a
x
peek ::
Ord t =>
Timeline t a ->
t ->
a
peek :: forall t a. Ord t => Timeline t a -> t -> a
peek Timeline {a
Map t a
values :: Map t a
initialValue :: a
$sel:values:Timeline :: forall t a. Timeline t a -> Map t a
$sel:initialValue:Timeline :: forall t a. Timeline t a -> a
..} t
time = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
initialValue forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupLE t
time Map t a
values
data TimeRange t = TimeRange
{
forall t. TimeRange t -> Maybe t
from :: Maybe t,
forall t. TimeRange t -> Maybe t
to :: Maybe t
}
deriving stock (Int -> TimeRange t -> ShowS
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
showList :: [TimeRange t] -> ShowS
$cshowList :: forall t. Show t => [TimeRange t] -> ShowS
show :: TimeRange t -> String
$cshow :: forall t. Show t => TimeRange t -> String
showsPrec :: Int -> TimeRange t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> TimeRange t -> ShowS
Show, TimeRange t -> TimeRange t -> Bool
forall t. Eq t => TimeRange t -> TimeRange t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeRange t -> TimeRange t -> Bool
$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
Eq, TimeRange t -> TimeRange t -> Bool
TimeRange t -> TimeRange t -> Ordering
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
min :: TimeRange t -> TimeRange t -> TimeRange t
$cmin :: forall t. Ord t => TimeRange t -> TimeRange t -> TimeRange t
max :: TimeRange t -> TimeRange t -> TimeRange t
$cmax :: forall t. Ord t => TimeRange t -> TimeRange t -> TimeRange t
>= :: 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
$c< :: forall t. Ord t => TimeRange t -> TimeRange t -> Bool
compare :: TimeRange t -> TimeRange t -> Ordering
$ccompare :: forall t. Ord t => TimeRange t -> TimeRange t -> Ordering
Ord, 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
$cto :: forall t x. Rep (TimeRange t) x -> TimeRange t
$cfrom :: forall t x. TimeRange t -> Rep (TimeRange t) x
Generic)
isTimeAfterRange :: Ord t => t -> TimeRange t -> Bool
isTimeAfterRange :: forall t. Ord t => t -> TimeRange t -> Bool
isTimeAfterRange t
t TimeRange {Maybe t
to :: Maybe t
$sel:to:TimeRange :: forall t. TimeRange t -> Maybe t
to} = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (t
t 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 :: Map t a
initialValue :: a
$sel:values:Timeline :: forall t a. Timeline t a -> Map t a
$sel:initialValue:Timeline :: forall t a. Timeline t a -> a
..} =
Timeline
{ $sel:initialValue:Timeline :: b
initialValue = TimeRange t -> a -> b
f TimeRange t
initialRange a
initialValue,
$sel:values:Timeline :: Map t b
values = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Map t a
values forall a b. (a -> b) -> a -> b
$ \t
from a
value ->
let timeRange :: TimeRange t
timeRange = forall t. Maybe t -> Maybe t -> TimeRange t
TimeRange (forall a. a -> Maybe a
Just t
from) (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall t. Maybe t -> Maybe t -> TimeRange t
TimeRange forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap TimeRange t -> a -> f b
f
changes :: Timeline t a -> Set t
changes :: forall t a. Timeline t a -> Set t
changes Timeline {Map t a
values :: Map t a
$sel:values:Timeline :: forall t a. Timeline t a -> Map t a
values} = forall k a. Map k a -> Set k
Map.keysSet Map t a
values
data Record t a = Record
{
forall t a. Record t a -> t
from :: t,
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
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
showList :: [Record t a] -> ShowS
$cshowList :: forall t a. (Show t, Show a) => [Record t a] -> ShowS
show :: Record t a -> String
$cshow :: forall t a. (Show t, Show a) => Record t a -> String
showsPrec :: Int -> Record t a -> ShowS
$cshowsPrec :: forall t a. (Show t, Show a) => Int -> Record t a -> ShowS
Show, Record t a -> Record t a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall t a. (Eq t, Eq a) => Record t a -> Record t a -> Bool
Eq, 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
<$ :: forall a b. a -> Record t b -> Record t a
$c<$ :: forall t a b. a -> Record t b -> Record t a
fmap :: forall a b. (a -> b) -> Record t a -> Record t b
$cfmap :: forall t a b. (a -> b) -> Record t a -> Record t b
Functor, forall a. Record t a -> Bool
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 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
product :: forall a. Num a => Record t a -> a
$cproduct :: forall t a. Num a => Record t a -> a
sum :: forall a. Num a => Record t a -> a
$csum :: forall t a. Num a => Record t a -> a
minimum :: forall a. Ord a => Record t a -> a
$cminimum :: forall t a. Ord a => Record t a -> a
maximum :: forall a. Ord a => Record t a -> a
$cmaximum :: forall t a. Ord a => Record t a -> a
elem :: forall a. Eq a => a -> Record t a -> Bool
$celem :: forall t a. Eq a => a -> Record t a -> Bool
length :: forall a. Record t a -> Int
$clength :: forall t a. Record t a -> Int
null :: forall a. Record t a -> Bool
$cnull :: forall t a. Record t a -> Bool
toList :: forall a. Record t a -> [a]
$ctoList :: forall t a. Record t a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Record t a -> a
$cfoldl1 :: forall t a. (a -> a -> a) -> Record t a -> a
foldr1 :: forall a. (a -> a -> a) -> Record t a -> a
$cfoldr1 :: forall t a. (a -> a -> a) -> Record t a -> a
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
$cfoldl :: forall t b a. (b -> a -> 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
$cfoldr :: forall t a b. (a -> b -> b) -> b -> Record t a -> b
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
$cfoldMap :: forall t m a. Monoid m => (a -> m) -> Record t a -> m
fold :: forall m. Monoid m => Record t m -> m
$cfold :: forall t m. Monoid m => Record t m -> m
Foldable, 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Record t a -> f (Record t b)
sequence :: forall (m :: * -> *) a. Monad m => Record t (m a) -> m (Record t a)
$csequence :: forall t (m :: * -> *) a.
Monad m =>
Record t (m a) -> m (Record t a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Record t a -> m (Record t b)
$cmapM :: forall t (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Record t a -> m (Record t b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Record t (f a) -> f (Record t a)
$csequenceA :: forall t (f :: * -> *) a.
Applicative f =>
Record t (f a) -> f (Record t a)
traverse :: 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)
Traversable, 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)
liftTyped :: forall (m :: * -> *). Quote m => Record t a -> Code m (Record t a)
$cliftTyped :: forall t a (m :: * -> *).
(Lift t, Lift a, Quote m) =>
Record t a -> Code m (Record t a)
lift :: forall (m :: * -> *). Quote m => Record t a -> m Exp
$clift :: forall t a (m :: * -> *).
(Lift t, Lift a, Quote m) =>
Record t a -> m Exp
TH.Lift)
recordFrom :: Record t a -> t
recordFrom :: forall t a. Record t a -> t
recordFrom Record {t
from :: t
$sel:from:Record :: forall t a. Record t a -> t
from} = t
from
recordTo :: Record t a -> Maybe t
recordTo :: forall t a. Record t a -> Maybe t
recordTo Record {Maybe t
to :: Maybe t
$sel:to:Record :: forall t a. Record t a -> Maybe t
to} = Maybe t
to
recordValue :: Record t a -> a
recordValue :: forall t a. Record t a -> a
recordValue = forall t a. Record t a -> a
value
makeRecord ::
Ord t =>
t ->
Maybe t ->
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 forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (t
from forall a. Ord a => a -> a -> Bool
>=) Maybe t
to
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just Record {t
a
Maybe t
value :: a
to :: Maybe t
from :: t
$sel:value:Record :: a
$sel:to:Record :: Maybe t
$sel:from:Record :: t
..}
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 =
forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> Splice m b) -> Splice m b
TH.bindSplice
( forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"effective to is no greater than effective from") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall t a. Ord t => t -> Maybe t -> a -> Maybe (Record t a)
makeRecord t
effectiveFrom Maybe t
effectiveTo a
value
)
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
TH.liftTyped
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
value :: a
to :: Maybe UTCTime
from :: UTCTime
$sel:value:Record :: forall t a. Record t a -> a
$sel:to:Record :: forall t a. Record t a -> Maybe t
$sel:from:Record :: forall t a. Record t a -> t
..} =
[||
Record
(unLiftUTCTime $$(TH.liftTyped $ LiftUTCTime from))
(fmap unLiftUTCTime $$(TH.liftTyped $ LiftUTCTime <$> to))
$$(TH.liftTyped value)
||]
newtype LiftUTCTime = LiftUTCTime UTCTime
deriving stock (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
$cto :: forall x. Rep LiftUTCTime x -> LiftUTCTime
$cfrom :: forall x. LiftUTCTime -> Rep LiftUTCTime x
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)) =
[||
LiftUTCTime $
UTCTime
(fromOrdinalDate $$(TH.liftTyped year) $$(TH.liftTyped day))
(picosecondsToDiffTime $$(TH.liftTyped (diffTimeToPicoseconds diffTime)))
||]
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
value :: a
to :: Maybe t
from :: t
$sel:value:Record :: forall t a. Record t a -> a
$sel:to:Record :: forall t a. Record t a -> Maybe t
$sel:from:Record :: forall t a. Record t a -> t
..} = forall a. Show a => a -> Text
tshow t
from forall a. Semigroup a => a -> a -> a
<> Text
" ~ " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Maybe t
to forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow a
value
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
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
stimes :: forall b. Integral b => b -> Overlaps t a -> Overlaps t a
$cstimes :: forall t a b. Integral b => b -> Overlaps t a -> Overlaps t a
sconcat :: NonEmpty (Overlaps t a) -> Overlaps t a
$csconcat :: forall t a. NonEmpty (Overlaps t a) -> Overlaps t a
<> :: Overlaps t a -> Overlaps t a -> Overlaps t a
$c<> :: forall t a. Overlaps t a -> Overlaps t a -> Overlaps t a
Semigroup)
deriving stock (Int -> Overlaps t a -> ShowS
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
showList :: [Overlaps t a] -> ShowS
$cshowList :: forall t a. (Show t, Show a) => [Overlaps t a] -> ShowS
show :: Overlaps t a -> String
$cshow :: forall t a. (Show t, Show a) => Overlaps t a -> String
showsPrec :: Int -> Overlaps t a -> ShowS
$cshowsPrec :: forall t a. (Show t, Show a) => Int -> Overlaps t a -> ShowS
Show, Overlaps t a -> Overlaps t a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall t a. (Eq t, Eq a) => Overlaps t a -> Overlaps t a -> Bool
Eq, 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
$cto :: forall t a x. Rep (Overlaps t a) x -> Overlaps t a
$cfrom :: forall t a x. Overlaps t a -> Rep (Overlaps t a) x
Generic)
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)
groups :: NonEmpty (OverlapGroup t a)
$sel:groups:Overlaps :: forall t a. Overlaps t a -> NonEmpty (OverlapGroup t a)
groups} =
Text
"Here are "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (OverlapGroup t a)
groups)
forall a. Semigroup a => a -> a -> a
<> Text
" group(s) of overlapping records\n"
forall a. Semigroup a => a -> a -> a
<> Text
sep
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
sep (forall t a. (Show t, Show a) => OverlapGroup t a -> Text
prettyOverlapGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (OverlapGroup t a)
groups)
forall a. Semigroup a => a -> a -> a
<> Text
sep
where
sep :: Text
sep = Text
"--------------------\n"
data OverlapGroup t a = OverlapGroup (Record t a) (Record t a) [Record t a]
deriving stock (Int -> OverlapGroup t a -> ShowS
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
showList :: [OverlapGroup t a] -> ShowS
$cshowList :: forall t a. (Show t, Show a) => [OverlapGroup t a] -> ShowS
show :: OverlapGroup t a -> String
$cshow :: forall t a. (Show t, Show a) => OverlapGroup t a -> String
showsPrec :: Int -> OverlapGroup t a -> ShowS
$cshowsPrec :: forall t a. (Show t, Show a) => Int -> OverlapGroup t a -> ShowS
Show, OverlapGroup t a -> OverlapGroup t a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall t a.
(Eq t, Eq a) =>
OverlapGroup t a -> OverlapGroup t a -> Bool
Eq, 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
$cto :: forall t a x. Rep (OverlapGroup t a) x -> OverlapGroup t a
$cfrom :: forall t a x. OverlapGroup t a -> Rep (OverlapGroup t a) x
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t a. (Show t, Show a) => Record t a -> Text
prettyRecord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. OverlapGroup t a -> [Record t a]
unpackOverlapGroup
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 forall a. a -> [a] -> [a]
: Record t a
r2 forall a. a -> [a] -> [a]
: [Record t a]
records
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 =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right Timeline t (Maybe a)
timeline) forall a b. a -> Either a b
Left Maybe (Overlaps t a)
overlaps
where
sortedRecords :: [Record t a]
sortedRecords = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall t a. Record t a -> t
recordFrom [Record t a]
records
overlaps :: Maybe (Overlaps t a)
overlaps =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable1 t, Semigroup m) => t m -> m
fold1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NonEmpty (Record t a) -> Maybe (Overlaps t a)
checkForOverlap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 []
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)
| Bool
isOverlapping = (Record t a
current forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.<| Record t a
next forall a. a -> [a] -> NonEmpty a
:| [Record t a]
group) forall a. a -> [a] -> [a]
: [NonEmpty (Record t a)]
groups
| Bool
otherwise = (Record t a
current forall a. a -> [a] -> NonEmpty a
:| []) forall a. a -> [a] -> [a]
: (Record t a
next forall a. a -> [a] -> NonEmpty a
:| [Record t a]
group) forall a. a -> [a] -> [a]
: [NonEmpty (Record t a)]
groups
where
isOverlapping :: Bool
isOverlapping = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall t a. Record t a -> t
recordFrom Record t a
next forall a. Ord a => a -> a -> Bool
<) (forall t a. Record t a -> Maybe t
recordTo Record t a
current)
mergeOverlappingNeighbours Record t a
current [] = [Record t a
current 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
_ :| []) = forall a. Maybe a
Nothing
checkForOverlap (Record t a
x1 :| Record t a
x2 : [Record t a]
xs) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. NonEmpty (OverlapGroup t a) -> Overlaps t a
Overlaps forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> NonEmpty a
:| []) forall a b. (a -> b) -> a -> b
$ 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
timeline :: Timeline t (Maybe a)
timeline :: Timeline t (Maybe a)
timeline =
case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Record t a]
sortedRecords of
Maybe (NonEmpty (Record t a))
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just NonEmpty (Record t a)
records' ->
Timeline
{ $sel:initialValue:Timeline :: Maybe a
initialValue = forall a. Maybe a
Nothing,
$sel:values:Timeline :: Map t (Maybe a)
values =
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
Record t a -> Maybe (Record t a) -> [(t, Maybe a)]
connectAdjacentRecords
(forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Record t a)
records')
((forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NonEmpty.tail NonEmpty (Record t a)
records') forall a. Semigroup a => a -> a -> 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 =
(forall t a. Record t a -> t
recordFrom Record t a
current, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t a. Record t a -> a
value Record t a
current)
forall a. a -> [a] -> [a]
: forall a. Maybe a -> [a]
maybeToList Maybe (t, Maybe a)
gap
where
gap :: Maybe (t, Maybe a)
gap = do
t
effectiveTo' <- forall t a. Record t a -> Maybe t
recordTo Record t a
current
if forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\Record t a
next' -> t
effectiveTo' forall a. Ord a => a -> a -> Bool
< forall t a. Record t a -> t
recordFrom Record t a
next') Maybe (Record t a)
next
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
effectiveTo', forall a. Maybe a
Nothing)
else forall a. Maybe a
Nothing