Implement basic scheduling

This commit is contained in:
Tissevert 2019-04-10 11:44:46 +02:00
parent b4fcc7857c
commit 0c875b78fe
2 changed files with 17 additions and 4 deletions

View file

@ -1,12 +1,15 @@
{-# LANGUAGE NamedFieldPuns #-}
module Main where module Main where
import CLI (Invocation(..), invoked) import CLI (Invocation(..), invoked)
import CSV (Row, parse) import CSV (Row, parse)
import Data.Time (UTCTime(..), getCurrentTime) import Data.List (minimum)
import Data.Map (elems, mergeWithKey)
import Data.Time (UTCTime(..), getCurrentTime, addDays)
import Event (Event) import Event (Event)
import Medicine (Medicine, Pharmacy, pharmacy) import Medicine (Medicine, Pharmacy, pharmacy)
import System.Exit (exitFailure, exitSuccess) import System.Exit (exitFailure, exitSuccess)
import Timeline (State, currentState) import Timeline (State(..), currentState)
readCSV :: Row a => FilePath -> IO [a] readCSV :: Row a => FilePath -> IO [a]
readCSV filePath = do readCSV filePath = do
@ -22,10 +25,20 @@ getCurrentState =
<*> (pharmacy <$> readCSV "medicine.csv") <*> (pharmacy <$> readCSV "medicine.csv")
<*> readCSV "timeline.csv" <*> readCSV "timeline.csv"
schedule :: State -> String
schedule (State {day, stock, consumptionRate}) = unlines [
"Days left: " ++ show deltaDays
, "Provision on: " ++ show (deltaDays `addDays` day )
]
where
daysLeftByMedicine =
mergeWithKey (\k a b -> Just $ a / b) id id stock consumptionRate
deltaDays = truncate . minimum $ elems daysLeftByMedicine
main :: IO () main :: IO ()
main = do main = do
invocation <- invoked invocation <- invoked
case invocation of case invocation of
Inventory -> show <$> getCurrentState >>= putStrLn Inventory -> show <$> getCurrentState >>= putStrLn
Schedule -> putStrLn "schedule" Schedule -> schedule <$> getCurrentState >>= putStrLn
Version version -> putStrLn version >> exitSuccess Version version -> putStrLn version >> exitSuccess

View file

@ -1,6 +1,6 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
module Timeline ( module Timeline (
State State(..)
, currentState , currentState
) where ) where