composite-cassava 0.0.2.0 → 0.0.3.0

raw patch · 6 files changed

+169/−16 lines, 6 filesdep +bytestringdep +composite-cassavadep +tastyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring, composite-cassava, tasty, tasty-hunit, vector

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• composite-cassava.cabal +26/−2
• src/Composite/Csv.hs +40/−14
• test/Spec.hs +92/−0
• test/data/A.csv +3/−0
• test/data/B.csv +3/−0

@@ -1,5 +1,10 @@ # Changelog for composite-cassava +## v0.0.3.0++* Add tests.+* Add `ToHeader` class with `generateRecHeader` function.+ ## v0.0.2.0  * Fix `ToNamedRecord` instances.

@@ -5,12 +5,12 @@ -- see: https://github.com/sol/hpack  name:           composite-cassava-version:        0.0.2.0+version:        0.0.3.0 synopsis:       Csv parsing functionality for composite. description:    Csv parsing functionality for composite. category:       Composite, Csv author:         Daniel Firth-maintainer:     dan.firth@homtopic.tech+maintainer:     dan.firth@homotopic.tech copyright:      Daniel Firth license:        MIT license-file:   LICENSE@@ -18,6 +18,8 @@ extra-source-files:     README.md     ChangeLog.md+    test/data/A.csv+    test/data/B.csv  source-repository head   type: git@@ -36,4 +38,26 @@     , composite-base >=0.7.0.0 && <0.8     , text     , unordered-containers+    , vector+  default-language: Haskell2010++test-suite composite-casssava-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_composite_cassava+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring+    , cassava >=0.5.0.0 && <0.6+    , composite-base >=0.7.0.0 && <0.8+    , composite-cassava+    , tasty+    , tasty-hunit+    , text+    , unordered-containers+    , vector   default-language: Haskell2010

@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-}@@ -10,25 +11,50 @@ import Composite.Record import Data.Csv import Data.HashMap.Strict as HM+import Data.Proxy import Data.Text.Encoding as T+import Data.Vector import GHC.TypeLits -instance FromNamedRecord (Rec f '[]) where-  parseNamedRecord m = pure RNil+instance FromNamedRecord (F f '[]) where+  parseNamedRecord m = pure $ F RNil -instance ToNamedRecord (Rec f '[]) where+instance ToNamedRecord (F f '[]) where   toNamedRecord m = mempty -instance (Functor f, KnownSymbol s, FromField (f x), FromNamedRecord (Rec f xs)) => FromNamedRecord (Rec f ((s :-> x) ': xs)) where+instance FromNamedRecord (TF f '[]) where+  parseNamedRecord m = pure $ TF RNil++instance ToNamedRecord (TF f '[]) where+  toNamedRecord m = mempty++newtype F f xs = F {unF :: Rec f xs}++instance (Functor f, KnownSymbol s, FromField (f x), FromNamedRecord (F f xs)) => FromNamedRecord (F f ((s :-> x) ': xs)) where   parseNamedRecord m = do-    let nL :: (s :-> x)-        nL = undefined-    x <- m .: T.encodeUtf8 (valName nL)-    f <- parseNamedRecord @(Rec f xs) m-    pure $ x :^: f+    x <- m .: T.encodeUtf8 (valName @s undefined)+    F f <- parseNamedRecord @(F f xs) m+    pure $ F $ x :^: f -instance (Functor f, KnownSymbol s, ToField (f x), ToNamedRecord (Rec f xs)) => ToNamedRecord (Rec f ((s :-> x) ': xs)) where-  toNamedRecord (x :^: xs) =-    let nL :: (s :-> x)-        nL = undefined-     in HM.singleton (T.encodeUtf8 (valName nL)) (toField x) <> toNamedRecord xs+instance (Functor f, KnownSymbol s, ToField (f x), ToNamedRecord (F f xs)) => ToNamedRecord (F f ((s :-> x) ': xs)) where+  toNamedRecord (F (x :^: xs)) = HM.singleton (T.encodeUtf8 (valName @s undefined)) (toField x) <> toNamedRecord (F xs)++newtype TF f xs = TF {unTF :: Rec f xs}++instance (Functor f, KnownSymbol s, FromField (f (s :-> x)), FromNamedRecord (TF f xs)) => FromNamedRecord (TF f ((s :-> x) ': xs)) where+  parseNamedRecord m = do+    x <- m .: T.encodeUtf8 (valName @s undefined)+    TF f <- parseNamedRecord @(TF f xs) m+    pure $ TF $ x :& f++instance (Functor f, KnownSymbol s, ToField (f (s :-> x)), ToNamedRecord (TF f xs)) => ToNamedRecord (TF f ((s :-> x) ': xs)) where+  toNamedRecord (TF (x :& xs)) = HM.singleton (T.encodeUtf8 (valName @s undefined)) (toField x) <> toNamedRecord (TF xs)++class ToHeader x where+  extractRecHeader :: Proxy x -> Vector Name++instance ToHeader (Rec f '[]) where+  extractRecHeader _ = Data.Vector.fromList []++instance (KnownSymbol s, ToHeader (Rec f xs)) => ToHeader (Rec f (s :-> x ': xs)) where+  extractRecHeader Proxy = pure (encodeUtf8 $ valName @s undefined) <> extractRecHeader (Proxy @(Rec f xs))

