diff --git a/src/CLI.hs b/src/CLI.hs index 7ffbb51..0773794 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -1,30 +1,47 @@ module CLI ( Invocation(..) + , Mode(..) , invoked ) where import Options.Applicative ( - Parser, execParser, flag, flag', fullDesc, header, help, helper, info, long, short + Parser, auto, execParser, flag, fullDesc, header, help, helper, info + , infoOption, long, option, short, value ) -import Control.Applicative ((<**>), (<|>)) +import Control.Applicative ((<**>), optional) import Data.Monoid ((<>)) +import Data.Time (Day) import Data.Version (showVersion) import qualified Paths_pilu as Pilu (version) -data Invocation = Inventory | Schedule | Version String +data Mode = Inventory | Schedule + +data Invocation = Invocation { + mode :: Mode + , date :: Maybe Day + } versionStr :: String versionStr = showVersion Pilu.version +version :: Parser (Invocation -> Invocation) +version = + infoOption versionStr + (short 'v' <> long "version" <> help "Show the version number") + invocation :: Parser Invocation -invocation = - flag' Inventory +invocation = Invocation + <$> flag Schedule Inventory (short 'i' <> long "inventory" <> help "Show a full inventory") - <|> flag Schedule (Version versionStr) - (long "version" <> help "Show the version number") + <*> option (optional auto) ( + value Nothing + <> short 'd' + <> long "date" + <> help "Evaluate the situation at that date" + ) invoked :: IO Invocation invoked = execParser $ info - (invocation <**> helper) + (invocation <**> version <**> helper) (fullDesc <> header ("Pilu v" ++ versionStr)) diff --git a/src/Main.hs b/src/Main.hs index 158767e..7154411 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,11 +1,11 @@ {-# LANGUAGE NamedFieldPuns #-} module Main where -import CLI (Invocation(..), invoked) +import CLI (Invocation(..), Mode(..), invoked) import CSV (Row, parse) -import Data.Time (UTCTime(..), getCurrentTime) +import Data.Time (Day, UTCTime(..), getCurrentTime) import Medicine (Pharmacy, pharmacy) -import System.Exit (exitFailure, exitSuccess) +import System.Exit (exitFailure) import Schedule (schedule) import Timeline (State(..), stateAt) import YAML (encode) @@ -17,20 +17,19 @@ readCSV filePath = do Left e -> (putStrLn $ show e) >> exitFailure Right rows -> return rows -getState :: Pharmacy -> IO State -getState aPharmacy = +getState :: Pharmacy -> Maybe Day -> IO State +getState aPharmacy atDate = stateAt - <$> (utctDay <$> getCurrentTime) - <*> (return aPharmacy) + <$> maybe (utctDay <$> getCurrentTime) return atDate + <*> return aPharmacy <*> readCSV "timeline.csv" main :: IO () main = do invocation <- invoked - display <- case invocation of - Inventory -> return $ const encode - Schedule -> return $ \ph -> encode . schedule ph - Version version -> putStrLn version >> exitSuccess thePharmacy <- pharmacy <$> readCSV "medicine.csv" - theState <- getState thePharmacy - putStrLn $ display thePharmacy theState + theState <- getState thePharmacy $ date invocation + let display = case mode invocation of + Inventory -> encode + Schedule -> encode . schedule thePharmacy + putStrLn $ display theState diff --git a/src/Timeline.hs b/src/Timeline.hs index 95bfe4a..43ceb8d 100644 --- a/src/Timeline.hs +++ b/src/Timeline.hs @@ -51,7 +51,10 @@ setDay newDay state@(State {day, stock, consumptionRate}) = state { max 0 $ initialAmount - duration * (consumptionRate ! medicineName) stateAt :: Day -> Pharmacy -> [Event] -> State -stateAt targetDay pharmacy events = - setDay targetDay lastState +stateAt targetDay pharmacy = + setDay targetDay . lastState where - lastState = foldl applyEvent (initState pharmacy) (sortOn date events) + lastState = + foldl applyEvent (initState pharmacy) + . sortOn date + . filter ((<= targetDay) . date)