69 lines
2.1 KiB
Haskell
69 lines
2.1 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Timeline (
|
|
State
|
|
, currentState
|
|
) where
|
|
|
|
import Control.Monad (foldM, join)
|
|
import Control.Monad.Reader (Reader, runReader, ask)
|
|
import Data.List (sortOn)
|
|
import Data.Map ((!), Map, mapWithKey, toList)
|
|
import Data.Time (Day, diffDays)
|
|
import Event (Event(..), EventType(..))
|
|
import Medicine (Pharmacy, Stock)
|
|
|
|
type ConsumptionRate = Map String Float
|
|
|
|
data State = State {
|
|
day :: Day
|
|
, stock :: Stock
|
|
, consumptionRate :: ConsumptionRate
|
|
}
|
|
|
|
instance Show State where
|
|
show (State {day, stock, consumptionRate}) = unlines $
|
|
("day: " ++ show day)
|
|
: ("stock:" : (indent <$> showAssoc stock) :: [String])
|
|
++ ("consumptionRate:" : (indent <$> showAssoc consumptionRate))
|
|
where
|
|
indent :: String -> String
|
|
indent = ('\t' :)
|
|
showAssoc :: Show a => Map String a -> [String]
|
|
showAssoc = fmap (\(key, val) -> key ++ ": " ++ show val) . toList
|
|
|
|
initState :: Reader Pharmacy State
|
|
initState = do
|
|
pharmacy <- ask
|
|
return $ State {
|
|
day = toEnum 0
|
|
, stock = const 0 <$> pharmacy
|
|
, consumptionRate = const 0 <$> pharmacy
|
|
}
|
|
|
|
applyEvent :: State -> Event -> State
|
|
applyEvent state (Event {date, amounts, eventType}) =
|
|
case eventType of
|
|
Prescription -> newState {consumptionRate = amounts}
|
|
Provisioning -> newState {stock = mapWithKey addAmount $ stock newState}
|
|
where
|
|
newState = setDay date state
|
|
addAmount medicineName = (+ (amounts ! medicineName))
|
|
|
|
setDay :: Day -> State -> State
|
|
setDay newDay state@(State {day, stock, consumptionRate}) = state {
|
|
day = newDay
|
|
, stock = mapWithKey consume stock
|
|
}
|
|
where
|
|
duration = toEnum . fromEnum $ newDay `diffDays` day
|
|
consume medicineName initialAmount =
|
|
max 0 $ initialAmount - duration * (consumptionRate ! medicineName)
|
|
|
|
lastState :: [Event] -> Reader Pharmacy State
|
|
lastState events =
|
|
foldl applyEvent <$> initState <*> (return $ sortOn date events)
|
|
|
|
currentState :: Day -> Pharmacy -> [Event] -> State
|
|
currentState targetDay pharmacy events =
|
|
setDay targetDay (runReader (lastState events) pharmacy)
|