Frames 0.5.1 → 0.7.4.2
raw patch · 43 files changed
Files
- CHANGELOG.md +33/−0
- Frames.cabal +58/−31
- README.md +48/−18
- benchmarks/BenchDemo.hs +13/−2
- benchmarks/InsuranceBench.hs +1/−1
- data/GetData.hs +11/−2
- demo/Main.hs +0/−73
- demo/ModifyCSV.hs +23/−0
- demo/Plot.hs +1/−1
- demo/Plot2.hs +2/−1
- demo/TimeZones/src/Columns.hs +30/−0
- demo/TimeZones/src/Main.hs +26/−0
- demo/TimeZones/src/TimeIn.hs +43/−0
- demo/framestack/app/Main.hs +51/−0
- src/Frames.hs +1/−1
- src/Frames/CSV.hs +348/−175
- src/Frames/Categorical.hs +12/−3
- src/Frames/ColumnTypeable.hs +15/−4
- src/Frames/ColumnUniverse.hs +172/−104
- src/Frames/Exploration.hs +42/−4
- src/Frames/ExtraInstances.hs +3/−0
- src/Frames/Frame.hs +1/−2
- src/Frames/InCore.hs +45/−14
- src/Frames/Rec.hs +1/−1
- src/Frames/RecF.hs +3/−2
- src/Frames/ShowCSV.hs +1/−0
- src/Frames/TH.hs +44/−46
- src/Frames/Utils.hs +28/−0
- test/Categorical.hs +29/−21
- test/Chunks.hs +23/−0
- test/DataCSV.hs +50/−39
- test/Issue114.hs +23/−20
- test/Issue145.hs +12/−0
- test/LatinTest.hs +1/−2
- test/NoHeader.hs +16/−11
- test/Overlap.hs +6/−3
- test/PrettyTH.hs +3/−2
- test/Spec.hs +74/−16
- test/UncurryFold.hs +4/−5
- test/UncurryFoldNoHeader.hs +7/−6
- test/data/issue145.csv +3/−0
- test/data/multiline.csv +8/−0
- test/examples.toml +58/−58
CHANGELOG.md view
@@ -1,3 +1,36 @@+# 0.7.4+Replace the `htoml` package used in a test with `tomland`.++# 0.7.2++- Add `writeCSVopts` that accepts options to specify the CSV delimiter.+- Add `inferencePrefix` that controls how many lines of the input file are used for column type inference (default is 1000).+- Add `readTableDebug` that loads and parses a data frame as `readTable`, but additionally prints lines that failed to parse to `stderr`.++# 0.7.1++- Add `showFrame`, `printFrame`, `takeRows`, and `dropRows` to the `Frames.Exploration` module. These helpers for working with `Frames` are re-exported from the `Frames` module itself. Thanks to @chfin.++- GHC-9.0.1 support.++# 0.7.0++GHC-8.10 support in Vinyl requires a major version bump.++# 0.6.3+ +- Fix support for categorical column names that include spaces (@epn09)++# 0.6.0+Support external CSV tokenizers++Internal functionality is now defined more cleanly atop a stream of rows already broken into columns (rather than a stream of rows that we quietly break into columns ourself). This permits the use of external parsers such as provided by the new [Frames-dsv](https://hackage.haskell.org/package/Frames-dsv) package that supplies a CSV parser built atop `hw-dsv`.++The built-in CSV parser remains for ease of installation.++# 0.5.1+GHC 8.6 compatibility+ # 0.5.0 - Renamed the `rgetf` and `rputf` exported by the `Frames` module to `rgetField` and `rputField`. This avoids clashing with the same names exported by `vinyl` and further advances the process of eliminating the old `Frames` `Col` type in favor of `vinyl`'s `ElField`.
Frames.cabal view
@@ -1,6 +1,6 @@ name: Frames-version: 0.5.1-synopsis: Data frames For working with tabular data files+version: 0.7.4.2+synopsis: Data frames for working with tabular data files description: User-friendly, type safe, runtime efficient tooling for working with tabular data deserialized from comma-separated values (CSV) files. The type of@@ -11,11 +11,11 @@ license-file: LICENSE author: Anthony Cowley maintainer: acowley@gmail.com-copyright: Copyright (C) 2014-2015 Anthony Cowley+copyright: Copyright (C) 2014-2018 Anthony Cowley category: Data build-type: Simple extra-source-files: benchmarks/*.hs benchmarks/*.py- demo/Main.hs CHANGELOG.md README.md+ demo/framestack/app/Main.hs CHANGELOG.md README.md data/GetData.hs test/examples.toml test/data/managers.csv test/data/employees.csv@@ -25,10 +25,12 @@ test/data/prestigeNoHeader.csv test/data/prestigePartial.csv test/data/catSmall.csv test/data/catLarge.csv+ test/data/multiline.csv+ test/data/issue145.csv data/left1.csv data/right1.csv data/left_summary.csv data/FL2.csv cabal-version: >=1.10-tested-with: GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1+tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.1 || == 9.2.1 || == 9.4.6 source-repository head type: git@@ -57,42 +59,47 @@ Frames.TypeLevel Frames.Joins Frames.ExtraInstances+ Frames.Utils other-extensions: DataKinds, GADTs, KindSignatures, TypeFamilies, TypeOperators, ConstraintKinds, StandaloneDeriving, UndecidableInstances, ScopedTypeVariables, OverloadedStrings, TypeApplications- build-depends: base >=4.8 && <4.13,- ghc-prim >=0.3 && <0.6,- primitive >= 0.6 && < 0.7,- text >= 1.1.1.0,- template-haskell,- transformers,- vector,- readable >= 0.3.1,+ build-depends: base >=4.10 && <4.20,+ ghc-prim >=0.3 && <0.12,+ primitive >= 0.6 && < 0.10,+ text >= 1.1.1.0 && < 2.2,+ template-haskell >= 2.10 && < 2.22,+ transformers >= 0.5.6 && < 0.7,+ vector < 0.14,+ readable >= 0.3.1 && < 0.4, pipes >= 4.1 && < 5, pipes-bytestring >= 2.1.6 && < 2.2, pipes-group >= 1.0.8 && < 1.1, pipes-parse >= 3.0 && < 3.1, pipes-safe >= 2.2.6 && < 2.4,- bytestring,- vinyl >= 0.10.0 && < 0.11,- discrimination,- contravariant,- hashable,- deepseq >= 1.4,- containers,- vector-th-unbox >= 0.2.1.6+ bytestring < 0.13,+ vinyl >= 0.13.0 && < 0.15,+ discrimination >= 0.4 && < 0.6,+ contravariant < 1.6,+ hashable >= 1.3 && < 1.5,+ deepseq >= 1.4 && < 1.6,+ containers < 0.8,+ vector-th-unbox >= 0.2.1.6 && < 0.3 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall --- Get the large-ish data files used in the demo and benchmark+-- Get the largeish data files used in the demo and benchmark executable getdata if !flag(demos) buildable: False main-is: GetData.hs if flag(demos)- build-depends: base, bytestring, http-client >= 0.4.3, zip-archive, directory+ build-depends:+ base, bytestring,+ http-client >= 0.4.3,+ http-client-tls,+ zip-archive, directory hs-source-dirs: data default-language: Haskell2010 ghc-options: -Wall@@ -141,9 +148,9 @@ build-depends: base, list-t, microlens, transformers, Frames, vector, text, template-haskell, ghc-prim, readable, pipes- hs-source-dirs: demo+ hs-source-dirs: demo/framestack/app default-language: Haskell2010- ghc-options: -O2+ ghc-options: -O2 -fsimpl-tick-factor=200 -- ghc-options: -O2 -fllvm executable tutorial@@ -169,7 +176,7 @@ hs-source-dirs: benchmarks default-language: Haskell2010 -- ghc-options: -O2- ghc-options: -O2 -fllvm+ ghc-options: -O2 -fllvm -fsimpl-tick-factor=200 -- A demonstration of dealing with missing data. Provided for source -- code and experimentation rather than a useful executable.@@ -211,18 +218,38 @@ hs-source-dirs: demo default-language: Haskell2010 +executable modcsv+ if !flag(demos)+ buildable: False+ main-is: ModifyCSV.hs+ if flag(demos)+ build-depends: base, Frames, microlens, pipes+ hs-source-dirs: demo+ default-language: Haskell2010++executable timezones+ if !flag(demos)+ buildable: False+ main-is: Main.hs+ other-modules: TimeIn Columns+ if flag(demos)+ build-depends: base, Frames, tz, text, time, readable,+ pipes, pipes-safe, template-haskell+ hs-source-dirs: demo/TimeZones/src+ default-language: Haskell2010+ test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs other-modules: DataCSV PrettyTH Temp LatinTest Issue114 NoHeader UncurryFold UncurryFoldNoHeader UncurryFoldPartialData- Categorical+ Categorical Chunks Issue145 build-depends: base, text, hspec, Frames, template-haskell,- temporary, directory, htoml, regex-applicative, pretty,- unordered-containers, pipes, HUnit, vinyl,- foldl >= 1.3 && < 1.5,- attoparsec, lens+ temporary, directory, tomland, regex-applicative, pretty,+ unordered-containers, pipes, HUnit, vinyl, + foldl >= 1.3 && < 1.5, validation-selective,+ attoparsec, lens, bytestring ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall default-language: Haskell2010
README.md view
@@ -17,15 +17,14 @@ If you have a CSV data where the values of each column may be classified by a single type, and ideally you have a header row giving each column a name, you may simply want to avoid writing out the Haskell type corresponding to each row. `Frames` provides `TemplateHaskell` machinery to infer a Haskell type for each row of your data set, thus preventing the situation where your code quietly diverges from your data. -We generate a collection of definitions generated by inspecting the data file at compile time (using `tableTypes`), then, at runtime, load that data into column-oriented storage in memory (an **in-core** array of structures (AoS)). We're going to compute the average ratio of two columns, so we'll use the `foldl` library. Our fold will project the columns we want, and apply a function that divides one by the other after appropriate numeric type conversions. Here is the entirety of that [program](https://github.com/acowley/Frames/tree/master/test/UncurryFold.hs).+We generate a collection of definitions generated by inspecting the data file at compile time (using `tableTypes`), then, at runtime, load that data into column-oriented storage in memory with a row-oriented interface (an **in-core** array of structures (AoS)). We're going to compute the average ratio of two columns, so we'll use the `foldl` library. Our fold will project the columns we want, and apply a function that divides one by the other after appropriate numeric type conversions. Here is the entirety of that [program](https://github.com/acowley/Frames/tree/main/test/UncurryFold.hs). ```haskell-{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell #-}+{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell, TypeApplications #-} module UncurryFold where-import qualified Control.Foldl as L-import Data.Vinyl (rcast)-import Data.Vinyl.Curry (runcurryX)-import Frames+import qualified Control.Foldl as L+import Data.Vinyl.Curry ( runcurryX )+import Frames -- Data set from http://vincentarelbundock.github.io/Rdatasets/datasets.html tableTypes "Row" "test/data/prestige.csv"@@ -46,16 +45,17 @@ ### Missing Header Row -Now consider a case where our data file lacks a header row (I deleted the first row from \`prestige.csv\`). We will provide our own name for the generated row type, our own column names, and, for the sake of demonstration, we will also specify a prefix to be added to every column-based identifier (particularly useful if the column names **do** come from a header row, and you want to work with multiple CSV files some of whose column names coincide). We customize behavior by updating whichever fields of the record produced by `rowGen` we care to change, passing the result to `tableTypes'`. [Link to code.](https://github.com/acowley/Frames/tree/master/test/UncurryFoldNoHeader.hs)+Now consider a case where our data file lacks a header row (I deleted the first row from \`prestige.csv\`). We will provide our own name for the generated row type, our own column names, and, for the sake of demonstration, we will also specify a prefix to be added to every column-based identifier (particularly useful if the column names **do** come from a header row, and you want to work with multiple CSV files some of whose column names coincide). We customize behavior by updating whichever fields of the record produced by `rowGen` we care to change, passing the result to `tableTypes'`. [Link to code.](https://github.com/acowley/Frames/tree/main/test/UncurryFoldNoHeader.hs) ```haskell-{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell #-}+{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell, TypeApplications #-} module UncurryFoldNoHeader where-import qualified Control.Foldl as L-import Data.Vinyl (rcast)-import Data.Vinyl.Curry (runcurryX)-import Frames-import Frames.TH (rowGen, RowGen(..))+import qualified Control.Foldl as L+import Data.Vinyl.Curry ( runcurryX )+import Frames+import Frames.TH ( rowGen+ , RowGen(..)+ ) -- Data set from http://vincentarelbundock.github.io/Rdatasets/datasets.html tableTypes' (rowGen "test/data/prestigeNoHeader.csv")@@ -84,7 +84,7 @@ "athletes",11.44,8206,8.13,,3373,NA -We can no longer parse a `Double` for that row, so we will work with row types parameterized by a `Maybe` type constructor. We are substantially filtering our data, so we will perform this operation in a streaming fashion without ever loading the entire table into memory. Our process will be to check if the `prestige` column was parsed, only keeping those rows for which it was not, then project the `income` column from those rows, and finally throw away `Nothing` elements. [Link to code](https://github.com/acowley/Frames/tree/master/test/UncurryFoldPartialData.hs).+We can no longer parse a `Double` for that row, so we will work with row types parameterized by a `Maybe` type constructor. We are substantially filtering our data, so we will perform this operation in a streaming fashion without ever loading the entire table into memory. Our process will be to check if the `prestige` column was parsed, only keeping those rows for which it was not, then project the `income` column from those rows, and finally throw away `Nothing` elements. [Link to code](https://github.com/acowley/Frames/tree/main/test/UncurryFoldPartialData.hs). ```haskell {-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell, TypeApplications, TypeOperators #-}@@ -127,15 +127,45 @@ ## Demos -There are various [demos](https://github.com/acowley/Frames/tree/master/demo) in the repository. Be sure to run the `getdata` build target to download the data files used by the demos! You can also download the data files manually and put them in a `data` directory in the directory from which you will be running the executables.+There are various [demos](https://github.com/acowley/Frames/tree/main/demo) in the repository. Be sure to run the `getdata` build target to download the data files used by the demos! You can also download the data files manually and put them in a `data` directory in the directory from which you will be running the executables. +## Contribute++You can build Frames via [nix](www.nixos.org) with the following command:+```+nix build .#Frames-8107 # or nix build .#Frames-921+```+this creates an ./result link in the current folder.++To get a development shell with all libraries, you can run:+```+nix develop .#Frames-921+```+To get just ghc and cabal in your shell, a simple `nix develop` will do.+ ## Benchmarks -The [benchmark](https://github.com/acowley/Frames/tree/master/benchmarks/InsuranceBench.hs) shows several ways of dealing with data when you want to perform multiple traversals.+The [benchmark](https://github.com/acowley/Frames/tree/main/benchmarks/InsuranceBench.hs) shows several ways of dealing with data when you want to perform multiple traversals. -Another [demo](https://github.com/acowley/Frames/tree/master/benchmarks/BenchDemo.hs) shows how to fuse multiple passes into one so that the full data set is never resident in memory. A [Pandas version](https://github.com/acowley/Frames/tree/master/benchmarks/panda.py) of a similar program is also provided for comparison.+Another [demo](https://github.com/acowley/Frames/tree/main/benchmarks/BenchDemo.hs) shows how to fuse multiple passes into one so that the full data set is never resident in memory. A [Pandas version](https://github.com/acowley/Frames/tree/main/benchmarks/panda.py) of a similar program is also provided for comparison. This is a trivial program, but shows that performance is comparable to Pandas, and the memory savings of a compiled program are substantial. -+First with Pandas,++```bash+$ nix-shell -p 'python3.withPackages (p: [p.pandas])' --run '$(which time) -f "%Uuser %Ssystem %Eelapsed %PCPU; %Mmaxresident KB" python benchmarks/panda.py'+28.087476512228815+-81.90356506136422+0.67user 0.04system 0:00.72elapsed 99%CPU; 79376maxresident KB+```++Then with Frames,++```bash+$ $(which time) -f '%Uuser %Ssystem %Eelapsed %PCPU; %Mmaxresident KB' dist-newstyle/build/x86_64-linux/ghc-8.10.4/Frames-0.7.2/x/benchdemo/build/benchdemo/benchdemo+28.087476512228815+-81.90356506136422+0.36user 0.00system 0:00.37elapsed 100%CPU; 5088maxresident KB+```
benchmarks/BenchDemo.hs view
@@ -1,14 +1,25 @@-{-# LANGUAGE DataKinds, FlexibleContexts, TemplateHaskell #-}+{-# LANGUAGE DataKinds, FlexibleContexts, TemplateHaskell, TypeApplications #-} -- | Demonstration of streaming data processing. Try building with -- cabal (@cabal build benchdemo@), then running in bash with -- something like, -- -- @$ /usr/bin/time -l dist/build/benchdemo/benchdemo 2>&1 | head -n 4@+-- Or, for cabal-install 3 (using Linux and GHC-8.8.2 as an example),+-- @$ time dist-newstyle/build/x86_64-linux/ghc-8.8.2/Frames-0.6.2/x/benchdemo/build/benchdemo/benchdemo@+-- Or, for all resource usage on linux (avoid the bash builtin time),+-- @$ $(which time) -v dist-newstyle/build/x86_64-linux/ghc-8.8.2/Frames-0.6.2/x/benchdemo/build/benchdemo/benchdemo@ import qualified Control.Foldl as F import Frames+import Frames.TH (rowGen, RowGen (rowTypeName, inferencePrefix)) import Pipes.Prelude (fold) -tableTypes "Ins" "data/FL2.csv"+-- The simple use of 'tableTypes' commented out here is what one+-- typically uses; it infers column types based the first 1000 rows of+-- the data file. In this data file, however, we need to see more rows+-- to properly identify the types.++-- tableTypes "Ins" "data/FL2.csv"+tableTypes' (rowGen "data/FL2.csv") { rowTypeName = "Ins", inferencePrefix = 2500 } main :: IO () main = do (lat,lng,n) <- runSafeT $ F.purely fold f (readTable "data/FL2.csv")
benchmarks/InsuranceBench.hs view
@@ -63,7 +63,7 @@ return $! P (sumLat / fromIntegral n) (sumLong / fromIntegral n) -- | Perform two consecutive folds after projecting a subset of an--- in-memory reprsentation.+-- in-memory representation. pipeBenchAoS :: IO (P Double) pipeBenchAoS = do tbl <- inCoreAoS' rcast tblP :: IO (Frame TinyIns) let (n,sumLat) =
data/GetData.hs view
@@ -2,14 +2,16 @@ import Codec.Archive.Zip import qualified Data.ByteString.Lazy.Char8 as B import Data.Maybe (fromJust)+import Data.Monoid (First(..)) import Network.HTTP.Client+import Network.HTTP.Client.TLS (tlsManagerSettings) import System.Directory (createDirectoryIfMissing) getPrestige :: IO ()-getPrestige = do m <- newManager defaultManagerSettings+getPrestige = do m <- newManager tlsManagerSettings httpLbs req m >>= B.writeFile "data/prestige.csv" . responseBody- where Just req = parseUrlThrow "http://vincentarelbundock.github.io/Rdatasets/csv/car/Prestige.csv"+ where Just req = parseUrlThrow "https://vincentarelbundock.github.io/Rdatasets/csv/carData/Prestige.csv" getFLinsurance :: IO () getFLinsurance = do m <- newManager defaultManagerSettings@@ -28,6 +30,13 @@ httpLbs req m >>= B.writeFile "data/adult.csv" . B.append colNames+ . B.unlines+ . map (\ln -> maybe ln id+ . getFirst+ $ foldMap (First . ($ ln))+ [ B.stripSuffix ", <=50K"+ , B.stripSuffix ", >50K" ])+ . B.lines . responseBody where Just req = parseUrlThrow "http://archive.ics.uci.edu/ml/machine-learning-databases/adult/adult.data" colNames = "age, workclass, fnlwgt, education, education-num, \
− demo/Main.hs
@@ -1,73 +0,0 @@-{-# LANGUAGE BangPatterns, DataKinds, TemplateHaskell #-}-{-# LANGUAGE FlexibleContexts, TypeApplications, TypeOperators #-}-module Main where-import Data.Functor.Identity-import Frames-import Lens.Micro-import qualified Pipes as P-import qualified Pipes.Prelude as P--tableTypes "Row" "data/data1.csv"--tbl :: IO [Row]-tbl = runSafeT . P.toListM $ readTable "data/data1.csv"--ageDoubler :: (Age ∈ rs) => Record rs -> Record rs-ageDoubler = age %~ (* 2)--tbl2 :: IO [Row]-tbl2 = runSafeT . P.toListM $ readTable "data/data2.csv"--tbl2a :: IO [ColFun Maybe Row]-tbl2a = runSafeT . P.toListM $ readTableMaybe "data/data2.csv"--{---REPL examples:--λ> tbl >>= mapM_ print-{name :-> "joe", age :-> 21}-{name :-> "sue", age :-> 23}-{name :-> "bob", age :-> 44}-{name :-> "laura", age :-> 18}--λ> tbl2 >>= mapM_ print-{name :-> "joe", age :-> 21}-{name :-> "sue", age :-> 23}-{name :-> "laura", age :-> 18}--λ> tbl2a >>= mapM_ (putStrLn . showRecF)-{Just (name :-> "joe"), Just (age :-> 21)}-{Just (name :-> "sue"), Just (age :-> 23)}-{Just (name :-> "bob"), Nothing}-{Just (name :-> "laura"), Just (age :-> 18)}---}---- Sample data from http://support.spatialkey.com/spatialkey-sample-csv-data/--- Note: We have to replace carriage returns (\r) with line feed--- characters (\n) for the text library's line parsing to work.-tableTypes "Ins" "data/FL2.csv"--insuranceTbl :: MonadSafe m => P.Producer Ins m ()-insuranceTbl = readTable "data/FL2.csv"--insMaybe :: MonadSafe m => P.Producer (ColFun Maybe Ins) m ()-insMaybe = readTableMaybe "data/FL2.csv"--type TinyIns = Record [PolicyID, PointLatitude, PointLongitude]--main :: IO ()-main = do itbl <- inCore $ P.for insuranceTbl (P.yield . rcast)- :: IO (P.Producer TinyIns Identity ())- putStrLn "In-core representation prepared"- let Identity (n,sumLat) =- P.fold (\ !(!i,!s) r -> (i+1, s+rgetField @PointLatitude r))- (0::Int,0)- id- itbl- putStrLn $ "Considering " ++ show n ++ " records..."- putStrLn $ "Average latitude: " ++ show (sumLat / fromIntegral n)- let Identity sumLong =- P.fold (\ !s r -> (s + rgetField @PointLongitude r)) 0 id itbl- putStrLn $ "Average longitude: " ++ show (sumLong / fromIntegral n)
+ demo/ModifyCSV.hs view
@@ -0,0 +1,23 @@+{-# language DataKinds, FlexibleContexts, TemplateHaskell, TypeApplications #-}+-- | A demonstration of ingesting a CSV file, modifying the data (in+-- this case multiplying a column by 2), then writing it back out to a+-- new CSV file.+import Frames+import Frames.CSV (pipeToCSV, consumeTextLines)+import Lens.Micro+import Pipes ((>->), Effect)+import qualified Pipes.Prelude as P++tableTypes "Row" "data/data1.csv"++myFun :: Row -> Row+myFun = age %~ (*2)++myPipeline :: MonadSafe m => Effect m ()+myPipeline = readTable "data/data1.csv"+ >-> P.map myFun+ >-> pipeToCSV+ >-> consumeTextLines "data/dataMod.csv"++main :: IO ()+main = runSafeEffect myPipeline
demo/Plot.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds, FlexibleContexts, TemplateHaskell #-}+{-# LANGUAGE DataKinds, FlexibleContexts, TemplateHaskell, TypeApplications #-} module Main where import qualified Data.Vector.Unboxed as V import Diagrams.Backend.Rasterific
demo/Plot2.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, DataKinds, FlexibleContexts, OverloadedStrings,- TemplateHaskell #-}+ TemplateHaskell, TypeApplications #-} import Diagrams.Backend.Rasterific import Diagrams (dims2D, width, height) import Frames@@ -44,6 +44,7 @@ putStrLn $ "The average farmer/fisher is "++ show (fromIntegral age_ / n) ++ " and made " ++ show (fromIntegral inc / n)+ mkPlot where aux !(!sumAge, !sumIncome, n) f = (sumAge + f^.age, sumIncome + f^.capitalGain, n+1) -- Independent folds
+ demo/TimeZones/src/Columns.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | Define the column types used to represent our data. Here, we wish+-- to parse data captured as 'Data.Time.LocalTime.LocalTime' values+-- into the \"America/Chicago\" time zone.+module Columns (MyColumns, TimeIn(..), Chicago(..)) where+import Data.Proxy (Proxy(..))+import Frames (CommonColumns)+import Frames.ColumnTypeable (Parseable(..))+import Frames.CSV (defaultSep, produceTokens)+import TimeIn++-- | Define a 'Parseable' instance for @TimeIn "America/Chicago"@+timeIn "America/Chicago"++-- | We need this newtype because Template Haskell can not handle the+-- type @TimeIn "America/Chicago"@ as of @GHC-8.0.1@ and+-- @template-haskell-2.11.0.0@+newtype Chicago = Chicago (TimeIn "America/Chicago") deriving Show++instance Parseable Chicago where+ parse = fmap (fmap Chicago) . parse++-- | The column types we expect our data to conform to+type MyColumns = Chicago ': CommonColumns
+ demo/TimeZones/src/Main.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+-- | Parse data including dates times in some implicit local time zone+-- into an absolute time using a supplied time zone.+module Main where+import Data.Proxy (Proxy(Proxy))+import Frames+import Frames.CSV+import Frames.TH (RowGen(columnUniverse), colQ, rowGen)+import Columns+import Pipes (Producer, (>->), runEffect)+import qualified Pipes.Prelude as P+import Pipes.Safe+import Frames (ColumnUniverse)+import Columns (MyColumns)++-- tableTypes' rowGen { columnUniverse = $(colQ ''MyColumns) } "/Users/acowley/Projects/Frames/demo/TimeZones/users.csv"+tableTypes' ((rowGen "demo/TimeZones/users.csv") { columnUniverse = Proxy @MyColumns })++loadUsers :: Producer Row (SafeT IO) ()+loadUsers = readTable "demo/TimeZones/users.csv"++main :: IO ()+main = runSafeEffect $ loadUsers >-> P.print
+ demo/TimeZones/src/TimeIn.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+-- | Define the 'TimeIn' type that lets us specify in the type how a+-- 'LocalTime' should be converted to a 'UTCTime'.+module TimeIn where+import Control.Monad (MonadPlus (mzero), msum)+import qualified Data.Text as T+import Data.Time.Clock+import Data.Time.Format+import Data.Time.LocalTime+import Data.Time.Zones+import Data.Time.Zones.TH+import Frames.ColumnTypeable (Parseable(..), Parsed(..))+import GHC.TypeLits+import Language.Haskell.TH++-- | A 'UTCTime' tagged with a symbol denoting the 'TZ' time zone from+-- whence it came.+newtype TimeIn (zone :: Symbol) = TimeIn UTCTime deriving Show++failZero :: MonadPlus m => Maybe r -> m r+failZero = maybe mzero pure++-- | Try to parse a 'LocalTime' value using common formats.+parseLocalTime :: MonadPlus m => T.Text -> m LocalTime+parseLocalTime t = msum (map (($ T.unpack t) . mkParser) formats)+ where formats = ["%F %T", "%F"]+ mkParser = (failZero .) . parseTimeM True defaultTimeLocale++-- | @zonedTime "America/Chicago"@ will create a 'Parseable' instance+-- for the type @TimeIn "America/Chicago"@. You can then use this type+-- when loading data.+timeIn :: String -> DecsQ+timeIn tzStr =+ do let fromLocal = [e| localTimeToUTCTZ $(includeTZFromDB tzStr) |]+ ex = [e| fmap (Definitely . TimeIn . $fromLocal) . parseLocalTime |]+ sequenceA [+ instanceD (pure [])+ [t|Parseable (TimeIn $(pure $ LitT (StrTyLit tzStr)))|]+ [ funD (mkName "parse") [clause [] (normalB ex) []] ] ]
+ demo/framestack/app/Main.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE BangPatterns, DataKinds, TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts, TypeApplications, TypeOperators #-}+module Main where+import Data.Functor.Identity+import Frames+import Lens.Micro+import qualified Pipes as P+import qualified Pipes.Prelude as P++tableTypes "Row" "data/data1.csv"++tbl :: IO [Row]+tbl = runSafeT . P.toListM $ readTable "data/data1.csv"+++ageDoubler :: (Age ∈ rs) => Record rs -> Record rs+ageDoubler = age %~ (* 2)++tbl2 :: IO [Row]+tbl2 = runSafeT . P.toListM $ readTable "data/data2.csv"++tbl2a :: IO [ColFun Maybe Row]+tbl2a = runSafeT . P.toListM $ readTableMaybe "data/data2.csv"++-- Sample data from http://support.spatialkey.com/spatialkey-sample-csv-data/+-- Note: We have to replace carriage returns (\r) with line feed+-- characters (\n) for the text library's line parsing to work.+tableTypes "Ins" "data/FL2.csv"++insuranceTbl :: MonadSafe m => P.Producer Ins m ()+insuranceTbl = readTable "data/FL2.csv"++insMaybe :: MonadSafe m => P.Producer (ColFun Maybe Ins) m ()+insMaybe = readTableMaybe "data/FL2.csv"++type TinyIns = Record [PolicyID, PointLatitude, PointLongitude]++main :: IO ()+main = do itbl <- inCore $ P.for insuranceTbl (P.yield . rcast)+ :: IO (P.Producer TinyIns Identity ())+ putStrLn "In-core representation prepared"+ let Identity (n,sumLat) =+ P.fold (\ !(!i,!s) r -> (i+1, s+rgetField @PointLatitude r))+ (0::Int,0)+ id+ itbl+ putStrLn $ "Considering " ++ show n ++ " records..."+ putStrLn $ "Average latitude: " ++ show (sumLat / fromIntegral n)+ let Identity sumLong =+ P.fold (\ !s r -> (s + rgetField @PointLongitude r)) 0 id itbl+ putStrLn $ "Average longitude: " ++ show (sumLong / fromIntegral n)
src/Frames.hs view
@@ -40,7 +40,7 @@ RDelete, RecAll) import Frames.Col ((:->), pattern Col) import Frames.ColumnUniverse-import Frames.CSV (readTable, readTableOpt, readTableMaybe, pipeTable, pipeTableMaybe)+import Frames.CSV (readTable, readTableOpt, readTableMaybe, readTableDebug, pipeTable, pipeTableMaybe) import Frames.Exploration import Frames.Frame import qualified Frames.InCore as I
src/Frames/CSV.hs view
@@ -1,27 +1,40 @@-{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs,- LambdaCase, OverloadedStrings, RankNTypes,- ScopedTypeVariables, TemplateHaskell, TypeApplications,- TypeOperators #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+ -- | Infer row types from comma-separated values (CSV) data and read -- that data from files. Template Haskell is used to generate the -- necessary types so that you can write type safe programs referring -- to those types. module Frames.CSV where-import Control.Exception (try, IOException)-import Control.Monad (when)++import Control.Exception (IOException, try)+import Control.Monad (unless, when) import qualified Data.ByteString.Char8 as B8 import qualified Data.Foldable as F import Data.List (intercalate)-import Data.Maybe (isNothing, fromMaybe)+import Data.Maybe (fromMaybe, isNothing)+#if __GLASGOW_HASKELL__ < 808 import Data.Monoid ((<>))+#endif import Data.Proxy import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T-import Data.Vinyl (recordToList, Rec(..), ElField(..), RecordToList)-import Data.Vinyl (RecMapMethod, rmapMethod, RMap, rmap)+import Data.Vinyl (ElField (..), RMap, Rec (..), RecMapMethod, RecordToList, recordToList, rmap, rmapMethod) import Data.Vinyl.Class.Method (PayloadType)-import Data.Vinyl.Functor (Const(..), (:.), Compose(..))+import Data.Vinyl.Functor (Compose (..), Const (..), (:.)) import Frames.Col import Frames.ColumnTypeable import Frames.Rec@@ -32,11 +45,11 @@ import Language.Haskell.TH.Syntax import Pipes ((>->)) import qualified Pipes as P-import qualified Pipes.Prelude as P import qualified Pipes.Parse as P+import qualified Pipes.Prelude as P import qualified Pipes.Safe as P import qualified Pipes.Safe.Prelude as Safe-import System.IO (Handle, IOMode(ReadMode, WriteMode))+import System.IO (Handle, IOMode (ReadMode, WriteMode), hPrint, stderr) -- * Parsing @@ -45,30 +58,37 @@ type QuoteChar = Char data QuotingMode- -- | No quoting enabled. The separator may not appear in values- = NoQuoting- -- | Quoted values with the given quoting character. Quotes are escaped by doubling them.- -- Mostly RFC4180 compliant, except doesn't support newlines in values- | RFC4180Quoting QuoteChar- deriving (Eq, Show)--data ParserOptions = ParserOptions { headerOverride :: Maybe [T.Text]- , columnSeparator :: Separator- , quotingMode :: QuotingMode }- deriving (Eq, Show)+ = -- | No quoting enabled. The separator may not appear in values+ NoQuoting+ | -- | Quoted values with the given quoting character. Quotes are escaped by doubling them.+ -- Mostly RFC4180 compliant, except doesn't support newlines in values+ RFC4180Quoting QuoteChar+ deriving (Eq, Show, Lift) -instance Lift QuotingMode where- lift NoQuoting = [|NoQuoting|]- lift (RFC4180Quoting char) = [|RFC4180Quoting $(litE . charL $ char)|]+data ParserOptions = ParserOptions+ { headerOverride :: Maybe [T.Text]+ , columnSeparator :: Separator+ , quotingMode :: QuotingMode+ }+ deriving (Eq, Show) instance Lift ParserOptions where- lift (ParserOptions Nothing sep quoting) = [|ParserOptions Nothing $sep' $quoting'|]- where sep' = [|T.pack $(stringE $ T.unpack sep)|]- quoting' = lift quoting- lift (ParserOptions (Just hs) sep quoting) = [|ParserOptions (Just $hs') $sep' $quoting'|]- where sep' = [|T.pack $(stringE $ T.unpack sep)|]- hs' = [|map T.pack $(listE $ map (stringE . T.unpack) hs)|]- quoting' = lift quoting+ lift (ParserOptions Nothing sep quoting) = [|ParserOptions Nothing $sep' $quoting'|]+ where+ sep' = [|T.pack $(stringE $ T.unpack sep)|]+ quoting' = lift quoting+ lift (ParserOptions (Just hs) sep quoting) = [|ParserOptions (Just $hs') $sep' $quoting'|]+ where+ sep' = [|T.pack $(stringE $ T.unpack sep)|]+ hs' = [|map T.pack $(listE $ map (stringE . T.unpack) hs)|]+ quoting' = lift quoting+#if MIN_VERSION_template_haskell(2,16,0)+#if MIN_VERSION_template_haskell(2,17,0)+ liftTyped = liftCode . unsafeTExpCoerce . lift+#else+ liftTyped = unsafeTExpCoerce . lift+#endif+#endif -- | Default 'ParseOptions' get column names from a header line, and -- use commas to separate columns.@@ -82,49 +102,51 @@ -- | Helper to split a 'T.Text' on commas and strip leading and -- trailing whitespace from each resulting chunk. tokenizeRow :: ParserOptions -> T.Text -> [T.Text]-tokenizeRow options =- handleQuoting . T.splitOn sep- where sep = columnSeparator options- quoting = quotingMode options- handleQuoting = case quoting of- NoQuoting -> id- RFC4180Quoting quote -> reassembleRFC4180QuotedParts sep quote+tokenizeRow options = handleQuoting . T.splitOn sep+ where+ sep = columnSeparator options+ quoting = quotingMode options+ handleQuoting = case quoting of+ NoQuoting -> id+ RFC4180Quoting quote -> reassembleRFC4180QuotedParts sep quote -- | Post processing applied to a list of tokens split by the--- separator which should have quoted sections reassembeld+-- separator which should have quoted sections reassembled reassembleRFC4180QuotedParts :: Separator -> QuoteChar -> [T.Text] -> [T.Text] reassembleRFC4180QuotedParts sep quoteChar = go- where go [] = []- go (part:parts)- | T.null part = T.empty : go parts- | prefixQuoted part =+ where+ go [] = []+ go (part : parts)+ | T.null part = T.empty : go parts+ | prefixQuoted part = if suffixQuoted part- then unescape (T.drop 1 . T.dropEnd 1 $ part) : go parts- else case break suffixQuoted parts of- (h,[]) -> [unescape (T.intercalate sep (T.drop 1 part : h))]- (h,t:ts) -> unescape- (T.intercalate- sep- (T.drop 1 part : h ++ [T.dropEnd 1 t]))- : go ts- | otherwise = T.strip part : go parts-- prefixQuoted t =- T.head t == quoteChar-- &&- -- T.length (T.takeWhile (== quoteChar) t) `rem` 2 == 1-- suffixQuoted t =- quoteText `T.isSuffixOf` t-- &&- -- T.length (T.takeWhileEnd (== quoteChar) t) `rem` 2 == 1+ then unescape (T.drop 1 . T.dropEnd 1 $ part) : go parts+ else case break suffixQuoted parts of+ (h, []) -> [unescape (T.intercalate sep (T.drop 1 part : h))]+ (h, t : ts) ->+ unescape+ ( T.intercalate+ sep+ (T.drop 1 part : h ++ [T.dropEnd 1 t])+ )+ : go ts+ | otherwise = T.strip part : go parts - quoteText = T.singleton quoteChar+ prefixQuoted t =+ T.head t == quoteChar -- &&+ -- T.length (T.takeWhile (== quoteChar) t) `rem` 2 == 1+ suffixQuoted t =+ quoteText `T.isSuffixOf` t -- &&+ -- T.length (T.takeWhileEnd (== quoteChar) t) `rem` 2 == 1+ quoteText = T.singleton quoteChar - unescape :: T.Text -> T.Text- unescape = T.replace q2 quoteText- where q2 = quoteText <> quoteText+ unescape :: T.Text -> T.Text+ unescape = T.replace q2 quoteText+ where+ q2 = quoteText <> quoteText ---tokenizeRow :: Separator -> T.Text -> [T.Text]---tokenizeRow sep = map (unquote . T.strip) . T.splitOn sep+-- tokenizeRow :: Separator -> T.Text -> [T.Text]+-- tokenizeRow sep = map (unquote . T.strip) . T.splitOn sep -- where unquote txt -- | quoted txt = case T.dropEnd 1 (T.drop 1 txt) of -- txt' | T.null txt' -> "Col"@@ -139,127 +161,181 @@ -- | Infer column types from a prefix (up to 1000 lines) of a CSV -- file.-prefixInference :: (ColumnTypeable a, Monoid a, Monad m)- => ParserOptions- -> P.Parser T.Text m [a]-prefixInference opts = P.draw >>= \case- Nothing -> return []- Just row1 -> P.foldAll (\ts -> zipWith (<>) ts . inferCols)- (inferCols row1)- id- where inferCols = map inferType . tokenizeRow opts+prefixInference ::+ (ColumnTypeable a, Semigroup a, Monad m, Show a) =>+ P.Parser [T.Text] m [a]+prefixInference =+ P.draw >>= \case+ Nothing -> return []+ Just row1 ->+ P.foldAll+ (\ts -> zipWith (<>) ts . inferCols)+ (inferCols row1)+ id+ where+ inferCols = map inferType -- | Extract column names and inferred types from a CSV file.-readColHeaders :: (ColumnTypeable a, Monoid a, Monad m)- => ParserOptions -> P.Producer T.Text m () -> m [(T.Text, a)]+readColHeaders ::+ (ColumnTypeable a, Semigroup a, Monad m, Show a) =>+ ParserOptions+ -> P.Producer [T.Text] m ()+ -> m [(T.Text, a)] readColHeaders opts = P.evalStateT $- do headerRow <- maybe ((tokenizeRow opts- . fromMaybe (error "Empty Producer has no header row")) <$> P.draw)- pure- (headerOverride opts)- colTypes <- prefixInference opts- return (zip headerRow colTypes)+ do+ headerRow <-+ maybe+ (fromMaybe err <$> P.draw)+ pure+ (headerOverride opts)+ colTypes <- prefixInference+ unless (length headerRow == length colTypes) (error errNumColumns)+ return (zip headerRow colTypes)+ where+ err = error "Empty Producer has no header row"+ errNumColumns =+ unlines+ [ ""+ , "Error parsing CSV: "+ , " Number of columns in header differs from number of columns"+ , " found in the remaining file. This may be due to newlines"+ , " being present within the data itself (not just separating"+ , " rows). If support for embedded newlines is required, "+ , " consider using the Frames-dsv package in conjunction with"+ , " Frames to make use of a different CSV parser."+ ] -- * Loading CSV Data -- | 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 (Either T.Text :. ElField) rs+ readRec :: [T.Text] -> Rec (Either T.Text :. ElField) rs instance ReadRec '[] where- readRec _ = RNil+ readRec _ = RNil instance (Parseable t, ReadRec ts, KnownSymbol s) => ReadRec (s :-> t ': ts) where- readRec [] = Compose (Left mempty) :& readRec []- readRec (h:t) = maybe (Compose (Left (T.copy h)))- (Compose . Right . Field)- (parse' h) :& readRec t+ readRec [] = Compose (Left mempty) :& readRec []+ readRec (h : t) =+ maybe+ (Compose (Left (T.copy h)))+ (Compose . Right . Field)+ (parse' h)+ :& readRec t -- | Opens a file (in 'P.MonadSafe') and repeatedly applies the given -- function to the 'Handle' to obtain lines to yield. Adapted from the -- moribund pipes-text package.-pipeLines :: P.MonadSafe m- => (Handle -> IO (Either IOException T.Text))- -> FilePath- -> P.Producer T.Text m ()+pipeLines ::+ (P.MonadSafe m) =>+ (Handle -> IO (Either IOException T.Text))+ -> FilePath+ -> P.Producer T.Text m () pipeLines pgetLine fp = Safe.withFile fp ReadMode $ \h ->- let loop = do txt <- P.liftIO (pgetLine h)- case txt of- Left _e -> return ()- Right y -> P.yield y >> loop- in loop+ let loop = do+ txt <- P.liftIO (pgetLine h)+ case txt of+ Left _e -> return ()+ Right y -> P.yield y >> loop+ in loop -- | Produce lines of 'T.Text'.-produceTextLines :: P.MonadSafe m => FilePath -> P.Producer T.Text m ()+produceTextLines :: (P.MonadSafe m) => FilePath -> P.Producer T.Text m () produceTextLines = pipeLines (try . T.hGetLine) +-- | Produce lines of tokens that were separated by the given+-- separator.+produceTokens ::+ (P.MonadSafe m) =>+ FilePath+ -> Separator+ -> P.Producer [T.Text] m ()+produceTokens fp sep = produceTextLines fp >-> P.map tokenize+ where+ tokenize = tokenizeRow popts+ popts = defaultParser{columnSeparator = sep}+ -- | Consume lines of 'T.Text', writing them to a file.-consumeTextLines :: P.MonadSafe m => FilePath -> P.Consumer T.Text m r+consumeTextLines :: (P.MonadSafe m) => FilePath -> P.Consumer T.Text m r consumeTextLines fp = Safe.withFile fp WriteMode $ \h ->- let loop = P.await >>= P.liftIO . T.hPutStrLn h >> loop- in loop+ let loop = P.await >>= P.liftIO . T.hPutStrLn h >> loop+ in loop -- | Produce the lines of a latin1 (or ISO8859 Part 1) encoded file as -- ’T.Text’ values.-readFileLatin1Ln :: P.MonadSafe m => FilePath -> P.Producer T.Text m ()-readFileLatin1Ln = pipeLines (try . fmap T.decodeLatin1 . B8.hGetLine)+readFileLatin1Ln :: (P.MonadSafe m) => FilePath -> P.Producer [T.Text] m ()+readFileLatin1Ln fp =+ pipeLines (try . fmap T.decodeLatin1 . B8.hGetLine) fp+ >-> P.map (tokenizeRow defaultParser) -- | Read a 'RecF' from one line of CSV.-readRow :: ReadRec rs- => ParserOptions -> T.Text -> Rec (Either T.Text :. ElField) rs+readRow ::+ (ReadRec rs) =>+ ParserOptions+ -> T.Text+ -> Rec (Either T.Text :. ElField) rs readRow = (readRec .) . tokenizeRow -- | Produce rows where any given entry can fail to parse.-readTableMaybeOpt :: (P.MonadSafe m, ReadRec rs, RMap rs)- => ParserOptions- -> FilePath- -> P.Producer (Rec (Maybe :. ElField) rs) m ()+readTableMaybeOpt ::+ (P.MonadSafe m, ReadRec rs, RMap rs) =>+ ParserOptions+ -> FilePath+ -> P.Producer (Rec (Maybe :. ElField) rs) m () readTableMaybeOpt opts csvFile =- produceTextLines csvFile >-> pipeTableMaybeOpt opts-{-# INLINE readTableMaybeOpt #-}+ produceTokens csvFile (columnSeparator opts) >-> pipeTableMaybeOpt opts -- | Stream lines of CSV data into rows of ’Rec’ values values where -- any given entry can fail to parse.-pipeTableMaybeOpt :: (Monad m, ReadRec rs, RMap rs)- => ParserOptions- -> P.Pipe T.Text (Rec (Maybe :. ElField) rs) m ()+pipeTableMaybeOpt ::+ (Monad m, ReadRec rs, RMap rs) =>+ ParserOptions+ -> P.Pipe [T.Text] (Rec (Maybe :. ElField) rs) m () pipeTableMaybeOpt opts = do- when (isNothing (headerOverride opts)) (() <$ P.await)- P.map (rmap (either (const (Compose Nothing)) (Compose . Just) . getCompose) . readRow opts)-{-# INLINE pipeTableMaybeOpt #-}+ when (isNothing (headerOverride opts)) (() <$ P.await)+ P.map+ ( rmap+ ( either+ (const (Compose Nothing))+ (Compose . Just)+ . getCompose+ )+ . readRec+ ) -- | 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 :. ElField) rs) m ()+pipeTableEitherOpt ::+ (Monad m, ReadRec rs) =>+ ParserOptions+ -> P.Pipe T.Text (Rec (Either T.Text :. ElField) rs) m () pipeTableEitherOpt opts = do- when (isNothing (headerOverride opts)) (() <$ P.await)- P.map (readRow opts)-{-# INLINE pipeTableEitherOpt #-}+ when (isNothing (headerOverride opts)) (() <$ P.await)+ P.map (readRow opts) -- | Produce rows where any given entry can fail to parse.-readTableMaybe :: (P.MonadSafe m, ReadRec rs, RMap rs)- => FilePath -> P.Producer (Rec (Maybe :. ElField) rs) m ()+readTableMaybe ::+ (P.MonadSafe m, ReadRec rs, RMap rs) =>+ FilePath+ -> P.Producer (Rec (Maybe :. ElField) rs) m () readTableMaybe = readTableMaybeOpt defaultParser-{-# INLINE readTableMaybe #-} -- | Stream lines of CSV data into rows of ’Rec’ values where any -- given entry can fail to parse.-pipeTableMaybe :: (Monad m, ReadRec rs, RMap rs)- => P.Pipe T.Text (Rec (Maybe :. ElField) rs) m ()+pipeTableMaybe ::+ (Monad m, ReadRec rs, RMap rs) =>+ P.Pipe [T.Text] (Rec (Maybe :. ElField) rs) m () 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 :. ElField) rs) m ()+pipeTableEither ::+ (Monad m, ReadRec rs) =>+ P.Pipe T.Text (Rec (Either T.Text :. ElField) 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'.@@ -276,82 +352,179 @@ -- False -> let r = recMaybe . readRow opts <$> T.hGetLine h -- in liftIO r >>= maybe go (flip mplus go . return) -- go--- {-# INLINE readTableOpt' #-} -- -- | Returns a `MonadPlus` producer of rows for which each column was -- -- successfully parsed. This is typically slower than 'readTable'. -- readTable' :: forall m rs. (P.MonadSafe m, ReadRec rs) -- => FilePath -> m (Record rs) -- readTable' = readTableOpt' defaultParser--- {-# INLINE readTable' #-} -- | Returns a producer of rows for which each column was successfully -- parsed.-readTableOpt :: (P.MonadSafe m, ReadRec rs, RMap rs)- => ParserOptions -> FilePath -> P.Producer (Record rs) m ()+readTableOpt ::+ (P.MonadSafe m, ReadRec rs, RMap rs) =>+ ParserOptions+ -> FilePath+ -> P.Producer (Record rs) m () readTableOpt opts csvFile = readTableMaybeOpt opts csvFile P.>-> go- where go = P.await >>= maybe go (\x -> P.yield x >> go) . recMaybe-{-# INLINE readTableOpt #-}+ where+ go = P.await >>= maybe go (\x -> P.yield x >> go) . recMaybe -- | Pipe lines of CSV text into rows for which each column was -- successfully parsed.-pipeTableOpt :: (ReadRec rs, RMap rs, Monad m)- => ParserOptions -> P.Pipe T.Text (Record rs) m ()+pipeTableOpt ::+ (ReadRec rs, RMap rs, Monad m) =>+ ParserOptions+ -> P.Pipe [T.Text] (Record rs) m () pipeTableOpt opts = pipeTableMaybeOpt opts >-> P.map recMaybe >-> P.concat-{-# INLINE pipeTableOpt #-} -- | Returns a producer of rows for which each column was successfully -- parsed.-readTable :: (P.MonadSafe m, ReadRec rs, RMap rs)- => FilePath -> P.Producer (Record rs) m ()+readTable ::+ (P.MonadSafe m, ReadRec rs, RMap rs) =>+ FilePath+ -> P.Producer (Record rs) m () readTable = readTableOpt defaultParser-{-# INLINE readTable #-} +readRecEither ::+ (ReadRec rs, RMap rs) =>+ [T.Text]+ -> Either (Rec (Either T.Text :. ElField) rs) (Record rs)+readRecEither tokens =+ let tmp = readRec tokens+ in case rtraverse getCompose tmp of+ Right r -> Right r+ _ -> Left tmp++-- | Similar to 'readTable' except that rows that fail to parse are+-- printed to @stderr@ with columns that failed to parse printed as+-- @"Left rawtext"@ while those that were successfully parsed are+-- shown as @"Right text"@.+readTableDebug ::+ forall m rs.+ ( P.MonadSafe m+ , ReadRec rs+ , RMap rs+ , RecMapMethod ShowCSV (Either T.Text :. ElField) rs+ , RecordToList rs+ ) =>+ FilePath+ -> P.Producer (Record rs) m ()+readTableDebug csvFile =+ produceTokens csvFile (columnSeparator opts) >-> go >-> debugAll+ where+ opts = defaultParser+ go = do+ when (isNothing (headerOverride opts)) (() <$ P.await)+ P.map readRecEither+ debugAll = do+ P.await >>= either (P.liftIO . hPrint stderr . debugOne) P.yield+ debugAll+ debugOne = recordToList . rmapMethod @ShowCSV (aux . getCompose)+ aux ::+ (ShowCSV (PayloadType ElField a)) =>+ Either T.Text (ElField a)+ -> Const T.Text a+ aux (Right (Field x)) = Const ("Right " <> showCSV x)+ aux (Left txt) = Const ("Left " <> txt)+ -- | Pipe lines of CSV text into rows for which each column was -- successfully parsed.-pipeTable :: (ReadRec rs, RMap rs, Monad m)- => P.Pipe T.Text (Record rs) m ()+pipeTable ::+ (ReadRec rs, RMap rs, Monad m) =>+ P.Pipe [T.Text] (Record rs) m () pipeTable = pipeTableOpt defaultParser-{-# INLINE pipeTable #-} -- * Writing CSV Data -showFieldsCSV :: (RecMapMethod ShowCSV ElField ts, RecordToList ts)- => Record ts -> [T.Text]+showFieldsCSV ::+ (RecMapMethod ShowCSV ElField ts, RecordToList ts) =>+ Record ts+ -> [T.Text] showFieldsCSV = recordToList . rmapMethod @ShowCSV aux- where aux :: (ShowCSV (PayloadType ElField a))- => ElField a -> Const T.Text a- aux (Field x) = Const (showCSV x)+ where+ aux ::+ (ShowCSV (PayloadType ElField a)) =>+ ElField a+ -> Const T.Text a+ aux (Field x) = Const (showCSV x) -- | 'P.yield' a header row with column names followed by a line of -- 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, Foldable f, Monad m, RecordToList ts,- RecMapMethod ShowCSV ElField ts)- => f (Record ts) -> P.Producer String m ()-produceCSV recs = do- P.yield (intercalate "," (columnHeaders (Proxy :: Proxy (Record ts))))- F.mapM_ (P.yield . T.unpack . T.intercalate "," . showFieldsCSV) recs+produceCSV ::+ forall f ts m.+ ( ColumnHeaders ts+ , Foldable f+ , Monad m+ , RecordToList ts+ , RecMapMethod ShowCSV ElField ts+ ) =>+ f (Record ts)+ -> P.Producer String m ()+produceCSV = produceDSV defaultParser +produceDSV ::+ forall f ts m.+ ( ColumnHeaders ts+ , Foldable f+ , Monad m+ , RecordToList ts+ , RecMapMethod ShowCSV ElField ts+ ) =>+ ParserOptions+ -> f (Record ts)+ -> P.Producer String m ()+produceDSV opts recs = do+ P.yield (intercalate (T.unpack separator) (columnHeaders (Proxy :: Proxy (Record ts))))+ F.mapM_ (P.yield . T.unpack . T.intercalate separator . showFieldsCSV) recs+ where+ separator = columnSeparator opts+ -- | '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+-- is the same as 'produceCSV', but adapted for cases where you have -- streaming input that you wish to use to produce streaming output.-pipeToCSV :: forall ts m.- (Monad m, ColumnHeaders ts, RecordToList ts,- RecMapMethod Show ElField ts)- => P.Pipe (Record ts) T.Text m ()+pipeToCSV ::+ forall ts m.+ ( Monad m+ , ColumnHeaders ts+ , RecordToList ts+ , RecMapMethod ShowCSV ElField ts+ ) =>+ 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)+ where+ header = columnHeaders (Proxy :: Proxy (Record ts))+ go :: P.Pipe (Record ts) T.Text m ()+ go = P.map (T.intercalate "," . showFieldsCSV) -- | Write a header row with column names followed by a line of text -- for each 'Record' to the given file.-writeCSV :: (ColumnHeaders ts, Foldable f, RecordToList ts,- RecMapMethod ShowCSV ElField ts)- => FilePath -> f (Record ts) -> IO ()-writeCSV fp recs = P.runSafeT . P.runEffect $- produceCSV recs >-> P.map T.pack >-> consumeTextLines fp+writeCSV ::+ ( ColumnHeaders ts+ , Foldable f+ , RecordToList ts+ , RecMapMethod ShowCSV ElField ts+ ) =>+ FilePath+ -> f (Record ts)+ -> IO ()+writeCSV = writeDSV defaultParser++-- | Write a header row with column names followed by a line of text+-- for each 'Record' to the given file.+writeDSV ::+ ( ColumnHeaders ts+ , Foldable f+ , RecordToList ts+ , RecMapMethod ShowCSV ElField ts+ ) =>+ ParserOptions+ -> FilePath+ -> f (Record ts)+ -> IO ()+writeDSV opts fp recs =+ P.runSafeT . P.runEffect $+ produceDSV opts recs >-> P.map T.pack >-> consumeTextLines fp
src/Frames/Categorical.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds, KindSignatures, MagicHash,+{-# LANGUAGE CPP, DataKinds, KindSignatures, MagicHash, ScopedTypeVariables, TemplateHaskell, TypeFamilies, ViewPatterns #-} -- | Support for representing so-called categorical variables: a@@ -24,6 +24,7 @@ import Frames.ColumnTypeable import Frames.InCore (VectorFor) import Frames.ShowCSV+import Frames.Utils import GHC.Exts (Proxy#, proxy#) import GHC.TypeNats import Language.Haskell.TH@@ -67,15 +68,19 @@ ([ dataDecl, iIsString, iReadable, iParseable , iShowCSV, iVectorFor, iNFData ] ++) <$> unboxDecls name (length variants)- where variantCons = map (mkName . maybe id (++) prefix . cap) variants+ where variantCons = map (mkName . T.unpack . sanitizeTypeName . T.pack . maybe id (++) prefix . cap) variants onVariants :: (String -> Name -> a) -> [a] onVariants f = getZipList (f <$> ZipList variants <*> ZipList variantCons)- nameName = mkName name+ nameName = mkName . T.unpack . sanitizeTypeName . T.pack $ name fromStringClause variant variantCon = Clause [LitP (StringL variant)] (NormalB (ConE variantCon)) [] showCSVClause variant variantCon =+#if MIN_VERSION_template_haskell(2,18,0)+ Clause [ConP variantCon [] []]+#else Clause [ConP variantCon []]+#endif (NormalB (AppE (VarE 'T.pack) (LitE (StringL variant)))) [] readableGuarded :: Name -> String -> Name -> (Guard, Exp)@@ -108,7 +113,11 @@ InstanceD Nothing [] (AppT (ConT ''ShowCSV) (ConT nameName)) [FunD 'showCSV (onVariants showCSVClause)] iVectorFor =+#if __GLASGOW_HASKELL__ >= 808+ TySynInstD (TySynEqn Nothing (AppT (ConT ''VectorFor) (ConT nameName)) (ConT ''VU.Vector))+#else TySynInstD ''VectorFor (TySynEqn [ConT nameName] (ConT ''VU.Vector))+#endif iNFData = let argName = mkName "x" in InstanceD Nothing [] (AppT (ConT ''NFData) (ConT nameName))
src/Frames/ColumnTypeable.hs view
@@ -1,11 +1,11 @@-{-# LANGUAGE BangPatterns, DefaultSignatures, LambdaCase,- ScopedTypeVariables #-}+{-# LANGUAGE DefaultSignatures, ScopedTypeVariables #-} module Frames.ColumnTypeable where import Control.Monad (MonadPlus) import Data.Maybe (fromMaybe) import Data.Readable (Readable(fromText)) import Data.Typeable (Proxy(..), typeRep, Typeable) import qualified Data.Text as T+import Data.Int (Int32, Int64) import Data.Vinyl.Functor (Const(..)) import Language.Haskell.TH @@ -58,10 +58,21 @@ parse' :: (MonadPlus m, Parseable a) => T.Text -> m a parse' = fmap discardConfidence . parse +parseIntish :: (Readable a, MonadPlus f) => T.Text -> f (Parsed a)+parseIntish t =+ Definitely <$> fromText (fromMaybe t (T.stripSuffix (T.pack ".0") t))+ instance Parseable Bool where+ instance Parseable Int where- parse t = Definitely <$>- fromText (fromMaybe t (T.stripSuffix (T.pack ".0") t))+ parse = parseIntish+instance Parseable Int32 where+ parse = parseIntish+instance Parseable Int64 where+ parse = parseIntish+instance Parseable Integer where+ parse = parseIntish+ instance Parseable Float where instance Parseable Double where -- Some CSV's export Doubles in a format like '1,000.00', filtering
src/Frames/ColumnUniverse.hs view
@@ -1,164 +1,232 @@-{-# LANGUAGE BangPatterns, CPP, ConstraintKinds, DataKinds,- FlexibleContexts, FlexibleInstances, GADTs, InstanceSigs,- KindSignatures, LambdaCase, MultiParamTypeClasses,- OverloadedStrings, QuasiQuotes, RankNTypes,- ScopedTypeVariables, TemplateHaskell, TypeApplications,- TypeFamilies, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+ module Frames.ColumnUniverse (- CoRec, Columns, ColumnUniverse, ColInfo,- CommonColumns, CommonColumnsCat, parsedTypeRep+ CoRec,+ Columns,+ ColumnUniverse,+ ColInfo,+ CommonColumns,+ CommonColumnsCat,+ parsedTypeRep, ) where+ import Data.Maybe (fromMaybe)+#if __GLASGOW_HASKELL__ < 808 import Data.Semigroup (Semigroup((<>)))+#endif+import Data.Either (fromRight) import qualified Data.Text as T import Data.Vinyl import Data.Vinyl.CoRec import Data.Vinyl.Functor-import Data.Vinyl.TypeLevel (RIndex, NatToInt)-import Frames.ColumnTypeable+import Data.Vinyl.TypeLevel (NatToInt, RIndex) import Frames.Categorical+import Frames.ColumnTypeable import Language.Haskell.TH -- | Extract a function to test whether some value of a given type -- could be read from some 'T.Text'.-inferParseable :: Parseable a => T.Text -> (Maybe :. Parsed) a+inferParseable :: (Parseable a) => T.Text -> (Maybe :. Parsed) a inferParseable = Compose . parse -- | Helper to call 'inferParseable' on variants of a 'CoRec'.-inferParseable' :: Parseable a => (((->) T.Text) :. (Maybe :. Parsed)) a+inferParseable' :: (Parseable a) => ((->) T.Text :. (Maybe :. Parsed)) a inferParseable' = Compose inferParseable -- * Record Helpers -tryParseAll :: forall ts. (RecApplicative ts, RPureConstrained Parseable ts)- => T.Text -> Rec (Maybe :. Parsed) ts+tryParseAll ::+ forall ts.+ (RecApplicative ts, RPureConstrained Parseable ts) =>+ T.Text+ -> Rec (Maybe :. Parsed) ts tryParseAll = rtraverse getCompose funs- where funs :: Rec (((->) T.Text) :. (Maybe :. Parsed)) ts- funs = rpureConstrained @Parseable inferParseable'+ where+ funs :: Rec (((->) T.Text) :. (Maybe :. Parsed)) ts+ funs = rpureConstrained @Parseable inferParseable' -- * Column Type Inference -- | Information necessary for synthesizing row types and comparing -- types. newtype ColInfo a = ColInfo (Either (String -> Q [Dec]) Type, Parsed a)-instance Show a => Show (ColInfo a) where- show (ColInfo (t,p)) = "(ColInfo {"- ++ either (const "cat") show t- ++ ", "- ++ show (discardConfidence p) ++"})" -parsedToColInfo :: Parseable a => Parsed a -> ColInfo a+instance (Show a) => Show (ColInfo a) where+ show (ColInfo (t, p)) =+ "(ColInfo {"+ ++ either (const "cat") show t+ ++ ", "+ ++ show (discardConfidence p)+ ++ "})"++parsedToColInfo :: (Parseable a) => Parsed a -> ColInfo a parsedToColInfo x = case getConst rep of- Left dec -> ColInfo (Left dec, x)- Right ty ->- ColInfo (Right ty, x)- where rep = representableAsType x+ Left dec -> ColInfo (Left dec, x)+ Right ty ->+ ColInfo (Right ty, x)+ where+ rep = representableAsType x parsedTypeRep :: ColInfo a -> Parsed Type-parsedTypeRep (ColInfo (t,p)) =- const (either (const (ConT (mkName "Categorical"))) id t) <$> p+parsedTypeRep (ColInfo (t, p)) =+ fromRight (ConT (mkName "Categorical")) t <$ p -- | Map 'Type's we know about (with a special treatment of -- synthesized types for categorical variables) to 'Int's for ordering -- purposes. orderParsePriorities :: Parsed (Maybe Type) -> Maybe Int orderParsePriorities x =- case discardConfidence x of- Nothing -> Just 1 -- categorical variable- Just t- | t == tyText -> Just (0 + uncertainty)- | t == tyDbl -> Just (2 + uncertainty)- | t == tyInt -> Just (3 + uncertainty)- | t == tyBool -> Just (4 + uncertainty)- | otherwise -> Nothing- where tyText = ConT (mkName "Text")- tyDbl = ConT (mkName "Double")- tyInt = ConT (mkName "Int")- tyBool = ConT (mkName "Bool")- uncertainty = case x of Definitely _ -> 0; Possibly _ -> 5+ case discardConfidence x of+ Nothing -> Just (1 + 6) -- categorical variable+ Just t+ | t == tyText -> Just (0 + uncertainty)+ | t == tyDbl -> Just (2 + uncertainty)+ | t == tyInt -> Just (3 + uncertainty)+ | t == tyBool -> Just (4 + uncertainty)+ | otherwise -> Just (5 + uncertainty) -- Unknown type+ where+ tyText = ConT (mkName "Text")+ tyDbl = ConT (mkName "Double")+ tyInt = ConT (mkName "Int")+ tyBool = ConT (mkName "Bool")+ uncertainty = case x of Definitely _ -> 0; Possibly _ -> 6 -- | We use a join semi-lattice on types for representations. The--- bottom of the lattice is effectively an error (we have nothing to--- represent), @Bool < Int@, @Int < Double@, and @forall n. n <= Text@.+-- bottom of the lattice is effectively an error (we have nothing to+-- represent), @Bool < Int@, @Int < Double@, and @forall n. n <= Text@. ----- The high-level goal here is that we will pick the "greater" of two--- choices in 'bestRep'. A 'Definitely' parse result is preferred over--- a 'Possibly' parse result. If we have two distinct 'Possibly' parse--- results, we give up. If we have two distinct 'Definitely' parse--- results, we are in dangerous waters: all data is parseable at--- /both/ types, so which do we default to? The defaulting choices--- made here are described in the previous paragraph. If there is no--- defaulting rule, we give up (i.e. use 'T.Text' as a--- representation).+-- The high-level goal here is that we will pick the "greater" of two+-- choices in 'bestRep'. A 'Definitely' parse result is preferred over+-- a 'Possibly' parse result. If we have two distinct 'Possibly' parse+-- results, we give up. If we have two distinct 'Definitely' parse+-- results, we are in dangerous waters: all data is parseable at+-- /both/ types, so which do we default to? The defaulting choices+-- made here are described in the previous paragraph. If there is no+-- defaulting rule, we give up (i.e. use 'T.Text' as a+-- representation). lubTypes :: Parsed (Maybe Type) -> Parsed (Maybe Type) -> Maybe Ordering lubTypes x y = compare <$> orderParsePriorities y <*> orderParsePriorities x -instance (T.Text ∈ ts, RPureConstrained Parseable ts) => Monoid (CoRec ColInfo ts) where- mempty = CoRec (ColInfo ( Right (ConT (mkName "Text")), Possibly T.empty))- mappend x y = x <> y+-- instance (T.Text ∈ ts, RPureConstrained Parseable ts) => Monoid (CoRec ColInfo ts) where+-- mempty = CoRec (ColInfo (Right (ConT (mkName "Text")), Possibly T.empty)) -- | A helper For the 'Semigroup' instance below.-mergeEqTypeParses :: forall ts. (RPureConstrained Parseable ts, T.Text ∈ ts)- => CoRec ColInfo ts -> CoRec ColInfo ts -> CoRec ColInfo ts-mergeEqTypeParses x@(CoRec _) y = fromMaybe definitelyText- $ coRecTraverse getCompose- (coRecMapC @Parseable aux x)- where definitelyText = CoRec (ColInfo (Right (ConT (mkName "Text")), Definitely T.empty))- aux :: forall a. (Parseable a, NatToInt (RIndex a ts))- => ColInfo a -> (Maybe :. ColInfo) a- aux (ColInfo (_, pX)) =- case asA' @a y of+mergeEqTypeParses ::+ forall ts.+ (RPureConstrained Parseable ts, T.Text ∈ ts) =>+ CoRec ColInfo ts+ -> CoRec ColInfo ts+ -> CoRec ColInfo ts+mergeEqTypeParses x@(CoRec _) y =+ fromMaybe definitelyText $+ coRecTraverse+ getCompose+ (coRecMapC @Parseable aux x)+ where+ definitelyText = CoRec (ColInfo (Right (ConT (mkName "Text")), Definitely T.empty))+ aux ::+ forall a.+ (Parseable a, NatToInt (RIndex a ts)) =>+ ColInfo a+ -> (Maybe :. ColInfo) a+ aux (ColInfo (_, pX)) =+ case asA' @a y of Nothing -> Compose Nothing Just (ColInfo (_, pY)) ->- maybe (Compose Nothing)+ maybe+ (Compose Nothing) (Compose . Just . parsedToColInfo) (parseCombine pX pY) -instance (T.Text ∈ ts, RPureConstrained Parseable ts)- => Semigroup (CoRec ColInfo ts) where- x@(CoRec (ColInfo (tyX, pX))) <> y@(CoRec (ColInfo (tyY, pY))) =- case lubTypes (const (either (const Nothing) Just tyX) <$> pX)- (const (either (const Nothing) Just tyY) <$> pY) of- Just GT -> x- Just LT -> y- Just EQ -> mergeEqTypeParses x y- Nothing -> mempty+instance+ (T.Text ∈ ts, RPureConstrained Parseable ts) =>+ Semigroup (CoRec ColInfo ts)+ where+ (<>) :: (T.Text ∈ ts, RPureConstrained Parseable ts) => CoRec ColInfo ts -> CoRec ColInfo ts -> CoRec ColInfo ts+ x@(CoRec (ColInfo (tyX, pX))) <> y@(CoRec (ColInfo (tyY, pY))) =+ case lubTypes+ (either (const Nothing) Just tyX <$ pX)+ (either (const Nothing) Just tyY <$ pY) of+ Just GT -> x+ Just LT -> y+ Just EQ -> mergeEqTypeParses x y+ Nothing -> undefined -- mempty -- | Find the best (i.e. smallest) 'CoRec' variant to represent a--- parsed value. For inspection in GHCi after loading this module,--- consider this example:+-- parsed value. For inspection in GHCi after loading this module,+-- consider this example: ----- >>> :set -XTypeApplications--- >>> :set -XOverloadedStrings--- >>> import Data.Vinyl.CoRec (foldCoRec)--- >>> foldCoRec parsedTypeRep (bestRep @CommonColumns "2.3")--- Definitely Double-bestRep :: forall ts.- (RPureConstrained Parseable ts,- FoldRec ts ts,- RecApplicative ts, T.Text ∈ ts)- => T.Text -> CoRec ColInfo ts+-- >>> :set -XTypeApplications+-- >>> :set -XOverloadedStrings+-- >>> import Data.Vinyl.CoRec (foldCoRec)+-- >>> foldCoRec parsedTypeRep (bestRep @CommonColumns "2.3")+-- Definitely Double+bestRep ::+ forall ts.+ ( RPureConstrained Parseable ts+ , RPureConstrained (ShowF ColInfo) ts+ , FoldRec ts ts+ , RecApplicative ts+ , T.Text ∈ ts+ ) =>+ T.Text+ -> CoRec ColInfo ts bestRep t- | T.null t || t == "NA" = (CoRec (parsedToColInfo (Possibly T.empty)))- | otherwise = coRecMapC @Parseable parsedToColInfo- . fromMaybe (CoRec (Possibly T.empty :: Parsed T.Text))- . firstField- . (tryParseAll :: T.Text -> Rec (Maybe :. Parsed) ts)- $ t-{-# INLINABLE bestRep #-}+ -- \| trace (show (aux t)) False = undefined+ | T.null t || t == "NA" = CoRec (parsedToColInfo (Possibly T.empty))+ | otherwise =+ coRecMapC @Parseable parsedToColInfo+ . fromMaybe (CoRec (Possibly T.empty :: Parsed T.Text))+ . firstField+ . (tryParseAll :: T.Text -> Rec (Maybe :. Parsed) ts)+ $ t+-- where+-- aux =+-- coRecMapC @Parseable parsedToColInfo+-- . fromMaybe (CoRec (Possibly T.empty :: Parsed T.Text))+-- . firstField+-- . (tryParseAll :: T.Text -> Rec (Maybe :. Parsed) ts)+{-# INLINEABLE bestRep #-} -instance (RPureConstrained Parseable ts, FoldRec ts ts,- RecApplicative ts, T.Text ∈ ts) =>- ColumnTypeable (CoRec ColInfo ts) where- colType (CoRec (ColInfo (t, _))) = t- {-# INLINE colType #-}- inferType = bestRep- {-# INLINABLE inferType #-}+instance+ ( RPureConstrained Parseable ts+ , FoldRec ts ts+ , RPureConstrained (ShowF ColInfo) ts+ , RecApplicative ts+ , T.Text ∈ ts+ ) =>+ ColumnTypeable (CoRec ColInfo ts)+ where+ colType (CoRec (ColInfo (t, _))) = t+ {-# INLINE colType #-}+ inferType = bestRep+ {-# INLINEABLE inferType #-} +#if !MIN_VERSION_vinyl(0,11,0) instance forall ts. (RPureConstrained Show ts, RecApplicative ts) => Show (CoRec ColInfo ts) where show x = "(Col " ++ onCoRec @Show show x ++")"+#endif -- * Common Columns @@ -172,7 +240,7 @@ type ColumnUniverse = CoRec ColInfo -- | A universe of common column variants. These are the default--- column types that @Frames@ can infer. See the--- <http://acowley.github.io/Frames/#sec-4 Tutorial> for an example of--- extending the default types with your own.+-- column types that @Frames@ can infer. See the+-- <http://acowley.github.io/Frames/#sec-4 Tutorial> for an example of+-- extending the default types with your own. type Columns = ColumnUniverse CommonColumns
src/Frames/Exploration.hs view
@@ -10,19 +10,26 @@ -- | Functions useful for interactively exploring and experimenting -- with a data set. module Frames.Exploration (pipePreview, select, lenses, recToList,- pr, pr1) where+ pr, pr1, showFrame, printFrame,+ takeRows, dropRows) where import Data.Char (isSpace, isUpper)+import qualified Data.Foldable as F+import Data.Kind (Type)+import Data.List (intercalate) import Data.Proxy import qualified Data.Vinyl as V import qualified Data.Vinyl.Class.Method as V import Data.Vinyl.Functor (ElField(Field), Const(..)) import Frames.Rec import GHC.TypeLits (Symbol)-import Language.Haskell.TH+import Language.Haskell.TH hiding (Type) import Language.Haskell.TH.Quote import Pipes hiding (Proxy)+import qualified Pipes as P import qualified Pipes.Prelude as P import Pipes.Safe (SafeT, runSafeT, MonadMask)+import Frames.Frame (Frame(Frame))+import Frames.RecF (columnHeaders, ColumnHeaders) -- * Preview Results @@ -86,11 +93,11 @@ -- * ToList -recToList :: forall a (rs :: [(Symbol,*)]).+recToList :: forall a (rs :: [(Symbol, Type)]). (V.RecMapMethod ((~) a) ElField rs, V.RecordToList rs) => Record rs -> [a] recToList = V.recordToList . V.rmapMethod @((~) a) aux- where aux :: a ~ (V.PayloadType ElField t) => V.ElField t -> Const a t+ where aux :: a ~ V.PayloadType ElField t => V.ElField t -> Const a t aux (Field x) = Const x -- * Helpers@@ -107,3 +114,34 @@ -- | Remove white space from both ends of a 'String'. strip :: String -> String strip = takeWhile (not . isSpace) . dropWhile isSpace++-- | @takeRows n frame@ produces a new 'Frame' made up of the first+-- @n@ rows of @frame@.+takeRows :: Int -> Frame (Record rs) -> Frame (Record rs)+takeRows n (Frame len rows) = Frame (min n len) rows++-- | @dropRows n frame@ produces a new 'Frame' just like @frame@, but+-- not including its first @n@ rows.+dropRows :: Int -> Frame (Record rs) -> Frame (Record rs)+dropRows n (Frame len rows) = Frame (max 0 (len - n)) (\i -> rows (i + n))++-- | Format a 'Frame' to a 'String'.+showFrame :: forall rs.+ (ColumnHeaders rs, V.RecMapMethod Show ElField rs, V.RecordToList rs)+ => String -- ^ Separator between fields+ -> Frame (Record rs) -- ^ The 'Frame' to be formatted to a 'String'+ -> String+showFrame sep frame =+ unlines (intercalate sep (columnHeaders (Proxy :: Proxy (Record rs))) : rows)+ where rows = P.toList (F.mapM_ (P.yield . intercalate sep . showFields) frame)++-- | Print a 'Frame' to 'System.IO.stdout'.+printFrame :: forall rs.+ (ColumnHeaders rs, V.RecMapMethod Show ElField rs, V.RecordToList rs)+ => String -- ^ Separator between fields+ -> Frame (Record rs) -- ^ The 'Frame' to be printed to @stdout@+ -> IO ()+printFrame sep frame = do+ putStrLn (intercalate sep (columnHeaders (Proxy :: Proxy (Record rs))))+ P.runEffect (rows >-> P.stdoutLn)+ where rows = F.mapM_ (P.yield . intercalate sep . showFields) frame
src/Frames/ExtraInstances.hs view
@@ -49,8 +49,11 @@ instance NFData1 VF.Identity where liftRnf r = r . getIdentity +#if MIN_VERSION_vinyl(0,13,1)+#else instance (NFData (f r), NFData (Rec f rs)) => NFData (Rec f (r ': rs)) where rnf (x :& xs) = rnf x `seq` rnf xs+#endif instance NFData (Rec f '[]) where rnf RNil = ()
src/Frames/Frame.hs view
@@ -29,14 +29,13 @@ instance Eq r => Eq (Frame r) where Frame l1 r1 == Frame l2 r2 =- l1 == l2 && and (map (\i -> r1 i == r2 i) [0 .. l1 - 1])+ l1 == l2 && all (\i -> r1 i == r2 i) [0 .. l1 - 1] -- | The 'Monoid' instance for 'Frame' provides a mechanism for -- vertical concatenation of 'Frame's. That is, @f1 <> f2@ will return -- a new 'Frame' with the rows of @f1@ followed by the rows of @f2@. instance Monoid (Frame r) where mempty = Frame 0 (const $ error "index out of bounds (empty frame)")- f1 `mappend` f2 = f1 <> f2 instance Semigroup (Frame r) where Frame l1 f1 <> Frame l2 f2 =
src/Frames/InCore.hs view
@@ -1,18 +1,12 @@-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE BangPatterns,- CPP,- DataKinds,- EmptyCase,- FlexibleInstances,- ScopedTypeVariables,- TupleSections,- TypeFamilies,- TypeOperators,- UndecidableInstances #-}+{-# LANGUAGE BangPatterns, CPP, DataKinds, EmptyCase,+ FlexibleContexts, FlexibleInstances, PolyKinds,+ ScopedTypeVariables, TupleSections, TypeFamilies,+ TypeOperators, UndecidableInstances #-} -- | Efficient in-memory (in-core) storage of tabular data. module Frames.InCore where import Control.Monad.Primitive import Control.Monad.ST (runST)+import Data.Kind (Type) import Data.Proxy import Data.Text (Text) import qualified Data.Vector as VB@@ -30,12 +24,12 @@ import GHC.Prim (RealWorld) #endif import GHC.TypeLits (KnownSymbol)-import GHC.Types (Symbol, Type)+import GHC.Types (Symbol) import qualified Pipes as P import qualified Pipes.Prelude as P -- | The most efficient vector type for each column data type.-type family VectorFor t :: * -> *+type family VectorFor t :: Type -> Type type instance VectorFor Bool = VU.Vector type instance VectorFor Int = VU.Vector type instance VectorFor Float = VU.Vector@@ -156,7 +150,8 @@ -- which provides an easier-to-use function that indexes into the -- table in a row-major fashion. inCoreSoA :: forall m rs. (PrimMonad m, RecVec rs)- => P.Producer (Record rs) m () -> m (Int, V.Rec (((->) Int) :. ElField) rs)+ => P.Producer (Record rs) m ()+ -> m (Int, V.Rec (((->) Int) :. ElField) rs) inCoreSoA xs = do mvs <- allocRec (Proxy :: Proxy rs) initialCapacity let feed (!i, !sz, !mvs') row@@ -227,3 +222,39 @@ filterFrame :: RecVec rs => (Record rs -> Bool) -> FrameRec rs -> FrameRec rs filterFrame p f = runST $ inCoreAoS $ P.each f P.>-> P.filter p {-# INLINE filterFrame #-}++-- | Process a stream of 'Record's into a stream of 'Frame's that each+-- contains no more than the given number of records.+produceFrameChunks :: forall rs m. (RecVec rs, PrimMonad m)+ => Int+ -> P.Producer (Record rs) m ()+ -> P.Producer (FrameRec rs) m ()+produceFrameChunks chunkSize = go+ where go src = do mutVecs <- P.lift (allocRec (Proxy :: Proxy rs) chunkSize)+ goChunk src mutVecs 0+ goChunk src mutVecs !i+ | i >= chunkSize =+ do chunk <- P.lift (freezeFrame i mutVecs)+ P.yield chunk+ go src+ | otherwise =+ do maybeRow <- P.lift (P.next src)+ case maybeRow of+ Left _ -> do+ P.lift (freezeFrame i mutVecs) >>= P.yield+ Right (r,src') -> do+ P.lift (writeRec (Proxy::Proxy rs) i mutVecs r)+ goChunk src' mutVecs (i+1)+ freezeFrame :: Int -> Record (VectorMs m rs) -> m (FrameRec rs)+ freezeFrame n =+ fmap (toAoS n . produceRec (Proxy::Proxy rs))+ . freezeRec (Proxy::Proxy rs) n+{-# INLINABLE produceFrameChunks #-}++-- | Split a 'Frame' into chunks of no more than the given number of+-- records. The underlying memory is shared with the original 'Frame'.+frameChunks :: Int -> FrameRec rs -> [FrameRec rs]+frameChunks chunkSize whole = map aux [ 0, chunkSize .. frameLength whole - 1 ]+ where aux i = Frame (min (frameLength whole - i) chunkSize)+ (frameRow whole . (+ i))+{-# INLINABLE frameChunks #-}
src/Frames/Rec.hs view
@@ -68,5 +68,5 @@ -- intended for use with @OverloadedLabels@. rputField :: forall t s a rs. (t ~ '(s,a), t ∈ rs, KnownSymbol s) => a -> Record rs -> Record rs-rputField = V.rput @t . Field+rputField = V.rput @_ @t . Field {-# INLINE rputField #-}
src/Frames/RecF.hs view
@@ -29,6 +29,7 @@ ColFun, ColumnHeaders, columnHeaders) where -- import Data.List (intercalate)+import Data.Kind (Type) import Data.Proxy import qualified Data.Vinyl as V import Data.Vinyl (Rec(..))@@ -70,7 +71,7 @@ -- pattern x :& xs <- (frameUncons -> (x, xs)) where -- x :& xs = frameCons x xs -class ColumnHeaders (cs::[(Symbol,*)]) where+class ColumnHeaders (cs::[(Symbol, Type)]) where -- | Return the column names for a record. columnHeaders :: proxy (Rec f cs) -> [String] @@ -88,7 +89,7 @@ -- | Strip the column information from each element of a list of -- types.-type family UnColumn (ts :: [(Symbol,*)]) where+type family UnColumn (ts :: [(Symbol, Type)]) where UnColumn '[] = '[] UnColumn ((s :-> t) ': ts) = t ': UnColumn ts
src/Frames/ShowCSV.hs view
@@ -14,3 +14,4 @@ instance ShowCSV Int where instance ShowCSV Double where instance ShowCSV Text where+ showCSV = id
src/Frames/TH.hs view
@@ -2,16 +2,14 @@ QuasiQuotes, RecordWildCards, RoleAnnotations, ScopedTypeVariables, TemplateHaskell, TupleSections, TypeApplications, TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-} -- | Code generation of types relevant to Frames use-cases. Generation -- may be driven by an automated inference process or manual use of -- the individual helpers. module Frames.TH where-import Control.Arrow (first, second)-import Data.Char (isAlpha, isAlphaNum, toLower, toUpper)+import Control.Arrow (second)+import Data.Char (toLower) import Data.Maybe (fromMaybe)-#if __GLASGOW_HASKELL__ < 804-import Data.Semigroup ((<>))-#endif import Data.Proxy (Proxy(..)) import qualified Data.Text as T import Data.Vinyl@@ -21,12 +19,14 @@ import Frames.ColumnUniverse import Frames.CSV import Frames.Rec(Record)+import Frames.Utils import qualified GHC.Types as GHC import Language.Haskell.TH import Language.Haskell.TH.Syntax import qualified Pipes as P import qualified Pipes.Prelude as P import qualified Pipes.Safe as P+import Data.Vinyl.CoRec (ShowF) -- | Generate a column type. recDec :: [Type] -> Type@@ -34,25 +34,6 @@ where go [] = PromotedNilT go (t:cs) = AppT (AppT PromotedConsT t) (go cs) --- | Capitalize the first letter of a 'T.Text'.-capitalize1 :: T.Text -> T.Text-capitalize1 = foldMap (onHead toUpper) . T.split (not . isAlphaNum)- where onHead f = maybe mempty (uncurry T.cons . first f) . T.uncons---- | Massage a column name from a CSV file into a valid Haskell type--- identifier.-sanitizeTypeName :: T.Text -> T.Text-sanitizeTypeName = unreserved . fixupStart- . T.concat . T.split (not . valid) . capitalize1- where valid c = isAlphaNum c || c == '\'' || c == '_'- unreserved t- | t `elem` ["Type", "Class"] = "Col" <> t- | otherwise = t- fixupStart t = case T.uncons t of- Nothing -> "Col"- Just (c,_) | isAlpha c -> t- | otherwise -> "Col" <> t- -- | Declare a type synonym for a column. mkColSynDec :: TypeQ -> Name -> DecQ mkColSynDec colTypeQ colTName = tySynD colTName [] colTypeQ@@ -91,7 +72,7 @@ -- | For each column, we declare a type synonym for its type, and a -- Proxy value of that type. colDec :: T.Text -> String -> T.Text- -> (Either (String -> Q [Dec]) Type)+ -> Either (String -> Q [Dec]) Type -> Q (Type, [Dec]) colDec prefix rowName colName colTypeGen = do (colTy, extraDecs) <- either colDecsHelper (pure . (,[])) colTypeGen@@ -150,37 +131,46 @@ -- ^ A record field that mentions the phantom type list of -- possible column types. Having this field prevents record -- update syntax from losing track of the type argument.- , lineReader :: P.Producer T.Text (P.SafeT IO) ()- -- ^ A producer of lines of ’T.Text’xs+ , inferencePrefix :: Int+ -- ^ Number of rows to inspect to infer a type for each+ -- column. Defaults to 1000.+ , lineReader :: Separator -> P.Producer [T.Text] (P.SafeT IO) ()+ -- ^ A producer of rows of ’T.Text’ values that were+ -- separated by a 'Separator' value. } -- -- | Shorthand for a 'Proxy' value of 'ColumnUniverse' applied to the -- -- given type list.--- colQ :: Name -> Q Exp--- colQ n = [e| (Proxy :: Proxy (ColumnUniverse $(conT n))) |]+colQ :: Name -> Q Exp+colQ n = [e| (Proxy :: Proxy (ColumnUniverse $(conT n))) |] -- | A default 'RowGen'. This instructs the type inference engine to -- get column names from the data file, use the default column -- separator (a comma), infer column types from the default 'Columns' -- set of types, and produce a row type with name @Row@. rowGen :: FilePath -> RowGen CommonColumns-rowGen = RowGen [] "" defaultSep "Row" Proxy . produceTextLines+rowGen = RowGen [] "" defaultSep "Row" Proxy 1000 . produceTokens -- | Like 'rowGen', but will also generate custom data types for -- 'Categorical' variables with up to 8 distinct variants. rowGenCat :: FilePath -> RowGen CommonColumnsCat-rowGenCat = RowGen [] "" defaultSep "Row" Proxy . produceTextLines+rowGenCat = RowGen [] "" defaultSep "Row" Proxy 1000 . produceTokens -- -- | Generate a type for each row of a table. This will be something -- -- like @Record ["x" :-> a, "y" :-> b, "z" :-> c]@. -- tableType :: String -> FilePath -> DecsQ -- tableType n fp = tableType' (rowGen fp) { rowTypeName = n } --- | Like 'tableType', but additionally generates a type synonym for--- each column, and a proxy value of that type. If the CSV file has--- column names \"foo\", \"bar\", and \"baz\", then this will declare--- @type Foo = "foo" :-> Int@, for example, @foo = rlens \@Foo@, and--- @foo' = rlens' \@Foo@.+-- | Generate types for a row of a table. This will be something like+-- @Record ["x" :-> a, "y" :-> b, "z" :-> c]@. This splice+-- additionally generates a type synonym for each column, and a proxy+-- value of that type. If the CSV file has column names \"foo\",+-- \"bar\", and \"baz\", then this will declare @type Foo = "foo" :->+-- Int@, for example, @foo = rlens \@Foo@, and @foo' = rlens' \@Foo@.+--+-- See 'tableTypes'' if you need to customize parsing to do things+-- like override the separator character (default is a single comma),+-- or supply column names. tableTypes :: String -> FilePath -> DecsQ tableTypes n fp = tableTypes' (rowGen fp) { rowTypeName = n } @@ -202,25 +192,24 @@ -- colNames' | null columnNames = Nothing -- | otherwise = Just (map T.pack columnNames) -- opts = ParserOptions colNames' separator (RFC4180Quoting '\"')--- lineSource = lineReader >-> P.take prefixSize+-- lineSource = lineReader separator >-> P.take prefixSize -- | Tokenize the first line of a ’P.Producer’.-colNamesP :: Monad m- => ParserOptions -> P.Producer T.Text m () -> m [T.Text]-colNamesP opts src = either (const []) (tokenizeRow opts . fst) <$> P.next src+colNamesP :: Monad m => P.Producer [T.Text] m () -> m [T.Text]+colNamesP src = either (const []) fst <$> P.next src -- | Generate a type for a row of a table all of whose columns remain -- unparsed 'Text' values. tableTypesText' :: forall a c.- (c ~ CoRec ColInfo a, ColumnTypeable c, Monoid c)+ (c ~ CoRec ColInfo a, ColumnTypeable c, Semigroup c) => RowGen a -> DecsQ-tableTypesText' (RowGen {..}) =+tableTypesText' RowGen {..} = do colNames <- runIO . P.runSafeT $- maybe (colNamesP opts lineReader)+ maybe (colNamesP (lineReader separator)) pure (headerOverride opts) let headers = zip colNames (repeat (ConT ''T.Text))- (colTypes, colDecs) <- (second concat . unzip)+ (colTypes, colDecs) <- second concat . unzip <$> mapM (uncurry mkColDecs) headers let recTy = TySynD (mkName rowTypeName) [] (recDec colTypes) optsName = case rowTypeName of@@ -246,7 +235,15 @@ -- the CSV file has column names \"foo\", \"bar\", and \"baz\", then -- this will declare @type Foo = "foo" :-> Int@, for example, @foo = -- rlens \@Foo@, and @foo' = rlens' \@Foo@.-tableTypes' :: forall a c. (c ~ CoRec ColInfo a, ColumnTypeable c, Monoid c)+--+-- The supplied 'RowGen' value is also used to produce a value of type+-- 'ParserOptions' that can be passed to functions like+-- 'readTableOpt'. This is useful if you need to customize parsing to+-- support something like a special separator string. This value of+-- type 'ParserOptions' will be given a name based on the row type+-- name. If the row type is @Row@, then thsi splice will generate a+-- value @rowParser :: ParserOptions@.+tableTypes' :: forall a c. (c ~ CoRec ColInfo a, ColumnTypeable c, Semigroup c, RPureConstrained (ShowF ColInfo) a) => RowGen a -> DecsQ tableTypes' (RowGen {..}) = do headers <- runIO . P.runSafeT@@ -266,7 +263,7 @@ where colNames' | null columnNames = Nothing | otherwise = Just (map T.pack columnNames) opts = ParserOptions colNames' separator (RFC4180Quoting '\"')- lineSource = lineReader P.>-> P.take prefixSize+ lineSource = lineReader separator P.>-> P.take inferencePrefix mkColDecs :: T.Text -> Either (String -> Q [Dec]) Type -> Q (Type, [Dec]) mkColDecs colNm colTy = do let safeName = tablePrefix ++ (T.unpack . sanitizeTypeName $ colNm)@@ -274,3 +271,4 @@ case mColNm of Just n -> pure (ConT n, []) -- Column's type was already defined Nothing -> colDec (T.pack tablePrefix) rowTypeName colNm colTy+
+ src/Frames/Utils.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+module Frames.Utils (capitalize1, sanitizeTypeName) where++import Control.Arrow (first)+import Data.Char (isAlpha, isAlphaNum, toUpper)+#if __GLASGOW_HASKELL__ < 804+import Data.Semigroup ((<>))+#endif+import qualified Data.Text as T++-- | Capitalize the first letter of a 'T.Text'.+capitalize1 :: T.Text -> T.Text+capitalize1 = foldMap (onHead toUpper) . T.split (not . isAlphaNum)+ where onHead f = maybe mempty (uncurry T.cons . first f) . T.uncons++-- | Massage a column name from a CSV file into a valid Haskell type+-- identifier.+sanitizeTypeName :: T.Text -> T.Text+sanitizeTypeName = unreserved . fixupStart+ . T.concat . T.split (not . valid) . capitalize1+ where valid c = isAlphaNum c || c == '\'' || c == '_'+ unreserved t+ | t `elem` ["Type", "Class"] = "Col" <> t+ | otherwise = t+ fixupStart t = case T.uncons t of+ Nothing -> "Col"+ Just (c,_) | isAlpha c -> t+ | otherwise -> "Col" <> t
test/Categorical.hs view
@@ -1,14 +1,19 @@ {-# LANGUAGE DataKinds, FlexibleContexts, MultiParamTypeClasses,- OverloadedLabels, OverloadedStrings, TemplateHaskell,- TypeFamilies, TypeOperators #-}+ OverloadedLabels, OverloadedStrings, TemplateHaskell, + TypeApplications, TypeFamilies, TypeOperators #-} module Categorical where-import Data.Vinyl.Derived-import Data.Vinyl.XRec (toHKD)-import Frames-import Frames.Categorical (declareCategorical)-import Frames.TH (rowGenCat, RowGen(..), declarePrefixedColumn)-import Pipes (Producer, (>->))-import qualified Pipes.Prelude as P+import Data.Vinyl.Derived+import Data.Vinyl.XRec ( toHKD )+import Frames+import Frames.Categorical ( declareCategorical )+import Frames.TH ( rowGenCat+ , RowGen(..)+ , declarePrefixedColumn+ )+import Pipes ( Producer+ , (>->)+ )+import qualified Pipes.Prelude as P -- * Automatically inferred categorical data types @@ -19,17 +24,19 @@ -- no more than 8 variants. In our small data file, five distinct -- months appear, so a data type is generated and used. fifthMonthSmall :: IO (Maybe SmallMonth)-fifthMonthSmall = fmap (fmap (rvalf #month)) . runSafeEffect . P.head- $ load >-> P.drop 4- where load :: MonadSafe m => Producer Small m ()- load = readTableOpt smallParser "test/data/catSmall.csv"+fifthMonthSmall =+ fmap (fmap (rvalf #month)) . runSafeEffect . P.head $ load >-> P.drop 4+ where+ load :: MonadSafe m => Producer Small m ()+ load = readTableOpt smallParser "test/data/catSmall.csv" -- When every month appears, Frames leaves that column's type as 'Text'. fifthMonthLarge :: IO (Maybe Text)-fifthMonthLarge = fmap (fmap (rvalf #month)) . runSafeEffect . P.head- $ load >-> P.drop 4- where load :: MonadSafe m => Producer Large m ()- load = readTableOpt largeParser "test/data/catLarge.csv"+fifthMonthLarge =+ fmap (fmap (rvalf #month)) . runSafeEffect . P.head $ load >-> P.drop 4+ where+ load :: MonadSafe m => Producer Large m ()+ load = readTableOpt largeParser "test/data/catLarge.csv" -- * Custom categorical type @@ -51,7 +58,8 @@ -- parses. We use 'toHKD' to cut through the noise of the @(Maybe -- :. ElField)@ interpretation we parsed into. fifthMonthCustom :: IO (Maybe MyMonthData)-fifthMonthCustom = fmap (>>= toHKD . rgetf #month) . runSafeEffect . P.head- $ load >-> P.drop 4- where load :: MonadSafe m => Producer (ColFun Maybe MyRow) m ()- load = readTableMaybe "test/data/catSmall.csv"+fifthMonthCustom =+ fmap (>>= toHKD . rgetf #month) . runSafeEffect . P.head $ load >-> P.drop 4+ where+ load :: MonadSafe m => Producer (ColFun Maybe MyRow) m ()+ load = readTableMaybe "test/data/catSmall.csv"
+ test/Chunks.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes,+ TemplateHaskell, TypeApplications #-}+module Chunks where+import Frames+import Frames.InCore (frameChunks, produceFrameChunks)+import Pipes ((>->))+import qualified Pipes.Prelude as P++tableTypes "Row" "test/data/prestige.csv"++getEducation :: Row -> Double+getEducation = rgetField @Education++chunkInCore :: IO [Double]+chunkInCore = do+ rows <- inCoreAoS (readTable "test/data/prestige.csv")+ let chunks = frameChunks 10 rows+ return $ map (getEducation . flip frameRow 0) chunks++chunkStream :: IO [Double]+chunkStream = runSafeT . P.toListM $+ produceFrameChunks 10 (readTable "test/data/prestige.csv")+ >-> P.map (getEducation . flip frameRow 0)
test/DataCSV.hs view
@@ -1,47 +1,58 @@-{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+ module DataCSV where-import Control.Monad ((>=>))+ import Data.Bifunctor (first)-import qualified Data.HashMap.Lazy as H-import Data.Maybe (catMaybes)+import qualified Data.Foldable as F import qualified Data.Text as T import qualified Data.Text.IO as T-import Language.Haskell.TH.Syntax (Lift(..))-import Text.Toml-import Text.Toml.Types (Node (VTable, VString), Table)+import Language.Haskell.TH.Syntax (Lift (..))+import qualified Toml+import Validation -data CsvExample = CsvExample { name :: String, csv :: String, generated :: String }+data CsvExample = CsvExample+ { name :: String+ , csv :: String+ , generated :: String+ }+ deriving (Lift, Show) -instance Lift CsvExample where- lift (CsvExample n c g) = [e| CsvExample n c g |]+keyText :: Toml.Key -> T.Text+keyText = F.fold . cleanup . map Toml.unPiece . F.toList . Toml.unKey+ where+ -- Top-level table names are parsed as @"name" :|+ -- ["name"]@. Remove that duplication here.+ cleanup [x, y] | x == y = [x]+ cleanup x = x -examplesFrom :: FilePath -> IO [CsvExample]-examplesFrom fp = (either error id . ((first show . parseTomlDoc "examples") >=> go))- <$> T.readFile fp- where go :: Table -> Either String [CsvExample]- go = fmap catMaybes . mapM (uncurry ex . first T.unpack) . H.toList- ex :: String -> Node -> Either String (Maybe CsvExample)- ex k (VTable v) =- do c <- case H.lookup "csv" v of- Nothing -> Right Nothing -- ("No csv key in "++k)- Just (VString c) -> Right (Just (T.unpack c))- Just _ -> Left ("csv key not a string in " ++ k)- g <- case H.lookup "generated" v of- Nothing -> Left ("No generated key in " ++ k)- Just (VString g) -> Right (Just (T.unpack g))- Just _ -> Left ("generated key not a string in " ++ k)- return (CsvExample k <$> c <*> g)- ex k _ = Left (k ++ " is not a table")+-- | Parse a TOML file that is a top-level table whose values are all+-- the same type. The @tomland@ codec API is centered around starting+-- with a key, but a top-level table does not have a key, so we must+-- use the lower level 'Toml.parse' and 'Toml.tomlTables' before+-- repeatedly applying the provided 'Toml.TomlCodec'.+parseFileOf :: forall a. Toml.TomlCodec a -> T.Text -> Either [T.Text] [(T.Text, a)]+parseFileOf codec =+ first (map Toml.prettyTomlDecodeError)+ . validationToEither+ . traverse (uncurry go)+ . Toml.toList+ . Toml.tomlTables+ . either (error . show) id+ . Toml.parse+ where+ go :: Toml.Key -> Toml.TOML -> Validation [Toml.TomlDecodeError] (T.Text, a)+ go k v = (keyText k,) <$> Toml.runTomlCodec codec v -generatedFrom :: FilePath -> String -> IO String-generatedFrom fp key = (either error id . (>>= go)- . first show . parseTomlDoc "examples")- <$> T.readFile fp- where go :: Table -> Either String String- go toml = do tbl <- case H.lookup (T.pack key) toml of- Just (VTable t) -> Right t- _ -> Left (key ++ " is not a table")- case H.lookup "generated" tbl of- Just (VString g) -> Right (T.unpack g)- Just _ -> Left ("generated key not a string in " ++ key)- Nothing -> Left ("No generated key in " ++ key)+parseExamples :: FilePath -> IO (Either [T.Text] [CsvExample])+parseExamples = fmap (fmap (map mkExample) . parseFileOf exampleCodec) . T.readFile+ where+ exampleCodec = Toml.pair (Toml.string "csv") (Toml.string "generated")+ mkExample (name', (csv', generated')) =+ CsvExample (T.unpack name') csv' generated'++-- | Wraps 'parseExamples' to call 'error' on any parse errors.+examplesFrom :: FilePath -> IO [CsvExample]+examplesFrom = fmap (either (error . show) id) . parseExamples
test/Issue114.hs view
@@ -5,23 +5,27 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-} module Issue114 where import Frames-import qualified Control.Foldl as Foldl+import qualified Control.Foldl as Foldl import Control.Lens-import Pipes.Prelude (fold)+import Pipes.Prelude ( fold ) import Pipes-import qualified Pipes.Prelude as P-import qualified Pipes.Core as PC+import qualified Pipes.Prelude as P+import qualified Pipes.Core as PC -import qualified Data.Vinyl as V-import Data.Vinyl (Rec(..))+import qualified Data.Vinyl as V+import Data.Vinyl ( Rec(..) ) -import qualified Data.Text as T+import qualified Data.Text as T import Data.Attoparsec.Text import Control.Applicative -import Frames.TH (tableTypesText', rowGen, RowGen(..))+import Frames.TH ( tableTypesText'+ , rowGen+ , RowGen(..)+ ) tableTypesText' (rowGen "test/data/issue114.csv") { rowTypeName = "ProductionData" } @@ -29,13 +33,12 @@ getOilVol :: ProductionData -> Record '[OilVolDouble] getOilVol x = V.Field (f (parseOnly parseDouble (x ^. oilVol))) :& RNil- where- f (Left _) = 0.0 / 0.0- f (Right y) = y+ where+ f (Left _) = 0.0 / 0.0+ f (Right y) = y readOilVol :: MonadSafe m => Producer (Record '[OilVolDouble]) m ()-readOilVol = (readTable "test/data/issue114.csv") >->- (P.map getOilVol)+readOilVol = (readTable "test/data/issue114.csv") >-> (P.map getOilVol) oilVolLength :: Foldl.Fold (Record '[OilVolDouble]) Int oilVolLength = Foldl.length@@ -48,16 +51,16 @@ parseDouble :: Parser Double parseDouble =- do d <- double- return d- <|>- do _ <- string ""- return 0.0+ do+ d <- double+ return d+ <|> do+ _ <- string ""+ return 0.0 test :: IO () test = do- (t, l) <- runSafeT $- Foldl.purely fold oilVolTotalAndLength readOilVol+ (t, l) <- runSafeT $ Foldl.purely fold oilVolTotalAndLength readOilVol putStrLn $ show l ++ " records totalling " ++ show t loadTable :: MonadSafe m => PC.Producer ProductionData m ()
+ test/Issue145.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Issue145 where++import Frames.TH (RowGen (..), rowGenCat, tableTypes')++tableTypes' (rowGenCat "test/data/issue145.csv") { rowTypeName = "Row", tablePrefix = "C" }
test/LatinTest.hs view
@@ -10,9 +10,8 @@ module LatinTest where -import Data.Vinyl (Rec) import Frames-import Frames.CSV (pipeTableMaybe, readFileLatin1Ln)+import Frames.CSV (readFileLatin1Ln) import Pipes (Producer, (>->)) import qualified Pipes.Prelude as P
test/NoHeader.hs view
@@ -1,11 +1,15 @@-{-# LANGUAGE DataKinds, FlexibleContexts, OverloadedLabels, TemplateHaskell #-}+{-# LANGUAGE DataKinds, FlexibleContexts, OverloadedLabels, TemplateHaskell, TypeApplications #-} module NoHeader where-import Control.Arrow ((&&&))-import Data.Vinyl.Derived-import Frames-import Frames.TH (rowGen, RowGen(..))-import Pipes (Producer, (>->))-import qualified Pipes.Prelude as P+import Control.Arrow ( (&&&) )+import Data.Vinyl.Derived+import Frames+import Frames.TH ( rowGen+ , RowGen(..)+ )+import Pipes ( Producer+ , (>->)+ )+import qualified Pipes.Prelude as P tableTypes' (rowGen "test/data/prestigeNoHeader.csv") { rowTypeName = "Row"@@ -22,7 +26,8 @@ -- | Extract the @Job@ and @Schooling@ columns of the indicated row. getJobAndSchooling :: Int -> IO (Maybe (Text, Double))-getJobAndSchooling n = fmap (fmap aux) . runSafeEffect . P.head- $ loadData >-> P.drop (max n 0)- where aux :: Row -> (Text, Double)- aux = rvalf #job &&& rvalf #schooling+getJobAndSchooling n =+ fmap (fmap aux) . runSafeEffect . P.head $ loadData >-> P.drop (max n 0)+ where+ aux :: Row -> (Text, Double)+ aux = rvalf #job &&& rvalf #schooling
test/Overlap.hs view
@@ -1,6 +1,9 @@-{-# LANGUAGE DataKinds, FlexibleContexts, TemplateHaskell #-}-module Main (main) where-import Frames+{-# LANGUAGE DataKinds, FlexibleContexts, TemplateHaskell, TypeApplications #-}+module Main+ ( main+ )+where+import Frames -- These data files have overlapping column definitions. Frames should -- not try to re-define an existing identifier.
test/PrettyTH.hs view
@@ -21,7 +21,7 @@ -- | Make template haskell-generated code more readable by -- unqualifying common names, making type operators infix, erasing--- inferrable types, and adding a bit of whitespace.+-- inferable types, and adding a bit of whitespace. makePretty :: String -> String makePretty = -- Add new lines before type synonym definitions replace' "\ntype " "\n\ntype "@@ -29,13 +29,14 @@ . (!! 10) . iterate (replace infixCons) . replace infixNil . replace infixCol- -- Erase inferrable type+ -- Erase inferable type . replace ((\x y -> x ++ " ∈ " ++ y) <$> ("RElem " *> some (psym (not . isSpace))) <*> ((some (psym isSpace) *> some (psym (not . isSpace))) <* " (RIndex " <* some (psym (/= ')')) <* ")")) -- Unqualify names . replace' "Frames.CSV.ParserOptions" "ParserOptions"+ . replace' "GHC.Maybe." "" . replace' "GHC.Base." "" . replace' "GHC.Types." "" . replace' "Data.Vinyl.Core." ""
test/Spec.hs view
@@ -1,17 +1,21 @@ {-# LANGUAGE CPP, DataKinds, OverloadedStrings, QuasiQuotes,- TemplateHaskell, TypeOperators #-}+ ScopedTypeVariables, TemplateHaskell, TypeApplications,+ TypeOperators #-} module Main (manualGeneration, main) where+import Control.Exception (ErrorCall, catch) import Control.Monad (unless) import Data.Functor.Identity import Data.Char import qualified Data.Foldable as F-import Data.List (find)+import Data.List (find, isPrefixOf) import Data.Monoid (First(..)) import qualified Data.Text as T-import Language.Haskell.TH as TH+import qualified Language.Haskell.TH as TH import Language.Haskell.TH.Syntax (addDependentFile) import Frames import Frames.CSV (produceCSV)+import Frames.CSV (defaultParser, produceTokens, defaultSep, readColHeaders)+import qualified Chunks import DataCSV import Pipes.Prelude (toListM) import PrettyTH@@ -21,22 +25,24 @@ import Test.HUnit.Lang (assertFailure) import qualified LatinTest as Latin-import qualified Issue114 as Issue114+import qualified Issue114+import qualified Issue145 import qualified NoHeader import qualified Categorical import qualified UncurryFold import qualified UncurryFoldNoHeader import qualified UncurryFoldPartialData+import Data.Vinyl (xrec) -- | Extract all example @(CSV, generatedCode)@ pairs from -- @test/examples.toml@ csvTests :: [(CsvExample, String)] csvTests = $(do addDependentFile "test/examples.toml" csvExamples <- TH.runIO (examplesFrom "test/examples.toml")- ListE <$> mapM (\x@(CsvExample _ c _) ->- [e|(x,$(generateCode "Row" c))|])- csvExamples)+ TH.ListE <$> mapM (\x@(CsvExample _ c _) ->+ [e|(x,$(generateCode "Row" c))|])+ csvExamples) -- | Detect type-compatible re-used names and do not attempt to -- re-generate definitions for them. This does not do the right thing@@ -62,7 +68,7 @@ -- -- Note that to load this file into a REPL may require some fiddling -- with the path to the examples file in the 'csvTests' splice above.-manualGeneration :: String -> Q Exp+manualGeneration :: String -> TH.Q TH.Exp manualGeneration k = do csvExamples <- TH.runIO (examplesFrom "test/examples.toml") maybe (error ("Table " ++ k ++ " not found")) (generateCode "Row")@@ -78,7 +84,16 @@ newtype Code = Code String instance Show Code where show (Code x) = x instance Eq Code where- Code a == Code b = filter (not . isSpace) a == filter (not . isSpace) b+ Code a == Code b = clean a == clean b+ where clean = go (removePrefix moduleNames) . filter (not . isSpace)+ go _ [] = []+ go f s@(c:cs) = case removePrefix moduleNames s of+ Nothing -> c : go f cs+ Just n -> go f (drop n s)+ moduleNames = [ "GHC.Maybe." ]+ removePrefix [] _ = Nothing+ removePrefix (w:ws) s | w `isPrefixOf` s = Just (length w)+ | otherwise = removePrefix ws s shouldBeWithinEpsilon :: Double -> Double -> Expectation shouldBeWithinEpsilon actual expected =@@ -92,10 +107,10 @@ main = do hspec $ do-#if __GLASGOW_HASKELL__ >= 804+ describe "Haskell type generation" $ mapM_ (\(CsvExample k _ g, g') -> it k (Code g' `shouldBe` Code g)) csvTests-#endif+ -- describe "Multiple tables" $ -- do _g <- H.runIO $ -- generatedFrom "test/examples.toml" "managers_employees"@@ -119,17 +134,18 @@ -- The test data isn't formatted quite how we'd do it: text -- fields aren't quoted, and salaries represented as Doubles -- do not have decimal points.- let csvInput' = T.replace "Joe" "\"Joe\""- . T.replace "Sarah" "\"Sarah\""- . T.replace "\"80,000\"" "80000.0"- $ T.pack csvInput+ -- let csvInput' = T.replace "Joe" "\"Joe\""+ -- . T.replace "Sarah" "\"Sarah\""+ -- . T.replace "\"80,000\"" "80000.0"+ -- $ T.pack csvInput+ let csvInput' = T.replace "\"80,000\"" "80000.0" (T.pack csvInput) it "Produces expected output" $ T.unlines (map T.pack csvOutput) `shouldBe` csvInput' it "Produces parseable output" $ unless (frame == frame2) (assertFailure "Reparsed CSV differs from input") describe "Latin1 Text Encoding" $- do managers <- H.runIO (Latin.managers)+ do managers <- H.runIO Latin.managers it "Parses" $ managers `shouldBe` ["João", "Esperança"] describe "Skip Missing Data" $ do@@ -189,3 +205,45 @@ mCustom <- H.runIO Categorical.fifthMonthCustom it "Can parse into manually-specified categorical variables" $ mCustom `shouldBe` Just Categorical.MyMay+ it "Can generate categorical types with space" $+ enumFrom (minBound :: Issue145.RowCategoryName)+ `shouldBe` [ Issue145.RowCategoryNameBarCategory+ , Issue145.RowCategoryNameFooCategory]+ describe "Detects parse failures" $ do+ caught <- H.runIO $+ (runSafeT $ do+ _ <- readColHeaders @Columns+ defaultParser+ (produceTokens "test/data/multiline.csv" defaultSep)+ return False)+ `catch` \(_ :: ErrorCall) -> return True+ it "Fails on embedded newlines" caught+ describe "Chunking" $ do+ let everyTenthEducation = [13.11,12.39,15.97,12.79,12.09,11.13,8.5,7.64,8.78,6.92,10.0]+ inCoreChunks <- H.runIO Chunks.chunkInCore+ it "Can split in-memory data into chunks" $+ inCoreChunks `shouldBe` everyTenthEducation+ streamedChunks <- H.runIO Chunks.chunkStream+ it "Can split an input stream into Frame chunks" $+ streamedChunks `shouldBe` everyTenthEducation+ describe "Printing with take and drop" $ do+ let frame :: Frame (Record '[ "id" :-> Int, "manager" :-> Text+ , "age" :-> Int, "pay" :-> Double ])+ frame = toFrame [ xrec (1, "Joe", 53, 80000)+ , xrec (2, "Sarah", 44, 80000) ]+ it "Can format a Frame to a String" $+ showFrame "\t" frame `shouldBe`+ unlines [+ "id\tmanager\tage\tpay"+ , "1\t\"Joe\"\t53\t80000.0"+ , "2\t\"Sarah\"\t44\t80000.0" ]+ it "Can take the first row" $+ showFrame "\t" (takeRows 1 frame) `shouldBe`+ unlines [+ "id\tmanager\tage\tpay"+ , "1\t\"Joe\"\t53\t80000.0" ]+ it "Can drop the first row" $+ showFrame "\t" (dropRows 1 frame) `shouldBe`+ unlines [+ "id\tmanager\tage\tpay"+ , "2\t\"Sarah\"\t44\t80000.0" ]
test/UncurryFold.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell #-}+{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell, TypeApplications #-} module UncurryFold where-import qualified Control.Foldl as L-import Data.Vinyl (rcast)-import Data.Vinyl.Curry (runcurryX)-import Frames+import qualified Control.Foldl as L+import Data.Vinyl.Curry ( runcurryX )+import Frames -- Data set from http://vincentarelbundock.github.io/Rdatasets/datasets.html tableTypes "Row" "test/data/prestige.csv"
test/UncurryFoldNoHeader.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell #-}+{-# LANGUAGE DataKinds, FlexibleContexts, QuasiQuotes, TemplateHaskell, TypeApplications #-} module UncurryFoldNoHeader where-import qualified Control.Foldl as L-import Data.Vinyl (rcast)-import Data.Vinyl.Curry (runcurryX)-import Frames-import Frames.TH (rowGen, RowGen(..))+import qualified Control.Foldl as L+import Data.Vinyl.Curry ( runcurryX )+import Frames+import Frames.TH ( rowGen+ , RowGen(..)+ ) -- Data set from http://vincentarelbundock.github.io/Rdatasets/datasets.html tableTypes' (rowGen "test/data/prestigeNoHeader.csv")
+ test/data/issue145.csv view
@@ -0,0 +1,3 @@+id,category name+1,foo category+2,bar category
+ test/data/multiline.csv view
@@ -0,0 +1,8 @@+RowNum,Description,X,Y+1,"simple",10,10+2,"""quoted""",20,20+3,"multi+line+text+field",30,30+4,"simple again",40,40
test/examples.toml view
@@ -102,72 +102,72 @@ Rec g_23 rs_24 -> f_22 (Rec g_23 rs_24) managerId' = rlens' @ManagerId""" -[managers_employees]-generated = """-type ManagerRec = Record [Id, Manager, Age, Pay]-managerRecParser :: ParserOptions-managerRecParser = ParserOptions Nothing (T.pack ",") (Frames.CSV.RFC4180Quoting '"')+# [managers_employees]+# generated = """+# type ManagerRec = Record [Id, Manager, Age, Pay]+# managerRecParser :: ParserOptions+# managerRecParser = 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 Bool) -> Record rs_1 -> f_0 (Record rs_1)-id = rlens @Id . rfield-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' @Id+# type Id = "id" :-> Int+# id :: forall f_0 rs_1 . (Functor f_0, Id ∈ rs_1) =>+# (Int -> f_0 Bool) -> Record rs_1 -> f_0 (Record rs_1)+# id = rlens @Id . rfield+# 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' @Id -type Manager = "manager" :-> Text-manager :: forall f_5 rs_6 . (Functor f_5, Manager ∈ rs_6) =>- (Text -> f_5 Text) -> Record rs_6 -> f_5 (Record rs_6)-manager = rlens @Manager . rfield-manager' :: forall f_7 g_8 rs_9 . (Functor f_7,- Manager ∈ rs_9) =>- (g_8 Manager -> f_7 (g_8 Manager)) -> Rec g_8 rs_9 -> f_7 (Rec g_8 rs_9)-manager' = rlens' @Manager+# type Manager = "manager" :-> Text+# manager :: forall f_5 rs_6 . (Functor f_5, Manager ∈ rs_6) =>+# (Text -> f_5 Text) -> Record rs_6 -> f_5 (Record rs_6)+# manager = rlens @Manager . rfield+# manager' :: forall f_7 g_8 rs_9 . (Functor f_7,+# Manager ∈ rs_9) =>+# (g_8 Manager -> f_7 (g_8 Manager)) -> Rec g_8 rs_9 -> f_7 (Rec g_8 rs_9)+# manager' = rlens' @Manager -type Age = "age" :-> Int-age :: forall f_10 rs_11 . (Functor f_10, Age ∈ rs_11) =>- (Int -> f_10 Int) -> Record rs_11 -> f_10 (Record rs_11)-age = rlens @Age . rfield-age' :: forall f_12 g_13 rs_14 . (Functor f_12,- Age ∈ rs_14) =>- (g_13 Age -> f_12 (g_13 Age)) -> Rec g_13 rs_14 -> f_12 (Rec g_13 rs_14)-age' = rlens' @Age+# type Age = "age" :-> Int+# age :: forall f_10 rs_11 . (Functor f_10, Age ∈ rs_11) =>+# (Int -> f_10 Int) -> Record rs_11 -> f_10 (Record rs_11)+# age = rlens @Age . rfield+# age' :: forall f_12 g_13 rs_14 . (Functor f_12,+# Age ∈ rs_14) =>+# (g_13 Age -> f_12 (g_13 Age)) -> Rec g_13 rs_14 -> f_12 (Rec g_13 rs_14)+# age' = rlens' @Age -type Pay = "pay" :-> Double-pay :: forall f_15 rs_16 . (Functor f_15, Pay ∈ rs_16) =>- (Double -> f_15 Double) -> Record rs_16 -> f_15 (Record rs_16)-pay = rlens @Pay . rfield-pay' :: forall f_17 g_18 rs_19 . (Functor f_17,- Pay ∈ rs_19) =>- (g_18 Pay -> f_17 (g_18 Pay)) -> Rec g_18 rs_19 -> f_17 (Rec g_18 rs_19)-pay' = rlens' @Pay+# type Pay = "pay" :-> Double+# pay :: forall f_15 rs_16 . (Functor f_15, Pay ∈ rs_16) =>+# (Double -> f_15 Double) -> Record rs_16 -> f_15 (Record rs_16)+# pay = rlens @Pay . rfield+# pay' :: forall f_17 g_18 rs_19 . (Functor f_17,+# Pay ∈ rs_19) =>+# (g_18 Pay -> f_17 (g_18 Pay)) -> Rec g_18 rs_19 -> f_17 (Rec g_18 rs_19)+# pay' = rlens' @Pay -type EmployeeRec = Record ["id" :-> Int, "employee" :-> Text, "age" :-> Int, "pay" :-> Double, "manager_id" :-> Int]-employeeRecParser :: ParserOptions-employeeRecParser = ParserOptions Nothing (T.pack ",") (Frames.CSV.RFC4180Quoting '"')+# type EmployeeRec = Record ["id" :-> Int, "employee" :-> Text, "age" :-> Int, "pay" :-> Double, "manager_id" :-> Int]+# employeeRecParser :: ParserOptions+# employeeRecParser = ParserOptions Nothing (T.pack ",") (Frames.CSV.RFC4180Quoting '"') -type Employee = "employee" :-> Text-employee :: forall f_5 rs_6 . (Functor f_5, Employee ∈ rs_6) =>- (Text -> f_5 Text) -> Record rs_6 -> f_5 (Record rs_6)-employee = rlens @Employee . rfield-employee' :: forall f_7 g_8 rs_9 . (Functor f_7,- Employee ∈ rs_9) =>- (g_8 Employee -> f_7 (g_8 Employee)) -> Rec g_8 rs_9 -> f_7 (Rec g_8 rs_9)-employee' = rlens' @Employee+# type Employee = "employee" :-> Text+# employee :: forall f_5 rs_6 . (Functor f_5, Employee ∈ rs_6) =>+# (Text -> f_5 Text) -> Record rs_6 -> f_5 (Record rs_6)+# employee = rlens @Employee . rfield+# employee' :: forall f_7 g_8 rs_9 . (Functor f_7,+# Employee ∈ rs_9) =>+# (g_8 Employee -> f_7 (g_8 Employee)) -> Rec g_8 rs_9 -> f_7 (Rec g_8 rs_9)+# employee' = rlens' @Employee -type Age = "age" :-> Int+# type Age = "age" :-> Int -type ManagerId = "manager_id" :-> Int-managerId :: forall f_20 rs_21 . (Functor f_20, ManagerId ∈ rs_21) =>- (Int -> f_20 Int) -> Record rs_21 -> f_20 (Record rs_21)-managerId = rlens @ManagerId . rfield-managerId' :: forall f_22 g_23 rs_24 . (Functor f_22,- ManagerId ∈ rs_24) =>- (g_23 ManagerId -> f_22 (g_23 ManagerId)) ->- Rec g_23 rs_24 -> f_22 (Rec g_23 rs_24)-managerId' = rlens' @ManagerId-"""+# type ManagerId = "manager_id" :-> Int+# managerId :: forall f_20 rs_21 . (Functor f_20, ManagerId ∈ rs_21) =>+# (Int -> f_20 Int) -> Record rs_21 -> f_20 (Record rs_21)+# managerId = rlens @ManagerId . rfield+# managerId' :: forall f_22 g_23 rs_24 . (Functor f_22,+# ManagerId ∈ rs_24) =>+# (g_23 ManagerId -> f_22 (g_23 ManagerId)) ->+# Rec g_23 rs_24 -> f_22 (Rec g_23 rs_24)+# managerId' = rlens' @ManagerId+# """ [double_gt_bool] csv = """