pilu/src/Event.hs

module Event (
      Event(..)
    , EventType(..)
  ) where

import CSV (Row(..))
import Control.Monad (foldM)
import Data.List (isSuffixOf, takeWhile)
import Data.Map (Map)
import qualified Data.Map as Map (difference, empty, fromList, insert, lookup, toList)
import Data.Time (Day)
import Medicine (MedicineName)
import Text.ParserCombinators.Parsec.Error (Message(..))

data EventType = Prescription | Provisioning deriving (Eq, Show)

data Event = Event {
      date :: Day
    , amounts :: Map MedicineName Float
    , eventType :: EventType
  } deriving (Show)

instance Row Event where
  fromRow assoc = do
      rowDate <- read <$> get "date"
      (kind, ints) <- foldM addAmount (Nothing, Map.empty) $ Map.toList medicineNames
      maybe
        (Left $ Expect "A prescription or provisioning for a medicine")
        (Right . Event rowDate ints)
        kind
    where
      get key = maybe (Left $ Expect key) Right $ Map.lookup key assoc
      unexpected = Left . UnExpect . show
      ignoredKeys = Map.fromList [("date", ""), ("comment", "")]
      medicineNames = Map.difference assoc ignoredKeys
      addAmount (evType, ints) (key, val) = do
        (newEvType, amount) <- readAmount val
        let newFloats = Map.insert key amount ints
        case evType of
          Nothing -> Right (Just newEvType, newFloats)
          Just currentEvType ->
            if currentEvType == newEvType then Right (evType, newFloats) else unexpected newEvType

readAmount :: String -> Either Message (EventType, Float)
readAmount [] = Left $ Expect "prescription or provisioning"
readAmount ('+':n) = Right (Provisioning, read n)
readAmount s =
  if "/j" `isSuffixOf` s
    then Right (Prescription, read $ takeWhile (/= '/') s)
    else Left $ Expect "rate"