From 9f50e5d3bb6576a7e421b7c5a8c302210bfe3660 Mon Sep 17 00:00:00 2001 From: Tissevert Date: Sun, 7 Apr 2019 18:08:22 +0200 Subject: [PATCH] Actually implement inventory handling --- pilu.cabal | 9 +++++-- src/CLI.hs | 29 +++++++++++++++++++++ src/CSV.hs | 4 +-- src/Event.hs | 15 ++++++----- src/Main.hs | 32 ++++++++++++++++++++++- src/Medicine.hs | 16 +++++++----- src/Timeline.hs | 68 +++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 155 insertions(+), 18 deletions(-) create mode 100644 src/CLI.hs create mode 100644 src/Timeline.hs diff --git a/pilu.cabal b/pilu.cabal index c3bdedd..8db2174 100644 --- a/pilu.cabal +++ b/pilu.cabal @@ -17,12 +17,17 @@ cabal-version: >=1.10 executable pilu main-is: Main.hs - other-modules: CSV + other-modules: CLI + , CSV , Event , Medicine + , Paths_pilu + , Timeline -- other-extensions: - build-depends: base >=4.9 && <4.10 + build-depends: base >=4.9 && <4.13 , containers + , mtl + , optparse-applicative , parsec , time hs-source-dirs: src diff --git a/src/CLI.hs b/src/CLI.hs new file mode 100644 index 0000000..5617a73 --- /dev/null +++ b/src/CLI.hs @@ -0,0 +1,29 @@ +module CLI ( + Invocation(..) + , invoked + ) where + +import Options.Applicative ( + Parser, execParser, flag, flag', fullDesc, header, help, helper, info, long + ) +import Control.Applicative ((<**>), (<|>)) +import Data.Version (showVersion) +import qualified Paths_pilu as Pilu (version) + +data Invocation = Inventory | Schedule | Version String + +versionStr :: String +versionStr = showVersion Pilu.version + +invocation :: Parser Invocation +invocation = + flag' Schedule + (long "schedule" <> help "Show when next to go for provisioning") + <|> flag Inventory (Version versionStr) + (long "version" <> help "Show the version number") + +invoked :: IO Invocation +invoked = execParser $ + info + (invocation <**> helper) + (fullDesc <> header ("Pilu v" ++ versionStr)) diff --git a/src/CSV.hs b/src/CSV.hs index bbfc433..4190a58 100644 --- a/src/CSV.hs +++ b/src/CSV.hs @@ -6,7 +6,7 @@ module CSV ( import Control.Applicative ((<|>)) import Data.Map (Map) -import qualified Data.Map as Map (fromList, keys) +import qualified Data.Map as Map (fromList, elems) import Text.Parsec.Pos (newPos) import Text.ParserCombinators.Parsec ((), Parser, ParseError, char, endBy, many, noneOf, sepBy, string, try) import Text.ParserCombinators.Parsec.Error (Message(..), newErrorMessage) @@ -16,7 +16,7 @@ class Row a where fromRow :: Map String String -> Either Message a instance Row [String] where - fromRow = return . Map.keys + fromRow = return . Map.elems csvFile :: Char -> Parser [[String]] csvFile separator = line `endBy` eol diff --git a/src/Event.hs b/src/Event.hs index 3a00253..6a2db63 100644 --- a/src/Event.hs +++ b/src/Event.hs @@ -1,4 +1,6 @@ module Event ( + Event(..) + , EventType(..) ) where import CSV (Row(..)) @@ -7,14 +9,15 @@ import Data.List (isSuffixOf, takeWhile, sortOn) import Data.Map (Map) import qualified Data.Map as Map (delete, empty, insert, lookup, toList) import Data.Time (Day) +import Medicine (MedicineName) import Text.ParserCombinators.Parsec.Error (Message(..)) data EventType = Prescription | Provisioning deriving (Eq, Show) data Event = Event { date :: Day - , amounts :: Map String Int - , eventtype :: EventType + , amounts :: Map MedicineName Float + , eventType :: EventType } deriving (Show) instance Row Event where @@ -30,13 +33,13 @@ instance Row Event where unexpected = Left . UnExpect . show addAmount (evType, ints) (key, val) = do (newEvType, amount) <- readAmount val - let newInts = Map.insert key amount ints + let newFloats = Map.insert key amount ints case evType of - Nothing -> Right (Just newEvType, newInts) + Nothing -> Right (Just newEvType, newFloats) Just currentEvType -> - if currentEvType == newEvType then Right (evType, newInts) else unexpected newEvType + if currentEvType == newEvType then Right (evType, newFloats) else unexpected newEvType -readAmount :: String -> Either Message (EventType, Int) +readAmount :: String -> Either Message (EventType, Float) readAmount [] = Left $ Expect "prescription or provisioning" readAmount ('+':n) = Right (Provisioning, read n) readAmount s = diff --git a/src/Main.hs b/src/Main.hs index 65ae4a0..91b196f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,34 @@ module Main where +import CLI (Invocation(..), invoked) +import CSV (Row, parse) +import Data.Time (UTCTime(..), getCurrentTime) +import Event (Event) +import Medicine (Medicine, Pharmacy, pharmacy) +import System.Exit (exitFailure, exitSuccess) +import Timeline (State, currentState) + +readCSV :: Row a => FilePath -> IO [a] +readCSV filePath = do + parsed <- parse filePath '\t' <$> readFile filePath + case parsed of + Left e -> (putStrLn $ show e) >> exitFailure + Right rows -> return rows + +getPharmacy :: String -> IO Pharmacy +getPharmacy = fmap pharmacy . readCSV + +getCurrentState :: IO State +getCurrentState = + currentState + <$> (utctDay <$> getCurrentTime) + <*> getPharmacy "medicine.csv" + <*> readCSV "timeline.csv" + main :: IO () -main = putStrLn "Hello, Haskell!" +main = do + invocation <- invoked + case invocation of + Inventory -> show <$> getCurrentState >>= putStrLn + Schedule -> putStrLn "schedule" + Version version -> putStrLn version >> exitSuccess diff --git a/src/Medicine.hs b/src/Medicine.hs index 671e058..1c7277b 100644 --- a/src/Medicine.hs +++ b/src/Medicine.hs @@ -1,7 +1,9 @@ {-# LANGUAGE NamedFieldPuns #-} module Medicine ( Medicine(..) + , MedicineName , Pharmacy + , Stock , pharmacy ) where @@ -10,22 +12,22 @@ import Data.Map (Map) import qualified Data.Map as Map (empty, insert, lookup) import Text.ParserCombinators.Parsec.Error (Message(..)) +type MedicineName = String + data Medicine = Medicine { - name :: String - , content :: Int - , minStock :: Int + name :: MedicineName + , minStock :: Float } deriving (Show) instance Row Medicine where fromRow assoc = Medicine <$> get "name" - <*> (read <$> get "content") <*> (read <$> get "minStock") where get key = maybe (Left $ Expect key) Right $ Map.lookup key assoc -type Pharmacy = Map String Medicine +type Pharmacy = Map MedicineName Medicine +type Stock = Map MedicineName Float pharmacy :: [Medicine] -> Pharmacy -pharmacy [] = Map.empty -pharmacy (medicine:medicines) = Map.insert (name medicine) medicine $ pharmacy medicines +pharmacy = foldr (\medicine -> Map.insert (name medicine) medicine) Map.empty diff --git a/src/Timeline.hs b/src/Timeline.hs new file mode 100644 index 0000000..1f11146 --- /dev/null +++ b/src/Timeline.hs @@ -0,0 +1,68 @@ +{-# 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)