{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
-- TODO: why is this needed?
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      : Functions for Parsing Events from JSON lines
-- Description : Defines FromJSON instances for Events.
-- Copyright   : (c) Target RWE 2023
-- License     : BSD3
-- Maintainer  : bbrown@targetrwe.com
--               ljackman@targetrwe.com
--               dpritchard@targetrwe.com
module EventDataTheory.EventLines
  ( EventLine (..),
    EventLineAble,
    parseEventLinesL',
    eitherDecodeEvent',
    decodeEvent',
    LineParseError (..),
    ParseEventLineOption (..),
    defaultParseEventLineOption,
    modifyEventLineWithContext,
    -- for internal use;
    FactsLine (..),
    TimeLine (..),
  )
where

import Control.Exception
import Control.Monad ((>=>))
import Data.Aeson
import Data.Bifunctor
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as B
import Data.Data
import Data.Either (Either (..), partitionEithers)
import Data.Scientific (floatingOrInteger)
import Data.Text (Text, pack)
import EventDataTheory.Core
import GHC.Generics (Generic)
import GHC.Num (Integer, Natural)
import IntervalAlgebra
  ( Interval,
    ParseErrorInterval,
    SizedIv (..),
    begin,
    beginerval,
    beginervalMoment,
    end,
    getInterval,
    parseInterval,
  )
import Type.Reflection (Typeable)
import Witch

-- |
-- At this time,
-- 'EventLine', 'FactsLine', and 'TimeLine' are
-- simply wrapper types
-- in order to create 'FromJSON' instances which can be used to marshal data from
-- [ndjson](http://ndjson.org/).
--
-- See [event data model docs](https://docs.novisci.com/event-data/3.0/index.html)
data EventLine t m a = MkEventLine Value Value Value Value [t] (FactsLine m a)
  deriving (EventLine t m a -> EventLine t m a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t m a.
(Eq t, Eq a, Eq m) =>
EventLine t m a -> EventLine t m a -> Bool
/= :: EventLine t m a -> EventLine t m a -> Bool
$c/= :: forall t m a.
(Eq t, Eq a, Eq m) =>
EventLine t m a -> EventLine t m a -> Bool
== :: EventLine t m a -> EventLine t m a -> Bool
$c== :: forall t m a.
(Eq t, Eq a, Eq m) =>
EventLine t m a -> EventLine t m a -> Bool
Eq, Int -> EventLine t m a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t m a.
(Show t, Show a, Show m) =>
Int -> EventLine t m a -> ShowS
forall t m a.
(Show t, Show a, Show m) =>
[EventLine t m a] -> ShowS
forall t m a. (Show t, Show a, Show m) => EventLine t m a -> String
showList :: [EventLine t m a] -> ShowS
$cshowList :: forall t m a.
(Show t, Show a, Show m) =>
[EventLine t m a] -> ShowS
show :: EventLine t m a -> String
$cshow :: forall t m a. (Show t, Show a, Show m) => EventLine t m a -> String
showsPrec :: Int -> EventLine t m a -> ShowS
$cshowsPrec :: forall t m a.
(Show t, Show a, Show m) =>
Int -> EventLine t m a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t m a x. Rep (EventLine t m a) x -> EventLine t m a
forall t m a x. EventLine t m a -> Rep (EventLine t m a) x
$cto :: forall t m a x. Rep (EventLine t m a) x -> EventLine t m a
$cfrom :: forall t m a x. EventLine t m a -> Rep (EventLine t m a) x
Generic)

instance
  (FromJSONEvent t m a) =>
  FromJSON (EventLine t m a)

instance (ToJSON a, ToJSON t, ToJSON m) => ToJSON (EventLine t m a)

-- TODO: check uses of this synonym and decide if the constraints are really needed.
-- if appropriate, come back and delete this.

-- | A synonym for the basic class constraints needed to create an @EventLine@.
type EventLineAble t m a b =
  (Generic m, Typeable m, Typeable t, Typeable a, SizedIv (Interval a))

-- INTERNAL utility for getting subjectID from EventLine
getSubjectID :: EventLine t m a -> SubjectID
getSubjectID :: forall t m a. EventLine t m a -> SubjectID
getSubjectID (MkEventLine Value
_ Value
_ Value
_ Value
_ [t]
_ FactsLine m a
fcts) = forall m a. FactsLine m a -> SubjectID
patient_id FactsLine m a
fcts

-- INTERNAL utility for getting the FactsLine from EventLine
fctln :: EventLine t m a -> FactsLine m a
fctln :: forall t m a. EventLine t m a -> FactsLine m a
fctln (MkEventLine Value
_ Value
_ Value
_ Value
_ [t]
_ FactsLine m a
x) = FactsLine m a
x

-- INTERNAL utility for getting a tag set from EventLine
tagSetIn :: EventLine t m a -> [t]
tagSetIn :: forall t m a. EventLine t m a -> [t]
tagSetIn (MkEventLine Value
_ Value
_ Value
_ Value
_ [t]
x FactsLine m a
_) = [t]
x

-- |
-- Options for how an 'EventLine' will be parsed into an 'Event'.
data ParseEventLineOption
  = -- | Add a 'moment' to the 'end' of all intervals,
    -- so long as one is provided and 'end x >= begin x'.
    -- In particular, this option creates a moment-length interval
    -- in the case where 'end x == begin x', which otherwise would
    -- fail to parse via @IntervalAlgebra.'parseInterval'@.
    --
    -- It does not modify intervals for which the provided end is null,
    -- which will fail to parse. See 'FixEnd' and 'AddMomentAndFix'.
    AddMomentToEnd
  | -- | Do not modify the @TimeLine@ before
    --   trying to 'IntervalAlgebra.parseInterval'.
    DoNotModifyTime
  | -- | Convert @TimeLine@ with @timeEnd@ as @Nothing@ to
    -- 'moment' - length intervals. Otherwise attempt to parse the
    -- interval as-is. An important difference with 'AddMomentToEnd'
    -- is that cases where timeEnd == timeBegin are unchanged here and
    -- will fail to parse.
    FixEnd
  | -- | Apply fixes from both 'FixEnd' and 'AddMomentToEnd'.
    AddMomentAndFix
  deriving (Int -> ParseEventLineOption -> ShowS
[ParseEventLineOption] -> ShowS
ParseEventLineOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseEventLineOption] -> ShowS
$cshowList :: [ParseEventLineOption] -> ShowS
show :: ParseEventLineOption -> String
$cshow :: ParseEventLineOption -> String
showsPrec :: Int -> ParseEventLineOption -> ShowS
$cshowsPrec :: Int -> ParseEventLineOption -> ShowS
Show)

-- | The default 'ParseEventLineOption'.
defaultParseEventLineOption :: ParseEventLineOption
defaultParseEventLineOption :: ParseEventLineOption
defaultParseEventLineOption = ParseEventLineOption
DoNotModifyTime

instance Exception ParseErrorInterval

-- | See 'EventLine'.
data FactsLine m a = MkFactsLine
  { forall m a. FactsLine m a -> TimeLine a
time :: TimeLine a,
    forall m a. FactsLine m a -> m
facts :: m,
    forall m a. FactsLine m a -> SubjectID
patient_id :: SubjectID,
    forall m a. FactsLine m a -> Maybe Source
source :: Maybe Source,
    forall m a. FactsLine m a -> Maybe Bool
valid :: Maybe Bool
  }
  deriving (FactsLine m a -> FactsLine m a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall m a. (Eq a, Eq m) => FactsLine m a -> FactsLine m a -> Bool
/= :: FactsLine m a -> FactsLine m a -> Bool
$c/= :: forall m a. (Eq a, Eq m) => FactsLine m a -> FactsLine m a -> Bool
== :: FactsLine m a -> FactsLine m a -> Bool
$c== :: forall m a. (Eq a, Eq m) => FactsLine m a -> FactsLine m a -> Bool
Eq, Int -> FactsLine m a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall m a. (Show a, Show m) => Int -> FactsLine m a -> ShowS
forall m a. (Show a, Show m) => [FactsLine m a] -> ShowS
forall m a. (Show a, Show m) => FactsLine m a -> String
showList :: [FactsLine m a] -> ShowS
$cshowList :: forall m a. (Show a, Show m) => [FactsLine m a] -> ShowS
show :: FactsLine m a -> String
$cshow :: forall m a. (Show a, Show m) => FactsLine m a -> String
showsPrec :: Int -> FactsLine m a -> ShowS
$cshowsPrec :: forall m a. (Show a, Show m) => Int -> FactsLine m a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall m a x. Rep (FactsLine m a) x -> FactsLine m a
forall m a x. FactsLine m a -> Rep (FactsLine m a) x
$cto :: forall m a x. Rep (FactsLine m a) x -> FactsLine m a
$cfrom :: forall m a x. FactsLine m a -> Rep (FactsLine m a) x
Generic)

instance
  (FromJSON a, FromJSON m) =>
  FromJSON (FactsLine m a)

instance (ToJSON a, ToJSON m) => ToJSON (FactsLine m a)

-- | See 'EventLine'.
data TimeLine a = MkTimeLine
  { forall a. TimeLine a -> a
timeBegin :: a,
    forall a. TimeLine a -> Maybe a
timeEnd :: Maybe a
  }
  deriving (TimeLine a -> TimeLine a -> Bool
forall a. Eq a => TimeLine a -> TimeLine a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeLine a -> TimeLine a -> Bool
$c/= :: forall a. Eq a => TimeLine a -> TimeLine a -> Bool
== :: TimeLine a -> TimeLine a -> Bool
$c== :: forall a. Eq a => TimeLine a -> TimeLine a -> Bool
Eq, Int -> TimeLine a -> ShowS
forall a. Show a => Int -> TimeLine a -> ShowS
forall a. Show a => [TimeLine a] -> ShowS
forall a. Show a => TimeLine a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeLine a] -> ShowS
$cshowList :: forall a. Show a => [TimeLine a] -> ShowS
show :: TimeLine a -> String
$cshow :: forall a. Show a => TimeLine a -> String
showsPrec :: Int -> TimeLine a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TimeLine a -> ShowS
Show)

instance (FromJSON a) => FromJSON (TimeLine a) where
  parseJSON :: Value -> Parser (TimeLine a)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TimeLine" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    a
b <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"begin"
    Maybe a
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"end"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a -> TimeLine a
MkTimeLine a
b Maybe a
e)

