81 lines
2.8 KiB
Haskell
81 lines
2.8 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
module Schedule (
|
|
schedule
|
|
) where
|
|
|
|
import Data.Map ((!), Map, elems, lookupMin, mapWithKey, partition, size)
|
|
import qualified Data.Map as Map (filter)
|
|
import Data.Time (Day, addDays)
|
|
import Medicine (Medicine(..), MedicineName, Pharmacy)
|
|
import Timeline (State(..))
|
|
import YAML ((.:), Value(..), YAML(..))
|
|
|
|
data ScheduleType = NextBox | Provision | OutOfStock deriving (Eq, Show)
|
|
|
|
instance YAML ScheduleType where
|
|
toYAML NextBox = Simple "start a new box"
|
|
toYAML Provision = Simple "go to the pharmacy get some more"
|
|
toYAML OutOfStock = Simple "out of it"
|
|
|
|
data Schedule = Schedule {
|
|
days :: Integer
|
|
, date :: Day
|
|
, scheduleType :: ScheduleType
|
|
} deriving (Show)
|
|
|
|
instance YAML (Map MedicineName Schedule) where
|
|
toYAML schedules = Object $ outOfStocks ++ nextDay
|
|
where
|
|
(urgent, normal) = partition ((== OutOfStock) . scheduleType) schedules
|
|
outOfStocks =
|
|
if size urgent > 0
|
|
then ["Warning ! Out of" .: (Object . timing <$> urgent)]
|
|
else []
|
|
nextDay = maybe [] (scheduleNext normal) (snd <$> lookupMin normal)
|
|
|
|
scheduleNext :: Map MedicineName Schedule -> Schedule -> [(String, Value)]
|
|
scheduleNext schedules aSchedule = ["Schedule" .: (Object $
|
|
timing aSchedule
|
|
++ ["TODO" .: (scheduleType <$> schedules)]
|
|
)]
|
|
|
|
timing :: Schedule -> [(String, Value)]
|
|
timing aSchedule =
|
|
["On" .: date aSchedule, "In" .: (show (days aSchedule) ++ " days")]
|
|
|
|
zipWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
|
|
zipWithKey f as bs =
|
|
mapWithKey (\k -> f k $ as ! k) bs
|
|
|
|
scheduleByMedicine :: Pharmacy -> Day -> MedicineName -> Float -> Float -> Schedule
|
|
scheduleByMedicine pharmacy day medicineName stockLeft rate =
|
|
let (scheduleType, amount) = typeAndAmount stockLeft minStock leftInBox in
|
|
let days = truncate (amount / rate) in
|
|
Schedule {days, date = days `addDays` day, scheduleType}
|
|
where
|
|
(Medicine {minStock, content}) = pharmacy ! medicineName
|
|
truncateF = fromInteger . truncate
|
|
leftInBox = stockLeft - (truncateF (stockLeft / content) * content)
|
|
|
|
typeAndAmount :: Float -> Float -> Float -> (ScheduleType, Float)
|
|
typeAndAmount stockLeft minStock leftInBox =
|
|
if secureLeft > 0
|
|
then
|
|
if secureLeft < leftInBox
|
|
then (Provision, secureLeft)
|
|
else (NextBox, leftInBox)
|
|
else (OutOfStock, stockLeft)
|
|
where
|
|
secureLeft = stockLeft - minStock
|
|
|
|
schedule :: Pharmacy -> State -> Map MedicineName Schedule
|
|
schedule pharmacy (State {day, stock, consumptionRate}) =
|
|
Map.filter keep schedules
|
|
where
|
|
schedules =
|
|
zipWithKey (scheduleByMedicine pharmacy day) stock consumptionRate
|
|
minDays = minimum . elems $ days <$> schedules
|
|
keep aSchedule =
|
|
days aSchedule == minDays || scheduleType aSchedule == OutOfStock
|