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