instance (ToJSON a) => ToJSON (TimeLine a) where
  toJSON :: TimeLine a -> Value
toJSON (MkTimeLine a
b Maybe a
e) = case Maybe a
e of
    Maybe a
Nothing -> [Pair] -> Value
object [Key
"begin" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
b]
    Just a
x -> [Pair] -> Value
object [Key
"begin" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
b, Key
"end" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
x]

{- DECODING / PARSING -}

-- |
-- Decode a bytestring corresponding to an 'EventLine' into
-- @Either String (SubjectID, Event t m a)@,
-- where the @String@ is an error message on failure
-- and @(SubjectID, Event t m a)@ is the success case.
--
-- NOTE: See https://hackage.haskell.org/package/aeson-2.0.3.0/docs/Data-Aeson.html#g:22
-- for discusson of json vs json'.
eitherDecodeEvent' ::
  forall m t a b.
  (Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a) =>
  ParseEventLineOption ->
  C.ByteString ->
  Either String (SubjectID, Event t m a)
eitherDecodeEvent' :: forall m t a b.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a) =>
ParseEventLineOption
-> ByteString -> Either String (SubjectID, Event t m a)
eitherDecodeEvent' ParseEventLineOption
opt = forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' @(EventLine t m a) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall {t} {a} {m} {b}.
(Show t, Show a, Show m, Show b, Typeable t, Typeable m,
 Typeable a, Typeable b,
 TryFrom (EventLine t m a, b) (Event t m a)) =>
