{-# 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"
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)
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)
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
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