Frames 0.3.0.2 → 0.4.0

raw patch · 19 files changed

+726/−59 lines, 19 filesdep +contravariantdep +deepseqdep +discriminationdep ~basedep ~vinylPVP ok

version bump matches the API change (PVP)

Dependencies added: contravariant, deepseq, discrimination, hashable

Dependency ranges changed: base, vinyl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• Frames.cabal +23/−9
• benchmarks/JoinsBench.hs +36/−0
• benchmarks/pandas_joins.py +38/−0
• src/Frames.hs +6/−2
• src/Frames/CSV.hs +49/−8
• src/Frames/Col.hs +10/−6
• src/Frames/ColumnTypeable.hs +3/−0
• src/Frames/ColumnUniverse.hs +11/−1
• src/Frames/Exploration.hs +7/−3
• src/Frames/ExtraInstances.hs +70/−0
• src/Frames/Frame.hs +3/−0
• src/Frames/Joins.hs +247/−0
• src/Frames/RecF.hs +18/−15
• src/Frames/TypeLevel.hs +8/−0
• test/LatinTest.hs +34/−0
• test/Spec.hs +49/−15
• test/data/latinManagers.csv +3/−0
• test/examples.toml +103/−0

@@ -1,3 +1,11 @@+# 0.4.0++- Added table joins in `Data.Vinyl.Joins` (Chris Hammill)++- Changed types of `mapMethod` and `mapMethodV`++These now rely on explicit `TypeApplications` rather than `Proxy` values.+ # 0.3.0  - Pervasive use of `pipes` for CSV data loading

@@ -1,5 +1,5 @@ name:                Frames-version:             0.3.0.2+version:             0.4.0 synopsis:            Data frames For working with tabular data files description:         User-friendly, type safe, runtime efficient tooling for                      working with tabular data deserialized from@@ -20,8 +20,9 @@                      test/examples.toml                      test/data/managers.csv test/data/employees.csv                      test/data/mpg.csv+                     test/data/latinManagers.csv cabal-version:       >=1.10-tested-with:         GHC == 7.10.3, GHC == 8.0.1, GHC == 8.2.1+tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1  source-repository head   type:     git@@ -46,11 +47,13 @@                        Frames.RecF                        Frames.RecLens                        Frames.TypeLevel+                       Frames.Joins+                       Frames.ExtraInstances   other-extensions:    DataKinds, GADTs, KindSignatures, TypeFamilies,                        TypeOperators, ConstraintKinds, StandaloneDeriving,                        UndecidableInstances, ScopedTypeVariables,                        OverloadedStrings-  build-depends:       base >=4.8 && <4.11,+  build-depends:       base >=4.8 && <4.12,                        ghc-prim >=0.3 && <0.6,                        primitive >= 0.6 && < 0.7,                        text >= 1.1.1.0,@@ -64,7 +67,11 @@                        pipes-parse >= 3.0 && < 3.1,                        pipes-safe >= 2.2.6 && < 2.3,                        pipes-text >= 0.0.2.5 && < 0.1,-                       vinyl >= 0.7 && < 0.8+                       vinyl >= 0.7 && < 0.9,+                       discrimination,+                       contravariant,+                       hashable,+                       deepseq >= 1.4   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:         -Wall@@ -152,9 +159,7 @@   hs-source-dirs:   benchmarks   default-language: Haskell2010   -- ghc-options:      -O2--  -- Use opt and llc found on PATH rather than the GHC settings file-  ghc-options:      -O2 -pgmlo opt -pgmlc llc -fllvm+  ghc-options: -O2 -fllvm  -- A demonstration of dealing with missing data. Provided for source -- code and experimentation rather than a useful executable.@@ -167,6 +172,15 @@   hs-source-dirs: demo   default-language: Haskell2010 +-- Demo the joins feature+benchmark joins+  type:             exitcode-stdio-1.0+  main-is:          JoinsBench.hs+  hs-source-dirs:   benchmarks+  build-depends:    base, Frames, criterion+  ghc-options:      -O2+  default-language: Haskell2010+ -- Benchmark showing tradeoffs of differing processing needs benchmark insurance   type:             exitcode-stdio-1.0@@ -191,10 +205,10 @@   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Spec.hs-  other-modules:       DataCSV PrettyTH Temp+  other-modules:       DataCSV PrettyTH Temp LatinTest   build-depends:       base, text, hspec, Frames, template-haskell,                        temporary, directory, htoml, regex-applicative, pretty,-                       unordered-containers, pipes, HUnit+                       unordered-containers, pipes, HUnit, vinyl   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall   default-language:    Haskell2010 