b -> EventLine t m a -> Either String (SubjectID, Event t m a)
convertOp ParseEventLineOption
opt
  where
    convertOp :: b -> EventLine t m a -> Either String (SubjectID, Event t m a)
convertOp b
opt' EventLine t m a
eline =
      --- Convert the TryFrom error into a String
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$
        -- Attach the subject id to the Right result of tryInto
        (forall t m a. EventLine t m a -> SubjectID
getSubjectID EventLine t m a
eline,)
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @(Event t m a) (EventLine t m a
eline, b
opt')

-- |
-- Decode a bytestring corresponding to an 'EventLine' into
-- @Maybe (SubjectID, Event t m a)@,
-- where the value is @Nothing@ on failure
-- and @Just (SubjectID, Event t m a)@ on success.
--
-- NOTE: See https://hackage.haskell.org/package/aeson-2.0.3.0/docs/Data-Aeson.html#g:22
-- for discusson of json vs json'.
decodeEvent' ::
  forall m t a b.
  (Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a) =>
  ParseEventLineOption ->
  C.ByteString ->
  Maybe (SubjectID, Event t m a)
decodeEvent' :: forall m t a b.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a) =>
ParseEventLineOption
-> ByteString -> Maybe (SubjectID, Event t m a)
decodeEvent' ParseEventLineOption
opt = forall b a. Either b a -> Maybe a
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m t a b.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a) =>
ParseEventLineOption
-> ByteString -> Either String (SubjectID, Event t m a)
eitherDecodeEvent' ParseEventLineOption
opt

