51 lines
1.7 KiB
Haskell
51 lines
1.7 KiB
Haskell
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"
|