First draft parsing medicines and events in CSV files

.gitignore

@@ -0,0 +1 @@
+dist*

ChangeLog.md

@@ -0,0 +1,5 @@
+# Revision history for pilu
+
+## 0.1.0.0  -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

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.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

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

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)

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"

src/Main.hs

@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = putStrLn "Hello, Haskell!"

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