Implement basic scheduling
This commit is contained in:
parent
b4fcc7857c
commit
0c875b78fe
2 changed files with 17 additions and 4 deletions
19
src/Main.hs
19
src/Main.hs
|
@ -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
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
module Timeline (
|
module Timeline (
|
||||||
State
|
State(..)
|
||||||
, currentState
|
, currentState
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue