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

module Hasklepias.Types.Event.Aeson(
      parseEventIntLines
    , parseEventDayLines
) where

import IntervalAlgebra
    ( beginerval, Interval, IntervalSizeable(diff) )
import Hasklepias.Types.Context
    ( Concepts, Concept, Context, context, packConcept, toConcepts )
import Hasklepias.Types.Event ( Event, event )
import Data.Aeson
    ( eitherDecode,
      (.:),
      withObject,
      FromJSON(parseJSON),
      Value(Array) )
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, fromRight)

instance FromJSON (Interval Int) where
    parseJSON :: Value -> Parser (Interval Int)
parseJSON = String
-> (Object -> Parser (Interval Int))
-> Value
-> Parser (Interval Int)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Time" ((Object -> Parser (Interval Int))
 -> Value -> Parser (Interval Int))
-> (Object -> Parser (Interval Int))
-> Value
-> Parser (Interval Int)
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"
        Int
b <- Object
t Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"begin"
        Int
e <- Object
t Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"end"
        Interval Int -> Parser (Interval Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Interval Int -> Parser (Interval Int))
-> Interval Int -> Parser (Interval Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Interval Int
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (Int -> Int -> Int
forall a b. IntervalSizeable a b => a -> a -> b
diff Int
e Int
b) Int
b
        --(parseInterval (b :: Day) (e :: Day))

instance FromJSON (Interval Day) where
    parseJSON :: Value -> Parser (Interval Day)
parseJSON = String
-> (Object -> Parser (Interval Day))
-> Value
-> Parser (Interval Day)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Time" ((Object -> Parser (Interval Day))
 -> Value -> Parser (Interval Day))
-> (Object -> Parser (Interval Day))
-> Value
-> Parser (Interval Day)
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"
        Day
b <- Object
t Object -> Text -> Parser Day
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"begin"
        Day
e <- Object
t Object -> Text -> Parser Day
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"end"
        Interval Day -> Parser (Interval Day)
forall (m :: * -> *) a. Monad m => a -> m a
return  (Interval Day -> Parser (Interval Day))
-> Interval Day -> Parser (Interval Day)
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Interval Day
forall a b. IntervalSizeable a b => b -> a -> Interval a
beginerval (Day -> Day -> Integer
forall a b. IntervalSizeable a b => a -> a -> b
diff Day
e Day
b) Day
b 
        --(parseInterval (b :: Day) (e :: Day))

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

instance FromJSON (Event Int) where
    parseJSON :: Value -> Parser (Event Int)
parseJSON (Array Array
v) = Interval Int -> Context -> Event Int
forall a. Interval a -> Context -> Event a
event (Interval Int -> Context -> Event Int)
-> Parser (Interval Int) -> Parser (Context -> Event Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Value -> Parser (Interval Int)
forall a. FromJSON a => Value -> Parser a
parseJSON (Array
v Array -> Int -> Value
forall a. Vector a -> Int -> a
! Int
5) Parser (Context -> Event Int)
-> Parser Context -> Parser (Event Int)
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
v Array -> Int -> Value
forall a. Vector a -> Int -> a
! Int
4)

instance FromJSON (Event Day) where
    parseJSON :: Value -> Parser (Event Day)
parseJSON (Array Array
v) = Interval Day -> Context -> Event Day
forall a. Interval a -> Context -> Event a
event (Interval Day -> Context -> Event Day)
-> Parser (Interval Day) -> Parser (Context -> Event Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Value -> Parser (Interval Day)
forall a. FromJSON a => Value -> Parser a
parseJSON (Array
v Array -> Int -> Value
forall a. Vector a -> Int -> a
! Int
5) Parser (Context -> Event Day)
-> Parser Context -> Parser (Event Day)
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
v Array -> Int -> Value
forall a. Vector a -> Int -> a
! Int
4)

-- |  Parse @Event Int@ from json lines.
-- 
-- This function and the event parsing in general needs a lot of work to be 
-- production-ready. But this is good enough for prototyping.
parseEventIntLines :: B.ByteString -> [Event Int]
parseEventIntLines :: ByteString -> [Event Int]
parseEventIntLines ByteString
l =
    [Either String (Event Int)] -> [Event Int]
forall a b. [Either a b] -> [b]
rights ([Either String (Event Int)] -> [Event Int])
-> [Either String (Event Int)] -> [Event Int]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either String (Event Int))
-> [ByteString] -> [Either String (Event Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
x -> ByteString -> Either String (Event Int)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String (Event Int))
-> ByteString -> Either String (Event Int)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.fromStrict ByteString
x :: Either String (Event Int))
        (ByteString -> [ByteString]
C.lines (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict ByteString
l)

-- |  Parse @Event Day@ from json lines.
parseEventDayLines :: B.ByteString -> [Event Day]
parseEventDayLines :: ByteString -> [Event Day]
parseEventDayLines ByteString
l =
    [Either String (Event Day)] -> [Event Day]
forall a b. [Either a b] -> [b]
rights ([Either String (Event Day)] -> [Event Day])
-> [Either String (Event Day)] -> [Event Day]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either String (Event Day))
-> [ByteString] -> [Either String (Event Day)]
forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
x -> ByteString -> Either String (Event Day)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String (Event Day))
-> ByteString -> Either String (Event Day)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.fromStrict ByteString
x :: Either String (Event Day))
        (ByteString -> [ByteString]
C.lines (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict ByteString
l)