-- | INTERNAL utlity for transforming an @Either@ into a @Maybe@.
rightToMaybe :: Either b a -> Maybe a
rightToMaybe :: forall b a. Either b a -> Maybe a
rightToMaybe (Left b
_) = forall a. Maybe a
Nothing
rightToMaybe (Right a
x) = forall a. a -> Maybe a
Just a
x

-- |
-- Contains the line number and error message of any parsing errors.
newtype LineParseError = MkLineParseError (Natural, String)
  deriving (LineParseError -> LineParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineParseError -> LineParseError -> Bool
$c/= :: LineParseError -> LineParseError -> Bool
== :: LineParseError -> LineParseError -> Bool
$c== :: LineParseError -> LineParseError -> Bool
Eq, Int -> LineParseError -> ShowS
[LineParseError] -> ShowS
LineParseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineParseError] -> ShowS
$cshowList :: [LineParseError] -> ShowS
show :: LineParseError -> String
$cshow :: LineParseError -> String
showsPrec :: Int -> LineParseError -> ShowS
$cshowsPrec :: Int -> LineParseError -> ShowS
Show, forall x. Rep LineParseError x -> LineParseError
forall x. LineParseError -> Rep LineParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineParseError x -> LineParseError
$cfrom :: forall x. LineParseError -> Rep LineParseError x
Generic)

-- providing a From instance making LineParseError values in the tests
instance From (Natural, String) LineParseError

-- |
-- Parse @Event t m a@ from new-line delimited JSON.
--
-- Per the [aeson docs](https://hackage.haskell.org/package/aeson-2.0.3.0/docs/Data-Aeson.html#g:22),
-- when using this version:
-- This is a strict version of json which avoids building up thunks during parsing;
-- it performs all conversions immediately.
-- Prefer this version if most of the JSON data needs to be accessed.
--
-- Returns a pair where
-- the first element is a list of parse errors
-- and the second element is a list of successfully parsed (subjectID, event) pairs.
--
-- Note the input must be UTF-8.
parseEventLinesL' ::
  forall m t a b.
  (Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a) =>
  ParseEventLineOption ->
  C.ByteString ->
  ([LineParseError], [(SubjectID, Event t m a)])
parseEventLinesL' :: forall m t a b.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a) =>
ParseEventLineOption
-> ByteString -> ([LineParseError], [(SubjectID, Event t m a)])
parseEventLinesL' ParseEventLineOption
opt ByteString
l =
  forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
      (\ByteString
x Natural
i -> forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\String
t -> (Natural, String) -> LineParseError
MkLineParseError (Natural
i, String
t)) (forall m t a b.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a) =>
ParseEventLineOption
-> ByteString -> Either String (SubjectID, Event t m a)
eitherDecodeEvent' ParseEventLineOption
opt ByteString
x))
      (ByteString -> [ByteString]
C.lines ByteString
l)
      [Natural
1 ..]

{- CONVERSION TO EVENTS -}

-- |
-- Try to parse an @'EventLine'@ into an @'Event'@,
-- given an 'ParseEventLineOption'.
instance
  (SizedIv (Interval a), Eventable t m a) =>
  TryFrom (EventLine t m a, ParseEventLineOption) (Event t m a)
  where
  tryFrom :: (EventLine t m a, ParseEventLineOption)
-> Either
     (TryFromException
        (EventLine t m a, ParseEventLineOption) (Event t m a))
     (Event t m a)
tryFrom (EventLine t m a
eline, ParseEventLineOption
opt) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a t m. Interval a -> Context t m -> Event t m a
event Context t m
ctx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {target}.
ParseEventLineOption
-> TimeLine a
-> Either
     (TryFromException (EventLine t m a, ParseEventLineOption) target)
     (Interval a)
parseIv ParseEventLineOption
opt TimeLine a
i
    where
      fcts :: FactsLine m a
fcts = forall t m a. EventLine t m a -> FactsLine m a
fctln EventLine t m a
eline
      i :: TimeLine a