@@ -0,0 +1,92 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}++module Main (main) where++import Composite+import Composite.Csv+import Composite.TH+import Data.ByteString.Lazy as LBS+import Data.Csv+import Data.Proxy+import Data.Text+import Data.Text.Encoding+import Data.Vector+import Test.Tasty+import Test.Tasty.HUnit++withLensesAndProxies+  [d|+    type A = "A" :-> Text++    type B = "B" :-> Double++    type C = "C" :-> Text++    type D = "D" :-> Int+    |]++type RecMaybe = Rec Maybe '[A, B, C, D]++deriving newtype instance FromField A++deriving newtype instance FromField B++deriving newtype instance FromField C++deriving newtype instance FromField D++deriving newtype instance ToField A++deriving newtype instance ToField B++deriving newtype instance ToField C++deriving newtype instance ToField D++deriving via (TF Maybe '[A, B, C, D]) instance FromNamedRecord RecMaybe++deriving via (TF Maybe '[A, B, C, D]) instance ToNamedRecord RecMaybe++rec1 :: RecMaybe+rec1 = Just "foo" :^: Just 5e-4 :^: Nothing :^: Just 5 :^: RNil++rec2 :: RecMaybe+rec2 = Just "bar" :^: Just 100e-10 :^: Just "quux" :^: Just 4 :^: RNil++testData :: [RecMaybe]+testData = [rec1, rec2]++tests :: TestTree+tests =+  testGroup+    "Parsing Tests"+    [ testCase "parses Record" $ do+        a <- LBS.readFile "./test/data/A.csv"+        let Right (x, toList -> xs) = decodeByName a+        assertEqual "" testData xs+        b <- LBS.readFile "./test/data/B.csv"+        let Right (y, toList -> ys) = decodeByName b+        assertEqual "" xs ys+        let a' = encodeByName x xs+        let Right (a'', toList -> xs') = decodeByName a'+        assertEqual "" xs xs'+        let b' = encodeByName (extractRecHeader (Proxy @RecMaybe)) ys+        let Right (b'', toList -> ys') = decodeByName b'+        assertEqual "" xs ys'+    ]++main :: IO ()+main = defaultMain tests

@@ -0,0 +1,3 @@+A,B,C,D+"foo",5e-4,,5+"bar",100e-10,"quux",4

@@ -0,0 +1,3 @@+A,D,C,B,E+"foo",5,,5e-4,"lemon"+"bar",4,"quux",100e-10,,