From 1eb6df9261ee62d2688178f6c82021c8349a00c1 Mon Sep 17 00:00:00 2001 From: Tissevert Date: Fri, 29 Mar 2019 19:06:23 +0100 Subject: [PATCH] First draft parsing medicines and events in CSV files --- .gitignore | 1 + ChangeLog.md | 5 +++++ LICENSE | 30 ++++++++++++++++++++++++++++++ Setup.hs | 2 ++ pilu.cabal | 29 +++++++++++++++++++++++++++++ src/CSV.hs | 43 +++++++++++++++++++++++++++++++++++++++++++ src/Event.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++ src/Main.hs | 4 ++++ src/Medicine.hs | 31 +++++++++++++++++++++++++++++++ 9 files changed, 190 insertions(+) create mode 100644 .gitignore create mode 100644 ChangeLog.md create mode 100644 LICENSE create mode 100644 Setup.hs create mode 100644 pilu.cabal create mode 100644 src/CSV.hs create mode 100644 src/Event.hs create mode 100644 src/Main.hs create mode 100644 src/Medicine.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..56ad05d --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +dist* diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 index 0000000..4185880 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for pilu + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..42f34d0 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Tissevert + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Tissevert nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/pilu.cabal b/pilu.cabal new file mode 100644 index 0000000..c3bdedd --- /dev/null +++ b/pilu.cabal @@ -0,0 +1,29 @@ +-- Initial pilu.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/ + +name: pilu +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD3 +license-file: LICENSE +author: Tissevert +maintainer: tissevert+devel@ens-lyon.fr +-- copyright: +category: Health +build-type: Simple +extra-source-files: ChangeLog.md +cabal-version: >=1.10 + +executable pilu + main-is: Main.hs + other-modules: CSV + , Event + , Medicine + -- other-extensions: + build-depends: base >=4.9 && <4.10 + , containers + , parsec + , time + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/CSV.hs b/src/CSV.hs new file mode 100644 index 0000000..bbfc433 --- /dev/null +++ b/src/CSV.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE FlexibleInstances #-} +module CSV ( + Row(..) + , parse + ) where + +import Control.Applicative ((<|>)) +import Data.Map (Map) +import qualified Data.Map as Map (fromList, keys) +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) +import qualified Text.ParserCombinators.Parsec as Parsec (parse) + +class Row a where + fromRow :: Map String String -> Either Message a + +instance Row [String] where + fromRow = return . Map.keys + +csvFile :: Char -> Parser [[String]] +csvFile separator = line `endBy` eol + where + line = cell `sepBy` (char separator) + cell = quoted <|> many (noneOf $ separator:"\r\n") + eol = try (string "\r\n") <|> try (string "\r") <|> try (string "\n") "end-of-line" + +quoted :: Parser String +quoted = char '"' *> many quotedChar <* char '"' "quote ending the cell" + where + quotedChar = noneOf "\"" <|> try (string "\"\"" *> return '"') + +parse :: Row a => String -> Char -> String -> Either ParseError [a] +parse name separator input = do + lines <- Parsec.parse (csvFile separator) name input + case lines of + [] -> Right [] + (header:rows) -> + let assocs = Map.fromList . zipWith (,) header <$> rows in + sequence $ zipWith parseRow [1..] assocs + where + parseRow n row = either (errorAt n) return $ fromRow row + errorAt n message = Left $ newErrorMessage message (newPos name n 0) diff --git a/src/Event.hs b/src/Event.hs new file mode 100644 index 0000000..3a00253 --- /dev/null +++ b/src/Event.hs @@ -0,0 +1,45 @@ +module Event ( + ) where + +import CSV (Row(..)) +import Control.Monad (foldM) +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 Text.ParserCombinators.Parsec.Error (Message(..)) + +data EventType = Prescription | Provisioning deriving (Eq, Show) + +data Event = Event { + date :: Day + , amounts :: Map String Int + , eventtype :: EventType + } deriving (Show) + +instance Row Event where + fromRow assoc = do + date <- read <$> get "date" + (kind, ints) <- foldM addAmount (Nothing, Map.empty) . Map.toList $ Map.delete "date" assoc + maybe + (Left $ Expect "A prescription or provisioning for a medicine") + (Right . Event date ints) + kind + where + get key = maybe (Left $ Expect key) Right $ Map.lookup key assoc + unexpected = Left . UnExpect . show + addAmount (evType, ints) (key, val) = do + (newEvType, amount) <- readAmount val + let newInts = Map.insert key amount ints + case evType of + Nothing -> Right (Just newEvType, newInts) + Just currentEvType -> + if currentEvType == newEvType then Right (evType, newInts) else unexpected newEvType + +readAmount :: String -> Either Message (EventType, Int) +readAmount [] = Left $ Expect "prescription or provisioning" +readAmount ('+':n) = Right (Provisioning, read n) +readAmount s = + if "/j" `isSuffixOf` s + then Right (Prescription, read $ takeWhile (/= '/') s) + else Left $ Expect "rate" diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..65ae4a0 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/src/Medicine.hs b/src/Medicine.hs new file mode 100644 index 0000000..671e058 --- /dev/null +++ b/src/Medicine.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE NamedFieldPuns #-} +module Medicine ( + Medicine(..) + , Pharmacy + , pharmacy + ) where + +import CSV (Row(..)) +import Data.Map (Map) +import qualified Data.Map as Map (empty, insert, lookup) +import Text.ParserCombinators.Parsec.Error (Message(..)) + +data Medicine = Medicine { + name :: String + , content :: Int + , minStock :: Int + } 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 + +pharmacy :: [Medicine] -> Pharmacy +pharmacy [] = Map.empty +pharmacy (medicine:medicines) = Map.insert (name medicine) medicine $ pharmacy medicines