i = forall m a. FactsLine m a -> TimeLine a
time FactsLine m a
fcts
      ctx :: Context t m
ctx = forall t d. TagSet t -> d -> Maybe Source -> Context t d
context (forall source target. From source target => source -> target
from @[t] forall a b. (a -> b) -> a -> b
$ forall t m a. EventLine t m a -> [t]
tagSetIn EventLine t m a
eline) (forall m a. FactsLine m a -> m
facts FactsLine m a
fcts) (forall m a. FactsLine m a -> Maybe Source
source FactsLine m a
fcts)
      -- Convert parseInterval errors to the more informative
      -- TryFromException.
      toTryFromException :: Maybe SomeException
-> TryFromException (EventLine t m a, ParseEventLineOption) target
toTryFromException = forall source target.
source -> Maybe SomeException -> TryFromException source target
TryFromException (EventLine t m a
eline, ParseEventLineOption
opt)
      tryParse :: a
-> a
-> Either
     (TryFromException (EventLine t m a, ParseEventLineOption) target)
     (Interval a)
tryParse a
b a
e = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall {target}.
Maybe SomeException
-> TryFromException (EventLine t m a, ParseEventLineOption) target
toTryFromException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toException) forall a b. (a -> b) -> a -> b
$ forall a.
(Show a, Ord a) =>
a -> a -> Either ParseErrorInterval (Interval a)
parseInterval a
b a
e
      addMoment :: a
-> a
-> Either
     (TryFromException (EventLine t m a, ParseEventLineOption) target)
     (Interval a)
addMoment a
b' a
e' =
        if a
b' forall a. Eq a => a -> a -> Bool
== a
e'
          then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. SizedIv (Interval a) => a -> Interval a
beginervalMoment a
b'
          else forall iv. SizedIv iv => Moment iv -> iv -> iv
ivExpandr (forall iv. SizedIv iv => Moment iv
moment @(Interval a)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a} {target}.
(Show a, Ord a) =>
a
-> a
-> Either
     (TryFromException (EventLine t m a, ParseEventLineOption) target)
     (Interval a)
tryParse a
b' a
e'
      parseIv :: ParseEventLineOption
-> TimeLine a
-> Either
     (TryFromException (EventLine t m a, ParseEventLineOption) target)
     (Interval a)
parseIv ParseEventLineOption
AddMomentToEnd TimeLine a
iv = case forall a. TimeLine a -> Maybe a
timeEnd TimeLine a
iv of
        Maybe a
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall {target}.
Maybe SomeException
-> TryFromException (EventLine t m a, ParseEventLineOption) target
toTryFromException forall a. Maybe a
Nothing
        Just a
e -> forall {target}.
a
-> a
-> Either
     (TryFromException (EventLine t m a, ParseEventLineOption) target)
     (Interval a)
addMoment (forall a. TimeLine a -> a
timeBegin TimeLine a
iv) a
e
      parseIv ParseEventLineOption
AddMomentAndFix TimeLine a
iv = case forall a. TimeLine a -> Maybe a
timeEnd TimeLine a
iv of
              Maybe a
Nothing -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. SizedIv (Interval a) => a -> Interval a
beginervalMoment forall a b. (a -> b) -> a -> b
$ forall a. TimeLine a -> a
timeBegin TimeLine a
iv
              Just a
e -> forall {target}.
a
-> a
-> Either
     (TryFromException (EventLine t m a, ParseEventLineOption) target)
     (Interval a)
addMoment (forall a. TimeLine a -> a
timeBegin TimeLine a
iv) a
e
      parseIv ParseEventLineOption
DoNotModifyTime TimeLine a
iv =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall {target}.
Maybe SomeException
-> TryFromException (EventLine t m a, ParseEventLineOption) target
toTryFromException forall a. Maybe a
Nothing) (forall {a} {target}.
(Show a, Ord a) =>
a
-> a
-> Either
     (TryFromException (EventLine t m a, ParseEventLineOption) target)
     (Interval a)
tryParse (forall a. TimeLine a -> a
timeBegin TimeLine a
iv)) forall a b. (a -> b) -> a -> b
$
          forall a. TimeLine a -> Maybe a
timeEnd TimeLine a
iv
      parseIv ParseEventLineOption
