diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +0.7.3.0 +* Add ordered versions of named records for consistent, controllable header column ordering. [PR 44](https://github.com/ozataman/csv-conduit/pull/44) +* Add support for GHC 9.0.1 + 0.7.2.0 * Remove some dependency upper bounds for forward compatibility. diff --git a/csv-conduit.cabal b/csv-conduit.cabal --- a/csv-conduit.cabal +++ b/csv-conduit.cabal @@ -1,5 +1,5 @@ Name: csv-conduit -Version: 0.7.2.0 +Version: 0.7.3.0 Synopsis: A flexible, fast, conduit-based CSV parser library for Haskell. Homepage: http://github.com/ozataman/csv-conduit License: BSD3 @@ -9,7 +9,7 @@ Category: Data, Conduit, CSV, Text Build-type: Simple Cabal-version: >= 1.10 -Tested-with: GHC == 7.6.1 +Tested-with: GHC == 9.0.1, GHC == 8.10.4, GHC == 8.8.4, GHC == 8.8.3, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2 Description: CSV files are the de-facto standard in many situations involving data transfer, particularly when dealing with enterprise application or disparate database @@ -94,6 +94,7 @@ , array , blaze-builder , unordered-containers + , ordered-containers , transformers , mtl , mmorph @@ -117,6 +118,7 @@ build-depends: base >= 4 && < 5 , bytestring + , conduit >= 1.3.0 , containers >= 0.3 , csv-conduit , directory @@ -125,6 +127,7 @@ , test-framework , test-framework-hunit , text + , ordered-containers , transformers , mtl , primitive diff --git a/src/Data/CSV/Conduit.hs b/src/Data/CSV/Conduit.hs --- a/src/Data/CSV/Conduit.hs +++ b/src/Data/CSV/Conduit.hs @@ -20,12 +20,14 @@ , transformCSV' , mapCSVFile , writeHeaders + , writeHeadersOrdered -- Types , CSV (..) , CSVSettings (..) , defCSVSettings , MapRow + , OrderedMapRow , Row -- * Re-exported For Convenience @@ -52,6 +54,7 @@ sourceFile) import qualified Data.Conduit.List as C import qualified Data.Map as M +import qualified Data.Map.Ordered as MO import Data.String import Data.Text (Text) import qualified Data.Text as T @@ -63,8 +66,11 @@ import System.IO ------------------------------------------------------------------------------- import Data.CSV.Conduit.Conversion (FromNamedRecord (..), + FromNamedRecordOrdered (..), Named (..), + NamedOrdered (..), ToNamedRecord (..), + ToNamedRecordOrdered (..), runParser) import qualified Data.CSV.Conduit.Parser.ByteString as BSP import qualified Data.CSV.Conduit.Parser.Text as TP @@ -224,7 +230,12 @@ intoCSV set = intoCSVMap set fromCSV set = fromCSVMap set +instance (CSV s (Row s'), Ord s', IsString s) => CSV s (OrderedMapRow s') where + rowToStr s r = rowToStr s . (map snd . MO.assocs) $ r + intoCSV set = intoCSVMapOrdered set + fromCSV set = fromCSVMapOrdered set + ------------------------------------------------------------------------------- intoCSVMap :: (Ord a, MonadThrow m, CSV s [a]) => CSVSettings -> ConduitM s (MapRow a) m () @@ -239,7 +250,20 @@ converter hs = awaitForever $ yield . toMapCSV hs toMapCSV !hs !fs = M.fromList $ zip hs fs +intoCSVMapOrdered :: (Ord a, MonadThrow m, CSV s [a]) + => CSVSettings -> ConduitM s (OrderedMapRow a) m () +intoCSVMapOrdered set = intoCSV set .| (headers >>= converter) + where + headers = do + mrow <- await + case mrow of + Nothing -> return [] + Just [] -> headers + Just hs -> return hs + converter hs = awaitForever $ yield . toMapCSV hs + toMapCSV !hs !fs = MO.fromList $ zip hs fs + -- | Conversion of stream directly to/from a custom complex haskell -- type. instance (FromNamedRecord a, ToNamedRecord a, CSV s (MapRow ByteString)) => @@ -254,7 +278,19 @@ where go = toNamedRecord . getNamed +instance (FromNamedRecordOrdered a, ToNamedRecordOrdered a, CSV s (OrderedMapRow ByteString)) => + CSV s (NamedOrdered a) where + rowToStr s a = rowToStr s . toNamedRecordOrdered . getNamedOrdered $ a + intoCSV set = intoCSV set .| C.mapMaybe go + where + go x = either (const Nothing) (Just . NamedOrdered) $ + runParser (parseNamedRecordOrdered x) + fromCSV set = C.map go .| fromCSV set + where + go = toNamedRecordOrdered . getNamedOrdered + + ------------------------------------------------------------------------------- fromCSVMap :: (Monad m, IsString s, CSV s [a]) => CSVSettings -> ConduitM (M.Map k a) s m () @@ -262,7 +298,13 @@ where push r = mapM_ yield [rowToStr set (M.elems r), "\n"] +fromCSVMapOrdered :: (Monad m, IsString s, CSV s [a]) + => CSVSettings -> ConduitM (MO.OMap k a) s m () +fromCSVMapOrdered set = awaitForever push + where + push r = mapM_ yield [rowToStr set (map snd $ MO.assocs r), "\n"] + ------------------------------------------------------------------------------- -- | Write headers AND the row into the output stream, once. If you -- don't call this while using 'MapRow' family of row types, then your @@ -282,6 +324,19 @@ Just row -> mapM_ yield [ rowToStr set (M.keys row) , "\n" , rowToStr set (M.elems row) + , "\n" ] + +writeHeadersOrdered + :: (Monad m, CSV s (Row r), IsString s) + => CSVSettings + -> ConduitM (OrderedMapRow r) s m () +writeHeadersOrdered set = do + mrow <- await + case mrow of + Nothing -> return () + Just row -> mapM_ yield [ rowToStr set (map fst $ MO.assocs row) + , "\n" + , rowToStr set (map snd $ MO.assocs row) , "\n" ] diff --git a/src/Data/CSV/Conduit/Conversion.hs b/src/Data/CSV/Conduit/Conversion.hs --- a/src/Data/CSV/Conduit/Conversion.hs +++ b/src/Data/CSV/Conduit/Conversion.hs @@ -28,11 +28,15 @@ -- * Type conversion Only(..) , Named (..) + , NamedOrdered (..) , Record , NamedRecord + , NamedRecordOrdered , FromRecord(..) , FromNamedRecord(..) + , FromNamedRecordOrdered(..) , ToNamedRecord(..) + , ToNamedRecordOrdered(..) , FromField(..) , ToRecord(..) , ToField(..) @@ -47,11 +51,13 @@ , (.!) , unsafeIndex , lookup + , lookupOrdered , (.:) , namedField , (.=) , record , namedRecord + , namedRecordOrdered ) where import Control.Applicative as A @@ -61,9 +67,10 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as L - import Data.Int (Int8, Int16, Int32, Int64) +import Data.Kind (Type) import qualified Data.Map as M +import qualified Data.Map.Ordered as MO import Data.Semigroup as Semigroup import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -107,6 +114,7 @@ -- | A shorthand for the ByteString case of 'MapRow' type NamedRecord = M.Map B8.ByteString B8.ByteString +type NamedRecordOrdered = MO.OMap B8.ByteString B8.ByteString -- | A wrapper around custom haskell types that can directly be @@ -116,6 +124,7 @@ -- about overlapping instances. Just use 'getNamed' to get your -- object out of the wrapper. newtype Named a = Named { getNamed :: a } deriving (Eq,Show,Read,Ord) +newtype NamedOrdered a = NamedOrdered { getNamedOrdered :: a } deriving (Eq,Show,Read,Ord) -- | A record corresponds to a single line in a CSV file. type Record = Vector B8.ByteString @@ -362,6 +371,9 @@ parseNamedRecord r = to <$> gparseNamedRecord r #endif +class FromNamedRecordOrdered a where + parseNamedRecordOrdered :: NamedRecordOrdered -> Parser a + -- | A type that can be converted to a single CSV record. -- -- An example type and instance: @@ -379,12 +391,21 @@ toNamedRecord = namedRecord . gtoRecord . from #endif +class ToNamedRecordOrdered a where + toNamedRecordOrdered :: a -> NamedRecordOrdered + instance FromField a => FromNamedRecord (M.Map B.ByteString a) where parseNamedRecord m = traverse parseField m +instance FromField a => FromNamedRecordOrdered (MO.OMap B.ByteString a) where + parseNamedRecordOrdered m = traverse parseField m + instance ToField a => ToNamedRecord (M.Map B.ByteString a) where toNamedRecord = M.map toField +instance ToField a => ToNamedRecordOrdered (MO.OMap B.ByteString a) where + toNamedRecordOrdered a = MO.fromList $ map (fmap toField) $ MO.assocs a + -- instance FromField a => FromNamedRecord (HM.HashMap B.ByteString a) where -- parseNamedRecord m = traverse (\ s -> parseField s) m @@ -700,6 +721,11 @@ where err = "no field named " ++ show (B8.unpack name) {-# INLINE lookup #-} +lookupOrdered :: FromField a => NamedRecordOrdered -> B.ByteString -> Parser a +lookupOrdered m name = maybe (fail err) parseField $ MO.lookup name m + where err = "no field named " ++ show (B8.unpack name) +{-# INLINE lookupOrdered #-} + -- | Alias for 'lookup'. (.:) :: FromField a => NamedRecord -> B.ByteString -> Parser a (.:) = lookup @@ -726,6 +752,9 @@ namedRecord :: [(B.ByteString, B.ByteString)] -> NamedRecord namedRecord = M.fromList +namedRecordOrdered :: [(B.ByteString, B.ByteString)] -> NamedRecordOrdered +namedRecordOrdered = MO.fromList + ------------------------------------------------------------------------ -- Parser for converting records to data types @@ -861,7 +890,7 @@ gparseRecordProd n = (n + 1, \v -> K1 <$> parseField (V.unsafeIndex v n)) #if MIN_VERSION_base(4,9,0) -data Proxy (s :: Meta) (f :: * -> *) a = Proxy +data Proxy (s :: Meta) (f :: Type -> Type) a = Proxy #else data Proxy s (f :: * -> *) a = Proxy #endif diff --git a/src/Data/CSV/Conduit/Types.hs b/src/Data/CSV/Conduit/Types.hs --- a/src/Data/CSV/Conduit/Types.hs +++ b/src/Data/CSV/Conduit/Types.hs @@ -5,7 +5,8 @@ ------------------------------------------------------------------------------- import Data.Default -import qualified Data.Map as M +import qualified Data.Map as M +import qualified Data.Map.Ordered as MO ------------------------------------------------------------------------------- @@ -51,3 +52,9 @@ -- are keys and row's individual cell values are the values of the -- 'Map'. type MapRow a = M.Map a a + +-- | An 'OrderedMapRow' is a dictionary based on 'Data.Map.Ordered' where column +-- names are keys and row's individual cell values are the values of the 'OMap'. +-- Unlike 'MapRow', 'OrderedMapRow' preserves the insertion ordering of columns. +-- 'OrderedMapRow' is a reasonable default in most cases. +type OrderedMapRow a = MO.OMap a a diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,103 +1,116 @@ {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module Main where -import Control.Exception -import qualified Data.ByteString.Char8 as B -import Data.Map ((!)) -import Data.Monoid as M -import Data.Text -import qualified Data.Vector as V -import System.Directory -import Test.Framework (Test, defaultMain, testGroup) -import Test.Framework.Providers.HUnit -import Test.HUnit (assertFailure, (@=?)) - -import Data.CSV.Conduit -import Data.CSV.Conduit.Conversion - +import qualified Conduit as C +import Control.Exception +import qualified Data.ByteString.Char8 as B +import Data.CSV.Conduit +import Data.CSV.Conduit.Conversion +import qualified Data.Map as Map +import qualified Data.Map.Ordered as OMap +import Data.Monoid as M +import Data.Text +import qualified Data.Vector as V +import System.Directory +import Test.Framework (Test, defaultMain, testGroup) +import Test.Framework.Providers.HUnit +import Test.HUnit (assertFailure, (@=?), (@?=)) main :: IO () main = defaultMain tests - tests :: [Test] tests = - [ testGroup "Basic Ops" baseTests - , testGroup "decodeCSV" decodeCSVTests + [ testGroup "Basic Ops" baseTests, + testGroup "decodeCSV" decodeCSVTests ] - baseTests :: [Test] baseTests = - [ testCase "mapping with id works" test_identityMap - , testCase "simple parsing works" test_simpleParse + [ testCase "mapping with id works" test_identityMap, + testCase "simple parsing works" test_simpleParse, + testCase "OrderedMap" test_orderedMap ] - decodeCSVTests :: [Test] decodeCSVTests = [ testCase "parses a CSV" $ do let efoos = decodeCSV defCSVSettings ("Foo\nfoo" :: B.ByteString) case efoos :: Either SomeException (V.Vector (Named Foo)) of - Left e -> assertFailure (show e) - Right foos -> V.fromList [Named Foo] @=? foos - , testCase "eats parse errors, evidently" $ do + Left e -> assertFailure (show e) + Right foos -> V.fromList [Named Foo] @=? foos, + testCase "eats parse errors, evidently" $ do let efoos = decodeCSV defCSVSettings ("Foo\nbad" :: B.ByteString) case efoos :: Either SomeException (V.Vector (Named Foo)) of - Left e -> assertFailure (show e) + Left e -> assertFailure (show e) Right foos -> M.mempty @=? foos ] - data Foo = Foo deriving (Show, Eq) - instance FromNamedRecord Foo where parseNamedRecord nr = do s <- nr .: "Foo" case s of "foo" -> pure Foo - _ -> fail ("Expected \"foo\" but got " <> B.unpack s) - + _ -> fail ("Expected \"foo\" but got " <> B.unpack s) instance ToNamedRecord Foo where toNamedRecord Foo = namedRecord ["Foo" .= ("foo" :: B.ByteString)] - test_identityMap :: IO () test_identityMap = do - _ <- runResourceT $ mapCSVFile csvSettings f testFile2 outFile - f1 <- readFile testFile2 - f2 <- readFile outFile - f1 @=? f2 - removeFile outFile + _ <- runResourceT $ mapCSVFile csvSettings f testFile2 outFile + f1 <- readFile testFile2 + f2 <- readFile outFile + f1 @=? f2 + removeFile outFile where outFile = "test/testOut.csv" f :: Row Text -> [Row Text] f = return - test_simpleParse :: IO () test_simpleParse = do (d :: V.Vector (MapRow B.ByteString)) <- readCSVFile csvSettings testFile1 V.mapM_ assertRow d where assertRow r = v3 @=? (v1 + v2) - where v1 = readBS $ r ! "Col2" - v2 = readBS $ r ! "Col3" - v3 = readBS $ r ! "Sum" + where + v1 = readBS $ r Map.! "Col2" + v2 = readBS $ r Map.! "Col3" + v3 = readBS $ r Map.! "Sum" +test_orderedMap :: IO () +test_orderedMap = do + unorderedRes <- + C.runConduit $ + C.yieldMany [unorderedRow] + C..| writeHeaders defCSVSettings + C..| C.foldC + unorderedRes @?= ("\"a\",\"b\"\n\"aval\",\"bval\"\n" :: B.ByteString) + orderedRes <- + C.runConduit $ + C.yieldMany [orderedRow] + C..| writeHeadersOrdered defCSVSettings + C..| C.foldC + orderedRes @?= ("\"b\",\"a\"\n\"bval\",\"aval\"\n" :: B.ByteString) + where + orderedRow :: OrderedMapRow Text + orderedRow = OMap.fromList pairs + unorderedRow :: MapRow Text + unorderedRow = Map.fromList pairs + pairs = [("b", "bval"), ("a", "aval")] csvSettings :: CSVSettings -csvSettings = defCSVSettings { csvQuoteChar = Just '`'} +csvSettings = defCSVSettings {csvQuoteChar = Just '`'} testFile1, testFile2 :: FilePath testFile1 = "test/test.csv" testFile2 = "test/test.csv" - readBS :: B.ByteString -> Int readBS = read . B.unpack