{-|
Module      : Functions for Parsing Hasklepias populations 
Description : Defines FromJSON instances for Hasklepias populations .
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TupleSections #-}

module Cohort.Input(
      parsePopulationLines
    , parsePopulationIntLines
    , parsePopulationDayLines
    , ParseError(..)
) where

import Control.Applicative                  ( Applicative((<*>)), (<$>) )
import Data.Aeson                           ( FromJSON(..)
                                            , ToJSON(..)
                                            , eitherDecode
                                            , Value(Array))
import qualified Data.ByteString.Lazy as B  ( fromStrict
                                            , toStrict
                                            , ByteString)
import qualified Data.ByteString.Char8 as C ( lines )
import Prelude                              (
                                             String)
import Data.Bifunctor                       ( Bifunctor(first) )
import Data.Either                          ( Either(..)
                                            , partitionEithers )
import Data.Eq                              ( Eq )
import Data.Function                        ( ($), id )                                        
import Data.Functor                         ( Functor(fmap) )
import Data.List                            ( sort, (++), zipWith )
import qualified Data.Map.Strict as M       ( toList, fromListWith)
import Data.Ord                             ( Ord )
import Data.Text                            (Text, pack)
import Data.Time.Calendar                   ( Day )
import Data.Vector                          ( (!) )
import EventData                            ( Events, event, Event )
import EventData.Aeson                      ()
import Cohort.Core                          ( Population(..)
                                            , ID
                                            , Subject(MkSubject) )
import GHC.Int                              ( Int )
import GHC.Num                              ( Natural )
import GHC.Show                             ( Show )
import IntervalAlgebra                      ( IntervalSizeable )


newtype SubjectEvent a = MkSubjectEvent (ID, Event a)

subjectEvent :: ID -> Event a -> SubjectEvent a
subjectEvent :: ID -> Event a -> SubjectEvent a
subjectEvent ID
x Event a
y = (ID, Event a) -> SubjectEvent a
forall a. (ID, Event a) -> SubjectEvent a
MkSubjectEvent (ID
x, Event a
y)

instance (FromJSON a, Show a, IntervalSizeable a b) => FromJSON (SubjectEvent a) where
    parseJSON :: Value -> Parser (SubjectEvent a)
parseJSON (Array Array
v) = ID -> Event a -> SubjectEvent a
forall a. ID -> Event a -> SubjectEvent a
subjectEvent (ID -> Event a -> SubjectEvent a)
-> Parser ID -> Parser (Event a -> SubjectEvent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Value -> Parser ID
forall a. FromJSON a => Value -> Parser a
parseJSON (Array
v Array -> Int -> Value
forall a. Vector a -> Int -> a
! Int
0) Parser (Event a -> SubjectEvent a)
-> Parser (Event a) -> Parser (SubjectEvent a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (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))

mapIntoPop :: (Ord a) => [SubjectEvent a] -> Population (Events a)
mapIntoPop :: [SubjectEvent a] -> Population (Events a)
mapIntoPop [SubjectEvent a]
l = [Subject (Events a)] -> Population (Events a)
forall d. [Subject d] -> Population d
MkPopulation ([Subject (Events a)] -> Population (Events a))
-> [Subject (Events a)] -> Population (Events a)
forall a b. (a -> b) -> a -> b
$
    ((ID, Events a) -> Subject (Events a))
-> [(ID, Events a)] -> [Subject (Events a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ID
id, Events a
es) -> (ID, Events a) -> Subject (Events a)
forall d. (ID, d) -> Subject d
MkSubject (ID
id, Events a -> Events a
forall a. Ord a => [a] -> [a]
sort Events a
es)) -- TODO: is there a way to avoid the sort?
        (Map ID (Events a) -> [(ID, Events a)]
forall k a. Map k a -> [(k, a)]
M.toList (Map ID (Events a) -> [(ID, Events a)])
-> Map ID (Events a) -> [(ID, Events a)]
forall a b. (a -> b) -> a -> b
$ (Events a -> Events a -> Events a)
-> [(ID, Events a)] -> Map ID (Events a)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Events a -> Events a -> Events a
forall a. [a] -> [a] -> [a]
(++) 
        ((SubjectEvent a -> (ID, Events a))
-> [SubjectEvent a] -> [(ID, Events a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(MkSubjectEvent (ID
id, Event a
e)) -> (ID
id, [Event a
e])) [SubjectEvent a]
l ))

decodeIntoSubj :: (FromJSON a, Show a, IntervalSizeable a b) => 
        B.ByteString  -> Either Text (SubjectEvent a)
decodeIntoSubj :: ByteString -> Either ID (SubjectEvent a)
decodeIntoSubj ByteString
x = (String -> ID)
-> Either String (SubjectEvent a) -> Either ID (SubjectEvent a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> ID
pack (Either String (SubjectEvent a) -> Either ID (SubjectEvent a))
-> Either String (SubjectEvent a) -> Either ID (SubjectEvent a)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String (SubjectEvent a)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
x 

-- | Contains the line number and error message.
newtype ParseError = MkParseError (Natural, Text) deriving (ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c== :: ParseError -> ParseError -> Bool
Eq, Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show)

-- |  Parse @Event Int@ from json lines.
parseSubjectLines ::
    (FromJSON a, Show a, IntervalSizeable a b) =>
        B.ByteString -> ( [ParseError], [SubjectEvent a] )
parseSubjectLines :: ByteString -> ([ParseError], [SubjectEvent a])
parseSubjectLines ByteString
l =
    [Either ParseError (SubjectEvent a)]
-> ([ParseError], [SubjectEvent a])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ParseError (SubjectEvent a)]
 -> ([ParseError], [SubjectEvent a]))
-> [Either ParseError (SubjectEvent a)]
-> ([ParseError], [SubjectEvent a])
forall a b. (a -> b) -> a -> b
$ (ByteString -> Natural -> Either ParseError (SubjectEvent a))
-> [ByteString]
-> [Natural]
-> [Either ParseError (SubjectEvent a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
      (\ByteString
x Natural
i -> (ID -> ParseError)
-> Either ID (SubjectEvent a) -> Either ParseError (SubjectEvent a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\ID
t -> (Natural, ID) -> ParseError
MkParseError (Natural
i,ID
t)) (ByteString -> Either ID (SubjectEvent a)
forall a b.
(FromJSON a, Show a, IntervalSizeable a b) =>
ByteString -> Either ID (SubjectEvent a)
decodeIntoSubj (ByteString -> Either ID (SubjectEvent a))
-> ByteString -> Either ID (SubjectEvent a)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.fromStrict ByteString
x) )
      (ByteString -> [ByteString]
C.lines (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict ByteString
l)
      [Natural
1..]

-- |  Parse @Event Int@ from json lines.
parsePopulationLines :: (FromJSON a, Show a, IntervalSizeable a b) => 
    B.ByteString -> ([ParseError], Population (Events a))
parsePopulationLines :: ByteString -> ([ParseError], Population (Events a))
parsePopulationLines ByteString
x = ([SubjectEvent a] -> Population (Events a))
-> ([ParseError], [SubjectEvent a])
-> ([ParseError], Population (Events a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SubjectEvent a] -> Population (Events a)
forall a. Ord a => [SubjectEvent a] -> Population (Events a)
mapIntoPop (ByteString -> ([ParseError], [SubjectEvent a])
forall a b.
(FromJSON a, Show a, IntervalSizeable a b) =>
ByteString -> ([ParseError], [SubjectEvent a])
parseSubjectLines ByteString
x)

-- |  Parse @Event Int@ from json lines.
parsePopulationIntLines :: B.ByteString -> ([ParseError], Population (Events Int))
parsePopulationIntLines :: ByteString -> ([ParseError], Population (Events Int))
parsePopulationIntLines ByteString
x = ([SubjectEvent Int] -> Population (Events Int))
-> ([ParseError], [SubjectEvent Int])
-> ([ParseError], Population (Events Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SubjectEvent Int] -> Population (Events Int)
forall a. Ord a => [SubjectEvent a] -> Population (Events a)
mapIntoPop (ByteString -> ([ParseError], [SubjectEvent Int])
forall a b.
(FromJSON a, Show a, IntervalSizeable a b) =>
ByteString -> ([ParseError], [SubjectEvent a])
parseSubjectLines ByteString
x)

-- |  Parse @Event Day@ from json lines.
parsePopulationDayLines :: B.ByteString -> ([ParseError], Population (Events Day))
parsePopulationDayLines :: ByteString -> ([ParseError], Population (Events Day))
parsePopulationDayLines ByteString
x = ([SubjectEvent Day] -> Population (Events Day))
-> ([ParseError], [SubjectEvent Day])
-> ([ParseError], Population (Events Day))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SubjectEvent Day] -> Population (Events Day)
forall a. Ord a => [SubjectEvent a] -> Population (Events a)
mapIntoPop (ByteString -> ([ParseError], [SubjectEvent Day])
forall a b.
(FromJSON a, Show a, IntervalSizeable a b) =>
ByteString -> ([ParseError], [SubjectEvent a])
parseSubjectLines ByteString
x)