FixEnd TimeLine a
iv =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. SizedIv (Interval a) => a -> Interval a
beginervalMoment (forall a. TimeLine a -> a
timeBegin TimeLine a
iv)) (forall {a} {target}.
(Show a, Ord a) =>
a
-> a
-> Either
     (TryFromException (EventLine t m a, ParseEventLineOption) target)
     (Interval a)
tryParse (forall a. TimeLine a -> a
timeBegin TimeLine a
iv)) forall a b. (a -> b) -> a -> b
$
          forall a. TimeLine a -> Maybe a
timeEnd TimeLine a
iv

{-------------------------------------------------------------------------------
Transforming event lines

-- TODO: it's unclera whether we need any of the remaining code of this module.
-- see #402.
-------------------------------------------------------------------------------}
{-
INTERNAL

Modify a @FactsLine@ value with values from a @Context@.
The @TimeLine@ value IS NOT changed.
Only those fields in the context that align with the factsline
are modified.
-}
updateFactsLine :: FactsLine m a -> Context t m' -> FactsLine m' a
updateFactsLine :: forall m a t m'. FactsLine m a -> Context t m' -> FactsLine m' a
updateFactsLine (MkFactsLine TimeLine a
tm m
_ SubjectID
sid Maybe Source
_ Maybe Bool
vld) Context t m'
x =
  MkFactsLine
    { $sel:time:MkFactsLine :: TimeLine a
time = TimeLine a
tm,
      $sel:facts:MkFactsLine :: m'
facts = forall t m. Context t m -> m
getFacts Context t m'
x,
      $sel:patient_id:MkFactsLine :: SubjectID
patient_id = SubjectID
sid,
      $sel:source:MkFactsLine :: Maybe Source
source = forall t m. Context t m -> Maybe Source
getSource Context t m'
x,
      $sel:valid:MkFactsLine :: Maybe Bool
valid = Maybe Bool
vld
    }

{-
INTERNAL

Modify a @FactsLine@ value with values from a @Context@.
The @TimeLine@ value IS NOT changed
based on the provided interval.
Only those fields in the context that align with the factsline
are modified.
-}
updateFactsLineWithInterval ::
  -- TODO: this can be downgraded to a PointedIv constraint when this is done:
  -- https://gitlab.com/TargetRWE/epistats/nsstat/interval-algebra/-/issues/142
  (SizedIv (Interval a')) =>
  FactsLine m a ->
  Context t m' ->
  Interval a' ->
  FactsLine m' a'
updateFactsLineWithInterval :: forall a' m a t m'.
SizedIv (Interval a') =>
FactsLine m a -> Context t m' -> Interval a' -> FactsLine m' a'
updateFactsLineWithInterval (MkFactsLine TimeLine a
_ m
_ SubjectID
sid Maybe Source
_ Maybe Bool
vld) Context t m'
x Interval a'
i =
  MkFactsLine
    { $sel:time:MkFactsLine :: TimeLine a'
time = forall a. a -> Maybe a -> TimeLine a
MkTimeLine (forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin Interval a'
i) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end Interval a'
i),
      $sel:facts:MkFactsLine :: m'
facts = forall t m. Context t m -> m
getFacts Context t m'
x,
      $sel:patient_id:MkFactsLine :: SubjectID
patient_id = SubjectID
sid,
      $sel:source:MkFactsLine :: Maybe Source
source = forall t m. Context t m -> Maybe Source
getSource Context t m'
x,
      $sel:valid:MkFactsLine :: Maybe Bool
valid = Maybe Bool
vld
    }

{-
INTERNAL

Modifies data in an @EventLine@
from data in an @Event@.
-}
updateEventLineFromEvent ::
  (Data m', SizedIv (Interval a'), ToJSON a', Ord t') =>
  EventLine t m a ->
  Event t' m' a' ->
  EventLine t' m' a'
updateEventLineFromEvent :: forall m' a' t' t m a.
(Data m', SizedIv (Interval a'), ToJSON a', Ord t') =>
EventLine t m a -> Event t' m' a' -> EventLine t' m' a'
updateEventLineFromEvent (MkEventLine Value
_ Value
_ Value
_ Value
_ [t]
_ FactsLine m a
f) Event t' m' a'
x =
  let ctxt :: Context t' m'
ctxt = forall t m a. Event t m a -> Context t m
getContext Event t' m' a'
x
   in let i :: Interval a'
i = forall (i :: * -> *) a. Intervallic i => i a -> Interval a
getInterval Event t' m' a'
x
       in forall t m a.
