packages feed

hasklepias-0.8.3: src/Hasklepias/Aeson.hs

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

module Hasklepias.Aeson(
      parsePopulationIntLines
    , parsePopulationDayLines
) where

import IntervalAlgebra
import EventData
import EventData.Aeson 
import Hasklepias.Cohort
import Data.Aeson                           ( FromJSON(..)
                                            , eitherDecode
                                            , Value(Array))
import qualified Data.ByteString.Lazy as B  ( fromStrict
                                            , toStrict
                                            , ByteString)
import qualified Data.ByteString.Char8 as C ( lines )
import Prelude                              ( (<$>), (<*>), ($), fmap
                                            , Int, String, Ord, Show)
import Data.Either                          ( Either, rights )
import Data.List                            ( sort, (++) )
import qualified Data.Map.Strict as M       ( toList, fromListWith)
import Data.Vector                          ( (!) )
import Data.Time.Calendar                   ( Day )

newtype SubjectEvent a = MkSubjectEvent (ID, Event a)

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

instance (FromJSON a, Show a, IntervalSizeable a b) => FromJSON (SubjectEvent a) where
    parseJSON (Array v) = subjectEvent <$> 
        parseJSON (v ! 0) <*> (event <$> parseJSON (v ! 5) <*> parseJSON (Array v))

mapIntoPop :: (Ord a) => [SubjectEvent a] -> Population (Events a)
mapIntoPop l = MkPopulation $ 
    fmap (\(id, es) -> MkSubject (id, sort es)) -- TODO: is there a way to avoid the sort
        (M.toList $ M.fromListWith (++) (fmap (\(MkSubjectEvent (id, e)) -> (id, [e])) l ))

-- |  Parse @Event Int@ from json lines.
parsePopulationLines :: 
    (FromJSON a, Show a, IntervalSizeable a b) => 
        B.ByteString -> Population (Events a)
parsePopulationLines l =
    mapIntoPop $ rights $ fmap 
    (\x -> eitherDecode $ B.fromStrict x :: (FromJSON a, Show a, IntervalSizeable a b) => Either String (SubjectEvent a))
        (C.lines $ B.toStrict l)


parsePopulationIntLines :: B.ByteString -> Population (Events Int)
parsePopulationIntLines = parsePopulationLines

-- |  Parse @Event Day@ from json lines.
parsePopulationDayLines :: B.ByteString -> Population (Events Day)
parsePopulationDayLines = parsePopulationLines