From 25a109c9e15c2b20905b429b5b974c954e6fd65a Mon Sep 17 00:00:00 2001
From: Maximilian Tagher <feedback.tagher@gmail.com>
Date: Mon, 20 Dec 2021 16:24:37 -0500
Subject: [PATCH] Add example of incremental, name based parsing

There is already an example for indexed-based decoding, but not for name-based.

This also adds a salaries.csv file, which is used by the new code, but incidentally closes https://github.com/haskell-hvr/cassava/issues/208
---
 examples/IncrementalNameBasedDecode.hs | 49 ++++++++++++++++++++++++++
 examples/cassava-examples.cabal        |  9 +++++
 examples/salaries.csv                  |  3 ++
 3 files changed, 61 insertions(+)
 create mode 100644 examples/IncrementalNameBasedDecode.hs
 create mode 100644 examples/salaries.csv

diff --git a/examples/IncrementalNameBasedDecode.hs b/examples/IncrementalNameBasedDecode.hs
new file mode 100644
index 0000000..509e475
--- /dev/null
+++ b/examples/IncrementalNameBasedDecode.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE BangPatterns, ScopedTypeVariables, OverloadedStrings #-}
+
+import Control.Monad
+import qualified Data.ByteString as B
+import Data.Csv (FromNamedRecord(..), (.:))
+import Data.Csv.Incremental
+import System.Exit
+import System.IO
+import Data.Either (rights)
+
+data SalaryInfo = SalaryInfo
+    { name :: String
+    , salary :: Int
+    }
+
+instance FromNamedRecord SalaryInfo where
+    parseNamedRecord m = SalaryInfo <$>
+                         m .: "name" <*>
+                         m .: "salary"
+
+main :: IO ()
+main = withFile "salaries.csv" ReadMode $ \ csvFile -> do
+
+    let headerLoop (FailH _ errMsg) = putStrLn errMsg >> exitFailure
+        headerLoop (PartialH fn) = headerLoop =<< feedHeader fn
+        headerLoop (DoneH header parser) = loop 0 parser
+
+        loop !_ (Fail _ errMsg) = putStrLn errMsg >> exitFailure
+        loop acc (Many rs k)    = loop (acc + sumSalaries rs) =<< feed k
+        loop acc (Done rs)      = putStrLn $ "Total salaries: " ++
+                                  show (sumSalaries rs + acc)
+
+        feedHeader k = do
+          isEof <- hIsEOF csvFile
+          if isEof
+                then return $ k B.empty
+                else k `fmap` B.hGetSome csvFile 4096
+
+        feed k = do
+            isEof <- hIsEOF csvFile
+            if isEof
+                then return $ k B.empty
+                else k `fmap` B.hGetSome csvFile 4096
+    headerLoop (decodeByName :: HeaderParser (Parser SalaryInfo))
+  where
+    sumSalaries :: [Either String SalaryInfo] -> Int
+    sumSalaries rs = 
+      let good = rights rs
+      in sum $ map (\sinfo -> salary sinfo) good
diff --git a/examples/cassava-examples.cabal b/examples/cassava-examples.cabal
index 6844b30..039901c 100644
--- a/examples/cassava-examples.cabal
+++ b/examples/cassava-examples.cabal
@@ -15,6 +15,15 @@ executable IncrementalIndexedBasedDecode
     vector
   default-language:    Haskell2010
 
+executable IncrementalNameBasedDecode
+  main-is: IncrementalNameBasedDecode.hs
+  build-depends:
+    base,
+    bytestring,
+    cassava,
+    vector
+  default-language:    Haskell2010
+
 executable IndexBasedDecode
   main-is: IndexBasedDecode.hs
   build-depends:
diff --git a/examples/salaries.csv b/examples/salaries.csv
new file mode 100644
index 0000000..a751578
--- /dev/null
+++ b/examples/salaries.csv
@@ -0,0 +1,3 @@
+name,salary
+Paul,100
+Sam,200