Value
-> Value
-> Value
-> Value
-> [t]
-> FactsLine m a
-> EventLine t m a
MkEventLine
            (forall a. ToJSON a => a -> Value
toJSON (forall m a. FactsLine m a -> SubjectID
patient_id FactsLine m a
f))
            (forall a. ToJSON a => a -> Value
toJSON (forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
begin Interval a'
i))
            (forall a. ToJSON a => a -> Value
toJSON (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (i :: * -> *) a.
(SizedIv (Interval a), Intervallic i) =>
i a -> a
end forall a b. (a -> b) -> a -> b
$ Interval a'
i))
            (forall a. ToJSON a => a -> Value
toJSON (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> Constr
toConstr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t m. Context t m -> m
getFacts forall a b. (a -> b) -> a -> b
$ Context t' m'
ctxt))
            (forall target source. From source target => source -> target
into (forall t m. Context t m -> TagSet t
getTagSet Context t' m'
ctxt))
            (forall a' m a t m'.
SizedIv (Interval a') =>
FactsLine m a -> Context t m' -> Interval a' -> FactsLine m' a'
updateFactsLineWithInterval FactsLine m a
f Context t' m'
ctxt Interval a'
i)

{-
INTERNAL

Transforms an Eventline via a function
that operates on the Context
within the Event corresponding to the EventLine.
-}
eitherModifyEventLineFromContext ::
  forall m m' t t' a b e.
  ( Eventable t m a,
    EventLineAble t m a b,
    FromJSONEvent t m a,
    Ord t',
    Data m'
  ) =>
  ParseEventLineOption ->
  (Context t m -> Context t' m') ->
  EventLine t m a ->
  Either String (EventLine t' m' a)
eitherModifyEventLineFromContext :: forall m m' t t' a b e.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a,
 Ord t', Data m') =>
ParseEventLineOption
-> (Context t m -> Context t' m')
-> EventLine t m a
-> Either String (EventLine t' m' a)
eitherModifyEventLineFromContext ParseEventLineOption
opt Context t m -> Context t' m'
g (MkEventLine Value
a Value
b Value
t Value
m [t]
e FactsLine m a
f) = do
  Event t m a
ev <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @(Event t m a) (forall t m a.
Value
-> Value
-> Value
-> Value
-> [t]
-> FactsLine m a
-> EventLine t m a
MkEventLine Value
a Value
b Value
t Value
m [t]
e FactsLine m a
f, ParseEventLineOption
opt)
  let ctxt :: Context t' m'
ctxt = Context t m -> Context t' m'
g (forall t m a. Event t m a -> Context t m
getContext Event t m a
ev)
  let newFl :: FactsLine m' a
newFl = forall m a t m'. FactsLine m a -> Context t m' -> FactsLine m' a
updateFactsLine FactsLine m a
f Context t' m'
ctxt
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall t m a.
Value
-> Value
-> Value
-> Value
-> [t]
-> FactsLine m a
-> EventLine t m a
MkEventLine Value
a Value
b Value
t Value
m (forall target source. From source target => source -> target
into forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t m. Context t m -> TagSet t
getTagSet forall a b. (a -> b) -> a -> b
$ Context t' m'
ctxt) FactsLine m' a
newFl