@@ -0,0 +1,36 @@+{-# LANGUAGE QuasiQuotes,+             DataKinds,+             FlexibleContexts,+             TypeApplications,+             TemplateHaskell #-}++import Frames+import Frames.Joins+import Criterion.Main++tableTypes "LCols" "data/left1.csv"+tableTypes "RCols" "data/right1.csv"+tableTypes "SmCols" "data/left_summary.csv"++lfi :: IO (Frame LCols)+lfi = inCoreAoS (readTable "data/left1.csv")++rfi :: IO (Frame RCols)+rfi = inCoreAoS (readTable "data/right1.csv")++smfi :: IO (Frame SmCols)+smfi = inCoreAoS (readTable "data/left_summary.csv")++main :: IO ()+main = do+  lf <- lfi+  rf <- rfi+  smf <- smfi+  defaultMain [+    bench "inner1a"   $ nf (innerJoin @'[PolicyID] lf) rf+    , bench "inner1b" $ nf (innerJoin @'[County] lf) smf+    , bench "inner2"  $ nf (innerJoin @'[PolicyID,County] lf) smf+    , bench "outer2"  $ nf (outerJoin @'[PolicyID,County] lf) smf+    , bench "left2"   $ nf (leftJoin  @'[PolicyID,County] lf) smf+    , bench "left2"   $ nf (rightJoin @'[PolicyID,County] lf) smf+    ]

@@ -0,0 +1,38 @@+# Demonstration of data frame joins with pandas. Build with+# cabal, then run in bash with something like+#+# $ /usr/bin/time -l python benchmarks/pandas_joins.py 2>&1 | head -n 4+#+# Or+# nix-shell -p 'python.withPackages (p: [p.pandas])' --run '/usr/bin/time -l python benchmarks/pandas_joins.py 2>&1 | head -n 4'++from pandas import DataFrame, read_csv+import pandas as pd++left = pd.read_csv('data/left1.csv')+right = pd.read_csv('data/right1.csv')+left_summary = pd.read_csv('data/left_summary.csv')++print(pd.merge(left, right+                , on = "policyID"+                , how = "inner").shape[0])++print(pd.merge(left, left_summary+                , on = "policyID"+                , how = "inner").shape[0])++print(pd.merge(left, left_summary+               , on = ("policyID", "county")+               , how = "inner").shape[0])++print(pd.merge(left, left_summary+                , on = ("policyID", "county")+                , how = "outer").shape[0])++print(pd.merge(left, left_summary+                , on = ("policyID", "county")+                , how = "left").shape[0])++print(pd.merge(left, left_summary+               , on = ("policyID", "county")+               , how = "right").shape[0])

@@ -20,16 +20,18 @@   , module Frames.RecF   , module Frames.RecLens   , module Frames.TypeLevel+  , module Frames.Joins   , module Pipes.Safe, runSafeEffect   , Text   ) where import Control.Monad.IO.Class (MonadIO) import Control.Monad.Primitive import Data.Text (Text)-import Data.Vinyl ((<+>), Rec)+import Data.Vinyl ((<+>), Rec, rcast, rsubset) import Data.Vinyl.CoRec (Field, onField, onCoRec) import Data.Vinyl.Lens hiding (rlens, rget, rput)-import Data.Vinyl.TypeLevel (AllConstrained, AllSatisfied, AllAllSat)+import Data.Vinyl.TypeLevel (AllConstrained, AllSatisfied, AllAllSat,+                             RDelete, RecAll) import Frames.Col ((:->)(..)) import Frames.ColumnUniverse import Frames.CSV (readTable, readTableMaybe, declareColumn,@@ -43,6 +45,8 @@ import Frames.RecF import Frames.RecLens import Frames.TypeLevel+import Frames.Joins+import Frames.ExtraInstances() import qualified Pipes as P import Pipes.Safe (MonadSafe, runSafeT, runSafeP, SafeT) import qualified Pipes.Safe as PS

@@ -24,7 +24,7 @@ import Data.Monoid ((<>)) import Data.Proxy import qualified Data.Text as T-import Data.Vinyl (RElem, Rec)+import Data.Vinyl (rmap, RElem, Rec) import Data.Vinyl.TypeLevel (RecAll, RIndex) import Data.Vinyl.Functor (Identity) import Frames.Col@@ -175,14 +175,15 @@ -- | Parsing each component of a 'RecF' from a list of text chunks, -- one chunk per record component. class ReadRec (rs :: [*]) where-  readRec :: [T.Text] -> Rec Maybe rs+  readRec :: [T.Text] -> Rec (Either T.Text) rs  instance ReadRec '[] where   readRec _ = Nil  instance (Parseable t, ReadRec ts) => ReadRec (s :-> t ': ts) where-  readRec [] = frameCons Nothing (readRec [])-  readRec (h:t) = frameCons (parse' h) (readRec t)+  readRec [] = frameCons (Left mempty) (readRec [])+  readRec (h:t) = frameCons (maybe (Left (T.copy h)) Right (parse' h))+                            (readRec t)  -- | Produce the lines of a latin1 (or ISO8859 Part 1) encoded file as -- ’T.Text’ values. Similar to ’PT.readFileLn’ that uses the system@@ -194,7 +195,7 @@   in Pipes.Group.concats latinLines  -- | Read a 'RecF' from one line of CSV.-readRow :: ReadRec rs => ParserOptions -> T.Text -> Rec Maybe rs+readRow :: ReadRec rs => ParserOptions -> T.Text -> Rec (Either T.Text) rs readRow = (readRec .) . tokenizeRow  -- | Produce rows where any given entry can fail to parse.@@ -211,9 +212,20 @@                   -> P.Pipe T.Text (Rec Maybe rs) m () pipeTableMaybeOpt opts = do   when (isNothing (headerOverride opts)) (() <$ P.await)-  P.map (readRow opts)+  P.map (rmap (either (const Nothing) Just) . readRow opts) {-# INLINE pipeTableMaybeOpt #-} +-- | Stream lines of CSV data into rows of ’Rec’ values values where+-- any given entry can fail to parse. In the case of a parse failure, the+-- raw 'T.Text' of that entry is retained.+pipeTableEitherOpt :: (Monad m, ReadRec rs)+                   => ParserOptions+                   -> P.Pipe T.Text (Rec (Either T.Text) rs) m ()+pipeTableEitherOpt opts = do+  when (isNothing (headerOverride opts)) (() <$ P.await)+  P.map (readRow opts)+{-# INLINE pipeTableEitherOpt #-}+ -- | Produce rows where any given entry can fail to parse. readTableMaybe :: (P.MonadSafe m, ReadRec rs)                => FilePath -> P.Producer (Rec Maybe rs) m ()@@ -226,6 +238,14 @@ pipeTableMaybe = pipeTableMaybeOpt defaultParser {-# INLINE pipeTableMaybe #-} +-- | Stream lines of CSV data into rows of ’Rec’ values where any+-- given entry can fail to parse. In the case of a parse failure, the+-- raw 'T.Text' of that entry is retained.+pipeTableEither :: (Monad m, ReadRec rs)+                => P.Pipe T.Text (Rec (Either T.Text) rs) m ()+pipeTableEither = pipeTableEitherOpt defaultParser+{-# INLINE pipeTableEither #-}+ -- -- | Returns a `MonadPlus` producer of rows for which each column was -- -- successfully parsed. This is typically slower than 'readTableOpt'. -- readTableOpt' :: forall m rs.@@ -458,12 +478,18 @@                       h:t -> mkName $ toLower h : t ++ "Parser"      optsTy <- sigD optsName [t|ParserOptions|]      optsDec <- valD (varP optsName) (normalB $ lift opts) []-     colDecs <- concat <$> mapM (uncurry $ colDec (T.pack tablePrefix)) headers+     colDecs <- concat <$> mapM (uncurry mkColDecs) headers      return (recTy : optsTy : optsDec : colDecs)   where recDec' = recDec . map (second colType) :: [(T.Text, a)] -> Q Type         colNames' | null columnNames = Nothing                   | otherwise = Just (map T.pack columnNames)         opts = ParserOptions colNames' separator (RFC4180Quoting '\"')+        mkColDecs colNm colTy = do+          let safeName = tablePrefix ++ (T.unpack . sanitizeTypeName $ colNm)+          mColNm <- lookupTypeName safeName+          case mColNm of+            Just _ -> pure []+            Nothing -> colDec (T.pack tablePrefix) colNm colTy  -- | Like 'tableType'', but additionally generates a type synonym for -- each column, and a proxy value of that type. If the CSV file has@@ -499,7 +525,9 @@ -- * Writing CSV Data  -- | 'P.yield' a header row with column names followed by a line of--- text for each 'Record' with each field separated by a comma.+-- text for each 'Record' with each field separated by a comma. If+-- your source of 'Record' values is a 'P.Producer', consider using+-- 'pipeToCSV' to keep everything streaming. produceCSV :: forall f ts m.               (ColumnHeaders ts, AsVinyl ts, Foldable f, Monad m,                RecAll Identity (UnColumn ts) Show)@@ -507,6 +535,19 @@ produceCSV recs = do   P.yield (intercalate "," (columnHeaders (Proxy :: Proxy (Record ts))))   F.mapM_ (P.yield . intercalate "," . showFields) recs++-- | 'P.yield' a header row with column names followed by a line of+-- text for each 'Record' with each field separated by a comma. This+-- is the same as 'produceCSV', but adapated for cases where you have+-- streaming input that you wish to use to produce streaming output.+pipeToCSV :: forall ts m.+             (Monad m, ColumnHeaders ts, AsVinyl ts,+              RecAll Identity (UnColumn ts) Show)+          => P.Pipe (Record ts) T.Text m ()+pipeToCSV = P.yield (T.intercalate "," (map T.pack header)) >> go+  where header = columnHeaders (Proxy :: Proxy (Record ts))+        go :: P.Pipe (Record ts) T.Text m ()+        go = P.map (T.intercalate "," . map T.pack . showFields)  -- | Write a header row with column names followed by a line of text -- for each 'Record' to the given file.

@@ -1,8 +1,5 @@-{-# LANGUAGE CPP,-             DataKinds,-             GeneralizedNewtypeDeriving,-             KindSignatures,-             ScopedTypeVariables,+{-# LANGUAGE CPP, DataKinds, GeneralizedNewtypeDeriving,+             KindSignatures, ScopedTypeVariables, TypeFamilies,              TypeOperators #-} -- | Column types module Frames.Col where@@ -10,12 +7,13 @@ import Data.Monoid #endif import Data.Proxy+import Data.Semigroup (Semigroup) import GHC.TypeLits  -- | A column's type includes a textual name and the data type of each -- element. newtype (:->) (s::Symbol) a = Col { getCol :: a }-  deriving (Eq,Ord,Num,Monoid,Real,RealFloat,RealFrac,Fractional,Floating)+  deriving (Eq,Ord,Num,Semigroup,Monoid,Real,RealFloat,RealFrac,Fractional,Floating)  instance forall s a. (KnownSymbol s, Show a) => Show (s :-> a) where   show (Col x) = symbolVal (Proxy::Proxy s)++" :-> "++show x@@ -29,3 +27,9 @@  instance (KnownSymbol s, Show a) => Show (Col' s a) where   show (Col' c) = "(" ++ show c ++ ")"++-- | @ReplaceColumns x ys@ keeps the textual name of each element of+-- @ys@, but replaces its data type with @x@.+type family ReplaceColumns x ys where+  ReplaceColumns x '[] = '[]+  ReplaceColumns x (c :-> y ': ys) = c :-> x ': ReplaceColumns x ys

@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns, DefaultSignatures, LambdaCase #-} module Frames.ColumnTypeable where import Control.Monad (MonadPlus)+import Data.Maybe (fromMaybe) import Data.Readable (Readable(fromText)) import qualified Data.Text as T import Language.Haskell.TH@@ -36,6 +37,8 @@  instance Parseable Bool where instance Parseable Int where+  parse t = Definitely <$>+            fromText (fromMaybe t (T.stripSuffix (T.pack ".0") t)) instance Parseable Float where instance Parseable Double where   -- Some CSV's export Doubles in a format like '1,000.00', filtering

@@ -25,6 +25,7 @@ import Data.Monoid #endif import Data.Proxy+import Data.Semigroup (Semigroup((<>))) import qualified Data.Text as T import Data.Typeable (Typeable, showsTypeRep, typeRep) import Data.Vinyl@@ -136,6 +137,14 @@         Just EQ -> x         Nothing -> mempty +instance (T.Text ∈ ts) => Semigroup (CoRec ColInfo ts) where+  x@(CoRec (ColInfo (_, trX))) <> y@(CoRec (ColInfo (_, trY))) =+    case lubTypeReps (fmap getConst trX) (fmap getConst trY) of+      Just GT -> x+      Just LT -> y+      Just EQ -> x+      Nothing -> CoRec (ColInfo ([t|T.Text|], Possibly mkTyped) :: ColInfo T.Text)+ -- | Find the best (i.e. smallest) 'CoRec' variant to represent a -- parsed value. For inspection in GHCi after loading this module, -- consider this example:@@ -150,7 +159,8 @@             RecApplicative ts, T.Text ∈ ts)         => T.Text -> CoRec ColInfo ts bestRep t-  | T.null t = aux (CoRec (Compose (Possibly (mkTyped :: Typed T.Text))))+  | T.null t || t == "NA" =+    aux (CoRec (Compose (Possibly (mkTyped :: Typed T.Text))))   | otherwise = aux               . fromMaybe (CoRec (Compose $ Possibly (mkTyped :: Typed T.Text)))               . firstField

@@ -16,14 +16,15 @@ import Language.Haskell.TH.Quote import Pipes hiding (Proxy) import qualified Pipes.Prelude as P+import Pipes.Safe (SafeT, runSafeT, MonadMask)  -- * Preview Results  -- | @preview src n f@ prints out the first @n@ results of piping -- @src@ through @f@.-pipePreview :: (MonadIO m, Show b)-            => Producer a m () -> Int -> Pipe a b m () -> m ()-pipePreview src n f = runEffect $ src >-> f >-> P.take n >-> P.print+pipePreview :: (Show b, MonadIO m, MonadMask m)+            => Producer a (SafeT m) () -> Int -> Pipe a b (SafeT m) () -> m ()+pipePreview src n f = runSafeT . runEffect $ src >-> f >-> P.take n >-> P.print  -- * Column Selection @@ -39,6 +40,9 @@ lenses :: (fs V.⊆ rs, Functor f)        => proxy fs -> (Record fs -> f (Record fs)) -> Record rs -> f (Record rs) lenses _ = V.rsubset++{-# DEPRECATED select "Use Data.Vinyl.rcast with a type application. " #-}+{-# DEPRECATED lenses "Use Data.Vinyl.rsubset with a type application." #-}  -- * Proxy Syntax 

@@ -0,0 +1,70 @@+{-# LANGUAGE ConstraintKinds, CPP, DataKinds, FlexibleContexts,+             FlexibleInstances, KindSignatures, MultiParamTypeClasses,+             PolyKinds, ScopedTypeVariables, TypeFamilies,+             TypeOperators, UndecidableInstances, TemplateHaskell,+             QuasiQuotes, Rank2Types, TypeApplications,+             AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Frames.ExtraInstances where++import Data.Functor.Contravariant+import Data.Functor.Contravariant.Divisible+import Data.Discrimination.Grouping+import Data.Hashable+import Control.DeepSeq+import Frames.Col+import Frames.Rec+import Frames.Frame+import Frames.RecF (AllCols)+import Data.Vinyl.Functor as VF+import Data.Vinyl+import Data.Text (Text)++-- Grouping instances+instance (AllCols Grouping rs+         , Grouping (Record rs)+         , Grouping (s :-> r)+         , Grouping r+         ) =>+         Grouping (Record ((s :-> r) : rs)) where+  grouping = divide recUncons grouping grouping++instance Grouping (Record '[]) where+  grouping = conquer++instance (Grouping a) => Grouping (s :-> a) where+   grouping = contramap getCol grouping++instance Grouping Text where+  grouping = contramap hash grouping+++-- NFData* instances+#if MIN_VERSION_deepseq(1,4,3)+instance (NFData a) =>+         NFData (VF.Identity a) where+  rnf = rnf1++instance NFData1 VF.Identity where+  liftRnf r = r . getIdentity++instance (AllCols NFData rs+         , NFData1 f+         , Functor f+         , NFData (Rec f rs)+         , NFData (s :-> r)+         , NFData r) =>+         NFData (Rec f ((s :-> r) : rs)) where+  rnf (r :& rs) = rnf1 r `seq` rnf rs++instance (NFData1 f) => NFData (Rec f '[]) where+  rnf = rwhnf+#endif++instance (NFData a) =>+         NFData (Frame a) where+  rnf = foldr (\x acc -> rnf x `seq` acc) ()++instance (NFData a) => NFData (s :-> a) where+  rnf = rnf . getCol

@@ -5,6 +5,7 @@ #if __GLASGOW_HASKELL__ < 800 import Data.Monoid #endif+import Data.Semigroup (Semigroup) import qualified Data.Vector as V import Data.Vinyl.TypeLevel import Frames.Rec (Record)@@ -38,6 +39,8 @@   mempty = Frame 0 (const $ error "index out of bounds (empty frame)")   Frame l1 f1 `mappend` Frame l2 f2 = Frame (l1+l2) $ \i ->                                       if i < l1 then f1 i else f2 (i - l1)++instance Semigroup (Frame r) where  instance Foldable Frame where   foldMap f (Frame n row) = foldMap (f . row) [0..n-1]

@@ -0,0 +1,247 @@+{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts, FlexibleInstances,+             KindSignatures, MultiParamTypeClasses, PolyKinds,+             ScopedTypeVariables, TypeFamilies, TypeOperators,+             UndecidableInstances, TemplateHaskell, QuasiQuotes,+             Rank2Types, TypeApplications, AllowAmbiguousTypes #-}++-- | Functions for performing SQL style table joins on+-- @Frame@ objects. Uses Data.Discrimination under the hood+-- for O(n) joins. These have behaviour equivalent to+-- @INNER JOIN@, @FULL JOIN@, @LEFT JOIN@, and @RIGHT JOIN@ from+-- SQL.+module Frames.Joins (innerJoin+                    , outerJoin+                    , leftJoin+                    , rightJoin)++where+import Data.Discrimination+import Data.Foldable as F+import Frames.Frame+import Frames.Rec+import Frames.InCore (toFrame)+import Frames.Melt (RDeleteAll)+import Frames.InCore (RecVec)+import Data.Vinyl.TypeLevel+import Data.Vinyl hiding (rcast)+import qualified Data.Vinyl+import Data.Vinyl.Functor++-- Easier argument ordering for type applications.+rcast :: forall rs ss f. rs ⊆ ss => Rec f ss -> Rec f rs+rcast = Data.Vinyl.rcast @Rec++mergeRec :: forall fs rs rs2 rs2'.+  (fs ⊆ rs2+  , rs2' ⊆ rs2+  , rs2' ~ RDeleteAll fs rs2+  , rs ⊆ (rs ++ rs2')) =>+  Record rs ->+  Record rs2 ->+  Record (rs ++ rs2')+{-# INLINE mergeRec #-}+mergeRec rec1 rec2 =+  rec1 <+> rec2'+  where+    rec2' = rcast @rs2' rec2+++-- | Perform an inner join operation on two frames.+--+-- Requires the language extension @TypeApplications@ for specifying the columns to+-- join on.+--+-- Joins can be done on on one or more columns provided the matched+-- columns have a @Grouping@ instance, most simple types do.+--+-- Presently join columns must be present and named identically in both left+-- and right frames.+--+-- Basic usage: @innerJoin \@'[JoinCol1, ..., JoinColN] leftFrame rightFrame@+innerJoin :: forall fs rs rs2 rs2'.+  (fs    ⊆ rs+    , fs   ⊆ rs2+    , rs ⊆ (rs ++ rs2')+    , rs2' ⊆ rs2+    , rs2' ~ RDeleteAll fs rs2+    , Grouping (Record fs)+    , RecVec rs+    , RecVec rs2'+    , RecVec (rs ++ rs2')+    ) =>+  Frame (Record rs)  -- ^ The left frame+  -> Frame (Record rs2) -- ^ The right frame+  -> Frame (Record (rs ++ rs2')) -- ^ The joined frame++innerJoin a b =+    toFrame $+    concat+    (inner grouping mergeFun proj1 proj2 (toList a) (toList b))+    where+      {-# INLINE mergeFun #-}+      mergeFun = mergeRec @fs+      {-# INLINE proj1 #-}+      proj1 = rcast @fs+      {-# INLINE proj2 #-}+      proj2 = rcast @fs+++justsFromRec :: Record fs -> Rec Maybe fs+{-# INLINE justsFromRec #-}+justsFromRec = rmap (Just . getIdentity)++mkNothingsRec :: forall fs.+  (RecApplicative fs) =>+  Rec Maybe fs+{-# INLINE mkNothingsRec #-}+mkNothingsRec = rpure @fs Nothing++-- | Perform an outer join (@FULL JOIN@) operation on two frames.+--+-- Requires the use the  language extension @TypeApplications@ for specifying the+-- columns to join on.+--+-- Joins can be done on on one or more columns provided the+-- columns have a @Grouping@ instance, most simple types do.+--+-- Presently join columns must be present and named identically in both left+-- and right frames.+--+-- Returns a list of Records in the Maybe interpretation functor.+-- If a key in the left table is missing from the right table, non-key+-- columns from the right table are filled with @Nothing@.+-- If a key in the right table is missing from the left table, non-key+-- columns from the right table are filled with @Nothing@.+--+-- Basic usage: @outerJoin \@'[JoinCol1, ..., JoinColN] leftFrame rightFrame@+outerJoin :: forall fs rs rs' rs2  rs2' ors.+  (fs    ⊆ rs+    , fs   ⊆ rs2+    , rs ⊆ (rs ++ rs2')+    , rs' ⊆ rs+    , rs' ~ RDeleteAll fs rs+    , rs2' ⊆ rs2+    , rs2' ~ RDeleteAll fs rs2+    , ors ~ (rs ++ rs2')+    , ors :~: (rs' ++ rs2)+    , RecApplicative rs2'+    , RecApplicative rs+    , RecApplicative rs'+    , Grouping (Record fs)+    , RecVec rs+    , RecVec rs2'+    , RecVec ors+    ) =>+  Frame (Record rs)  -- ^ The left frame+  -> Frame (Record rs2) -- ^ The right frame+  -> [Rec Maybe ors] -- ^ A list of the merged records, now in the Maybe functor++outerJoin a b =+  concat+  (outer grouping mergeFun mergeLeftEmpty mergeRightEmpty+    proj1 proj2 (toList a) (toList b))+  where+    {-# INLINE proj1 #-}+    proj1 = rcast @fs+    {-# INLINE proj2 #-}+    proj2 = rcast @fs+    {-# INLINE mergeFun #-}+    mergeFun l r = justsFromRec $ mergeRec @fs l r+    {-# INLINE mergeLeftEmpty #-}+    mergeLeftEmpty l = justsFromRec l <+> mkNothingsRec @rs2'+    {-# INLINE mergeRightEmpty #-}+    mergeRightEmpty r = rcast @ors (mkNothingsRec @rs' <+> justsFromRec r)++-- | Perform an right join operation on two frames.+--+-- Requires the language extension @TypeApplications@ for specifying the+-- columns to join on.+--+-- Joins can be done on on one or more columns provided the+-- columns have a @Grouping@ instance, most simple types do.+--+-- Presently join columns must be present and named identically in both left+-- and right frames.+--+-- Returns a list of Records in the Maybe interpretation functor.+-- If a key in the right table is missing from the left table, non-key+-- columns from the right table are filled with @Nothing@.+--+-- Basic usage: @rightJoin \@'[JoinCol1, ..., JoinColN] leftFrame rightFrame@+rightJoin :: forall fs rs rs' rs2  rs2' ors.+  (fs    ⊆ rs+    , fs   ⊆ rs2+    , rs ⊆ (rs ++ rs2')+    , rs' ⊆ rs+    , rs' ~ RDeleteAll fs rs+    , rs2' ⊆ rs2+    , rs2' ~ RDeleteAll fs rs2+    , ors ~ (rs ++ rs2')+    , ors :~: (rs' ++ rs2)+    , RecApplicative rs2'+    , RecApplicative rs+    , RecApplicative rs'+    , Grouping (Record fs)+    , RecVec rs+    , RecVec rs2'+    , RecVec ors+    ) =>+  Frame (Record rs)  -- ^ The left frame+  -> Frame (Record rs2) -- ^ The right frame+  -> [Rec Maybe ors] -- ^ A list of the merged records, now in the Maybe functor++rightJoin a b =+  concat  $+  rightOuter grouping mergeFun mergeRightEmpty+  proj1 proj2 (toList a) (toList b)+  where+    {-# INLINE proj1 #-}+    proj1 = rcast @fs+    {-# INLINE proj2 #-}+    proj2 = rcast @fs+    {-# INLINE mergeFun #-}+    mergeFun l r = justsFromRec $ mergeRec @fs l r+    {-# INLINE mergeRightEmpty #-}+    mergeRightEmpty r = rcast @ors (mkNothingsRec @rs' <+> justsFromRec r)++-- | Perform an left join operation on two frames.+--+-- Requires the language extension @TypeApplications@ for specifying the+-- columns to join on.+--+-- Joins can be done on on one or more columns provided the+-- columns have a @Grouping@ instance, most simple types do.+--+-- Presently join columns must be present and named identically in both left+-- and right frames.+--+-- Returns a list of Records in the Maybe interpretation functor.+-- If a key in the left table is missing from the right table, non-key+-- columns from the right table are filled with @Nothing@.+--+-- Basic usage: @leftJoin \@'[JoinCol1, ..., JoinColN] leftFrame rightFrame@+leftJoin :: forall fs rs rs2  rs2'.+  (fs    ⊆ rs+    , fs   ⊆ rs2+    , rs ⊆ (rs ++ rs2')+    , rs2' ⊆ rs2+    , rs2' ~ RDeleteAll fs rs2+    , RecApplicative rs2'+    , Grouping (Record fs)+    , RecVec rs+    , RecVec rs2'+    , RecVec (rs ++ rs2')+    ) =>+  Frame (Record rs)  -- ^ The left frame+  -> Frame (Record rs2) -- ^ The right frame+  -> [Rec Maybe (rs ++ rs2')] -- ^ A list of the merged records, now in the Maybe functor++leftJoin a b =+  concat+  (leftOuter grouping mergeFun mergeLeftEmpty+    proj1 proj2 (toList a) (toList b))+  where+    proj1 = rcast @fs+    proj2 = rcast @fs+    mergeFun l r = justsFromRec $ mergeRec @fs l r+    mergeLeftEmpty l = justsFromRec l <+> mkNothingsRec @rs2'

@@ -1,4 +1,5 @@-{-# LANGUAGE ConstraintKinds,+{-# LANGUAGE AllowAmbiguousTypes,+             ConstraintKinds,              CPP,              DataKinds,              FlexibleContexts,@@ -9,6 +10,7 @@              PatternSynonyms,              RankNTypes,              ScopedTypeVariables,+             TypeApplications,              TypeFamilies,              TypeOperators,              ViewPatterns #-}@@ -52,14 +54,12 @@ {-# INLINE frameSnoc #-}  pattern Nil :: Rec f '[]-pattern Nil = V.RNil+pattern Nil <- V.RNil where+  Nil = V.RNil  pattern (:&) :: Functor f => f r -> Rec f rs -> Rec f (s :-> r ': rs)-pattern x :& xs <- (frameUncons -> (x, xs))---- NOTE: A bidirectional pattern synonym would be great, but we'll--- have to wait for GHC 7.10 to gain wide acceptance before depending--- upon its availability.+pattern x :& xs <- (frameUncons -> (x, xs)) where+  x :& xs = frameCons x xs  class ColumnHeaders (cs::[*]) where   -- | Return the column names for a record.@@ -104,30 +104,33 @@ #endif  -- | Map a function across a homogeneous, monomorphic 'V.Rec'.-mapMonoV :: (Functor f, AllAre a ts) => (a -> a) -> V.Rec f ts -> V.Rec f ts+mapMonoV :: (Functor f, AllAre a ts)+         => (a -> b) -> V.Rec f ts -> V.Rec f (ReplaceAll b ts) mapMonoV _ V.RNil = V.RNil mapMonoV f (x V.:& xs) = fmap f x V.:& mapMonoV f xs  -- | Map a function across a homogeneous, monomorphic 'Rec'.-mapMono :: (AllAre a (UnColumn ts), Functor f, AsVinyl ts)-        => (a -> a) -> Rec f ts -> Rec f ts+mapMono :: (AllAre a (UnColumn ts), AsVinyl ts, Functor f,+            AsVinyl (ReplaceColumns b ts),+            ReplaceAll b (UnColumn ts) ~ UnColumn (ReplaceColumns b ts))+        => (a -> b) -> Rec f ts -> Rec f (ReplaceColumns b ts) mapMono f = fromVinyl . mapMonoV f . toVinyl  -- | Map a typeclass method across a 'V.Rec' each of whose fields -- have instances of the typeclass. mapMethodV :: forall c f ts. (Functor f, AllConstrained c ts)-           => Proxy c -> (forall a. c a => a -> a) -> V.Rec f ts -> V.Rec f ts-mapMethodV _ f = go+           => (forall a. c a => a -> a) -> V.Rec f ts -> V.Rec f ts+mapMethodV f = go   where go :: AllConstrained c ts' => V.Rec f ts' -> V.Rec f ts'         go V.RNil = V.RNil         go (x V.:& xs) = fmap f x V.:& go xs  -- | Map a typeclass method across a 'Rec' each of whose fields -- has an instance of the typeclass.-mapMethod :: forall f c ts.+mapMethod :: forall c f ts.              (Functor f, AllConstrained c (UnColumn ts), AsVinyl ts)-          => Proxy c -> (forall a. c a => a -> a) -> Rec f ts -> Rec f ts-mapMethod p f = fromVinyl . mapMethodV p f . toVinyl+          => (forall a. c a => a -> a) -> Rec f ts -> Rec f ts+mapMethod f = fromVinyl . mapMethodV @c f . toVinyl  -- * Currying Adapted from "Vinyl.Curry" 

@@ -13,3 +13,11 @@ type family AllAre a ts :: Constraint where   AllAre a '[] = ()   AllAre a (t ': ts) = (t ~ a, AllAre a ts)++-- | @ReplaceAll x ys@ produces a type-level list of the same length+-- as @ys@ where each element is @x@. In other words, it replaces each+-- element of @ys@ with @x@. This would be @map (const x) ys@ in+-- value-level Haskell.+type family ReplaceAll a xs where+  ReplaceAll a '[] = '[]+  ReplaceAll a (x ': xs) = a ': ReplaceAll a xs

@@ -0,0 +1,34 @@+{-# LANGUAGE ConstraintKinds   #-}+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE TypeOperators     #-}+{-# OPTIONS_GHC -Wall #-}++module LatinTest where++import           Data.Vinyl    (Rec)+import           Frames        ((:->), MonadSafe, Text, runSafeEffect, rget)+import           Frames.CSV    (declareColumn, pipeTableMaybe, readFileLatin1Ln)+import           Frames.Rec+import           Pipes         (Producer, (>->))+import qualified Pipes.Prelude as P++declareColumn "mId" ''Int+declareColumn "manager" '' Text+declareColumn "age" ''Int+declareColumn "pay" ''Int++type ManColumns = '["id" :-> Int, "manager" :-> Text, "age" :-> Int, "pay" :-> Text]+type ManRow = Record ManColumns+type ManMaybe = Rec Maybe ManColumns++manStreamM :: MonadSafe m => Producer ManMaybe m ()+manStreamM = readFileLatin1Ln "test/data/latinManagers.csv" >-> pipeTableMaybe++managers :: IO [Text]+managers =+  runSafeEffect . P.toListM $+  manStreamM >-> P.map recMaybe >-> P.concat >-> P.map (rget manager)

@@ -4,6 +4,7 @@ import Control.Monad (unless) import Data.Functor.Identity import Data.Char+import qualified Data.Foldable as F import Data.List (find) import Data.Monoid (First(..)) import qualified Data.Text as T@@ -19,6 +20,8 @@ import Test.Hspec as H import Test.HUnit.Lang (assertFailure) +import qualified LatinTest as Latin+ -- | Extract all example @(CSV, generatedCode)@ pairs from -- @test/examples.toml@ csvTests :: [(CsvExample, String)]@@ -33,16 +36,16 @@ -- since the generated declarations are never turned into actual -- declarations, they do not affect the `lookupTypeName` call that is -- designed to prevent duplicate declarations.-overlappingGeneration :: String-overlappingGeneration = m ++ "\n\n" ++ e-  where m = $(do csvExamples <- TH.runIO (examplesFrom "test/examples.toml")-                 let Just (CsvExample _ managers _) =-                       find (\(CsvExample k _ _) -> k == "managers") csvExamples-                 generateCode "ManagerRec" managers)-        e = $(do csvExamples <- TH.runIO (examplesFrom "test/examples.toml")-                 let Just (CsvExample _ employees _) =-                       find (\(CsvExample k _ _) -> k == "employees") csvExamples-                 generateCode "EmployeeRec" employees)+-- overlappingGeneration :: String+-- overlappingGeneration = m ++ "\n\n" ++ e+--   where m = $(do csvExamples <- TH.runIO (examplesFrom "test/examples.toml")+--                  let Just (CsvExample _ managers _) =+--                        find (\(CsvExample k _ _) -> k == "managers") csvExamples+--                  generateCode "ManagerRec" managers)+--         e = $(do csvExamples <- TH.runIO (examplesFrom "test/examples.toml")+--                  let Just (CsvExample _ employees _) =+--                        find (\(CsvExample k _ _) -> k == "employees") csvExamples+--                  generateCode "EmployeeRec" employees)  -- | To generate example generated code from raw CSV data, add the csv -- to @examples.toml@ and set the @generated@ key to an empty@@ -63,6 +66,8 @@ type ManagersRow =   Record ["id" :-> Int, "manager" :-> Text, "age" :-> Int, "pay" :-> Double] +type NoTruncateRow = Record ["id" :-> Int, "foo" :-> Int]+ newtype Code = Code String instance Show Code where show (Code x) = x instance Eq Code where@@ -71,12 +76,15 @@ main :: IO () main = do   hspec $-    do describe "Haskell type generation" $+    do+#if __GLASGOW_HASKELL__ < 804+       describe "Haskell type generation" $          mapM_ (\(CsvExample k _ g, g') -> it k (Code g' `shouldBe` Code g)) csvTests-       describe "Multiple tables" $-          do _g <- H.runIO $-                   generatedFrom "test/examples.toml" "managers_employees"-             it "Shouldn't duplicate columns" pending+#endif+       -- describe "Multiple tables" $+       --    do _g <- H.runIO $+       --             generatedFrom "test/examples.toml" "managers_employees"+       --       it "Shouldn't duplicate columns" pending        describe "Writing CSV Data" $ do          let csvInput = case find ((== "managers") . name . fst) csvTests of                           Just (ex,_) -> csv ex@@ -105,3 +113,29 @@          it "Produces parseable output" $            unless (frame == frame2)                   (assertFailure "Reparsed CSV differs from input")+       describe "Latin1 Text Encoding" $+         do managers <- H.runIO (Latin.managers)+            it "Parses" $+              managers `shouldBe` ["João", "Esperança"]+       describe "Skip Missing Data" $ do+         let csvInput = case find ((== "NoTruncate") . name . fst) csvTests of+                          Just (ex,_) -> csv ex+                          Nothing -> error "Couldn't find NoTruncate test data"+         frameMissing <- H.runIO $+                         withSystemTempFile "FramesSpecOutput" $ \fp h -> do+                           hClose h+                           writeFile fp csvInput+                           inCoreAoS (readTable fp) :: IO (Frame NoTruncateRow)+         it "Doesn't truncate after missing data" $+           F.length frameMissing `shouldBe` 3+       describe "Skip NA Data" $ do+         let csvInput = case find ((== "NoTruncateNA") . name . fst) csvTests of+                          Just (ex,_) -> csv ex+                          Nothing -> error "Couldn't find NoTruncateNA test data"+         frameMissing <- H.runIO $+                         withSystemTempFile "FramesSpecOutput" $ \fp h -> do+                           hClose h+                           writeFile fp csvInput+                           inCoreAoS (readTable fp) :: IO (Frame NoTruncateRow)+         it "Doesn't truncate after missing data" $+           F.length frameMissing `shouldBe` 4

@@ -0,0 +1,3 @@+id,manager,age,pay+1,João,53,"80,000"+2,Esperança,44,"80,000"

@@ -284,3 +284,106 @@                                 ColB ∈ rs_9) =>                                (g_8 ColB -> f_7 (g_8 ColB)) -> Rec g_8 rs_9 -> f_7 (Rec g_8 rs_9) colB' = rlens' (Proxy :: Proxy ColB)"""++[NoTruncate]+csv = """+id,foo+1,23+2,42+3,+4,56+"""++generated = """+type Row = Record ["id" :-> Int, "foo" :-> Int]+rowParser :: ParserOptions+rowParser = ParserOptions Nothing (T.pack ",") (Frames.CSV.RFC4180Quoting '"')++type Id = "id" :-> Int+id :: forall f_0 rs_1 . (Functor f_0, Id ∈ rs_1) =>+                        (Int -> f_0 Int) -> Record rs_1 -> f_0 (Record rs_1)+id = rlens (Proxy :: Proxy Id)+id' :: forall f_2 g_3 rs_4 . (Functor f_2, Functor g_3, Id ∈ rs_4) =>+                             (g_3 Id -> f_2 (g_3 Id)) -> Rec g_3 rs_4 -> f_2 (Rec g_3 rs_4)+id' = rlens' (Proxy :: Proxy Id)++type Foo = "foo" :-> Int+foo :: forall f_5 rs_6 . (Functor f_5, Foo ∈ rs_6) =>+                             (Int -> f_5 Int) -> Record rs_6 -> f_5 (Record rs_6)+foo = rlens (Proxy :: Proxy Foo)+foo' :: forall f_7 g_8 rs_9 . (Functor f_7,+                                   Functor g_8,+                                   Foo ∈ rs_9) =>+                                  (g_8 Foo -> f_7 (g_8 Foo)) -> Rec g_8 rs_9 -> f_7 (Rec g_8 rs_9)+foo' = rlens' (Proxy :: Proxy Foo)"""++[NoTruncateNA]+csv = """+id,foo+1,23+2,42+3,+4,56+5,NA+6,19+"""++generated = """+type Row = Record ["id" :-> Int, "foo" :-> Int]+rowParser :: ParserOptions+rowParser = ParserOptions Nothing (T.pack ",") (Frames.CSV.RFC4180Quoting '"')++type Id = "id" :-> Int+id :: forall f_0 rs_1 . (Functor f_0, Id ∈ rs_1) =>+                        (Int -> f_0 Int) -> Record rs_1 -> f_0 (Record rs_1)+id = rlens (Proxy :: Proxy Id)+id' :: forall f_2 g_3 rs_4 . (Functor f_2, Functor g_3, Id ∈ rs_4) =>+                             (g_3 Id -> f_2 (g_3 Id)) -> Rec g_3 rs_4 -> f_2 (Rec g_3 rs_4)+id' = rlens' (Proxy :: Proxy Id)++type Foo = "foo" :-> Int+foo :: forall f_5 rs_6 . (Functor f_5, Foo ∈ rs_6) =>+                             (Int -> f_5 Int) -> Record rs_6 -> f_5 (Record rs_6)+foo = rlens (Proxy :: Proxy Foo)+foo' :: forall f_7 g_8 rs_9 . (Functor f_7,+                                   Functor g_8,+                                   Foo ∈ rs_9) =>+                                  (g_8 Foo -> f_7 (g_8 Foo)) -> Rec g_8 rs_9 -> f_7 (Rec g_8 rs_9)+foo' = rlens' (Proxy :: Proxy Foo)"""++[DataHaskellSurvey]+csv = """+Label,Count+"Beginner : read(ing) tutorial material/solved some coding exercises",11+"Beginning : wrote less than 2 libraries or applications/unpublished",30+"Intermediate : wrote and published on Hackage 3 or more libraries/applications",16+"Advanced intermediate : wrote multiple libraries/applications - co-maintain various packages",13+"Advanced : contribute regularly patches to GHC - among other things",0+"Expert : proposed or commented on one or more language extensions",0+"""++generated = """+type Row = Record ["Label" :-> T.Text, "Count" :-> Int]+rowParser :: ParserOptions+rowParser = ParserOptions Nothing (T.pack ",") (Frames.CSV.RFC4180Quoting '"')++type Label = "Label" :-> T.Text+label :: forall f_0 rs_1 . (Functor f_0, Label ∈ rs_1) =>+         (T.Text -> f_0 T.Text) -> Record rs_1 -> f_0 (Record rs_1)+label = rlens (Proxy :: Proxy Label)+label' :: forall f_2 g_3 rs_4 . (Functor f_2,+                                 Functor g_3,+                                 Label ∈ rs_4) =>+          (g_3 Label -> f_2 (g_3 Label)) -> Rec g_3 rs_4 -> f_2 (Rec g_3 rs_4)+label' = rlens' (Proxy :: Proxy Label)++type Count = "Count" :-> Int+count :: forall f_5 rs_6 . (Functor f_5, Count ∈ rs_6) =>+         (Int -> f_5 Int) -> Record rs_6 -> f_5 (Record rs_6)+count = rlens (Proxy :: Proxy Count)+count' :: forall f_7 g_8 rs_9 . (Functor f_7,+                                 Functor g_8,+                                 Count ∈ rs_9) =>+          (g_8 Count -> f_7 (g_8 Count)) -> Rec g_8 rs_9 -> f_7 (Rec g_8 rs_9)+count' = rlens' (Proxy :: Proxy Count)+"""