Frames-beam (empty) → 0.1.0.0
raw patch · 15 files changed
+1284/−0 lines, 15 filesdep +Framesdep +Frames-beamdep +QuickChecksetup-changed
Dependencies added: Frames, Frames-beam, QuickCheck, base, beam-core, beam-migrate, beam-postgres, bytestring, conduit, generics-sop, hspec, hspec-core, monad-control, postgresql-simple, process, scientific, template-haskell, text, time, uuid-types, vinyl
Files
- CHANGELOG.md +3/−0
- Frames-beam.cabal +83/−0
- LICENSE +30/−0
- README.md +188/−0
- Setup.hs +2/−0
- data/users.sql +86/−0
- src/Frames/SQL/Beam/Postgres.hs +294/−0
- src/Frames/SQL/Beam/Postgres/BeamSchemaGen.hs +94/−0
- src/Frames/SQL/Beam/Postgres/Helpers.hs +33/−0
- src/Frames/SQL/Beam/Postgres/Query.hs +70/−0
- src/Frames/SQL/Beam/Postgres/Streaming.hs +100/−0
- src/Frames/SQL/Beam/Postgres/Vinylize.hs +59/−0
- test/LibSpec.hs +164/−0
- test/NewBeamSchema.hs +77/−0
- test/Spec.hs +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1.0.0++Initial version
+ Frames-beam.cabal view
@@ -0,0 +1,83 @@+cabal-version: >=1.10+name: Frames-beam+version: 0.1.0.0+license: BSD3+license-file: LICENSE+copyright: 2018 Gagandeep Bhatia+maintainer: gagandeepbhatia.in@gmail.com+author: Gagandeep Bhatia+homepage: https://github.com/gagandeepb/Frames-beam+synopsis: A library for accessing Postgres tables as in-memory data structures.+description:+ This library provides a way to access Postgres tables as data frames by providing helpers for generating+ types (at compile time) corresponding to a database schema and canned queries to execute against a database+ instance. Additionally, provides utilities to convert plain Haskell records (i.e. the format of query results)+ to vinyl records (upon which the Frames library is based). Can be used for interactive exploration by loading+ all data in-memory at once (and converting to a data frame), and also in a constant memory streaming mode.+ Start here: "Frames.SQL.Beam.Postgres".+category: Data, Database, Data Science+build-type: Simple+extra-source-files:+ README.md+ data/users.sql+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/gagandeepb/Frames-beam++library+ exposed-modules:+ Frames.SQL.Beam.Postgres+ Frames.SQL.Beam.Postgres.BeamSchemaGen+ Frames.SQL.Beam.Postgres.Vinylize+ Frames.SQL.Beam.Postgres.Query+ Frames.SQL.Beam.Postgres.Streaming+ hs-source-dirs: src+ other-modules:+ Frames.SQL.Beam.Postgres.Helpers+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5,+ beam-core >=0.7.2.1 && <0.8,+ beam-postgres >=0.3.2.0 && <0.4,+ beam-migrate >=0.3.2.1 && <0.4,+ text >=1.2.3.0 && <1.3,+ postgresql-simple >=0.5.3.0 && <0.6,+ Frames >=0.3.0.2 && <0.4,+ template-haskell >=2.12.0.0 && <2.13,+ generics-sop >=0.3.2.0 && <0.4,+ vinyl >=0.7.0 && <0.8,+ process >=1.6.1.0 && <1.7,+ conduit >=1.3.0.2 && <1.4,+ monad-control >=1.0.2.3 && <1.1,+ bytestring >=0.10.8.2 && <0.11,+ scientific >=0.3.5.3 && <0.4,+ time >=1.8.0.2 && <1.9,+ uuid-types >=1.0.3 && <1.1++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ other-modules:+ LibSpec+ NewBeamSchema+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.10.1.0 && <4.11,+ Frames-beam -any,+ hspec >=2.4.8 && <2.5,+ hspec-core >=2.4.8 && <2.5,+ QuickCheck >=2.10.1 && <2.11,+ conduit >=1.3.0.2 && <1.4,+ generics-sop >=0.3.2.0 && <0.4,+ text >=1.2.3.0 && <1.3,+ vinyl >=0.7.0 && <0.8,+ Frames >=0.3.0.2 && <0.4,+ beam-core >=0.7.2.1 && <0.8,+ beam-postgres >=0.3.2.0 && <0.4,+ beam-migrate >=0.3.2.1 && <0.4,+ bytestring >=0.10.8.2 && <0.11
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Gagandeep Bhatia (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Anthony Cowley nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,188 @@+# Frames-beam++[](https://travis-ci.org/gagandeepb/Frames-beam)++## Accessing Postgres in a data frame in Haskell++A library for accessing Postgres tables as in-memory data structures.++This library provides helpers for generating types (at compile time) corresponding to a database schema and 'canned queries' to execute against a database instance. Additionally, it provides utilities to convert plain Haskell records (i.e. the format of query results) to `vinyl` records (upon which the Frames library is based). Can be used for interactive exploration by loading all data in-memory at once (and converting to a data frame), and also in a constant memory streaming mode. ++## Usage Example +In this example we assume there is a local Postgres instance with schema and rows given by the small DB-dump present in `data/users.sql`.++### A. Interactive Workflow Steps+1. **Bootstrap database schema:** In a new project, assume a file `Example.hs` is present in the `src` directory with the code below. You may of course change the string passed to `genBeamSchema` to match your database instance of interest.+```haskell+-- Example.hs +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+module Example where++import qualified Data.Conduit.List as CL+import qualified Data.Vinyl.Functor as VF+import qualified Frames as F+import Frames.SQL.Beam.Postgres++++$(genBeamSchema "host=localhost dbname=shoppingcart1")+```++2. Next, execute `stack build` or `stack ghci`. This compilation step, if completed without any errors, will establish a connection to your database instance of interest, read its schema, generate corresponding Haskell types and put them in a module named `NewBeamSchema` in your `src` directory (the file creation step is also part of the compilation process).++3. Assuming step 2 worked fine for you and you were using the test DB-dump from the `data` folder you should now have a module with code matching that in the `test/NewBeamSchema.hs` file of this repository. In case you used some other database instance of your own, your generated module would look different.+Import this module into `Example`:++```haskell+-- Example.hs+-- Extensions elided+module Example where++import qualified Data.Conduit.List as CL+import qualified Data.Vinyl.Functor as VF+import qualified Frames as F+import Frames.SQL.Beam.Postgres++import NewBeamSchema+++$(genBeamSchema "host=localhost dbname=shoppingcart1")+```++4. Let's assume the table of interest is `Cart_usersT`. We want to pull rows from this table into a data frame to explore it interactively from `ghci`. Note that `beam` query results are lists of plain Haskell records whereas `Frames` requires a list of `vinyl` records. In order to make this conversion, we add the following two invokations of code-generating (Template-Haskell) functions to `Example`:++```haskell+-- Example.hs+-- rest of the module elided++import NewBeamSchema+++$(genBeamSchema "host=localhost dbname=shoppingcart1")++deriveGeneric ''Cart_usersT+deriveVinyl ''Cart_usersT+```+...and build your project. This will add some additional code into the `Example` module. You can inspect this code by adding the appropriate compiler flags to your `.cabal` file.++5. **Querying the DB:**+In this step we will execute a `SELECT * FROM tbl WHERE...` query and convert the results to a data frame. Note that the table declaration (`_cart_users`) and the database declaration (`db`) are exported by the `NewBeamSchema` module. More importantly, these declarations are autogenerated at compile time, so in case new tables are added, the corresponding declarations are automatically available for use.++```haskell+-- Example.hs+connString :: ByteString+connString = "host=localhost dbname=shoppingcart1"++-- selects 'n' rows from the specified table in the db.+loadRows1 :: Int -> IO [(Cart_usersT Identity)]+loadRows1 n =+ withConnection connString $+ bulkSelectAllRows _cart_users db n++loadRows2 :: Int -> IO [(Cart_usersT Identity)]+loadRows2 n =+ withConnection connString $+ bulkSelectAllRowsWhere _cart_users db n (\c -> (_cart_usersFirst_name c) `like_` "J%")+```+Notice the lambda passed to `bulkSelectAllRowsWhere` in `loadRows2`. This is a 'filter lambda' that forms the `WHERE ...` part of the SQL query and is executed at the DB-level. We will see how to create our own 'filter lambdas' in another section below. For now, if we were to enter `ghci` by executing `stack ghci` after adding the above code:+```ghci+ghci>res1 <- loadRows1 5+ghci>:t res1+res1 :: [Cart_usersT Identity]+ghci>:t (map createRecId res1)+(map createRecId res1)+ :: [F.Rec+ VF.Identity+ '["_cart_usersEmail" F.:-> Text,+ "_cart_usersFirst_name" F.:-> Text,+ "_cart_usersLast_name" F.:-> Text,+ "_cart_usersIs_member" F.:-> Bool,+ "_cart_usersDays_in_queue" F.:-> Int]]+ghci>:t (F.toFrame $ map createRecId res1)+(F.toFrame $ map createRecId res1)+ :: F.Frame+ (F.Record+ '["_cart_usersEmail" F.:-> Text,+ "_cart_usersFirst_name" F.:-> Text,+ "_cart_usersLast_name" F.:-> Text,+ "_cart_usersIs_member" F.:-> Bool,+ "_cart_usersDays_in_queue" F.:-> Int])+ghci>myFrame = F.toFrame $ map createRecId res1+ghci>:set -XTypeApplications+ghci>:set -XTypeOperators+ghci>:set -XDataKinds+ghci>miniFrame = fmap (F.rcast @'["_cart_usersEmail" F.:-> Text, "_cart_usersDays_in_queue" F.:-> Int]) myFrame+ghci>mapM_ print miniFrame+{_cart_usersEmail :-> "james@example.com", _cart_usersDays_in_queue :-> 1}+{_cart_usersEmail :-> "betty@example.com", _cart_usersDays_in_queue :-> 42}+{_cart_usersEmail :-> "james@pallo.com", _cart_usersDays_in_queue :-> 1}+{_cart_usersEmail :-> "betty@sims.com", _cart_usersDays_in_queue :-> 42}+{_cart_usersEmail :-> "james@oreily.com", _cart_usersDays_in_queue :-> 1}+```+We could have used `loadRows2` in place of `loadRows1` in order to have the `WHERE ...` clause executed at the DB-level.+Note that in the above, once the query results are converted to a data frame, you're free to play with the frame in anyway, just like you would for a data frame created from a CSV.++### B. Streaming Workflow Steps++Once you're done working with a small subset of data, and would like to scale up your analysis by looking at a larger-subset-of/complete data, then it's time to look at writing your own `conduit` to process incoming rows from the DB.++1 - 4: Same as 'Interactive Workflow Steps'++5. **Writing your own streaming pipeline:**++Consider the following:+```haskell+streamRows :: IO ()+streamRows = do+ res <- withConnection connString $+ streamingSelectAllPipeline' _cart_users db 1000 (\c -> (_cart_usersFirst_name c) `like_` "J%") $+ (CL.map (\record -> F.rcast @["_cart_usersEmail" F.:-> Text, "_cart_usersIs_member" F.:-> Bool] record))+ mapM_ print res+```+In the above, we select all rows from the specified table that match a certain pattern (`"J%"`), then the function `streamingSelectAllPipeline'` converts the query results to vinyl records inside a `conduit` and sends it downstream, where we can operate on its output. Here, specifically, we do a column subset of the output using `rcast`, and `CL.map` applies `rcast` to every incoming row and sends it downstream, where the result gets returned. We then print the list of `vinyl` records.++In order to write your own conduit, all you need to know is that internally the conduit flow is as follows:++```haskell+(\c -> runConduit $ c .| CL.map createRecId+ .| recordProcessorConduit+ .| CL.take nrows)+```+In the above, you supply the `recordProcessorConduit` to the `streamingSelectAllPipeline'` function which takes a `vinyl` record as input and sends it downstream to the `CL.take`. Note that in all functions in the `Frames.SQL.Beam.Postgres.Streaming` module, you need to specify the number of rows you want to return (this is an upper bound of sorts, the actual number of rows returned depends on the amount of data present in your database).++## A Note on 'Canned Queries' and 'Filter Lambdas'++There are three things needed to execute a canned query (`SELECT * FROM tbl WHERE ...`):+* `PostgresTable a b`: auto generated by BeamSchemaGen module+* `PostgresDB b`: auto generated by BeamSchemaGen module+* `PostgresFilterLambda a s`: The `WHERE...` clause. All filter lambdas are of the form:+```haskell+(\tbl -> (_fieldName tbl) `op` constant)+```+or+```haskell+(\tbl -> (_fieldName1 tbl) `op` (_fieldName2 tbl))+```+In the above `op` can be one of : [`==.`, `/=.`, `>.`, `<.`, `<=.`, `>=.`, `between_`, `like_`, `in_` ] (some of these are not be applicable to the second case). You may use `(&&.)` and `(||.)` to combine expressions inside the lambda. To see some actual examples of 'filter lambdas', check out `test/LibSpec.hs` in this repository.++## Background Reading:++* About `deriveGeneric` and `deriveVinyl`: [Deriving Vinyl Representation From Plain Haskell Records][generic-vinyl]+* [Frames tutorial][frames-tutorial]+* [Beam tutorial and user-guide][beam-indepth]+++[generic-vinyl]: https://www.gagandeepbhatia.com/blog/deriving-vinyl-representation-from-plain-haskell-records/+[frames-tutorial]: http://acowley.github.io/Frames/+[beam-indepth]: https://tathougies.github.io/beam/
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ data/users.sql view
@@ -0,0 +1,86 @@+--+-- PostgreSQL database dump+--++-- Dumped from database version 9.5.13+-- Dumped by pg_dump version 10.4++SET statement_timeout = 0;+SET lock_timeout = 0;+SET idle_in_transaction_session_timeout = 0;+SET client_encoding = 'UTF8';+SET standard_conforming_strings = on;+SELECT pg_catalog.set_config('search_path', '', false);+SET check_function_bodies = false;+SET client_min_messages = warning;+SET row_security = off;++--+-- Name: plpgsql; Type: EXTENSION; Schema: -; Owner: -+--++CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;+++--+-- Name: EXTENSION plpgsql; Type: COMMENT; Schema: -; Owner: -+--++COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language';+++SET default_tablespace = '';++SET default_with_oids = false;++--+-- Name: cart_users; Type: TABLE; Schema: public; Owner: -+--++CREATE TABLE public.cart_users (+ email character varying NOT NULL,+ first_name character varying NOT NULL,+ last_name character varying NOT NULL,+ is_member boolean NOT NULL,+ days_in_queue integer NOT NULL+);+++--+-- Data for Name: cart_users; Type: TABLE DATA; Schema: public; Owner: -+--++COPY public.cart_users (email, first_name, last_name, is_member, days_in_queue) FROM stdin;+james@example.com James Smith t 1+betty@example.com Betty Jones f 42+james@pallo.com James Pallo t 1+betty@sims.com Betty Sims f 42+james@oreily.com James O'Reily t 1+sam@sophitz.com Sam Sophitz f 42+sam@jely.com Sam Jely t 1+sam@example.com Sam Taylor f 42+\.+++--+-- Name: cart_users cart_users_pkey; Type: CONSTRAINT; Schema: public; Owner: -+--++ALTER TABLE ONLY public.cart_users+ ADD CONSTRAINT cart_users_pkey PRIMARY KEY (email);+++--+-- Name: SCHEMA public; Type: ACL; Schema: -; Owner: -+--++REVOKE ALL ON SCHEMA public FROM PUBLIC;+REVOKE ALL ON SCHEMA public FROM postgres;+GRANT ALL ON SCHEMA public TO postgres;+GRANT ALL ON SCHEMA public TO PUBLIC;+++--+-- PostgreSQL database dump complete+--+
+ src/Frames/SQL/Beam/Postgres.hs view
@@ -0,0 +1,294 @@+{-|+Module : Frames.SQL.Beam.Postgres+Description : Re-exports the underlying modules. Contains usage examples.+Copyright : (c) Gagandeep Bhatia, 2018+License : BSD3+Stability : experimental++This library provides a way to access Postgres tables as data frames by providing helpers for generating+types (at compile time) corresponding to a database schema ("Frames.SQL.Beam.Postgres.BeamSchemaGen")+and canned queries to execute against a database ("Frames.SQL.Beam.Postgres.Query")+instance.+Additionally, provides utilities to convert plain Haskell records (i.e. the format of query results)+to vinyl records (upon which the Frames library is based) ("Frames.SQL.Beam.Postgres.Vinylize").+Can be used for interactive exploration by loading all data in-memory at once (and converting to+a data frame), and also in a constant memory streaming mode ("Frames.SQL.Beam.Postgres.Streaming").++-}+module Frames.SQL.Beam.Postgres+ (+ -- * Usage Example++ -- ** A. Interactive Workflow Steps+ -- $interactive++ -- ** B. Streaming Workflow Steps+ -- $streaming++ -- * A Note on 'Filter Lambdas'+ -- $filter-lambda-note++ -- * Re-exports of the underlying modules+ module Frames.SQL.Beam.Postgres.Vinylize+ , module Frames.SQL.Beam.Postgres.BeamSchemaGen+ , module Frames.SQL.Beam.Postgres.Query+ , module Frames.SQL.Beam.Postgres.Streaming++ -- * Re-exports of @beam-core@ and @beam-postgres@+ , module Database.Beam+ , module Database.Beam.Postgres++ -- * Postgres Column Types+ , ByteString+ , Text+ , UUID+ , Scientific+ , UTCTime+ , LocalTimestamp+ , UTCTimestamp+ , ZonedTimestamp+ , LocalTime+ , TimeOfDay+ , Date+ , Day++ -- * Re-exports for the @deriveGeneric@ plus @deriveVinyl@ combination+ , module Data.Coerce+ , module Generics.SOP+ , deriveGeneric++ ) where++import Frames.SQL.Beam.Postgres.BeamSchemaGen+import Frames.SQL.Beam.Postgres.Query+import Frames.SQL.Beam.Postgres.Streaming+import Frames.SQL.Beam.Postgres.Vinylize+++import Database.Beam+import Database.Beam.Postgres++import Data.ByteString (ByteString)+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Time (Day, LocalTime,+ TimeOfDay, UTCTime)+import Data.UUID.Types (UUID)+import Database.PostgreSQL.Simple.Time (Date, LocalTimestamp,+ UTCTimestamp,+ ZonedTimestamp)++import Data.Coerce+import Generics.SOP hiding (Generic,+ fieldName)+import Generics.SOP.TH (deriveGeneric)++{- $streaming++ Once you're done working with a small subset of data, and would like to+ scale up your analysis by looking at a larger-subset-of/complete data,+ then it's time to look at writing your own `conduit` to process incoming+ rows from the DB.++ @1 - 4:@ Same as 'Interactive Workflow Steps'++ @5.@ Writing your own streaming pipeline:+ Consider the following:++ @+ streamRows :: IO ()+ streamRows = do+ res <- 'withConnection' connString $+ 'streamingSelectAllPipeline'' _cart_users db 1000 (\c -> (_cart_usersFirst_name c) \`like_\` \"J%\") $+ (CL.map (\record -> F.rcast @["_cart_usersEmail" F.:-> Text, "_cart_usersIs_member" F.:-> Bool] record))+ mapM_ print res+ @++ In the above, we select all rows from the specified table that match a+ certain pattern (@\"J%\"@), then the function `streamingSelectAllPipeline'`+ converts the query results to vinyl records inside a @conduit@ and sends+ it downstream, where we can operate on its output.+ Here, specifically, we do a column subset of the output using @rcast@, and+ @CL.map@ applies @rcast@ to every incoming row and sends it downstream,+ where the result gets returned. We then print the list of `vinyl` records.++ In order to write your own conduit, all you need to know is that internally+ the conduit flow is as follows:++ @+ (\c -> runConduit $ c .| CL.map 'createRecId'+ .| recordProcessorConduit+ .| CL.take nrows)+ @++ In the above, you supply the `recordProcessorConduit` to the+ `streamingSelectAllPipeline'` function which takes a @vinyl@ record as input+ and sends it downstream to the @CL.take@. Note that in all functions in the+ "Frames.SQL.Beam.Postgres.Streaming" module, you need to specify the number+ of rows you want to return (this is an upper bound of sorts, the actual number+ of rows returned depends on the amount of data present in your database).++-}++{- $interactive+ @1.@ Bootstrap database schema: In a new project, assume a file @Example.hs@ is present+ in the @src@ directory with the code below. You may of course change the string passed+ to `genBeamSchema` to match your database instance of interest.++ @+ -- Example.hs+ -- Extensions elided+ module Example where++ import qualified Data.Conduit.List as CL+ import qualified Data.Vinyl.Functor as VF+ import qualified Frames as F+ import Frames.SQL.Beam.Postgres++ $('genBeamSchema' "host=localhost dbname=shoppingcart1")+ @++ @2.@ Next, execute @stack build@ or @stack ghci@. This compilation step, if completed+ without any errors, will establish a connection to your database instance of interest,+ read its schema, generate corresponding Haskell types and put them in a module named+ @NewBeamSchema@ in your @src@ directory (the file creation step is also part of the+ compilation process).++ @3.@ Assuming step 2 worked fine for you and you were using the test DB-dump from the+ @data@ folder in the repo, you should now have a module with code matching that in+ the @test/NewBeamSchema.hs@ file of this repository. In case you used some other database+ instance of your own, your generated module would look different.++ Import this module into @Example@:++ @+ -- Example.hs+ -- Extensions elided+ module Example where++ import qualified Data.Conduit.List as CL+ import qualified Data.Vinyl.Functor as VF+ import qualified Frames as F+ import Frames.SQL.Beam.Postgres++ import NewBeamSchema+++ $('genBeamSchema' "host=localhost dbname=shoppingcart1")+ @++ @4.@ Let's assume the table of interest is @Cart_usersT@. We want to pull rows from this+ table into a data frame to explore it interactively from @ghci@. Note that @beam@ query+ results are lists of plain Haskell records whereas "Frames" requires a list of @vinyl@+ records. In order to make this conversion, we add the following two invokations of+ code-generating (Template-Haskell) functions to @Example@:++ @+ -- Example.hs+ -- rest of the module elided++ import NewBeamSchema+++ $('genBeamSchema' "host=localhost dbname=shoppingcart1")++ 'deriveGeneric' ''Cart_usersT+ 'deriveVinyl' ''Cart_usersT+ @+ ...and build your project. This will add some additional code into the @Example@ module.+ You can inspect this code by adding the appropriate compiler flags to your @.cabal@ file.++ @5.@ Querying the DB:+ In this step we will execute a 'SELECT * FROM tbl WHERE...' query and convert the results+ to a data frame. Note that the table declaration (@_cart_users@) and the database+ declaration (@db@) are exported by the @NewBeamSchema@ module. More importantly,+ these declarations are autogenerated at compile time, so in case new tables are added,+ the corresponding declarations are automatically available for use.++ @+ -- Example.hs+ connString :: ByteString+ connString = "host=localhost dbname=shoppingcart1"++ -- selects 'n' rows from the specified table in the db.+ loadRows1 :: Int -> IO [(Cart_usersT Identity)]+ loadRows1 n =+ 'withConnection' connString $+ 'bulkSelectAllRows' _cart_users db n++ loadRows2 :: Int -> IO [(Cart_usersT Identity)]+ loadRows2 n =+ 'withConnection' connString $+ 'bulkSelectAllRowsWhere' _cart_users db n (\c -> (_cart_usersFirst_name c) \`like_\` \"J%\")+ @++ Notice the lambda passed to `bulkSelectAllRowsWhere` in `loadRows2`. This is a 'filter lambda'+ that forms the `WHERE ...` part of the SQL query and is executed at the DB-level. We will see+ how to create our own 'filter lambdas' in another section below. For now, if we were to+ enter @ghci@ by executing @stack ghci@ after adding the above code:++ @+ ghci>res1 <- loadRows1 5+ ghci>:t res1+ res1 :: [Cart_usersT Identity]+ ghci>:t (map createRecId res1)+ (map createRecId res1)+ :: [F.Rec+ VF.Identity+ '["_cart_usersEmail" F.:-> Text,+ "_cart_usersFirst_name" F.:-> Text,+ "_cart_usersLast_name" F.:-> Text,+ "_cart_usersIs_member" F.:-> Bool,+ "_cart_usersDays_in_queue" F.:-> Int]]+ ghci>:t (F.toFrame $ map createRecId res1)+ (F.toFrame $ map createRecId res1)+ :: F.Frame+ (F.Record+ '["_cart_usersEmail" F.:-> Text,+ "_cart_usersFirst_name" F.:-> Text,+ "_cart_usersLast_name" F.:-> Text,+ "_cart_usersIs_member" F.:-> Bool,+ "_cart_usersDays_in_queue" F.:-> Int])+ ghci>myFrame = F.toFrame $ map createRecId res1+ ghci>:set -XTypeApplications+ ghci>:set -XTypeOperators+ ghci>:set -XDataKinds+ ghci>miniFrame = fmap (F.rcast @'["_cart_usersEmail" F.:-> Text, "_cart_usersDays_in_queue" F.:-> Int]) myFrame+ ghci>mapM_ print miniFrame+ {_cart_usersEmail :-> "james@example.com", _cart_usersDays_in_queue :-> 1}+ {_cart_usersEmail :-> "betty@example.com", _cart_usersDays_in_queue :-> 42}+ {_cart_usersEmail :-> "james@pallo.com", _cart_usersDays_in_queue :-> 1}+ {_cart_usersEmail :-> "betty@sims.com", _cart_usersDays_in_queue :-> 42}+ {_cart_usersEmail :-> "james@oreily.com", _cart_usersDays_in_queue :-> 1}+ @++ We could have used `loadRows2` in place of `loadRows1` in order to have the @WHERE ...@+ clause executed at the DB-level.+ Note that in the above, once the query results are converted to a data frame, you're free+ to play with the frame in anyway, just like you would for a data frame created from a CSV.++-}++{- $filter-lambda-note+ A Note on 'Canned Queries' and 'Filter Lambdas':++ There are three things needed to execute a canned query ('SELECT * FROM tbl WHERE ...'):++ * @PostgresTable a b@: auto generated by BeamSchemaGen module+ * @PostgresDB b@: auto generated by BeamSchemaGen module+ * @PostgresFilterLambda a s@: The @WHERE...@ clause. All filter lambdas are of the form:++ @+ (\tbl -> (_fieldName tbl) `op` constant)+ @++ or++ @+ (\tbl -> (_fieldName1 tbl) `op` (_fieldName2 tbl))+ @+ In the above `op` can be one of : [`==.`, `/=.`, `>.`, `<.`, `<=.`, `>=.`, `between_`, `like_`, `in_` ]+ (some of these are not be applicable to the second case). You may use `&&.` and `||.` to combine+ expressions inside the lambda. To see some actual examples of 'filter lambdas', check out+ @test/LibSpec.hs@ in this repository.+-}
+ src/Frames/SQL/Beam/Postgres/BeamSchemaGen.hs view
@@ -0,0 +1,94 @@+-- | Functions that help generate Beam schema at compile time.+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Frames.SQL.Beam.Postgres.BeamSchemaGen (+ genBeamSchema,+ genBeamSchemaForTests,+ getCode+) where++import qualified Data.ByteString as B+import qualified Data.Text as T+import Database.Beam.Migrate.Simple (haskellSchema)+import Database.Beam.Postgres (runBeamPostgres)+import Database.Beam.Postgres.Migrate (migrationBackend)+import qualified Database.PostgreSQL.Simple as Pg+import Language.Haskell.TH+import System.Process++data FolderName = Src | Test++instance Show FolderName where+ show Src = "src"+ show Test = "test"++go :: B.ByteString -> FolderName -> Q String+go connString folder = do+ _ <- runIO $ readCreateProcess (shell ("touch " ++ (show folder) ++ "/NewBeamSchema.hs")) ""+ code <- runIO $ getCode connString+ return code++genBeamSchemaHelper :: B.ByteString -> FolderName -> Q [Dec]+genBeamSchemaHelper str folder = do+ code <- go str folder+ _ <- runIO $ readCreateProcess (shell ("echo " ++ (show code) ++ " > " ++ (show folder) ++ "/NewBeamSchema.hs")) ""+ [d| id x = x |]++-- | Takes code generated by @getCode@ and puts it in a file named+-- "NewBeamSchema.hs" in the 'src' directory (relative to your project's root)+-- at compile time.+genBeamSchema :: B.ByteString -> Q [Dec]+genBeamSchema str = genBeamSchemaHelper str Src++-- | Takes code generated by @getCode@ and puts it in a file named+-- "NewBeamSchema.hs" in the 'test' directory (relative to your project's root)+-- at compile time. Used internally in the test suite.+genBeamSchemaForTests :: B.ByteString -> Q [Dec]+genBeamSchemaForTests str = genBeamSchemaHelper str Test++-- | Generates Beam code for a schema corresponding to the postgres+-- database referred to in the connection string.+getCode :: B.ByteString -> IO String+getCode connString = do+ conn <- Pg.connectPostgreSQL connString+ codeString <- runBeamPostgres conn (haskellSchema migrationBackend)+ return $ sanitizeCode codeString++-- | Edits code at the Text level to bring it into a form that compiles.+sanitizeCode :: String -> String+sanitizeCode str =+ addExts ++ (T.unpack moduleNameAndImports) ++ addImports ++ (T.unpack beforeMigrationTySig) +++ "\nmigration :: Migration PgCommandSyntax (CheckedDatabaseSettings Postgres Db)\n" +++ (T.unpack includeThisChunk) +++ "\ndb :: DatabaseSettings Postgres Db\ndb = unCheckDatabase (runMigrationSilenced (migration))\n"+ where+ txt = T.pack str+ (_exts, remainingCode) = T.breakOn "module" txt+ (moduleNameAndImports, rest) = T.breakOn "data" remainingCode+ (beforeMigrationTySig, afterIncludingMigrationTySig) = T.breakOn "migration ::" rest+ (_migrationTySig, afterIncludingMigrationDecl) = T.breakOn "migration\n =" afterIncludingMigrationTySig+ (includeThisChunk, _discardThisChunk) = T.breakOn "db ::" afterIncludingMigrationDecl++addExts :: String+addExts =+ "{-# LANGUAGE StandaloneDeriving #-}\n" +++ "{-# LANGUAGE DeriveGeneric #-}\n" +++ "{-# LANGUAGE ExplicitNamespaces #-}\n" +++ "{-# LANGUAGE FlexibleContexts #-}\n" +++ "{-# LANGUAGE FlexibleInstances #-}\n" +++ "{-# LANGUAGE GADTs #-}\n" +++ "{-# LANGUAGE MultiParamTypeClasses #-}\n" +++ "{-# LANGUAGE OverloadedStrings #-}\n" +++ "{-# LANGUAGE ScopedTypeVariables #-}\n" +++ "{-# LANGUAGE StandaloneDeriving #-}\n" +++ "{-# LANGUAGE TypeFamilies #-}\n" +++ "{-# LANGUAGE TypeSynonymInstances #-}\n"+++addImports :: String+addImports =+ "import Database.Beam.Postgres\n\n\n"++++
+ src/Frames/SQL/Beam/Postgres/Helpers.hs view
@@ -0,0 +1,33 @@+-- | Template Haskell helper functions used internally.+{-# LANGUAGE TemplateHaskell #-}+module Frames.SQL.Beam.Postgres.Helpers (+ fNamesTypeLevel+) where++import Language.Haskell.TH++-- | Returns a type-level list of record field names+fNamesTypeLevel :: Name -> Q Type+fNamesTypeLevel name = do+ fnames <- fmap getRecordFields $ reify name+ fnames' <- fnames+ foldr (\x xs -> appT (appT promotedConsT x) xs) promotedNilT $ map (litT . strTyLit) fnames'+++getRecordFields :: Info -> Q [String]+getRecordFields (TyConI (DataD _ _ _ _ cons _)) = return $ concatMap getRF cons+getRecordFields _ = return []++getRF :: Con -> [String]+getRF (RecC _name fields) = map getFieldInfo fields+getRF _ = []++getFieldInfo :: (Name, Strict, Type) -> String+getFieldInfo (name, _, AppT (AppT (ConT _) (VarT _f)) (ConT _ty)) = (nameBase name)+getFieldInfo (_, _, _) = error "Inappropriate name passed"++++++
+ src/Frames/SQL/Beam/Postgres/Query.hs view
@@ -0,0 +1,70 @@+-- | This module provides certain "canned" queries that would be useful for+-- pulling Postgres rows into a data frame. Also contains a utility function+-- for handling results of join queries.+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module Frames.SQL.Beam.Postgres.Query where++import Data.Vinyl.TypeLevel+import Database.Beam+import Database.Beam.Postgres+import Database.Beam.Postgres.Syntax+import Frames.Frame+import Frames.InCore+import Frames.SQL.Beam.Postgres.Vinylize++type PostgresTable a b =+ DatabaseSettings Postgres b -> DatabaseEntity Postgres b (TableEntity a)++type PostgresDB b = DatabaseSettings Postgres b++type PostgresFilterLambda a s =+ (a (QExpr PgExpressionSyntax s)) -> QExpr PgExpressionSyntax s Bool++type JoinQueryResults a b = [(a Identity, b Identity)]++-- | Helps select all rows from a particular table in a database.+-- Note that the table and database declaration is present in+-- the module generated by @genBeamSchema@, invoked in the end-user code.+-- Equivalent to SQL: "SELECT * FROM tbl;" when run using an appropriate+-- run function from the "FramesBeam.Streaming" module.+allRows :: (Database Postgres b, Table a) =>+ PostgresTable a b+ -> PostgresDB b+ -> Q PgSelectSyntax b s (a (QExpr PgExpressionSyntax s))+allRows tbl db = all_ (tbl db)++-- | Helps select all rows from a particular table in a database that+-- satisfy a certain filter condition that is executed at the DB-level.+-- Note that the table and database declaration is present in+-- the module generated by @genBeamSchema@, invoked in the end-user code.+-- Equivalent to SQL: "SELECT * FROM tbl WHERE ...;" when run using an+-- appropriate run function from the "FramesBeam.Streaming" module.+allRowsWhere :: (Database Postgres b, Table a) =>+ PostgresTable a b+ -> PostgresDB b+ -> PostgresFilterLambda a s+ -> Q PgSelectSyntax b s (a (QExpr PgExpressionSyntax s))+allRowsWhere tbl db filterLambda =+ filter_ (filterLambda) (allRows tbl db)++-- | Function for creating a data frame from the results of executing+-- a join query.+join2 :: (Table a, Table b, GenericVinyl (a Identity) a_names a_rs,+ GenericVinyl (b Identity) b_names b_rs, RecVec (ZipTypes a_names a_rs),+ RecVec (ZipTypes b_names b_rs)) =>+ JoinQueryResults a b ->+ FrameRec (ZipTypes a_names a_rs ++ ZipTypes b_names b_rs)+join2 joinQueryResults =+ zipFrames aFrame bFrame+ where+ (aQRes, bQRes) = unzip joinQueryResults+ aRecs = map createRecId aQRes+ bRecs = map createRecId bQRes+ aFrame = toFrame aRecs+ bFrame = toFrame bRecs++
+ src/Frames/SQL/Beam/Postgres/Streaming.hs view
@@ -0,0 +1,100 @@+-- | Functions for streaming DB queries.+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+module Frames.SQL.Beam.Postgres.Streaming where++import Control.Exception (bracket)+import Control.Monad.Trans.Control (MonadBaseControl)+import qualified Data.ByteString as B+import Data.Conduit (ConduitT, runConduit, (.|))+import qualified Data.Conduit.List as CL+import Database.Beam+import Database.Beam.Postgres+import qualified Database.Beam.Postgres.Conduit as DBPC+import Database.Beam.Postgres.Syntax+import qualified Database.PostgreSQL.Simple as Pg+import Frames.Rec (Record)+import Frames.SQL.Beam.Postgres.Query+import Frames.SQL.Beam.Postgres.Vinylize++type NumberOfRows = Int++-- | Selects a given number of rows. Result returned as a list of plain+-- Haskell records.+bulkSelectAllRows ::+ (Database Postgres b, Table a, MonadIO m,+ MonadBaseControl IO m,+ FromBackendRow Postgres (a Identity)) =>+ PostgresTable a b+ -> PostgresDB b+ -> NumberOfRows+ -> Connection+ -> m [(a Identity)]+bulkSelectAllRows tbl db nrows conn =+ DBPC.runSelect conn (select (allRows tbl db)) (\c -> runConduit $ c .| CL.take nrows)++-- | Selects a given number of rows that satisfy a filter condition that+-- is executed at the DB-level. Result returned as a list of plain+-- Haskell records.+bulkSelectAllRowsWhere ::+ (Database Postgres b, Table a, MonadIO m,+ MonadBaseControl IO m,+ FromBackendRow Postgres (a Identity)) =>+ PostgresTable a b+ -> PostgresDB b+ -> NumberOfRows+ -> (forall s. PostgresFilterLambda a s)+ -> Connection+ -> m [(a Identity)]+bulkSelectAllRowsWhere tbl db nrows filterLambda conn =+ DBPC.runSelect conn (select (allRowsWhere tbl db filterLambda)) (\c -> runConduit $ c .| CL.take nrows)++-- | Selects a given number of rows, and processes them using a user-provided+-- @conduit@. User-provided @conduit@ takes in vinyl-records, and sends output+-- downstream. Result returned as a list of outputs of the @conduit@.+streamingSelectAllPipeline ::+ (Database Postgres b, Table a, MonadIO m, MonadBaseControl IO m,+ FromBackendRow Postgres (a Identity),+ GenericVinyl (a Identity) a_names a_rs) =>+ PostgresTable a b+ -> PostgresDB b+ -> NumberOfRows+ -> ConduitT (Record (ZipTypes a_names a_rs)) out m ()+ -> Connection+ -> m [out]+streamingSelectAllPipeline tbl db nrows recordProcessorConduit conn =+ DBPC.runSelect conn (select (allRows tbl db)) $+ (\c -> runConduit $ c .| CL.map createRecId+ .| recordProcessorConduit+ .| CL.take nrows)++-- | Similar as @streamingSelectAllPipeline@, with an additional @filterLambda@+-- parameter that executes a SQL 'SELECT * FROM tbl WHERE' at the DB-level+-- prior to sending results downstream.+streamingSelectAllPipeline' ::+ (Database Postgres b, Table a, MonadIO m, MonadBaseControl IO m,+ FromBackendRow Postgres (a Identity),+ GenericVinyl (a Identity) a_names a_rs) =>+ PostgresTable a b+ -> PostgresDB b+ -> NumberOfRows+ -> (forall s. PostgresFilterLambda a s)+ -> ConduitT (Record (ZipTypes a_names a_rs)) out m ()+ -> Connection+ -> m [out]+streamingSelectAllPipeline' tbl db nrows filterLambda recordProcessorConduit conn =+ DBPC.runSelect conn (select (allRowsWhere tbl db filterLambda)) $+ (\c -> runConduit $ c .| CL.map createRecId+ .| recordProcessorConduit+ .| CL.take nrows)++-- | Takes in the connection string, one of the the other 4 functions in+-- in this module with just the @Connection@ object unapplied. Internally,+-- it acquires the connection object using the string, passes it to the+-- function that performs an IO action, and then cleans up afterwards by+-- closing the database connection.+withConnection :: B.ByteString -> (Connection -> IO a) -> IO a+withConnection connString =+ bracket+ (connectPostgreSQL connString)+ (Pg.close)
+ src/Frames/SQL/Beam/Postgres/Vinylize.hs view
@@ -0,0 +1,59 @@+-- | Typeclass and an instance generator for the typeclass to convert+-- plain Haskell records to their vinyl representation.+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+module Frames.SQL.Beam.Postgres.Vinylize where++import Data.Proxy+import Data.Vinyl+import qualified Data.Vinyl.Functor as VF+import qualified Database.Beam as B+import Frames.Col+import Frames.SQL.Beam.Postgres.Helpers (fNamesTypeLevel)+import Generics.SOP+import qualified Generics.SOP.NP as GSN+import GHC.TypeLits+import Language.Haskell.TH++-- | Type family that generates the column types for the vinyl representation.+type family ZipTypes (ns :: [Symbol]) (ys :: [*]) = (zs :: [k]) | zs -> ns ys+type instance ZipTypes '[] '[] = '[]+type instance ZipTypes (n ': ns) (y ': ys) = ( n :-> y) ': (ZipTypes ns ys)++-- | Typeclass for converting a plain Haskell record to it's vinyl+-- representation.+class GenericVinyl a names rs | a -> names rs where+ type FieldNames a :: [Symbol]+ createRecId :: a -> Rec VF.Identity (ZipTypes names rs)++-- | Helps generate an instance for @GenericVinyl@, given a plain+-- Haskell record declaration name. Uses Template Haskell, so+-- if, say, the record is named @MyRecord@, then first you must+-- invoke @deriveGeneric ''MyRecord@ to get the Sum-of-Products (SOP)+-- representation (imported from @generic-sop@) of the record in-scope,+-- in the current module. This is followed by invoking+-- @deriveVinyl ''MyRecord@, which makes use of the SOP representation+-- of the plain record and generates a @GenericVinyl@ instance for the record.+deriveVinyl :: Name -> DecsQ+deriveVinyl name = entireInstance+ where+ n = conT name+ typeList1 = fNamesTypeLevel name+ entireInstance=+ [d|+ instance (((Code ($(n) B.Identity)) ~ '[rs]),+ (ns3 ~ FieldNames ($(n) B.Identity)) )+ => GenericVinyl ($(n) B.Identity) ns3 rs where+ type FieldNames ($(n) B.Identity) = $(typeList1)+ createRecId r = (go tranformedNP)+ where+ SOP (Z prod) = from r+ tranformedNP = (((GSN.trans_NP (Proxy :: Proxy (LiftedCoercible I VF.Identity)) (\(I x) -> VF.Identity $ coerce x) prod)) )+ go = GSN.cata_NP RNil (:&)+ |]
+ test/LibSpec.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+module LibSpec where++import Test.Hspec+import Test.Hspec.Core.Util++import qualified Data.Conduit.List as CL+import qualified Data.Vinyl.Functor as VF+import qualified Frames as F+import Frames.SQL.Beam.Postgres+import GHC.Exception (SomeException)+import NewBeamSchema++++$(genBeamSchemaForTests "host=localhost dbname=shoppingcart1")++deriveGeneric ''Cart_usersT++deriveVinyl ''Cart_usersT++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "Integration Tests (Requires DB environment)" $ do+ it "test0" $ do+ res <- safeTry $ test0+ (formatEx res) `shouldBe` (NoExceptionRaised)+ it "testStream1" $ do+ res <- safeTry $ testStream1 2+ (formatEx res) `shouldBe` (NoExceptionRaised)+ it "testStream2" $ do+ res <- safeTry $ testStream2 2+ (formatEx res) `shouldBe` (NoExceptionRaised)+ it "testStream3" $ do+ res <- safeTry $ testStream3 2+ (formatEx res) `shouldBe` (NoExceptionRaised)+ it "testStream4" $ do+ res <- safeTry $ testStream4+ (formatEx res) `shouldBe` (NoExceptionRaised)+ it "testStream5" $ do+ res <- safeTry $ testStream5+ (formatEx res) `shouldBe` (NoExceptionRaised)+ it "testStream6" $ do+ res <- safeTry $ testStream6+ (formatEx res) `shouldBe` (NoExceptionRaised)+ it "testStream7" $ do+ res <- safeTry $ testStream7+ (formatEx res) `shouldBe` (NoExceptionRaised)+ it "testStream8" $ do+ res <- safeTry $ testStream8+ (formatEx res) `shouldBe` (NoExceptionRaised)+ it "testStream9" $ do+ res <- safeTry $ testStream9+ (formatEx res) `shouldBe` (NoExceptionRaised)+ it "testStream10" $ do+ res <- safeTry $ testStream10+ (formatEx res) `shouldBe` (NoExceptionRaised)++data ExceptionStatus = ExceptionRaised String | NoExceptionRaised deriving (Show, Eq)++formatEx :: Either SomeException b -> ExceptionStatus+formatEx (Left e) = ExceptionRaised (formatException e)+formatEx (Right _) = NoExceptionRaised++connString :: ByteString+connString = "host=localhost dbname=shoppingcart1"++test0 :: IO ()+test0 = do+ res <- testStream1 5+ mapM_ print $ F.toFrame $ map createRecId res++testStream1 :: Int -> IO [(Cart_usersT Identity)]+testStream1 n =+ withConnection connString $+ bulkSelectAllRows _cart_users db n+++testStream2 :: Int -> IO ()+testStream2 n = do+ res <- testStream3 n+ mapM_ print $ map createRecId res+++testStream3 :: Int -> IO [(Cart_usersT Identity)]+testStream3 n =+ withConnection connString $+ bulkSelectAllRowsWhere _cart_users db n (\c -> (_cart_usersFirst_name c) `like_` "J%")++++testStream4 :: IO ()+testStream4 = do+ res <- testStream1 5+ mapM_ (print . createRecId) res+++testStream5 :: IO ()+testStream5 = do+ res <- withConnection connString $+ streamingSelectAllPipeline' _cart_users db 1000 (\c -> (_cart_usersFirst_name c) `like_` "J%") $+ (CL.isolate 1000)+ mapM_ print res++-- Streaming column-subset+testStream6 :: IO ()+testStream6 = do+ res <- withConnection connString $+ streamingSelectAllPipeline' _cart_users db 1000 (\c -> (_cart_usersFirst_name c) `like_` "J%") $+ (CL.map (\record -> F.rcast @["_cart_usersEmail" F.:-> Text, "_cart_usersIs_member" F.:-> Bool] record))+ mapM_ print res+++testStream7 :: IO ()+testStream7 = do+ res <- withConnection connString $+ streamingSelectAllPipeline' _cart_users db 1000 (\c ->+ (charLength_ $ _cart_usersFirst_name c) >. (charLength_ $ _cart_usersLast_name c)) $+ (CL.isolate 1000)+ mapM_ print res+++testStream8 :: IO ()+testStream8 = do+ res <- withConnection connString $+ streamingSelectAllPipeline' _cart_users db 1000 (\c ->+ ((_cart_usersFirst_name c) `like_` "J%") &&.+ ((_cart_usersLast_name c) `like_` "S%") ) $+ (CL.isolate 1000)+ mapM_ print res+++testStream9 :: IO ()+testStream9 = do+ res <- withConnection connString $+ streamingSelectAllPipeline' _cart_users db 1000 (\c ->+ ((_cart_usersFirst_name c) `like_` "J%") ||.+ ((_cart_usersDays_in_queue c) `in_` [1, 5, 10, 20, 30]) ) $+ (CL.isolate 1000)+ mapM_ print res+++testStream10 :: IO ()+testStream10 = do+ res <- withConnection connString $+ streamingSelectAllPipeline' _cart_users db 1000 (\c ->+ not_ ((_cart_usersFirst_name c) `like_` "J%") &&.+ ((_cart_usersDays_in_queue c) ==. 42) ) $+ (CL.isolate 1000)+ mapM_ print res
+ test/NewBeamSchema.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+module NewBeamSchema+ (db, migration, Db(..), Cart_usersT(..), Cart_usersT,+ Cart_usersKey)+ where+import Database.Beam+import Control.Applicative+import Data.Text (Text)+import Database.Beam.Migrate+ (CheckedDatabaseSettings, Migration, Sql92SaneDdlCommandSyntax,+ boolean, createTable, field, int, notNull, runMigrationSilenced,+ unCheckDatabase, varchar)++import Database.Beam.Postgres+++data Cart_usersT f = Cart_users{_cart_usersEmail ::+ Columnar f Text,+ _cart_usersFirst_name :: Columnar f Text,+ _cart_usersLast_name :: Columnar f Text,+ _cart_usersIs_member :: Columnar f Bool,+ _cart_usersDays_in_queue :: Columnar f Int}+ deriving Generic++instance Beamable Cart_usersT++type Cart_users = Cart_usersT Identity++deriving instance Show Cart_users++deriving instance Eq Cart_users++instance Table Cart_usersT where+ data PrimaryKey Cart_usersT f = Cart_usersKey (Columnar f Text)+ deriving Generic+ primaryKey = Cart_usersKey <$> _cart_usersEmail++type Cart_usersKey = PrimaryKey Cart_usersT Identity++instance Beamable (PrimaryKey Cart_usersT)++deriving instance Eq Cart_usersKey++deriving instance Show Cart_usersKey++data Db entity = Db{_cart_users ::+ entity (TableEntity Cart_usersT)}+ deriving Generic+++migration :: Migration PgCommandSyntax (CheckedDatabaseSettings Postgres Db)+migration+ = do cart_users <- createTable "cart_users"+ (Cart_users (field "email" (varchar Nothing) notNull)+ (field "first_name" (varchar Nothing) notNull)+ (field "last_name" (varchar Nothing) notNull)+ (field "is_member" boolean notNull)+ (field "days_in_queue" int notNull))+ pure Db{_cart_users = cart_users}++instance Database be Db+++db :: DatabaseSettings Postgres Db+db = unCheckDatabase (runMigrationSilenced (migration))+
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}