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

module EventData.Aeson(
      parseEventIntLines
    , parseEventDayLines
) where

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

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 -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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) (a -> a
forall a. a -> a
id) 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
_              -> 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) = Maybe Domain -> Concepts -> Context
context (Maybe Domain -> Concepts -> Context)
-> Parser (Maybe Domain) -> Parser (Concepts -> Context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Value -> Parser (Maybe 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)
    -- parseJSON v = context <$> parseJSON v

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)
    -- parseJSON (Array v) = event <$>
    --         parseJSON (v ! 5) <*>
    --         parseJSON (v ! 4)

-- |  Parse @Event Int@ from json lines.
parseEventLines :: (FromJSON a, Show a, IntervalSizeable a b) => B.ByteString -> [Event a]
parseEventLines :: ByteString -> [Event a]
parseEventLines ByteString
l =
    [Either String (Event a)] -> [Event a]
forall a b. [Either a b] -> [b]
rights ([Either String (Event a)] -> [Event a])
-> [Either String (Event a)] -> [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)


parseEventIntLines :: B.ByteString -> [Event Int]
parseEventIntLines :: ByteString -> [Event Int]
parseEventIntLines = ByteString -> [Event Int]
forall a b.
(FromJSON a, Show a, IntervalSizeable a b) =>
ByteString -> [Event a]
parseEventLines

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