46 lines
1.5 KiB
Haskell
46 lines
1.5 KiB
Haskell
module Event (
|
|
) where
|
|
|
|
import CSV (Row(..))
|
|
import Control.Monad (foldM)
|
|
import Data.List (isSuffixOf, takeWhile, sortOn)
|
|
import Data.Map (Map)
|
|
import qualified Data.Map as Map (delete, empty, insert, lookup, toList)
|
|
import Data.Time (Day)
|
|
import Text.ParserCombinators.Parsec.Error (Message(..))
|
|
|
|
data EventType = Prescription | Provisioning deriving (Eq, Show)
|
|
|
|
data Event = Event {
|
|
date :: Day
|
|
, amounts :: Map String Int
|
|
, eventtype :: EventType
|
|
} deriving (Show)
|
|
|
|
instance Row Event where
|
|
fromRow assoc = do
|
|
date <- read <$> get "date"
|
|
(kind, ints) <- foldM addAmount (Nothing, Map.empty) . Map.toList $ Map.delete "date" assoc
|
|
maybe
|
|
(Left $ Expect "A prescription or provisioning for a medicine")
|
|
(Right . Event date ints)
|
|
kind
|
|
where
|
|
get key = maybe (Left $ Expect key) Right $ Map.lookup key assoc
|
|
unexpected = Left . UnExpect . show
|
|
addAmount (evType, ints) (key, val) = do
|
|
(newEvType, amount) <- readAmount val
|
|
let newInts = Map.insert key amount ints
|
|
case evType of
|
|
Nothing -> Right (Just newEvType, newInts)
|
|
Just currentEvType ->
|
|
if currentEvType == newEvType then Right (evType, newInts) else unexpected newEvType
|
|
|
|
readAmount :: String -> Either Message (EventType, Int)
|
|
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"
|