{-
TODO
-}
eitherModifyEventLineFromEvent ::
  forall m m' t t' a a' b e.
  ( Eventable t m a,
    Eventable t' m' a',
    EventLineAble t m a b,
    SizedIv (Interval a'),
    FromJSONEvent t m a,
    ToJSON a',
    Data m'
  ) =>
  ParseEventLineOption ->
  (Event t m a -> Event t' m' a') ->
  EventLine t m a ->
  Either String (EventLine t' m' a')
eitherModifyEventLineFromEvent :: forall m m' t t' a a' b e.
(Eventable t m a, Eventable t' m' a', EventLineAble t m a b,
 SizedIv (Interval a'), FromJSONEvent t m a, ToJSON a', Data m') =>
ParseEventLineOption
-> (Event t m a -> Event t' m' a')
-> EventLine t m a
-> Either String (EventLine t' m' a')
eitherModifyEventLineFromEvent ParseEventLineOption
opt Event t m a -> Event t' m' a'
g EventLine t m a
x = do
  Event t m a
ev1 <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @(Event t m a) (EventLine t m a
x, ParseEventLineOption
opt)
  let ev2 :: Event t' m' a'
ev2 = Event t m a -> Event t' m' a'
g Event t m a
ev1
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m' a' t' t m a.
(Data m', SizedIv (Interval a'), ToJSON a', Ord t') =>
EventLine t m a -> Event t' m' a' -> EventLine t' m' a'
updateEventLineFromEvent EventLine t m a
x Event t' m' a'
ev2

-- |
-- This function:
--
-- * parses a JSON bytestring into an 'EventLine'
-- * modifies the data in the 'EventLine'
-- that corresponds to an 'Event' 'Context'
-- using the supplied function
--
-- The function may fail and return an error message
-- if either the JSON parsing fails
-- or the 'EventLine' -> 'Event' tranformation fails.
--
-- This function does not modify the time information in the 'EventLine',
-- nor any of the first four elements of the 'EventLine'.
--
-- See 'modifyEventLineWithEvent' for a function that can also modify the interval.
modifyEventLineWithContext ::
  forall m m' t t' a b.
  ( Eventable t m a,
    EventLineAble t m a b,
    FromJSONEvent t m a,
    Eventable t' m' a,
    Data m'
  ) =>
  ParseEventLineOption ->
  (Context t m -> Context t' m') ->
  B.ByteString ->
  Either String (EventLine t' m' a)
modifyEventLineWithContext :: forall m m' t t' a b.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a,
 Eventable t' m' a, Data m') =>
ParseEventLineOption
-> (Context t m -> Context t' m')
-> ByteString
-> Either String (EventLine t' m' a)
modifyEventLineWithContext ParseEventLineOption
opt Context t m -> Context t' m'
f ByteString
x =
  let el :: Either String (EventLine t m a)
el = forall a. FromJSON a => ByteString -> Either String a
eitherDecode @(EventLine t m a) ByteString
x
   in forall m m' t t' a b e.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a,
 Ord t', Data m') =>
ParseEventLineOption
-> (Context t m -> Context t' m')
-> EventLine t m a
-> Either String (EventLine t' m' a)
eitherModifyEventLineFromContext ParseEventLineOption
opt Context t m -> Context t' m'
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either String (EventLine t m a)
el

{-
NOT EXPORTED AT THIS TIME
HERE FOR FURTHER CONSIDERATION

This function:

\* parses a JSON bytestring into an 'EventLine'
\* modifies the data in the 'EventLine'
that corresponds to an 'Event'
using the supplied function

The function may fail and return an error message
if either the JSON parsing fails
or the 'EventLine' -> 'Event' tranformation fails.

This function may modify time information in the 'EventLine',
thus cannot be used to roundtrip to/from JSON isomorphically.
For example, if the end of an interval is missing in the input JSON,
the output will contain an interval end if the 'AddMomentToTimeEnd'
parse option was used.

Therefore, USER BEWARE.

-}
modifyEventLineWithEvent ::
  forall m m' t t' a a' b.
  ( FromJSONEvent t m a,
    Eventable t m a,
    Eventable t' m' a',
    SizedIv (Interval a'),
    EventLineAble t m a b,
    ToJSON a',
    Data m'
  ) =>
  ParseEventLineOption ->
  (Event t m a -> Event t' m' a') ->
  B.ByteString ->
  Either String (EventLine t' m' a')
modifyEventLineWithEvent :: forall m m' t t' a a' b.
(FromJSONEvent t m a, Eventable t m a, Eventable t' m' a',
 SizedIv (Interval a'), EventLineAble t m a b, ToJSON a',
 Data m') =>
ParseEventLineOption
-> (Event t m a -> Event t' m' a')
-> ByteString
-> Either String (EventLine t' m' a')
modifyEventLineWithEvent ParseEventLineOption
opt Event t m a -> Event t' m' a'
f ByteString
x =
  let el :: Either String (EventLine t m a)
el = forall a. FromJSON a => ByteString -> Either String a
eitherDecode @(EventLine t m a) ByteString
x
   in forall m m' t t' a a' b e.
(Eventable t m a, Eventable t' m' a', EventLineAble t m a b,
 SizedIv (Interval a'), FromJSONEvent t m a, ToJSON a', Data m') =>
ParseEventLineOption
-> (Event t m a -> Event t' m' a')
-> EventLine t m a
-> Either String (EventLine t' m' a')
eitherModifyEventLineFromEvent ParseEventLineOption
opt Event t m a -> Event t' m' a'
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either String (EventLine t m a)
el