{-|
Module      : Functions for Parsing Event data model
Description : Defines FromJSON instances for Events.
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

module EventData.Aeson
  ( parseEventIntLines
  , parseEventDayLines
  ) where

import           Control.Monad
import           Data.Aeson                     ( (.:)
                                                , (.:?)
                                                , FromJSON(parseJSON)
                                                , Value(Array)
                                                , eitherDecode
                                                , withObject
                                                )
import qualified Data.ByteString.Char8         as C
import qualified Data.ByteString.Lazy          as B
import           Data.Either                    ( Either(..)
                                                , either
                                                , partitionEithers
                                                )
import           Data.Maybe                     ( fromMaybe )
import           Data.Text                      ( Text )
import           Data.Time                      ( Day )
import           Data.Vector                    ( (!) )
import           EventData.Context              ( Concept
                                                , Concepts
                                                , Context
                                                , context
                                                , packConcept
                                                , toConcepts
                                                )
import           EventData.Context.Domain
import           EventData.Core                 ( Event
                                                , event
                                                )
import           IntervalAlgebra                ( Interval
                                                , IntervalSizeable
                                                  ( add
                                                  , diff
                                                  , moment
                                                  )
                                                , beginerval
                                                , parseInterval
                                                )
import           Prelude                        ( ($)
                                                , (<$>)
                                                , (<*>)
                                                , Int
                                                , Ord
                                                , Show
                                                , String
                                                , fmap
                                                , id
                                                , pure
                                                )

instance (FromJSON a, Show a, IntervalSizeable a b) => FromJSON (Interval a) where
  parseJSON :: Value -> Parser (Interval a)
parseJSON = String
-> (Object -> Parser (Interval a)) -> Value -> Parser (Interval a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Time" ((Object -> Parser (Interval a)) -> Value -> Parser (Interval a))
-> (Object -> Parser (Interval a)) -> Value -> Parser (Interval a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
t <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"time"
    a
b <- Object
t Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"begin"
    Maybe a
e <- Object
t Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"end"
    -- In the case that the end is missing, create a moment
    let e2 :: a
e2 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (b -> a -> a
forall a b. IntervalSizeable a b => b -> a -> a
add (forall b. IntervalSizeable a b => b
forall a b. IntervalSizeable a b => b
moment @a) a
b) Maybe a
e
    let ei :: Either String (Interval a)
ei = a -> a -> Either String (Interval a)
forall a. (Show a, Ord a) => a -> a -> Either String (Interval a)
parseInterval a
b a
e2
    case Either String (Interval a)
ei of
      Left  String
e -> String -> Parser (Interval a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
      Right Interval a
i -> Interval a -> Parser (Interval a)
forall (m :: * -> *) a. Monad m => a -> m a
return Interval a
i

instance FromJSON Domain where
  parseJSON :: Value -> Parser Domain
parseJSON = String -> (Object -> Parser Domain) -> Value -> Parser Domain
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Domain" ((Object -> Parser Domain) -> Value -> Parser Domain)
-> (Object -> Parser Domain) -> Value -> Parser Domain
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
domain :: Text <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"domain"
    case Text
domain of
      Text
"Demographics" -> DemographicsFacts -> Domain
Demographics (DemographicsFacts -> Domain)
-> Parser DemographicsFacts -> Parser Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser DemographicsFacts
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"facts"
      Text
"Enrollment"   -> Domain -> Parser Domain
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain -> Parser Domain) -> Domain -> Parser Domain
forall a b. (a -> b) -> a -> b
$ EnrollmentFacts -> Domain
Enrollment (() -> EnrollmentFacts
EnrollmentFacts ())
      Text
_              -> Domain -> Parser Domain
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Domain
UnimplementedDomain ())

instance FromJSON Concept where
  parseJSON :: Value -> Parser Concept
parseJSON Value
c = Text -> Concept
packConcept (Text -> Concept) -> Parser Text -> Parser Concept
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
c

instance FromJSON Concepts where
  parseJSON :: Value -> Parser Concepts
parseJSON Value
c = Set Concept -> Concepts
toConcepts (Set Concept -> Concepts)
-> Parser (Set Concept) -> Parser Concepts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Set Concept)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
c

instance FromJSON Context where
  parseJSON :: Value -> Parser Context
parseJSON (Array Array
v) = Domain -> Concepts -> Context
context (Domain -> Concepts -> Context)
-> Parser Domain -> Parser (Concepts -> Context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Domain
forall a. FromJSON a => Value -> Parser a
parseJSON (Array
v Array -> Int -> Value
forall a. Vector a -> Int -> a
! Int
5) Parser (Concepts -> Context) -> Parser Concepts -> Parser Context
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser Concepts
forall a. FromJSON a => Value -> Parser a
parseJSON (Array
v Array -> Int -> Value
forall a. Vector a -> Int -> a
! Int
4)

instance  (FromJSON a, Show a, IntervalSizeable a b) => FromJSON (Event a) where
  parseJSON :: Value -> Parser (Event a)
parseJSON (Array Array
v) = Interval a -> Context -> Event a
forall a. Interval a -> Context -> Event a
event (Interval a -> Context -> Event a)
-> Parser (Interval a) -> Parser (Context -> Event a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Interval a)
forall a. FromJSON a => Value -> Parser a
parseJSON (Array
v Array -> Int -> Value
forall a. Vector a -> Int -> a
! Int
5) Parser (Context -> Event a) -> Parser Context -> Parser (Event a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser Context
forall a. FromJSON a => Value -> Parser a
parseJSON (Array -> Value
Array Array
v)

-- |  Parse @Event Int@ from json lines.
parseEventLines
  :: (FromJSON a, Show a, IntervalSizeable a b)
  => B.ByteString
  -> ([String], [Event a])
parseEventLines :: ByteString -> ([String], [Event a])
parseEventLines ByteString
l = [Either String (Event a)] -> ([String], [Event a])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either String (Event a)] -> ([String], [Event a]))
-> [Either String (Event a)] -> ([String], [Event a])
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either String (Event a))
-> [ByteString] -> [Either String (Event a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\ByteString
x ->
    ByteString -> Either String (Event a)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String (Event a))
-> ByteString -> Either String (Event a)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.fromStrict ByteString
x :: (FromJSON a, Show a, IntervalSizeable a b)
      => Either String (Event a)
  )
  (ByteString -> [ByteString]
C.lines (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict ByteString
l)

-- |  Parse @Event Int@ from json lines.
parseEventIntLines
  :: (FromJSON a, Show a, IntervalSizeable a b)
  => B.ByteString
  -> ([String], [Event a])
parseEventIntLines :: ByteString -> ([String], [Event a])
parseEventIntLines = ByteString -> ([String], [Event a])
forall a b.
(FromJSON a, Show a, IntervalSizeable a b) =>
ByteString -> ([String], [Event a])
parseEventLines

-- |  Parse @Event Day@ from json lines.
parseEventDayLines
  :: (FromJSON a, Show a, IntervalSizeable a b)
  => B.ByteString
  -> ([String], [Event a])
parseEventDayLines :: ByteString -> ([String], [Event a])
parseEventDayLines = ByteString -> ([String], [Event a])
forall a b.
(FromJSON a, Show a, IntervalSizeable a b) =>
ByteString -> ([String], [Event a])
parseEventLines