DBFunctor (empty) → 0.1.0.0
raw patch · 11 files changed
+7911/−0 lines, 11 filesdep +DBFunctordep +MissingHdep +basesetup-changed
Dependencies added: DBFunctor, MissingH, base, bytestring, cassava, cereal, containers, deepseq, either, text, transformers, unordered-containers, vector
Files
- ChangeLog.md +9/−0
- DBFunctor.cabal +100/−0
- LICENSE +30/−0
- README.md +294/−0
- Setup.hs +2/−0
- app/Main.hs +81/−0
- src/Etl/Internal/Core.hs +577/−0
- src/Etl/Julius.hs +1394/−0
- src/RTable/Core.hs +3726/−0
- src/RTable/Data/CSV.hs +745/−0
- test/DBFTests.hs +953/−0
+ ChangeLog.md view
@@ -0,0 +1,9 @@+# Changelog for DBFunctor + +### 0.1.0.0 + - Initial Version. Includes a full-working version of + - Julius: A type-level Embedded Domain Specific (EDSL) Language for ETL + - all common Relational Algebra operations, + - the ETL Mapping and other typical ETL constructs and operations + - operations applicable to all kinds of tabular data + - In-memory, database-less data processing.
+ DBFunctor.cabal view
@@ -0,0 +1,100 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 99671845ea773b6269f7c818d876e85741000c789f156dfc6c6f5d513eec516e++name: DBFunctor+version: 0.1.0.0+synopsis: DBFunctor - Functional Data Management => ETL/ELT Data Processing in Haskell+description: Please see the README on Github at https://github.com/nkarag/haskell-DBFunctor+category: ETL+homepage: https://github.com/nkarag/DBFunctor#readme+bug-reports: https://github.com/nkarag/DBFunctor/issues+author: Nikos Karagiannidis+maintainer: nkarag@gmail.com+copyright: 2018 Nikos Karagiannidis+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/nkarag/DBFunctor++library+ hs-source-dirs:+ src+ build-depends:+ MissingH+ , base >=4.7 && <5+ , bytestring+ , cassava+ , cereal+ , containers+ , deepseq+ , either+ , text+ , transformers+ , unordered-containers+ , vector+ exposed-modules:+ Etl.Internal.Core+ Etl.Julius+ RTable.Core+ RTable.Data.CSV+ other-modules:+ Paths_DBFunctor+ default-language: Haskell2010++executable dbfunctor-example+ main-is: Main.hs+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:+ DBFunctor+ , MissingH+ , base >=4.7 && <5+ , bytestring+ , cassava+ , cereal+ , containers+ , deepseq+ , either+ , text+ , transformers+ , unordered-containers+ , vector+ other-modules:+ Paths_DBFunctor+ default-language: Haskell2010++test-suite dbfunctor-test+ type: exitcode-stdio-1.0+ main-is: DBFTests.hs+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:+ DBFunctor+ , MissingH+ , base >=4.7 && <5+ , bytestring+ , cassava+ , cereal+ , containers+ , deepseq+ , either+ , text+ , transformers+ , unordered-containers+ , vector+ other-modules:+ Paths_DBFunctor+ default-language: Haskell2010
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Nikolaos Karagiannidis (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 Author name here 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,294 @@+ +# DBFunctor: Functional Data Management +## ETL/ELT* Data Processing in Haskell +**DBFunctor** is a [Haskell](https://haskell-lang.org/) library for *ETL/ELT[^1]* data processing of tabular data. What does this mean? +It simply means that whenever you have a ***data analysis*, *data preparation*, or *data transformation* task** and you want to do it with Haskell type-safe code, that you enjoy, love and trust so much, now you can! +### Main Features + 1. **Julius: An Embedded Domain Specific (EDSL) Language for ETL** +Provides an intuitive type-level Embedded Domain Specific (EDSL) Language called *Julius* for expressing complex data flows (i.e., ETL flows) but also for performing SQL-like data analysis. For more info check this [Julius tutorial](https://github.com/nkarag/haskell-DBFunctor/blob/master/doc/JULIUS-TUTORIAL.md). + 2. **Supports all known relational operations** +Julius supports all known relational operations (selection, projection, inner/outer join, grouping, ordering, aggregation, set operations etc.) + 3. **Provides the ETL Mapping and other typical ETL constructs and operations** +Julius implements typical ETL constructs such the *Column Mapping* and the *ETL Mapping*. + 4. **Applicable to all kinds of tabular data** +It is applicable to all kinds of "tabular data" (see explanation below) + 5. **In-memory, database-less data processing** +Data transformations or queries can run *in-memory*, within your Haskell code, without the need for a database to process your data. +6. **Offloading to a database for heavy queries/data transformations** +In addition, a query or data transformation can be *offloaded to a Database*, when data don't fit in memory, or heavy data processing over large volumes of data is required. The result can be fetched into the client's memory (i.e., where your haskell code runs) in the `RTable` data structure (see below), or stored in a database staging table. + 7. **Workflow Operations** +Julius provides common workflow operations. Workflows provide the ability to combine the evaluation of several different Julius Expressions (i.e., data pipelines) in an arbitrary logic. Examples of such operations include: + - Ability to handle a failure of some operation in a Julius expression: + - retry the failed operation (after corrective actions have taken place) and continue the evaluation of the Julius expression from this point onward. + - skip the failed operation and move on with the rest operations in the pipeline. + - restart the Julius expression from the beginning + - terminate the Julius expression and skip all pending operations + - Ability to start a Julius expression based on the success or failure result of another one + - Ability to fork several different Julius expressions that will run concurrently + - Conditional execution of Julius expressions and iteration functionality + - Workflow hierarchy (i.e., flows, subflows etc.) + 8. **"Declarative ETL"** +Enables *declarative ETL* implementation in the same sense that SQL is declarative for querying data (see more below). +### Typical examples of DBFunctor use-cases + - **Build database-less Haskell apps.** Build your data processing haskell apps without the need to import your data in a database for querying functionality or any for executing any data transformations. Analyze your CSV files in-place with plain haskell code (*for Haskellers!*). + - **Data Preparation.** I.e., clean-up data, calculate derived fields and variables, group by and aggregate etc., in order to feed some machine learning algorithm (*for Data Scientists*). + - **Data Transformation.** in order to transform data from Data Model A to Data Model B (typical use-case *for Data Engineers* who perform ETL/ELT[^1] tasks for feeding Data Warehouses or Data Marts) + - **Data Exploration.** Ad hoc data analysis tasks, in order to explore a data set for several purposes such as to find business insights and solve a specific business problem, or maybe to do data profiling in order to evaluate the quality of the data coming from a data source, etc (*for Data Analysts*). + - **Business Intelligence.** Build reports, or dashboards in order to share business insights with others and drive decision making process (*for BI power-users*) + +[^1]: **ETL** stands for **Extract Transform and Load** and is the standard technology for accomplishing data management tasks in Data Warehouses / Data Marts and in general for preparing data for any analytic purposes (Ad hoc queries, data exploration/data analysis, Reporting and Business Intelligence, feeding Machine Learning algorithms, etc.). **ELT** is a newer variation of ETL and means that the data are first Loaded into their final destination and then the data transformation runs in-place (as opposed to running at a separate staging area on possibly a different server)). + +### When to Use it? +DBFunctor should be used whenever a data analysis, or data manipulation, or data transformation task, over *tabular data*, must be performed and we wish to perform it with Haskell code -yielding all the well-known (to Haskellers) benefits from doing that- without the need to use a database query engine for this task. +DBFunctor provides an in-memory data structure called `RTable`, which implements the concept of a *Relational Table* (which -simply put- is a set of tuples) and all relevant relational algebra operations (Selection, Projection, Inner Join, Outer Joins, aggregations, Group By, Set Operations etc.). +Moreover, it implements the concept of *Column Mapping* (for deriving new columns based on existing ones - by splitting , merging , or with any other possible combination using a lambda expression or a function to define the new value) and that of the *ETL Mapping*, which is the equivalent of a "mapping" in an ETL tool (like Informatica, Talend, Oracle Data Integrator, SSIS, Pentaho, etc.). With this powerful construct, one can **build arbitrary complex data pipelines**, which can enable any type of data transformations and all these **by writing Haskell code.** +### What Kinds of Data? +With the term "tabular data" we mean any type of data that can be mapped to an RTable (e.g., CSV (or any other delimiter), DB Table/Query, JSON etc). Essentially, for a Haskell data type `a`to be "tabular", one must implement the following functions: +```haskell + toRTable :: RTableMData -> a -> RTable + fromRTable :: RTableMData -> RTable -> a +``` +These two functions implement the "logic" of transforming data type `a` to/from an RTable based on specific RTable Metadata, which specify the column names and data types of the RTable, as well as (optionally) the primary key constraint, and/or alternative unique constraints (i.e., similar information provided with a CREATE TABLE statement in SQL) . +By implementing these two functions, data type `a` essentially becomes an instance of the type `class RTabular` and thus can be transformed with the DBFunctor package. Currently, we have implemented a CSV data type (any delimeter allowed), based one the [Cassava](https://github.com/haskell-hvr/cassava) library, in order to enable data transformations over CSV files. +### Current Status and Roadmap +Currently (version DBFunctor-0.1.0.0), the DBFunctor package **is stable for in-memory data transformation and queries of CSV files** (any delimiter allowed), with the **Julius EDSL** (module Etl.Julius) , or directly via RTable functions (module RTable.Core). The use of the Julius language is strongly recommended because it simplifies greatly and standardizes the creation of complex ETL flows. +All in all, currently main features from #1 to #5 (from the list above) have been implemented and main features > #5 are future work that will be released in later versions. +### Future Vision -> Declarative ETL +Our ultimate goal is, eventually to make DBFunctor the **first *Declarative library for ETL/ELT, or data processing in general***, by exploiting the virtues of functional programming and Haskell strong type system in particular. +Here we use "declarative" in the same sense that SQL is a declarative language for querying data. (You only have to state what data you want to be returned and you don't care about how this will be accomplished - the DBMS engine does this for you behind the scenes). +In the same manner, ideally, one should only need to code the desired data transformation from a *source schema* to a *target schema*, as well as all the *data integrity constraints* and *business rules* that should hold after the transformation and not having to define all the individual steps for implementing the transformation, as it is the common practice today. This will yield tremendous benefits compared to common ETL challenges faced today and change the way we build data transformation flows. Just to name a few: + - Automated ETL coding driven by Source-to-Target mapping and business rules + - ETL code correctness out-of-the-box + - Data Integrity / Business Rules controls automatically embedded in your ETL code + - Self-documented ETL code (Your documentation i.e., the Source-to-Target mapping and the business rules, is also the only code you need to write!) + - Drastically minimize time-to-market for delivering Data Marts and Data Warehouses, or simply implementing Data Analysis tasks. + +The above is inspired by the theoretical work on Categorical Databases by David Spivak, +### Available Modules +*DBFunctor* consists of the following set of Haskell modules: +* **RTable.Core**: Implements the relational Table concept. Defines all necessary data types like `RTable` and `RTuple` as well as basic relational algebra operations on RTables. +* **Etl.Julius**: A simple Embedded DSL for ETL/ELT data processing in Haskell +* **RTable.Data.CSV**: Implements `RTable` over CSV (TSV, or any other delimiter) files logic. It is based on the [Cassava](https://github.com/haskell-hvr/cassava) library. +### A Very Simple Example + In this example, we will load a CSV file, turn it into an RTable and then issue a very simple query on it and print the result, just to show the whole concept. +So lets say we have a CSV file called test-data.csv. The file stores table metadata from an Oracle database. Each row represents a table stored in the database. Here is a small extract from the csv file: + + $ head test-data.csv + OWNER,TABLE_NAME,TABLESPACE_NAME,STATUS,NUM_ROWS,BLOCKS,LAST_ANALYZED + APEX_030200,SYS_IOT_OVER_71833,SYSAUX,VALID,0,0,06/08/2012 16:22:36 + APEX_030200,WWV_COLUMN_EXCEPTIONS,SYSAUX,VALID,3,3,06/08/2012 16:22:33 + APEX_030200,WWV_FLOWS,SYSAUX,VALID,10,3,06/08/2012 22:01:21 + APEX_030200,WWV_FLOWS_RESERVED,SYSAUX,VALID,0,0,06/08/2012 16:22:33 + APEX_030200,WWV_FLOW_ACTIVITY_LOG1$,SYSAUX,VALID,1,29,07/20/2012 19:07:57 + APEX_030200,WWV_FLOW_ACTIVITY_LOG2$,SYSAUX,VALID,14,29,07/20/2012 19:07:57 + APEX_030200,WWV_FLOW_ACTIVITY_LOG_NUMBER$,SYSAUX,VALID,1,3,07/20/2012 19:08:00 + APEX_030200,WWV_FLOW_ALTERNATE_CONFIG,SYSAUX,VALID,0,0,06/08/2012 16:22:33 + APEX_030200,WWV_FLOW_ALT_CONFIG_DETAIL,SYSAUX,VALID,0,0,06/08/2012 16:22:33 +**1. Turn the CSV file into an RTable** +The first thing we want to do is to read the file and turn it into an RTable. In order to do this we need to define the RTable Metadata, which is the same information one can provide in an SQL CREATE TABLE statement, i,e, column names, column data types and integrity constraints (Primary Key, Unique Key only - no Foreign Keys). So lets see how this is done: +```haskell + -- Define table metadata + src_DBTab_MData :: RTableMData + src_DBTab_MData = + createRTableMData ( "sourceTab" -- table name + ,[ ("OWNER", Varchar) -- Owner of the table + ,("TABLE_NAME", Varchar) -- Name of the table + ,("TABLESPACE_NAME", Varchar) -- Tablespace name + ,("STATUS",Varchar) -- Status of the table object (VALID/IVALID) + ,("NUM_ROWS", Integer) -- Number of rows in the table + ,("BLOCKS", Integer) -- Number of Blocks allocated for this table + ,("LAST_ANALYZED", Timestamp "MM/DD/YYYY HH24:MI:SS") -- Timestamp of the last time the table was analyzed (i.e., gathered statistics) + ] + ) + ["OWNER", "TABLE_NAME"] -- primary key + [] -- (alternative) unique keys + main :: IO () + main = do + -- read source csv file + srcCSV <- readCSV "./app/test-data.csv" + let + -- turn source csv to an RTable + src_DBTab = toRTable src_DBTab_MData srcCSV + ... +``` +We have used the following functions: +```haskell +-- | createRTableMData : creates RTableMData from input given in the form of a list +-- We assume that the column order of the input list defines the fixed column order of the RTuple. +createRTableMData :: + (RTableName, [(ColumnName, ColumnDType)]) + -> [ColumnName] -- ^ Primary Key. [] if no PK exists + -> [[ColumnName]] -- ^ list of unique keys. [] if no unique keys exists + -> RTableMData +``` +in order to define the RTable metadata. +For reading the CSV file we have used: +```haskell +-- | readCSV: reads a CSV file and returns a CSV data type (Treating CSV data as opaque byte strings) +readCSV :: + FilePath -- ^ the CSV file + -> IO CSV -- ^ the output CSV type +``` +Finally, in order to turn the CSV data type into an RTable, we have used function: +```haskell +toRTable :: RTableMData -> CSV -> RTable +``` +which comes from the `RTabular` type class instance of the `CSV` data type. + **2. Query the RTable** +Once we have created an RTable, we can issue queries on it, or apply any type of data transformations. Note that due to immutability, each query or data transformation creates a new RTable. + We will now issue the following query: +We return all the rows, which correspond to some filter predicate - in particular all rows where the table_name starts with a 'B'. For this we use the Julius EDSL, in order to express the query and then with the function `juliusToRTable :: ETLMappingExpr -> RTable `, we evaluate the expression into an RTable. +```haskell +tabs_with_B = juliusToRTable $ + EtlMapStart + :-> (EtlR $ + ROpStart + -- apply a filter on RTable "src_DBTab" based on a predicate, expressed with a lambda expression + :. (Filter (From $ Tab src_DBTab) $ + FilterBy (\t -> let fstChar = Data.Text.take 1 $ fromJust $ toText (t <!> "TABLE_NAME") + in fstChar == (pack "B")) + ) + -- A simple column projection applied on the Previous result + :. (Select ["OWNER", "TABLE_NAME"] $ From Previous) + ) +``` +A Julius expression is a *data processing chain* consisting of various Relational Algebra operations `(EtlR $ ...)` and/or column mappings `(EtlC $ ...)` connected together via the `:->` data constructor, of the form (Julius expressions are read *from top-to-bottom or from left-to-right*): +```haskell +myJulExpression = + EtlMapStart + :-> (EtlC $ ...) -- this is a Column Mapping + :-> (EtlR $ -- this is a series of Relational Algebra Operations + ROpStart + :. (Rel Operation 1) -- a relational algebra operation + :. (Rel Operation 2)) + :-> (EtlC $ ...) -- This is another Column Mapping + :-> (EtlR $ -- more relational algebra operations + ROpStart + :. (Rel Operation 3) + :. (Rel Operation 4) + :. (Rel Operation 5)) + :-> (EtlC $ ...) -- This is Column Mapping 3 + :-> (EtlC $ ...) -- This is Column Mapping 4 + ... +``` +In our example, the Julius expression consists only of two relational algebra operations: a `Filter` operation, which uses an RTuple predicate of the form `RTuple -> Bool` to filter out RTuples (i.e., rows) that dont satisfy this predicate. The predicate is expressed as the lambda expression: +```haskell +FilterBy (\t -> let fstChar = Data.Text.take 1 $ fromJust $ toText (t <!> "TABLE_NAME") + in fstChar == (pack "B")) +``` +The second relational operation is a simple Projection expressed with the node `(Select ["OWNER", "TABLE_NAME"] $ From Previous)` +Finally, in order to print the result of the query on the screen, we use the `printfRTable :: RTupleFormat -> RTable -> IO()` function, which brings printf-like functionality into the printing of RTables +And here is the output: +``` +$ stack exec -- dbfunctor-example +These are the tables that start with a "B": + +------------------------------------- +OWNER TABLE_NAME +~~~~~ ~~~~~~~~~~ +DBSNMP BSLN_BASELINES +DBSNMP BSLN_METRIC_DEFAULTS +DBSNMP BSLN_STATISTICS +DBSNMP BSLN_THRESHOLD_PARAMS +SYS BOOTSTRAP$ + +5 rows returned +------------------------------------- +``` +Here is the complete example. +```haskell +module Main where + +import RTable.Core (RTableMData ,ColumnDType (..) ,createRTableMData, printfRTable, genRTupleFormat, genDefaultColFormatMap, toText, (<!>)) +import RTable.Data.CSV (CSV, readCSV, toRTable) +import Etl.Julius + +import Data.Text (take, pack) +import Data.Maybe (fromJust) + + +-- Define Source Schema (i.e., a set of tables) + +-- | This is the basic source table +-- It includes the tables of an imaginary database +src_DBTab_MData :: RTableMData +src_DBTab_MData = + createRTableMData ( "sourceTab" -- table name + ,[ ("OWNER", Varchar) -- Owner of the table + ,("TABLE_NAME", Varchar) -- Name of the table + ,("TABLESPACE_NAME", Varchar) -- Tablespace name + ,("STATUS",Varchar) -- Status of the table object (VALID/IVALID) + ,("NUM_ROWS", Integer) -- Number of rows in the table + ,("BLOCKS", Integer) -- Number of Blocks allocated for this table + ,("LAST_ANALYZED", Timestamp "MM/DD/YYYY HH24:MI:SS") -- Timestamp of the last time the table was analyzed (i.e., gathered statistics) + ] + ) + ["OWNER", "TABLE_NAME"] -- primary key + [] -- (alternative) unique keys + +-- | Define Target Schema (i.e., a set of tables) + + +main :: IO () +main = do + -- read source csv file + srcCSV <- readCSV "./app/test-data.csv" + + let + -- create source RTable from source csv + src_DBTab = toRTable src_DBTab_MData srcCSV + + -- select all tables starting with a B + tabs_with_B = juliusToRTable $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (Filter (From $ Tab src_DBTab) $ + FilterBy (\t -> let fstChar = Data.Text.take 1 $ fromJust $ toText (t <!> "TABLE_NAME") in fstChar == (pack "B")) + ) + :. (Select ["OWNER", "TABLE_NAME"] $ + From Previous + ) + ) + + putStrLn "\nThese are the tables that start with a \"B\":\n" + + -- print source RTable first 100 rows + printfRTable ( + -- this is the equivalent when pinting on the screen to a list of columns in a SELECT clause in SQL + genRTupleFormat ["OWNER", "TABLE_NAME"] genDefaultColFormatMap + ) $ tabs_with_B +``` + +### Julius Tutorial +We have written [a Julius tutorial](https://github.com/nkarag/haskell-DBFunctor/blob/master/doc/JULIUS-TUTORIAL.md) to help you get started with Julius DSL. +<a name="howtorun"></a> +### How to run +Download or clone DBFunctor in a new directory, +``` +$ git clone https://github.com/nkarag/haskell-DBFunctor +$ cd haskell-DBFunctor/ +``` +then run +``` +$ stack build --haddock +``` +in order to build the code and generate the documentation with the [stack](https://docs.haskellstack.org/en/stable/README/) tool. +In order, to use it in you own haskell app, you only need to import the Julius module (you dont have to import RTable.Core, because it is exported by Julius) +```Haskell +import Etl.Julius +``` +Finally, for a successful build of your app, you must direct stack to treat it as a local package (Soon DBFunctor will be added to Hackage and you will not need to use it as a local package.). +So you have to include it in your stack.yaml file, as a local package that you want to link your code to. +``` +packages: +- location: . +- location: <path where DBFunctor package has been cloned> + extra-dep: true +``` +And of course, you must not forget to add the dependency of your app to the DBFunctor package in your .cabal file +``` + build-depends: ... + , DBFunctor + +```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-} + +module Main where + +-- import RTable.Core (RTableMData ,ColumnDType (..) ,createRTableMData, restrictNrows, printfRTable, genRTupleFormat, genDefaultColFormatMap, toText, (<!>)) +import RTable.Data.CSV (readCSV, toRTable) -- MyType (..) ) +import Etl.Julius + +import Data.Text (take, pack) +import Data.Maybe (fromJust) + + +-- Define Source Schema (i.e., a set of tables) + +-- | This is the basic source table +-- It includes the tables of an imaginary database +src_DBTab_MData :: RTableMData +src_DBTab_MData = + createRTableMData ( "sourceTab" -- table name + ,[ ("OWNER", Varchar) -- Owner of the table + ,("TABLE_NAME", Varchar) -- Name of the table + ,("TABLESPACE_NAME", Varchar) -- Tablespace name + ,("STATUS",Varchar) -- Status of the table object (VALID/IVALID) + ,("NUM_ROWS", Integer) -- Number of rows in the table + ,("BLOCKS", Integer) -- Number of Blocks allocated for this table + ,("LAST_ANALYZED", Timestamp "MM/DD/YYYY HH24:MI:SS") -- Timestamp of the last time the table was analyzed (i.e., gathered statistics) + ] + ) + ["OWNER", "TABLE_NAME"] -- primary key + [] -- (alternative) unique keys + +-- | Define Target Schema (i.e., a set of tables) + + +main :: IO () +main = do + -- read source csv file + srcCSV <- readCSV "./app/test-data.csv" + + let + --t = toRTable src_DBTab_MData (MyType (4::Int)) + + -- create source RTable from source csv + src_DBTab = toRTable src_DBTab_MData srcCSV + -- get only the first 10 rows + src_DBTab_10rows = limit 10 src_DBTab + -- select all tables starting with a B + tabs_with_B = juliusToRTable $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (Filter (From $ Tab src_DBTab) $ + FilterBy (\t -> let fstChar = Data.Text.take 1 $ fromJust $ toText (t <!> "TABLE_NAME") in fstChar == (pack "B")) + ) + :. (Select ["OWNER", "TABLE_NAME"] $ + From Previous + ) + ) + + putStrLn "\nThese are the fisrt 10 rows of the source table:\n" + -- print source RTable first 100 rows + printfRTable ( + -- this is the equivalent when printing on the screen to a list of columns in a SELECT clause in SQL + genRTupleFormat ["OWNER", "TABLE_NAME", "TABLESPACE_NAME", "STATUS", "NUM_ROWS", "BLOCKS", "LAST_ANALYZED"] genDefaultColFormatMap + ) $ src_DBTab_10rows + + + + putStrLn "\nThese are the tables that start with a \"B\":\n" + -- print RTuples with table_names that start with a 'B' + printfRTable ( + -- this is the equivalent when printing on the screen to a list of columns in a SELECT clause in SQL + genRTupleFormat ["OWNER", "TABLE_NAME"] genDefaultColFormatMap + ) $ tabs_with_B + + + -- Do ETL and get result + + -- print result on screen + + -- save result into files
+ src/Etl/Internal/Core.hs view
@@ -0,0 +1,577 @@+{-| +Module : ETL +Description : Implements ETL operations over RTables. +Copyright : (c) Nikos Karagiannidis, 2018 + +License : BSD3 +Maintainer : nkarag@gmail.com +Stability : stable +Portability : POSIX + +This is an internal module (i.e., not to be imported directly) that implements the core ETL functionality +that is exposed via the __Julius__ EDSL for ETL/ELT found in the "Etl.Julius" module) +-} + +{-# LANGUAGE OverloadedStrings #-} +-- :set -XOverloadedStrings +--{-# LANGUAGE OverloadedRecordFields #-} +--{-# LANGUAGE DuplicateRecordFields #-} + +module Etl.Internal.Core + ( + -- * Basic Data Types + RColMapping (..) + ,ColXForm + ,createColMapping + ,ETLOperation (..) + ,ETLMapping (..) + ,YesNo (..) + -- * Execution of an ETL Mapping + ,runCM + ,etlOpU + ,etlOpB + ,etl + ,etlRes + -- * Functions for \"Building\" an ETL Mapping + ,rtabToETLMapping + ,createLeafETLMapLD + ,createLeafBinETLMapLD + ,connectETLMapLD + -- * Various ETL Operations + , + ) where + +-- Data.RTable +import RTable.Core + +-- Text +import Data.Text as T + +-- HashMap -- https://hackage.haskell.org/package/unordered-containers-0.2.7.2/docs/Data-HashMap-Strict.html +import Data.HashMap.Strict as HM + +-- Data.List +import Data.List (notElem, map, zip) + +-- Data.Vector +import Data.Vector as V + +data YesNo = Yes | No deriving (Eq, Show) + +-- | This is the basic data type to define the column-to-column mapping from a source 'RTable' to a target 'RTable'. +-- Essentially, an 'RColMapping' represents the column-level transformations of an 'RTuple' that will yield a target 'RTuple'. +-- +-- A mapping is simply a triple of the form ( Source-Column(s), Target-Column(s), Transformation, RTuple-Filter), where we define the source columns +-- over which a transformation (i.e. a function) will be applied in order to yield the target columns. Also, an 'RPredicate' (i.e. a filter) might be applied on the source 'RTuple'. +-- Remember that an 'RTuple' is essentially a mapping between a key (the Column Name) and a value (the 'RDataType' value). So the various 'RColMapping' +-- data constructors below simply describe the possible modifications of an 'RTuple' orginating from its own columns. +-- +-- So, we can have the following mapping types: +-- a) single-source column to single-target column mapping (1 to 1), +-- the source column will be removed or not based on the 'removeSrcCol' flag (dublicate column names are not allowed in an 'RTuple') +-- b) multiple-source columns to single-target column mapping (N to 1), +-- The N columns will be merged to the single target column based on the transformation. +-- The N columns will be removed from the RTuple or not based on the 'removeSrcCol' flag (dublicate column names are not allowed in an 'RTuple') +-- c) single-source column to multiple-target columns mapping (1 to M) +-- the source column will be "expanded" to M target columns based ont he transformation. +-- the source column will be removed or not based on the 'removeSrcCol' flag (dublicate column names are not allowed in an 'RTuple') +-- d) multiple-source column to multiple target columns mapping (N to M) +-- The N source columns will be mapped to M target columns based on the transformation. +-- The N columns will be removed from the RTuple or not based on the 'removeSrcCol' flag (dublicate column names are not allow in an 'RTuple') +-- +-- Some examples of mapping are the following: +-- +-- @ +-- ("Start_Date", No, "StartDate", \t -> True) -- copy the source value to target and dont remove the source column, so the target RTuple will have both columns "Start_Date" and "StartDate" +-- -- with the exactly the same value) +-- +-- (["Amount", "Discount"], Yes, "FinalAmount", (\[a, d] -> a * d) ) -- "FinalAmount" is a derived column based on a function applied to the two source columns. +-- -- In the final RTuple we remove the two source columns. +-- @ +-- +-- An 'RColMapping' can be applied with the 'runCM' (runColMapping) operator +-- +data RColMapping = + ColMapEmpty + | RMap1x1 { srcCol :: ColumnName, removeSrcCol :: YesNo, trgCol :: ColumnName, transform1x1 :: RDataType -> RDataType, srcRTupleFilter:: RPredicate } -- ^ single-source column to single-target column mapping (1 to 1). + | RMapNx1 { srcColGrp :: [ColumnName], removeSrcCol :: YesNo, trgCol :: ColumnName, transformNx1 :: [RDataType] -> RDataType, srcRTupleFilter:: RPredicate } -- ^ multiple-source columns to single-target column mapping (N to 1) + | RMap1xN { srcCol :: ColumnName, removeSrcCol :: YesNo, trgColGrp :: [ColumnName], transform1xN :: RDataType -> [RDataType], srcRTupleFilter:: RPredicate } -- ^ single-source column to multiple-target columns mapping (1 to N) + | RMapNxM { srcColGrp :: [ColumnName], removeSrcCol :: YesNo, trgColGrp :: [ColumnName], transformNxM :: [RDataType] -> [RDataType], srcRTupleFilter:: RPredicate } -- ^ multiple-source column to multiple target columns mapping (N to M) + +-- | A Column Transformation function data type. +-- It is used in order to define an arbitrary column-level transformation (i.e., from a list of N input Column-Values we produce a list of M derived (output) Column-Values). +-- A Column value is represented with the 'RDataType'. +type ColXForm = [RDataType] -> [RDataType] + +-- | Constructs an RColMapping. +-- This is the suggested method for creating a column mapping and not by calling the data constructors directly. +createColMapping :: + [ColumnName] -- ^ List of source column names + -> [ColumnName] -- ^ List of target column names + -> ColXForm -- ^ Column Transformation function + -> YesNo -- ^ Remove source column option + -> RPredicate -- ^ Filtering predicate + -> RColMapping -- ^ Output Column Mapping +createColMapping (src:[]) (trg:[]) xForm remove fPred = RMap1x1 {srcCol = src, removeSrcCol = remove, trgCol = trg, transform1x1 = \x -> unlist $ xForm (x:[]), srcRTupleFilter = fPred} + where unlist :: [a] -> a + unlist (x:[]) = x -- since this is a 1x1 col mapping, we are sure that xForm will return a single element list +createColMapping srcCols (trg:[]) xForm remove fPred = RMapNx1 {srcColGrp = srcCols, removeSrcCol = remove, trgCol = trg, transformNx1 = \x -> unlist $ xForm (x), srcRTupleFilter = fPred} + where unlist :: [a] -> a + unlist (x:[]) = x -- since this is a Nx1 col mapping, we are sure that xForm will return a single element list +createColMapping (src:[]) trgCols xForm remove fPred = RMap1xN {srcCol = src, removeSrcCol = remove, trgColGrp = trgCols, transform1xN = \x -> xForm (x:[]), srcRTupleFilter = fPred} +createColMapping srcCols trgCols xForm remove fPred = RMapNxM {srcColGrp = srcCols, removeSrcCol = remove, trgColGrp = trgCols, transformNxM = xForm, srcRTupleFilter = fPred} + + +-- | runCM operator executes an RColMapping +-- If a target-column has the same name with a source-column and a DontRemoveSrc (i.e., removeSrcCol == No) has been specified, then the (target-column, target-value) key-value pair, +-- overwrites the corresponding (source-column, source-value) key-value pair +runCM = runColMapping + +-- | Apply an RColMapping to a source RTable and produce a new RTable. +-- If a target-column has the same name with a source-column and a DontRemoveSrc (i.e., removeSrcCol == No) has been specified, then the (target-column, target-value) key-value pair, +-- overwrites the corresponding (source-column, source-value) key-value pair. +-- If a filter is embedded in the 'RColMapping', then the returned 'RTable' will include only the 'RTuple's that satisfy the filter predicate. +runColMapping :: RColMapping -> RTable -> RTable +runColMapping ColMapEmpty rtabS = rtabS +runColMapping rmap rtabS = + if isRTabEmpty rtabS + then emptyRTable + else + case rmap of + RMap1x1 {srcCol = src, trgCol = trg, removeSrcCol = rmvFlag, transform1x1 = xform, srcRTupleFilter = pred} -> do -- an RTable is a Monad just like a list is a Monad, representing a non-deterministic value + srcRtuple <- f pred rtabS + let + -- 1. get original column value + srcValue = getRTupColValue src srcRtuple + -- srcValue = HM.lookupDefault Null -- return Null if value cannot be found based on column name + -- src -- column name to look for (source) - i.e., the key in the HashMap + -- srcRtuple -- source RTuple (i.e., a HashMap ColumnName RDataType) + + -- 2. apply transformation to retrieve new column value + trgValue = xform srcValue + + -- 3. remove the original ColumnName, Value mapping from the RTuple + rtupleTemp = + case rmvFlag of + Yes -> HM.delete src srcRtuple + No -> srcRtuple + + -- 4. insert new (ColumnName, Value) pair and thus create the target RTuple + trgRtuple = HM.insert trg trgValue rtupleTemp + + -- return new RTable + return trgRtuple + + RMapNx1 {srcColGrp = srcL, trgCol = trg, removeSrcCol = rmvFlag, transformNx1 = xform, srcRTupleFilter = pred} -> do -- an RTable is a Monad just like a list is a Monad, representing a non-deterministic value + srcRtuple <- f pred rtabS + let + -- 1. get original column value (in this case it is a list of values) + srcValueL = Data.List.map ( \src -> getRTupColValue src srcRtuple + + -- \src -> HM.lookupDefault Null -- return Null if value cannot be found based on column name + -- src -- column name to look for (source) - i.e., the key in the HashMap + -- srcRtuple -- source RTuple (i.e., a HashMap ColumnName RDataType) + ) srcL + + -- 2. apply transformation to retrieve new column value + trgValue = xform srcValueL + + -- 3. remove the original (ColumnName, Value) mappings from the RTuple (i.e., remove ColumnNames mentioned in the RColMapping from source RTuple) + rtupleTemp = + case rmvFlag of + Yes -> HM.filterWithKey (\colName _ -> Data.List.notElem colName srcL) srcRtuple + No -> srcRtuple + + -- 4. insert new ColumnName, Value mapping as the target RTuple must be + trgRtuple = HM.insert trg trgValue rtupleTemp + -- return new RTable + return trgRtuple + + RMap1xN {srcCol = src, trgColGrp = trgL, removeSrcCol = rmvFlag, transform1xN = xform, srcRTupleFilter = pred} -> do -- an RTable is a Monad just like a list is a Monad, representing a non-deterministic value + srcRtuple <- f pred rtabS + let + -- 1. get original column value + srcValue = getRTupColValue src srcRtuple + + -- srcValue = HM.lookupDefault Null -- return Null if value cannot be found based on column name + -- src -- column name to look for (source) - i.e., the key in the HashMap + -- srcRtuple -- source RTuple (i.e., a HashMap ColumnName RDataType) + + -- 2. apply transformation to retrieve new column value list + trgValueL = xform srcValue + + -- 3. remove the original ColumnName, Value mapping from the RTuple + rtupleTemp = + case rmvFlag of + Yes -> HM.delete src srcRtuple + No -> srcRtuple + + -- 4. insert new (ColumnName, Value) pairs to the target RTuple + tempL = Data.List.zip trgL trgValueL + trgRtuple = HM.union (HM.fromList tempL) rtupleTemp -- implement as a hashmap union between new (columnName,value) pairs and source tuple + + -- return new RTable + return trgRtuple + + RMapNxM {srcColGrp = srcL, trgColGrp = trgL, removeSrcCol = rmvFlag, transformNxM = xform, srcRTupleFilter = pred} -> do -- an RTable is a Monad just like a list is a Monad, representing a non-deterministic value + srcRtuple <- f pred rtabS + let + -- 1. get original column value (in this case it is a list of values) + srcValueL = Data.List.map ( \src -> getRTupColValue src srcRtuple + + -- \src -> HM.lookupDefault Null -- return Null if value cannot be found based on column name + -- src -- column name to look for (source) - i.e., the key in the HashMap + -- srcRtuple -- source RTuple (i.e., a HashMap ColumnName RDataType) + ) srcL + + -- 2. apply transformation to retrieve new column value + trgValueL = xform srcValueL + + -- 3. remove the original ColumnName, Value mapping from the RTuple + rtupleTemp = + case rmvFlag of + Yes -> HM.filterWithKey (\colName _ -> Data.List.notElem colName srcL) srcRtuple + No -> srcRtuple + + -- 4. insert new (ColumnName, Value) pairs to the target RTuple + tempL = Data.List.zip trgL trgValueL + trgRtuple = HM.union (HM.fromList tempL) rtupleTemp -- implement as a hashmap union between new (columnName,value) pairs and source tuple + + -- return new RTable + return trgRtuple + +-- | An ETL operation applied to an RTable can be either an 'ROperation' (a relational agebra operation like join, filter etc.) defined in "RTable.Core" module, +-- or an 'RColMapping' applied to an 'RTable' +data ETLOperation = + ETLrOp { rop :: ROperation } + | ETLcOp { cmap :: RColMapping } + + + +-- | executes a Unary ETL Operation +etlOpU = runUnaryETLOperation + +-- | executes an ETL Operation +runUnaryETLOperation :: + ETLOperation + -> RTable -- ^ input RTable + -> RTable -- ^ output RTable +runUnaryETLOperation op inpRtab = + case op of + ETLrOp { rop = relOp } -> ropU relOp inpRtab + ETLcOp { cmap = colMap } -> runCM colMap inpRtab + +-- | executes a Binary ETL Operation +etlOpB = runBinaryETLOperation + +-- | executes an ETL Operation +runBinaryETLOperation :: + ETLOperation + -> RTable -- ^ input RTable1 + -> RTable -- ^ input RTable2 + -> RTable -- ^ output RTable +runBinaryETLOperation ETLrOp {rop = relOp} inpT1 inpT2 = ropB relOp inpT1 inpT2 + + +-- | ETLmapping : it is the equivalent of a mapping in an ETL tool and consists of a series of ETLOperations that are applied, one-by-one, +-- to some initial input RTable, but if binary ETLOperations are included in the ETLMapping, then there will be more than one input RTables that +-- the ETLOperations of the ETLMapping will be applied to. When we apply (i.e., run) an ETLOperation of the ETLMapping we get a new RTable, +-- which is then inputed to the next ETLOperation, until we finally run all ETLOperations. The purpose of the execution of an ETLMapping is +-- to produce a single new RTable as the result of the execution of all the ETLOperations of the ETLMapping. +-- In terms of database operations an ETLMapping is the equivalent of an CREATE AS SELECT (CTAS) operation in an RDBMS. This means that +-- anything that can be done in the SELECT part (i.e., column projection, row filtering, grouping and join operations, etc.) +-- in order to produce a new table, can be included in an ETLMapping. +-- +-- An ETLMapping is executed with the etl (runETLmapping) operator +-- +-- Implementation: +-- An ETLMapping is implemented as a binary tree where the node represents the ETLOperation to be executed and the left branch is another +-- ETLMapping, while the right branch is an RTable (that might be empty in the case of a Unary ETLOperation). +-- Execution proceeds from bottom-left to top-right. +-- This is similar in concept to a left-deep join tree. In a Left-Deep ETLOperation tree the "pipe" of ETLOperations comes from +-- the left branches always. +-- The leaf node is always an ETLMapping with an ETLMapEmpty in the left branch and an RTable in the right branch (the initial RTable inputed +-- to the ETLMapping). +-- In this way, the result of the execution of each ETLOperation (which is an RTable) is passed on to the next ETLOperation. Here is an example: +-- +-- @ +-- A Left-Deep ETLOperation Tree +-- +-- final RTable result +-- / +-- etlOp3 +-- / \ +-- etlOp2 rtab2 +-- / \ +-- A leaf-node --> etlOp1 emptyRTab +-- / \ +-- ETLMapEmpty rtab1 +-- +-- @ +-- +-- You see that always on the left branch we have an ETLMapping data type (i.e., a left-deep ETLOperation tree). +-- So how do we implement the following case? +-- +-- @ +-- +-- final RTable result +-- / +-- A leaf-node --> etlOp1 +-- / \ +-- rtab1 rtab2 +-- +-- @ +-- +-- The answer is that we "model" the left RTable (rtab1 in our example) as an ETLMapping of the form: +-- +-- @ +-- ETLMapLD { etlOp = ETLcOp{cmap = ColMapEmpty}, tabL = ETLMapEmpty, tabR = rtab1 } +-- @ +-- +-- So we embed the rtab1 in a ETLMapping, which is a leaf (i.e., it has an empty prevMap), the rtab1 is in +-- the right branch (tabR) and the ETLOperation is the EmptyColMapping, which returns its input RTable when executed. +-- We can use function 'rtabToETLMapping' for this job. So it becomes +-- @ +-- A leaf-node --> etlOp1 +-- / \ +-- rtabToETLMapping rtab1 rtab2 +-- @ +-- +-- In this manner, a leaf-node can also be implemented like this: +-- +-- @ +-- final RTable result +-- / +-- etlOp3 +-- / \ +-- etlOp2 rtab2 +-- / \ +-- A leaf-node --> etlOp1 emptyRTab +-- / \ +-- rtabToETLMapping rtab1 emptyRTable +-- @ +-- +data ETLMapping = + ETLMapEmpty -- ^ an empty node + | ETLMapLD + { etlOp :: ETLOperation -- ^ the ETLOperation to be executed + ,tabL :: ETLMapping -- ^ the left-branch corresponding to the previous ETLOperation, which is input to this one. + -- + ,tabR :: RTable -- ^ the right branch corresponds to another RTable (for binary ETL operations). + -- If this is a Unary ETLOperation then this field must be an empty RTable. + } -- ^ a Left-Deep node + | ETLMapRD + { etlOp :: ETLOperation -- ^ the ETLOperation to be executed + ,tabLrd :: RTable -- ^ the left-branch corresponds to another RTable (for binary ETL operations). + -- If this is a Unary ETLOperation then this field must be an empty RTable. + ,tabRrd :: ETLMapping -- ^ the right branch corresponding to the previous ETLOperation, which is input to this one. + } -- ^ a Right-Deep node + | ETLMapBal + { etlOp :: ETLOperation -- ^ the ETLOperation to be executed + ,tabLbal :: ETLMapping -- ^ the left-branch corresponding to the previous ETLOperation, which is input to this one. + -- If this is a Unary ETLOperation then this field might be an empty ETLMapping. + ,tabRbal :: ETLMapping -- ^ the right branch corresponding corresponding to the previous ETLOperation, which is input to this one. -- If this is a Unary ETLOperation then this field might be an empty ETLMapping. + } -- ^ a Balanced node + + +instance Eq ETLMapping where + etlMap1 == etlMap2 = + (etl etlMap1) == (etl etlMap2) -- two ETLMappings are equal if the RTables resulting from their execution are equal + +-- | Creates a left-deep leaf ETL Mapping, of the following form: +-- +-- @ +-- A Left-Deep ETLOperation Tree +-- +-- final RTable result +-- / +-- etlOp3 +-- / \ +-- etlOp2 rtab2 +-- / \ +-- A leaf-node --> etlOp1 emptyRTab +-- / \ +-- ETLMapEmpty rtab1 +-- +-- @ +-- +createLeafETLMapLD :: + ETLOperation -- ^ ETL operation of this ETL mapping + -> RTable -- ^ input RTable + -> ETLMapping -- ^ output ETLMapping +createLeafETLMapLD etlop rt = ETLMapLD { etlOp = etlop, tabL = ETLMapEmpty, tabR = rt} + +-- | creates a Binary operation leaf node of the form: +-- +-- @ +-- +-- A leaf-node --> etlOp1 +-- / \ +-- rtabToETLMapping rtab1 rtab2 +-- @ +-- +createLeafBinETLMapLD :: + ETLOperation -- ^ ETL operation of this ETL mapping + -> RTable -- ^ input RTable1 + -> RTable -- ^ input RTable2 + -> ETLMapping -- ^ output ETLMapping +createLeafBinETLMapLD etlop rt1 rt2 = ETLMapLD { etlOp = etlop, tabL = rtabToETLMapping rt1, tabR = rt2} + +-- | Connects an ETL Mapping to a left-deep ETL Mapping tree, of the form +-- +-- @ +-- A Left-Deep ETLOperation Tree +-- +-- final RTable result +-- / +-- etlOp3 +-- / \ +-- etlOp2 rtab2 +-- / \ +-- A leaf-node --> etlOp1 emptyRTab +-- / \ +-- ETLMapEmpty rtab1 +-- +-- @ +-- +-- Example: +-- +-- @ +-- -- connect a Unary ETL mapping (etlOp2) +-- +-- etlOp2 +-- / \ +-- etlOp1 emptyRTab +-- +-- => connectETLMapLD etlOp2 emptyRTable prevMap +-- +-- -- connect a Binary ETL Mapping (etlOp3) +-- +-- etlOp3 +-- / \ +-- etlOp2 rtab2 +-- +-- => connectETLMapLD etlOp3 rtab2 prevMap +-- @ +-- +-- Note that the right branch (RTable) appears first in the list of input arguments of this function and +-- the left branch (ETLMapping) appears second. This is strange, and one could thought that it is a mistake +-- (i.e., the left branch should appear first and the right branch second) since we are reading from left to right. +-- However this was a deliberate choice, so that we leave the left branch (which is the connection point with the +-- previous ETLMapping) as the last argument, and thus we can partially apply the argumenets and get a new function +-- with input parameter only the previous mapping. This is very helpfull in function composition +-- +connectETLMapLD :: + ETLOperation -- ^ ETL operation of this ETL Mapping + -> RTable -- ^ Right RTable (right branch) (if this is a Unary ETL mapping this should be an emptyRTable) + -> ETLMapping -- ^ Previous ETL mapping (left branch) + -> ETLMapping -- ^ New ETL Mapping, which has added at the end the new node +connectETLMapLD etlop rt prevMap = ETLMapLD { etlOp = etlop, tabL = prevMap, tabR = rt} + + +-- | This operator executes an 'ETLMapping' +etl = runETLmapping + +-- | Executes an 'ETLMapping' +runETLmapping :: + ETLMapping -- ^ input ETLMapping + -> RTable -- ^ output RTable +-- empty ETL mapping +runETLmapping ETLMapEmpty = emptyRTable +-- ETL mapping with an empty ETLOperation, which is just modelling an RTable +runETLmapping ETLMapLD { etlOp = ETLcOp{cmap = ColMapEmpty}, tabL = ETLMapEmpty, tabR = rtab } = rtab +-- leaf node --> unary ETLOperation on RTable +runETLmapping ETLMapLD { etlOp = runMe, tabL = ETLMapEmpty, tabR = rtab } = etlOpU runMe rtab {-- if (isRTabEmpty rtab) + then emptyRTable + else etlOpU runMe rtab --} +runETLmapping ETLMapLD { etlOp = runMe, tabL = prevmap, tabR = rtab } = + if (isRTabEmpty rtab) + then let + prevRtab = runETLmapping prevmap -- execute previous ETLMapping to get the resulting RTable + in etlOpU runMe prevRtab + else let + prevRtab = runETLmapping prevmap -- execute previous ETLMapping to get the resulting RTable + in etlOpB runMe prevRtab rtab + +-- | This operator executes an 'ETLMapping' and returns the 'RTabResult' 'Writer' Monad +-- that embedds apart from the resulting RTable, also the number of 'RTuple's returned +etlRes :: + ETLMapping -- ^ input ETLMapping + -> RTabResult -- ^ output RTabResult +etlRes etlm = + let resultRtab = etl etlm + returnedRtups = rtuplesRet $ V.length resultRtab + in rtabResult (resultRtab, returnedRtups) + +-- | Model an 'RTable' as an 'ETLMapping' which when executed will return the input 'RTable' +rtabToETLMapping :: + RTable + -> ETLMapping +rtabToETLMapping rt = if (isRTabEmpty rt) + then ETLMapEmpty + else ETLMapLD { etlOp = ETLcOp {cmap = ColMapEmpty}, tabL = ETLMapEmpty, tabR = rt } + +-- +-- An ETLMapping is implemented as a series of ETLOperations conected with the :=> operator which is right associative +-- i.e., ETLOp3 :=> ETLOp2 :=> ETLOp1 RTable is (ETLOp3 :=> (ETLOp2 :=> (ETLOp1 RTable)) +-- infixr 9 :=> +-- data ETLMapping = EmptyETLop RTable | ETLMapping :=> ETLOperation + + +{-- +-- | Executes an ETL mapping +-- Note htat the source RTables are "embedded" in the data constructors of the ETLMapping data type. +runETLmapping :: + ETLMapping -- ^ input ETLMapping + -> RTable -- output RTable +runETLmapping EmptyETLop rtab = rtab +runETLmapping etlMap :=> etlOp = runETLmapping etlMap + + case etlOp of + ETLrOp {rop = relOp} -> runROperation relOp +--} + +-- Example of an ETLMapping((<T> TabColTransformation).(<F> RPredicate).(<T> TabTransformation) rtable1) `(<EJ> RJoinPredicate)` rtable2 + + +-- ################################################## +-- * Various useful RDataType Transformations +-- * and pre-cooked Column Mappings +-- ################################################## + + + + +-- | Returns an ETL Operation that adds a surrogate key column to an RTable +-- The first argument is the initial value of the surrogate key. If Nothing is given, then +-- the initial value will be 0. +-- addSurrogateKey_old :: Integral a => +-- Maybe a -- ^ The initial value of the Surrogate Key will be the value of this parameter + 1 +-- -> a -- ^ Number of rows that the Surrogate Key will be assigned +-- -> ColumnName -- ^ The name of the surrogate key column +-- -> ETLOperation -- ^ Output ETL operation which encapsulates the add surrogate key column mapping +-- addSurrogateKey_old init 0 cname = +-- let initVal = case init of +-- Just x -> x +-- Nothing -> 0 +-- cmap = RMap1x1 { +-- srcCol = "", removeSrcCol = No -- the source column can be any column in this mapping, even "" +-- ,trgCol = cname +-- ,transform1x1 = \_ -> RInt (fromIntegral initVal) +-- ,srcRTupleFilter = \_ -> True +-- } +-- in ETLcOp cmap +-- addSurrogateKey_old init numRows cname = +-- let initVal = case init of +-- Just x -> x +-- Nothing -> 0 +-- cmap = RMap1x1 { +-- srcCol = "", removeSrcCol = No -- the source column can be any column in this mapping, even "" +-- ,trgCol = cname +-- ,transform1x1 = \_ -> RInt (fromIntegral initVal + 1) +-- ,srcRTupleFilter = \_ -> True +-- } +-- in addSurrogateKey_old (Just (initVal + 1)) (numRows - 1) cname + + +
+ src/Etl/Julius.hs view
@@ -0,0 +1,1394 @@+{-| +Module : Julius +Description : A simple Embedded DSL for ETL/ELT data processing in Haskell +Copyright : (c) Nikos Karagiannidis, 2018 + +License : BSD3 +Maintainer : nkarag@gmail.com +Stability : stable +Portability : POSIX + +__Julius__ is a type-level /Embedded Domain Specific Language (EDSL)/ for ETL/ELT data processing in Haskell. +Julius enables us to express complex data transformation flows (i.e., an arbitrary combination of ETL operations) in a more friendly manner (a __Julius Expression__), +with plain Haskell code (no special language for ETL scripting required). For more information read this [Julius Tutorial] (https://github.com/nkarag/haskell-DBFunctor/blob/master/doc/JULIUS-TUTORIAL.md). + += When to use this module +This module should be used whenever one has "tabular data" (e.g., some CSV files, or any type of data that can be an instance of the 'RTabular' +type class and thus define the 'toRTable' and 'fromRTable' functions) and wants to analyze them in-memory with the well-known relational algebra operations +(selection, projection, join, groupby, aggregations etc) that lie behind SQL. +This data analysis takes place within your haskell code, without the need to import the data into a database (database-less +data processing) and the result can be turned into the original format (e.g., CSV) with a simple call to the 'fromRTable' function. + +"Etl.Julius" provides a simple language for expressing all relational algebra operations and arbitrary combinations of them, and thus is a powerful +tool for expressing complex data transfromations in Haskell. Moreover, the Julius language includes a clause for the __Column Mapping__ ('RColMapping') concept, which +is a construct used in ETL tools and enables arbitrary transformations at the column level and the creation of derived columns based on arbitrary expressions on the existing ones. +Finally, the ad hoc combination of relational operations and Column Mappings, chained in an data transformation flow, implements the concept of the __ETL Mapping__ ('ETLMapping'), +which is the core data mapping unit in all ETL tools and embeds all the \"ETL-logic\" for loading/creating a single __target__ 'RTable' from a set of __source__ 'RTable's. +It is implemented in the "ETL.Internal.Core" module. For the relational algebra operations, Julius exploits the functions in the "RTable.Core" +module, which also exports it. + +The [Julius EDSL] (https://github.com/nkarag/haskell-DBFunctor/blob/master/doc/JULIUS-TUTORIAL.md) is the recommended method for expressing ETL flows in Haskell, as well as doing any data analysis task within the "DBFunctor" package. "Etl.Julius" is a self-sufficient +module and imports all neccesary functionality from "RTable.Core" and "Etl.Internal.Core" modules, so a programmer should only import "Etl.Julius" and nothing else, in order to have +complete functionality. + += Overview +The core data type in the Julius EDSL is the 'ETLMappingExpr'. This data type creates a so-called __Julius Expression__. This Julius expression is +the \"Haskell equivalent\" to the ETL Mapping concept discussed above. It is evaluated to an 'ETLMapping' (see 'ETLMapping'), which is our data structure +for the internal representation of the ETL Mapping, with the 'evalJulius' function and from then, evaluated into an 'RTable' (see 'juliusToRTable'), which is the final result of our transformation. + +A /Julius Expression/ is a chain of ETL Operation Expressions ('EtlOpExpr') connected with the ':->' constructor (or with the ':=>' constructor for named result operations - see below for an explanation) +This chain of ETL Operations always starts with the 'EtlMapStart' constructor and is executed from left-to-right, or from top-to-bottom: + +@ +EtlMapStart :-> \<ETLOpExpr\> :-> \<ETLOpExpr\> :-> ... :-> \<ETLOpExpr\> +-- equivalently +EtlMapStart :-> \<ETLOpExpr\> + :-> \<ETLOpExpr\> + :-> ... + :-> \<ETLOpExpr\> +@ + +A Named ETL Operation Expression ('NamedMap') is just an ETL Operation with a name, so as to be able to reference this specific step in the chain of ETL Operations. It is +actually __a named intermediate result__, which can reference and use in other parts of our Julius expression. It is similar in notion to a subquery, known as an \INLINE VIEW\, +or better, it is equivalent to the @WITH@ clause in SQL (i.e., also called subquery factoring in SQL parlance) +For example: + +@ +EtlMapStart :-> \<ETLOpExpr\> + :=> NamedResult \"my_intermdt_result\" \<ETLOpExpr\> + :-> ... + :-> \<ETLOpExpr\> +@ + +An ETL Operation Expression ('ETLOpExpr') - a.k.a. a __Julius Expression__ - is either a Column Mapping Expression ('ColMappingExpr'), or a Relational Operation Expression ('ROpExpr'). The former is used +in order to express a __Column Mapping__ (i.e., an arbitrary transformation at the column level, with which we can create any derived column based on existing columns, see 'RColMapping') and +the latter is __Relational Operation__ (Selection, Projection, Join, Outer Join, Group By, Order By, Aggregate, or a generic Unary or Binary RTable operation, see 'ROperation') + +== Typical Structure of an ETL Program using "Etl.Julius" +@ +{-# LANGUAGE OverloadedStrings #-} + +import Etl.Julius +import RTable.Data.CSV (CSV, readCSV, writeCSV, toRTable) + +-- 1. Define table metadata +-- E.g., +src_DBTab_MData :: RTableMData +src_DBTab_MData = + createRTableMData ( \"sourceTab\" -- table name + ,[ (\"OWNER\", Varchar) -- Owner of the table + ,(\"TABLE_NAME\", Varchar) -- Name of the table + ,(\"TABLESPACE_NAME\", Varchar) -- Tablespace name + ,(\"STATUS\",Varchar) -- Status of the table object (VALID/IVALID) + ,(\"NUM_ROWS\", Integer) -- Number of rows in the table + ,(\"BLOCKS\", Integer) -- Number of Blocks allocated for this table + ,(\"LAST_ANALYZED\", Timestamp "MM/DD/YYYY HH24:MI:SS") -- Timestamp of the last time the table was analyzed (i.e., gathered statistics) + ] + ) + [\"OWNER\", \"TABLE_NAME\"] -- primary key + [] -- (alternative) unique keys + +-- Result RTable metadata +result_tab_MData :: RTableMData +result_tab_MData = ... + +-- 2. Define your ETL code +-- E.g., +myEtl :: [RTable] -> [RTable] +myEtl [rtab] = + -- 3. Define your Julius Expression(s) + let jul = + EtlMapStart + :-> (EtlR $ + ROpStart + :. (...) + ... + -- 4. Evaluate Julius to the Result RTable + in [juliusToRTable jul] + +main :: IO () +main = do + + -- 5. read source csv files + -- E.g., + srcCSV <- readCSV \".\/app\/test-data.csv\" + + -- 6. Convert CSV to an RTable and do your ETL + [resultRTab] <- runETL myETL $ [toRTable src_DBTab_MData srcCSV] + + -- 7. Print your results on screen + -- E.g., + printfRTable (genRTupleFormat [\"OWNER\", \"TABLE_NAME\",\"LAST_ANALYZED\"] genDefaultColFormatMap) $ resultRTab + + -- 8. Save your result to a CSV file + -- E.g., + writeCSV \".\/app\/result-data.csv\" $ + fromRTable result_tab_MData resultRTab +@ + +[-- 1.] We define the necessary 'RTable' metadata, for each 'RTable' in our program. This is equivalent to a @CREATE TABLE@ ddl clause in SQL. +[-- 2.] Here is where we define our ETL code. We dont want to do our ETL in the main function, so we separate the ETL code into a separate function (@myETL@). In general, + in our main, we want to follow the pattern: + + * Read your Input (Extract phase) + * Do your ETL (Transform phase) + * Write your Output (Load phase) + + This function receives as input a list with all the necessary __Source__ 'RTable's (in our case we have a single item list) and outputs + a list with all the resulting (__Target__) 'RTable', after the all the necessary transformation steps have been executed. + Of course an ETL code might produce more than one target 'RTable's, e.g., + a target schema (in DB parlance) and not just one as in our example. Moreover, the myETL function can be arbitrary complex, depending on the ETL logic that we want to + implement in each case. It is essentially the entry point to our ETL implementation + +[-- 3.] Our ETL code in general will consist of an arbitrary number of Julius expressions. One can define multiple separate Julius expressions, + some of which might depend on others, in order to implement the corresponding ETL logic. + Keep in mind that each Julius expression encapsulates the \"transformtioin logic\" for producing a __single target RTable__. This holds, + even if the target RTable is an intermediate result in the overall ETL process and not a final result RTable. + + The evaluation of each individual Julius expression must be in conformance with the input-RTable prerequisites of each + Julius expression. So, first we must evaluate all the Julius expressions that dont depend on other Julius expressions but only on + source RTables. Then, we evaluate the Julius expressions that depend on the previous ones and so on. + +[-- 4.] In our case our ETL code consists of a single source RTable that produces a single target RTable. The Julius expression is evaluated + into an 'RTable' and returned to the caller of the ETL code (in our case this is @main@) +[-- 5.] Here is where we read our input for the ETL. In our case, this is a simple CSV file that we read with the help of the 'readCSV' function. +[-- 6.] We convert our input CSV to an 'RTable', with the 'toRTable' and pass it as input to our ETL code. We execute our ETL code with the 'runETL' function. +[-- 7.] We print our target 'RTable' on screen using the 'printfRTable' function for formatted printed ('Text.Printf.printf' like) of 'RTable's. +[-- 8.] We save our target 'RTable' to a CSV file with the 'fromRTable' function. + + +== Simple Julius Expression Examples +Note: Julius Expression are read from top to bottom and from left to right. + +=== Selection (i.e., Filter) +==== SQL +@ +SELECT * +FROM expenses exp +WHERE exp.category = \'FOOD:SUPER_MARKET\' + AND exp.amount > 50.00 +@ +==== Julius +@ +juliusToRTable $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (Filter (From $ Tab expenses) $ FilterBy myFpred)) + +myFpred :: RPredicate +myFpred = \\t -> t \<!\> \"category\" == \"FOOD:SUPER_MARKET\" + && + t \<!\> \"amount\" > 50.00 +@ + +=== Projection +==== SQL +@ +SELECT \"TxTimeStamp\", \"Category\", \"Description\", \"Amount\" +FROM expenses exp +WHERE exp.category = \'FOOD:SUPER_MARKET\' + AND exp.amount > 50.00 +@ +==== Julius +@ +juliusToRTable $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (Filter (From $ Tab expenses) $ FilterBy myFpred) + :. (Select [\"TxTimeStamp\", \"Category\",\"Description\", \"Amount\"] $ From Previous)) + +myFpred :: RPredicate +myFpred = \\t -> t \<!\> \"category\" == \"FOOD:SUPER_MARKET\" + && + t \<!\> \"amount\" > 50.00 +@ + +=== Sorting (Order By) +==== SQL +@ +SELECT \"TxTimeStamp\", \"Category\", \"Description\", \"Amount\" +FROM expenses exp +WHERE exp.category = \'FOOD:SUPER_MARKET\' + AND exp.amount > 50.00 +ORDER BY \"TxTimeStamp\" DESC +@ +==== Julius +@ +juliusToRTable $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (Filter (From $ Tab expenses) $ FilterBy myFpred) + :. (Select [\"TxTimeStamp\", \"Category\",\"Description\", \"Amount\"] $ From Previous) + :. (OrderBy [(\"TxTimeStamp\", Desc)] $ From Previous)) + +myFpred :: RPredicate +myFpred = \\t -> t \<!\> \"category\" == \"FOOD:SUPER_MARKET\" + && + t \<!\> \"amount\" > 50.00 +@ + +=== Grouping and Aggregation +==== SQL +@ +SELECT \"Category\", sum(\"Amount\") AS \"TotalAmount\" +FROM expenses exp +GROUP BY \"Category\" +ORDER BY \"TotalAmount\" DESC +@ +==== Julius +@ +juliusToRTable $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (GroupBy [\"Category\"] + (AggOn [Sum \"Amount\" $ As \"TotalAmount\"] (From $ Tab expenses)) $ + GroupOn (\t1 t2 -> t1 \<!\> \"Category\" == t2 \<!\> \"Category\") + ) + :. (OrderBy [ (\"TotalAmount\", Desc)] $ From Previous)) +@ + +=== Group By and then Right Outer Join +First group the expenses table by category of expenses and then do a right outer join with the budget table, in order to pair +the expenses at the category level with the correpsonding budget amount (if there is one). Preserve the rows from the expenses table. + +==== SQL +@ +WITH exp +as ( + SELECT \"Category\", sum(\"Amount\") AS \"TotalAmount\" + FROM expenses + GROUP BY \"Category\" +) +SELECT exp.\"Category\", exp.\"TotalAmount\", bdg.\"YearlyBudget\" +FROM budget bdg RIGHT JOIN exp ON (bdg.\"Category\" = exp.\"Category\") +ORDER BY exp.\"TotalAmount\" DESC +@ +==== Julius +@ +juliusToRTable $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (GroupBy [\"Category\"] + (AggOn [Sum \"Amount\" $ As \"TotalAmount\"] (From $ Tab expenses)) $ + GroupOn (\t1 t2 -> t1 \<!\> \"Category\" == t2 \<!\> \"Category\") + ) + -- >>> A Right Outer Join that preserves the Previous result RTuples and joins with the budget table + :. (RJoin (TabL budget) Previous $ + JoinOn (\tl tr -> + tl \<!\> \"Category\" == tr \<!\> \"Category\") + ) + ) + :. (OrderBy [ (\"TotalAmount\", Desc)] $ From Previous)) +@ + +=== A Column Mapping +We will use the previous result (i.e., a table with expenses and budget amounts per category of expenses), in order to create a derived column +to calculate the residual amount, with the help of a Column Mapping Expression ('ColMappingExpr'). + +==== SQL +@ +WITH exp +as ( + SELECT \"Category\", sum(\"Amount\") AS \"TotalAmount\" + FROM expenses + GROUP BY \"Category\" +) +SELECT exp.\"Category\", exp.\"TotalAmount\", bdg.\"YearlyBudget\", bdg.\"YearlyBudget\" - exp.\"TotalAmount\" AS \"ResidualAmount\" +FROM budget bdg RIGHT JOIN exp ON (bdg.\"Category\" = exp.\"Category\") +ORDER BY exp.\"TotalAmount\" DESC +@ +==== Julius +@ +juliusToRTable $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (GroupBy [\"Category\"] + (AggOn [Sum \"Amount\" $ As \"TotalAmount\"] (From $ Tab expenses)) $ + GroupOn (\t1 t2 -> t1 \<!\> \"Category\" == t2 \<!\> \"Category\") + ) + :. (RJoin (TabL budget) Previous $ + JoinOn (\tl tr -> + tl \<!\> \"Category\" == tr \<!\> \"Category\") + ) + ) + :. (Select [\"Category\", \"TotalAmount\", \"YearlyBudget\"] $ From Previous) + :. (OrderBy [ (\"TotalAmount\", Desc)] $ From Previous) + ) + -- >>> A Column Mapping to create a derived column (\"ResidualAmount\"") + :-> (EtlC $ + Source [\"TotalAmount\", \"YearlyBudget\"] $ + Target [\"ResidualAmount\"] $ + By (\[totAmount, yearlyBudget] -> [yearlyBudget - totAmount]) + (On Previous) DontRemoveSrc $ FilterBy (\t -> True) + ) +@ + +=== Naming Intermediate Results in a Julius Expression +In the following example, each named result is an autonomous (intermediate) result, that can be accessed directly and we can handle it as a distinct result (i.e.,'RTable'). +So we can refer to such a result in a subsequent expression, or we can print this result separately, with the 'printRTable' function etc. Each such named result resembles +a separate subquery in an SQL @WITH@ clause. + +==== SQL +@ +WITH detailYearTXTab +as ( + SELECT \"TxTimeStamp\", \"Category\", \"Description\", \"Amount\",\"DebitCredit\" + FROM txTab + WHERE to_number(to_char(\"TxTimeStamp\", 'YYYY')) >= yearInput + AND + to_number(to_char(\"TxTimeStamp\", 'YYYY')) < yearInput + 1 +), +expGroupbyCategory +as ( + SELECT \"Category\", sum (\"Amount\") AS \"AmountSpent\" + FROM detailYearTXTab + WHERE + \"DebitCredit\" = \"D\" + GROUP BY \"Category\" + ORDER BY 2 DESC +), +revGroupbyCategory +as ( + SELECT \"Category\", sum(\"Amount\") AS \"AmountReceived\" + FROM detailYearTXTab + WHERE + \"DebitCredit\" = \"C\" + GROUP BY \"Category\" + ORDER BY 2 DESC +), +ojoinedWithBudget +as( + SELECT \"Category\", \"AmountSpent\", YearlyBudget\" + FROM budget bdg RIGHT JOIN expGroupbyCategory exp ON (bdg.\"Category\" = exp.\"Category\") +), +calculatedFields +as( + SELECT \"Category\", \"AmountSpent\", \"YearlyBudget\", \"YearlyBudget\" - \"AmountSpent\" AS \"ResidualAmount\" + FROM ojoinedWithBudget +) +SELECT * +FROM calculatedFields +@ +==== Julius +@ +let + julExpr = + -- 1. get detailed transactions of the year + :=> NamedResult \"detailYearTXtab\" (EtlR $ + ROpStart + -- keep RTuples only of the specified year + :. (Filter (From $ Tab txTab) $ + FilterBy (\t -> rtime (t \<!\> \"TxTimeStamp\") >= + RTimestampVal {year = yearInput, month = 1, day = 1, hours24 = 0, minutes = 0, seconds = 0} + && + rtime (t \<!\> \"TxTimeStamp\") < + RTimestampVal { year = yearInput + 1, + month = 1, + day = 1, hours24 = 0, minutes = 0, seconds = 0}) + ) + -- keep only columns of interest + :. (Select [\"TxTimeStamp\", \"Category\", \"Description\", \"Amount\",\"DebitCredit\"] $ From Previous) + :. (OrderBy [(\"TxTimeStamp\", Asc)] $ From Previous) + ) + -- 2. expenses group by category + :=> NamedResult \"expGroupbyCategory\" (EtlR $ + ROpStart + -- keep only the \"debit\" transactions + :. (FilterBy (From Previous) $ + FilterBy (\t -> t \<!\> \"DebitCredit\" == \"D\") + ) + :. (GroupBy [\"Category\"] + (AggOn [Sum \"Amount\" $ As \"AmountSpent\" ] $ From Previous) $ + GroupOn (\t1 t2 -> t1 \<!\> \"Category\" == t2 \<!\> \"Category\") + ) + :. (OrderBy [(\"AmountSpent\", Desc)] $ From Previous) + ) + -- 3. revenues group by category + :=> NamedResult \"revGroupbyCategory\" (EtlR $ + ROpStart + -- keep only the \"credit\" transactions + :. (FilterBy (From $ juliusToRTable $ takeNamedResult \"detailYearTXtab\" julExpr) $ + FilterBy (\t -> t \<!\> \"DebitCredit\" == \"C\") + ) + :. (GroupBy [\"Category\"] + (AggOn [Sum \"Amount\" $ As \"AmountReceived\" ] $ From Previous) $ + GroupOn (\t1 t2 -> t1 \<!\> \"Category\" == t2 \<!\> \"Category\") + ) + :. (OrderBy [(\"AmountReceived\", Desc)] $ From Previous) + ) + -- 3. Expenses Group By Category Outer joined with budget info + :=> NamedResult \"ojoinedWithBudget\" (EtlR $ + ROpStart + :. (RJoin (TabL budget) (Tab $ juliusToRTable $ takeNamedResult \"expGroupbyCategory\" julExpr) $ + JoinOn (\tl tr -> + tl \<!\> \"Category\" == tr \<!\> \"Category\") + ) + ) + :. (Select [\"Category\", \"AmountSpent\", \"YearlyBudget\"] $ From Previous) + :. (OrderBy [ (\"TotalAmount\", Desc)] $ From Previous) + ) + -- 4. A Column Mapping to create a derived column (\"ResidualAmount\") + :=> NamedResult \"calculatedFields\" (EtlC $ + Source [\"AmountSpent\", \"YearlyBudget\"] $ + Target [\"ResidualAmount\"] $ + By (\[amountSpent, yearlyBudget] -> [yearlyBudget - amountSpent]) + (On Previous) DontRemoveSrc $ FilterBy (\t -> True) + ) + +-- 5. Print detail transactions +printRTable $ juliusToRTable $ takeNamedResult \"detailYearTXtab\" julExpr + +-- 6. Print Expenses by Category +printRTable $ juliusToRTable $ takeNamedResult \"expGroupbyCategory\" julExpr + +-- 7. Print Expenses with Budgeting Info and Residual Amount +printRTable $ juliusToRTable $ takeNamedResult \"calculatedFields\" julExpr + +-- equivalently +printRTable $ juliusToRTable julExpr + +-- 8. Print Revenues by Category +printRTable $ juliusToRTable $ takeNamedResult \"revGroupbyCategory\" julExpr +@ + +Explanation of each named result in the above example: + +["detailYearTXtab"] We retrieve the detail transactions of the current year only and project the columns of interest. We order result by transaction timestamp. +["expGroupbyCategory"] We filter the previous result ("detailYearTXtab"), in order to get only the transactions corresponding to expenses (@t \<!\> \"DebitCredit\" == \"D\"@) +and then we group by category, in order to get a total amount spent by category of expenses. +["revGroupbyCategory"] We filter the "detailYearTXtab" result (see the use of the 'takeNamedResult' function in order to access the "detailYearTXtab" intermediate result), +in order to get only the transactions corresponding to revenues (@t \<!\> \"DebitCredit\" == \"C\"@) and then we group by category, in order to get a total amount received by +category of revenues. +["ojoinedWithBudget"] We do a right join of the grouped expenses with the budget table. Again note the use of the 'takeNamedResult' function. The preserved 'RTable' is the +grouped expenses ("expGroupbyCategory"). +["calculatedFields"] Finally, we use a Column Mapping in order to create a derived column, which holds the residual amount for each category of expenses. + +-} + +{-# LANGUAGE OverloadedStrings #-} +-- :set -XOverloadedStrings +--{-# LANGUAGE OverloadedRecordFields #-} +--{-# LANGUAGE DuplicateRecordFields #-} + +module Etl.Julius ( + module RTable.Core + + -- * The Julius EDSL Syntax + -- ** The Julius Expression + ,ETLMappingExpr (..) + ,ETLOpExpr (..) + ,NamedMap (..) + ,NamedResultName + -- ** The Column Mapping Clause + ,ColMappingExpr (..) + ,ToColumn (..) + ,ByFunction (..) + ,OnRTable (..) + ,TabExpr (..) + ,RemoveSrcCol (..) + ,ByPred (..) + -- ** The Relational Operation Clause + ,ROpExpr(..) + ,RelationalOp (..) + ,FromRTable (..) + ,Aggregate (..) + ,AggOp (..) + ,AsColumn (..) + ,AggBy (..) + ,GroupOnPred (..) + ,TabLiteral (..) + ,TabExprJoin (..) + ,ByGenUnaryOperation (..) + ,ByGenBinaryOperation (..) + -- * Julius Expression Evaluation + ,evalJulius + ,juliusToRTable + ,runJulius + ,eitherRunJulius + ,juliusToResult + ,runJuliusToResult + ,eitherRunJuliusToResult + ,runETL + ,eitherRunETL + ,takeNamedResult + -- * Various ETL Operations + ,addSurrogateKeyJ + ,appendRTableJ + ,addSurrogateKey + ,appendRTable + ) where + +-- Data.RTable +import RTable.Core +-- Data.RTable.Etl +import Etl.Internal.Core + +-- Data.Vector +import Data.Vector as V + +import Control.Exception +import Control.DeepSeq as CDS + +----------------------------------------------------------------- +-- Define an Embedded DSL in Haskell' s type system +----------------------------------------------------------------- + +-- | An ETL Mapping Expression is a __\"Julius Expression\"__. It is a sequence of individual ETL Operation Expressions. Each +-- such ETL Operation "acts" on some input 'RTable' and produces a new "transformed" output 'RTable'. +-- The ETL Mapping connector ':->' (as well as the ':=>' connector) is left associative because in a 'ETLMappingExpr' operations are evaluated from left to right (or top to bottom) +-- A Named ETL Operation Expression ('NamedMap') is just an ETL Operation with a name, so as to be able to reference this specific step in the chain of ETL Operations. +-- It is actually a /named intermediate result/, which we can reference and use in other parts of our Julius expression +infixl 5 :-> +infixl 5 :=> +data ETLMappingExpr = + EtlMapStart + | ETLMappingExpr :-> ETLOpExpr + | ETLMappingExpr :=> NamedMap + + +-- | An ETL Operation Expression is either a Column Mapping Expression ('ColMappingExpr'), or a Relational Operation Expression ('ROpExpr') +data ETLOpExpr = EtlC ColMappingExpr | EtlR ROpExpr + +-- | The name of an intermediate result, used as a key for accessing this result via the 'takeNamedResult' function. +type NamedResultName = String + +-- | A named intermediate result in a Julius expression ('ETLMappingExpr'), which we can access via the 'takeNamedResult' function. +data NamedMap = NamedResult NamedResultName ETLOpExpr + +-- | A Column Mapping ('RColMapping') is the main ETL/ELT construct for defining a column-level transformation. +-- Essentially with a Column Mapping we can create one or more new (derived) column(s) (/Target Columns/), based on an arbitrary transformation function ('ColXForm') +-- with input parameters any of the existing columns (/Source Columns/). +-- So a 'ColMappingExpr' is either empty, or it defines the source columns, the target columns and the transformation from source to target. +-- Notes: +-- * If a target-column has the same name with a source-column and a 'DontRemoveSrc', or a 'RemoveSrc' has been specified, then the (target-column, target-value) key-value pair, +-- overwrites the corresponding (source-column, source-value) key-value pair +-- * The returned 'RTable' will include only the 'RTuple's that satisfy the filter predicate specified in the 'FilterBy' clause. +data ColMappingExpr = Source [ColumnName] ToColumn | ColMappingEmpty + +-- | Defines the Target Columns of a Column Mapping Expression ('ColMappingExpr') and the column transformation function ('ColXForm'). +data ToColumn = Target [ColumnName] ByFunction + +-- | Defines the column transformation function of a Column Mapping Expression ('ColMappingExpr'), the input 'RTable' that this transformation will take place, an +-- indicator ('RemoveSrcCol') of whether the Source Columns will be removed or not in the new 'RTable' that will be created after the Column Mapping is executed and +-- finally, an 'RTuple' filter predicate ('ByPred') that defines the subset of 'RTuple's that this Column Mapping will be applied to. If it must be applied to all 'RTuple's, +-- then for the last parameter ('ByPred'), we can just provide the following 'RPredicate': +-- +-- @ +-- FilterBy (\\_ -> True) +-- @ +-- +data ByFunction = By ColXForm OnRTable RemoveSrcCol ByPred + +-- | Defines the 'RTable' that the current operation will be applied to. +data OnRTable = On TabExpr + +-- | Indicator of whether the source column(s) in a Column Mapping will be removed or not (used in 'ColMappingExpr') +-- If a target-column has the same name with a source-column and a 'DontRemoveSrc' has been specified, then the (target-column, target-value) key-value pair, +-- overwrites the corresponding (source-column, source-value) key-value pair. +data RemoveSrcCol = RemoveSrc | DontRemoveSrc + +-- | An 'RTuple' predicate clause. +data ByPred = FilterBy RPredicate + +-- | A Relational Operation Expression ('ROpExpr') is a sequence of one or more Relational Algebra Operations applied on a input 'RTable'. +-- It is a sub-expression within a Julius Expression ('ETLMappingExpr') and we use it whenever we want to apply relational algebra operations on an RTable +-- (which might be the result of previous operations in a Julius Expression). A Julius Expression ('ETLMappingExpr') can contain an arbitrary number of +-- 'ROpExpr's. +-- The relational operation connector ':.' is left associative because in a 'ROpExpr' operations are evaluated from left to right (or top to bottom). +infixl 6 :. +data ROpExpr = + ROpStart + | ROpExpr :. RelationalOp + + +-- @ +-- \<RelationalOp\> = +-- \"Filter\" \"From\" \<TabExpr\> \<ByPred\> +-- \| \"Select\" \"\[\" \<ColName\> \{,\<ColName\>\} \"] \"From\" \<TabExpr\> +-- | "Agg" <Aggregate> +-- | "GroupBy" "[" <ColName> {,<ColName>} "]" <Aggregate> "GroupOn" <RGroupPredicate> +-- | "Join" <TabLiteral> <TabExpr> "JoinOn" <RJoinPredicate> +-- | "LJoin" <TabLiteral> <TabExpr> "JoinOn" <RJoinPredicate> +-- | "RJoin" <TabLiteral> <TabExpr> "JoinOn" <RJoinPredicate> +-- | "FOJoin" <TabLiteral> <TabExpr> "JoinOn" <RJoinPredicate> +-- | <TabLiteral> "`Intersect`" <TabExpr> +-- | <TabLiteral> "`Union`" <TabExpr> +-- | <TabLiteral> "`Minus`" <TabExpr> +-- | "GenUnaryOp" "On" <TabExpr> "ByUnaryOp" <UnaryRTableOperation> +-- | "GenBinaryOp" <TabLiteral> <TabExpr> "ByBinaryOp" <BinaryRTableOperation> +-- | "OrderBy" "[" "("<ColName> "," <OrderingSpec> ")" {,"("<ColName> "," <OrderingSpec> ")"} "]" +-- @ + + +-- | The Relational Operation ('RelationalOp') is a Julius clause that represents a __Relational Algebra Operation__. +data RelationalOp = + Filter FromRTable ByPred -- ^ 'RTuple' filtering clause (selection operation), based on an arbitrary predicate function ('RPredicate') + | Select [ColumnName] FromRTable -- ^ Column projection clause + | Agg Aggregate -- ^ Aggregate Operation clause + | GroupBy [ColumnName] Aggregate GroupOnPred -- ^ Group By clause, based on an arbitrary Grouping predicate function ('RGroupPredicate') + | Join TabLiteral TabExpr TabExprJoin -- ^ Inner Join clause, based on an arbitrary join predicate function - not just equi-join - ('RJoinPredicate') + | LJoin TabLiteral TabExpr TabExprJoin -- ^ Left Join clause, based on an arbitrary join predicate function - not just equi-join - ('RJoinPredicate') + | RJoin TabLiteral TabExpr TabExprJoin -- ^ Right Join clause, based on an arbitrary join predicate function - not just equi-join - ('RJoinPredicate') + | FOJoin TabLiteral TabExpr TabExprJoin -- ^ Full Outer Join clause, based on an arbitrary join predicate function - not just equi-join - ('RJoinPredicate') + | TabLiteral `Intersect` TabExpr -- ^ Intersection clause + | TabLiteral `Union` TabExpr -- ^ Union clause + | TabLiteral `Minus` TabExpr -- ^ Minus clause (set Difference operation) + | TabExpr `MinusP` TabLiteral -- ^ This is a Minus operation to be used when the left table must be the 'Previous' value. + | GenUnaryOp OnRTable ByGenUnaryOperation -- ^ This is a generic unary operation on a RTable ('UnaryRTableOperation'). It is used to define an arbitrary unary operation on an 'RTable' + | GenBinaryOp TabLiteral TabExpr ByGenBinaryOperation -- ^ This is a generic binary operation on a RTable ('BinaryRTableOperation'). It is used to define an arbitrary binary operation on an 'RTable' + | OrderBy [(ColumnName, OrderingSpec)] FromRTable -- ^ Order By clause. + +-- | It is used to define an arbitrary unary operation on an 'RTable' +data ByGenUnaryOperation = ByUnaryOp UnaryRTableOperation + +-- | It is used to define an arbitrary binary operation on an 'RTable' +data ByGenBinaryOperation = ByBinaryOp BinaryRTableOperation + +-- | Resembles the \"FROM" clause in SQL. It defines the 'RTable' on which the Relational Operation will be applied +data FromRTable = From TabExpr + +-- | A Table Expression defines the 'RTable' on which the current ETL Operation will be applied. If the 'Previous' constructor is used, then +-- this 'RTable' is the result of the previous ETL Operations in the current Julius Expression ('ETLMappingExpr') +data TabExpr = Tab RTable | Previous + +-- | This clause is used for expressions where we do not allow the use of the Previous value +data TabLiteral = TabL RTable + +-- <TabExprJoin> = <TabExpr> "`On`" <RJoinPredicate +--data TabExprJoin = TabExpr `JoinOn` RJoinPredicate + +-- | Join Predicate Clause. It defines when two 'RTuple's should be paired. +data TabExprJoin = JoinOn RJoinPredicate + +-- | An Aggregate Operation Clause +data Aggregate = AggOn [AggOp] FromRTable + +-- | These are the available aggregate operation clauses +data AggOp = + Sum ColumnName AsColumn + | Count ColumnName AsColumn -- ^ Count aggregation (no distinct) + -- | CountDist ColumnName AsColumn -- ^ Count distinct aggregation. Returns the distinct number of values for this column. + -- | CountStar AsColumn -- ^ Returns the number of 'RTuple's in the 'RTable' (i.e., @count(*)@ in SQL) + | Min ColumnName AsColumn + | Max ColumnName AsColumn + | Avg ColumnName AsColumn -- ^ Average aggregation + | GenAgg ColumnName AsColumn AggBy -- ^ A custom aggregate operation + +-- | Julius Clause to provide a custom aggregation function +data AggBy = AggBy AggFunction + +-- | Defines the name of the column that will hold the aggregate operation result. +-- It resembles the \"AS\" clause in SQL. +data AsColumn = As ColumnName + +-- | A grouping predicate clause. It defines an arbitrary function ('RGroupPRedicate'), which drives when two 'RTuple's should belong in the same group. +data GroupOnPred = GroupOn RGroupPredicate + +----------------------- +-- Example: +----------------------- +myTransformation :: ColXForm +myTransformation = undefined + +myTransformation2 :: ColXForm +myTransformation2 = undefined + +myTable :: RTable +myTable = undefined + +myTable2 :: RTable +myTable2 = undefined + +myTable3 :: RTable +myTable3 = undefined + +myTable4 :: RTable +myTable4 = undefined + +myFpred :: RPredicate +myFpred = undefined + +myFpred2 :: RPredicate +myFpred2 = undefined + +myGpred :: RGroupPredicate +myGpred = undefined + +myJoinPred :: RJoinPredicate +myJoinPred = undefined + +myJoinPred2 :: RJoinPredicate +myJoinPred2 = undefined + +myJoinPred3 :: RJoinPredicate +myJoinPred3 = undefined + +-- Empty ETL Mappings +myEtlExpr1 = EtlMapStart +myEtlExpr2 = EtlMapStart :-> EtlC ColMappingEmpty +myEtlExpr3 = EtlMapStart :-> EtlR ROpStart + +-- Simple Relational Operations examples: +-- Filter => SELECT * FROM myTable WHERE myFpred +myEtlExpr4 = EtlMapStart + :-> (EtlR $ + ROpStart + :. (Filter (From $ Tab myTable) $ FilterBy myFpred)) +--(EtlR $ (Filter (From $ Tab myTable) $ FilterBy myFpred) :. ROpStart) + +-- Projection => SELECT col1, col2, col3 FROM myTable +myEtlExpr5 = EtlMapStart + :-> (EtlR $ + ROpStart + :. (Select ["col1", "col2", "col3"] $ From $ Tab myTable)) + + --(EtlR $ (Select ["col1", "col2", "col3"] $ From $ Tab myTable) :. ROpStart) + +-- Filter then Projection => SELECT col1, col2, col3 FROM myTable WHERE myFpred +myEtlExpr51 = EtlMapStart + :-> (EtlR $ + ROpStart + :. (Filter (From $ Tab myTable) $ FilterBy myFpred) + :. (Select ["col1", "col2", "col3"] $ From $ Tab myTable)) + + -- (EtlR $ (Select ["col1", "col2", "col3"] $ From $ Tab myTable) + -- :. (Filter (From $ Tab myTable) $ FilterBy myFpred) + -- :. ROpStart + -- ) + +-- Aggregation => SELECT sum(trgCol2) as trgCol2Sum FROM myTable + +myEtlExpr6 = EtlMapStart + :-> (EtlR $ + ROpStart + :. (Agg $ AggOn [Sum "trgCol2" $ As "trgCol2Sum"] $ From $ Tab myTable)) + + --(EtlR $ (Agg $ AggOn [Sum "trgCol2" $ As "trgCol2Sum"] $ From $ Tab myTable) :. ROpStart) + +-- Group By => SELECT col1, col2, col3, sum(col4) as col4Sum, max(col4) as col4Max FROM myTable GROUP BY col1, col2, col3 +myEtlExpr7 = EtlMapStart + :-> (EtlR $ + ROpStart + :. (GroupBy ["col1", "col2", "col3"] (AggOn [Sum "col4" $ As "col4Sum", Max "col4" $ As "col4Max"] $ From $ Tab myTable) $ GroupOn myGpred)) + + + --(EtlR $ (GroupBy ["col1", "col2", "col3"] (AggOn [Sum "col4" $ As "col4Sum", Max "col4" $ As "col4Max"] $ From $ Tab myTable) $ GroupOn myGpred) :. ROpStart) + +-- Inner Join => SELECT * FROM myTable JOIN myTable2 ON (myJoinPred) +myEtlExpr8 = EtlMapStart + :-> (EtlR $ + ROpStart + :. (Join (TabL myTable) (Tab myTable2) $ JoinOn myJoinPred) ) + +-- (EtlR $ (Join (TabL myTable) (Tab myTable2) $ JoinOn myJoinPred) :. ROpStart) + +-- A 3-way Inner Join => SELECT * FROM myTable JOIN myTable2 ON (myJoinPred) JOIN myTable3 ON (myJoinPred2) JOIN ON myTable4 ON (myJoinPred4) +myEtlExpr9 = EtlMapStart + :-> (EtlR $ + ROpStart + :. (Join (TabL myTable) (Tab myTable2) $ JoinOn myJoinPred) + :. (Join (TabL myTable3) Previous $ JoinOn myJoinPred2) + :. (Join (TabL myTable4) Previous $ JoinOn myJoinPred3)) + + -- (EtlR $ (Join (TabL myTable4) Previous $ JoinOn myJoinPred3) + -- :. (Join (TabL myTable3) Previous $ JoinOn myJoinPred2) + -- :. (Join (TabL myTable) (Tab myTable2) $ JoinOn myJoinPred) + -- :. ROpStart + -- ) + + +-- Union => SELECT * FROM myTable UNION SELECT * FROM myTable2 +myEtlExpr10 = EtlMapStart + :-> (EtlR $ + ROpStart + :. (Union (TabL myTable) (Tab myTable2))) + +-- (EtlR $ (Union (TabL myTable) (Tab myTable2)) :. ROpStart) + +-- A more general example of an ETL mapping including column mappings and relational operations: +-- You read the Julius expression from bottom to top, and results to the follwoing discrete processing steps: +-- A 1x1 column mapping on myTable based on myTransformation, produces and output table that is input to the next step +-- -> A filter operation based on myFpred predicate : SELECT * FROM <previous result> WHERE myFpred +-- -> A group by operation: SELECT col1, col2, col3, SUM(col4) as col2sum, MAX(col4) as col4Max FROM <previous result> +-- -> A projection operation: SELECT col1, col2, col3, col4sum FROM <previous result> +-- -> A 1x1 column mapping on myTable based on myTransformation +-- -> An aggregation: SELECT SUM(trgCol2) as trgCol2Sum FROM <previous result> +-- -> A 1xN column mapping based on myTransformation2 +myEtlExpr :: ETLMappingExpr +myEtlExpr = EtlMapStart + :-> (EtlC $ Source ["srcCol"] $ Target ["trgCol"] $ By myTransformation (On $ Tab myTable) DontRemoveSrc $ FilterBy myFpred2) + :-> (EtlR $ + ROpStart + :. (Filter (From Previous) $ FilterBy myFpred) + :. (GroupBy ["col1", "col2", "col3"] (AggOn [Sum "col4" $ As "col4Sum", Max "col4" $ As "col4Max"] $ From Previous) $ GroupOn myGpred) + :. (Select ["col1", "col2", "col3", "col4Sum"] $ From Previous) + ) + :-> (EtlC $ Source ["tgrCol"] $ Target ["trgCol2"] $ By myTransformation (On Previous) RemoveSrc $ FilterBy myFpred2) + :-> (EtlR $ ROpStart :. (Agg $ AggOn [Sum "trgCol2" $ As "trgCol2Sum"] $ From Previous)) + :-> (EtlC $ Source ["trgCol2Sum"] $ Target ["newCol1", "newCol2"] $ By myTransformation2 (On Previous) DontRemoveSrc $ FilterBy myFpred2) + + -- (EtlC $ Source ["trgCol2Sum"] $ Target ["newCol1", "newCol2"] $ By myTransformation2 (On Previous) DontRemoveSrc $ FilterBy myFpred2) + -- :-> (EtlR $ (Agg $ AggOn [Sum "trgCol2" $ As "trgCol2Sum"] $ From Previous) :. ROpStart ) + -- :-> (EtlC $ Source ["tgrCol"] $ Target ["trgCol2"] $ By myTransformation (On Previous) RemoveSrc $ FilterBy myFpred2) + -- :-> (EtlR $ + -- -- You read it from bottom to top + -- (Select ["col1", "col2", "col3", "col4Sum"] $ From Previous) + -- :. (GroupBy ["col1", "col2", "col3"] (AggOn [Sum "col4" $ As "col4Sum", Max "col4" $ As "col4Max"] $ From Previous) $ GroupOn myGpred) + -- :. (Filter (From Previous) $ FilterBy myFpred) + -- :. ROpStart + -- ) + -- :-> (EtlC $ Source ["srcCol"] $ Target ["trgCol"] $ By myTransformation (On $ Tab myTable) DontRemoveSrc $ FilterBy myFpred2) + -- :-> EtlMapStart + + +-- | Returns a prefix of an ETLMappingExpr that matches a named intermediate result. +-- For example, below we show a Julius expression where we define an intermediate named result called "myResult". +-- This result, is used at a later stage in this Julius expression, with the use of the function takeNamedResult. +-- +-- @ +-- etlXpression = +-- EtlMapStart +-- :-> (EtlC $ ...) +-- :=> NamedResult "myResult" (EtlR $ ...) +-- :-> (EtlR $ ... ) +-- :-> (EtlR $ +-- ROpStart +-- :. (Minus +-- (TabL $ +-- juliusToRTable $ takeNamedResult "myResult" etlXpression -- THIS IS THE POINT WHERE WE USE THE NAMED RESULT! +-- ) +-- (Previous)) +-- ) +-- @ +-- +-- In the above Julius expression (etlXpresion) the \"myResult\" named result equals to the prefix of the etlXpresion, up to the operation (included) with the +-- named result \"myResult\". +-- +-- @ +-- +-- takeNamedResult "myResult" etlXpression == EtlMapStart +-- :-> (EtlC $ ...) +-- :=> NamedResult "myResult" (EtlR $ ...) +-- +-- @ +-- +-- Note that the julius expression is scanned from right to left and thus it will return the longest prefix expression that matches the input name +-- +takeNamedResult :: + NamedResultName -- ^ the name of the intermediate result + -> ETLMappingExpr -- ^ input ETLMapping Expression + -> ETLMappingExpr -- ^ output ETLMapping Expression +takeNamedResult _ EtlMapStart = EtlMapStart +takeNamedResult rname (restExpression :-> etlOpXpr) = takeNamedResult rname restExpression +takeNamedResult rname (restExpression :=> NamedResult n etlOpXpr) = + if rname == n + then (restExpression :=> NamedResult n etlOpXpr) + else takeNamedResult rname restExpression + +-- | Evaluates (parses) the Julius exrpession and produces an 'ETLMapping'. The 'ETLMapping' is an internal representation of the Julius expression and one needs +-- to combine it with the 'etl' function, in order to evaluate the Julius expression into an 'RTable'. This can be achieved directly with function 'juliusToRTable' +evalJulius :: ETLMappingExpr -> ETLMapping +evalJulius EtlMapStart = ETLMapEmpty +evalJulius (restExpression :-> (EtlC colMapExpression)) = + case colMapExpression of + ColMappingEmpty + -> connectETLMapLD ETLcOp {cmap = ColMapEmpty} emptyRTable (evalJulius restExpression) -- (evalJulius restExpression) returns the previous ETLMapping + Source srcColumns (Target trgColumns (By colXformation (On tabExpr) removeSource (FilterBy filterPred))) + -> let prevMapping = case tabExpr of + Tab tab -> rtabToETLMapping tab -- make the RTable an ETLMapping (this is a leaf node) + Previous -> evalJulius restExpression + removeOption = case removeSource of + RemoveSrc -> Yes + DontRemoveSrc -> No + in connectETLMapLD ETLcOp {cmap = createColMapping srcColumns trgColumns colXformation removeOption filterPred} + emptyRTable -- right branch + prevMapping -- left branch +evalJulius (restExpression :=> NamedResult rname (EtlC colMapExpression)) = + case colMapExpression of + ColMappingEmpty + -> connectETLMapLD ETLcOp {cmap = ColMapEmpty} emptyRTable (evalJulius restExpression) -- (evalJulius restExpression) returns the previous ETLMapping + Source srcColumns (Target trgColumns (By colXformation (On tabExpr) removeSource (FilterBy filterPred))) + -> let prevMapping = case tabExpr of + Tab tab -> rtabToETLMapping tab -- make the RTable an ETLMapping (this is a leaf node) + Previous -> evalJulius restExpression + removeOption = case removeSource of + RemoveSrc -> Yes + DontRemoveSrc -> No + in connectETLMapLD ETLcOp {cmap = createColMapping srcColumns trgColumns colXformation removeOption filterPred} + emptyRTable -- right branch + prevMapping -- left branch +evalJulius (restExpression :-> (EtlR relOperExpression)) = + let (roperation, leftTabExpr, rightTabExpr) = evalROpExpr relOperExpression + (prevMapping, rightBranch) = case (leftTabExpr, rightTabExpr) of + -- binary operation (leaf) + (TXE (Tab tab1), TXE (Tab tab2)) -> (rtabToETLMapping tab1, tab2) + -- binary operation (no leaf) + (TXE Previous, TXE (Tab tab)) -> (evalJulius restExpression, tab) + -- unary operation (leaf) - option 1 + (TXE (Tab tab), EmptyTab) -> (rtabToETLMapping tab, emptyRTable) + -- unary operation (leaf) - option 2 + (EmptyTab, TXE (Tab tab)) -> (ETLMapEmpty, tab) + -- unary operation (no leaf) + (TXE Previous, EmptyTab) -> (evalJulius restExpression, emptyRTable) + -- everything else is just wrong!! Do nothing + (_, _) -> (ETLMapEmpty, emptyRTable) + in connectETLMapLD ETLrOp {rop = roperation} rightBranch prevMapping -- (evalJulius restExpression) returns the previous ETLMapping +evalJulius (restExpression :=> NamedResult rname (EtlR relOperExpression)) = + let (roperation, leftTabExpr, rightTabExpr) = evalROpExpr relOperExpression + (prevMapping, rightBranch) = case (leftTabExpr, rightTabExpr) of + -- binary operation (leaf) + (TXE (Tab tab1), TXE (Tab tab2)) -> (rtabToETLMapping tab1, tab2) + -- binary operation (no leaf) + (TXE Previous, TXE (Tab tab)) -> (evalJulius restExpression, tab) + -- unary operation (leaf) - option 1 + (TXE (Tab tab), EmptyTab) -> (rtabToETLMapping tab, emptyRTable) + -- unary operation (leaf) - option 2 + (EmptyTab, TXE (Tab tab)) -> (ETLMapEmpty, tab) + -- unary operation (no leaf) + (TXE Previous, EmptyTab) -> (evalJulius restExpression, emptyRTable) + -- everything else is just wrong!! Do nothing + (_, _) -> (ETLMapEmpty, emptyRTable) + in connectETLMapLD ETLrOp {rop = roperation} rightBranch prevMapping -- (evalJulius restExpression) returns the previous ETLMapping + + +-- | Pure code to evaluate the \"ETL-logic\" of a Julius expression and generate the corresponding target RTable. +-- +-- The evaluation of a Julius expression (i.e., a 'ETLMappingExpr') to an RTable is strict. It evaluates fully to Normal Form (NF) +-- as opposed to a lazy evaluation (i.e., only during IO), or evaluation to a WHNF. +-- This is for efficiency reasons (e.g., avoid space leaks and excessive memory usage). It also has the impact that exceptions will be thrown +-- at the same line of code that 'juliusToRTable' is called. Thus one should wrap this call with a 'catch' handler, or use 'eitherPrintRTable', +-- or 'eitherPrintfRTable', if one wants to handle the exception gracefully. +-- +-- Example: +-- +-- @ +-- do +-- catch (printRTable $ juliusToRTable $ \<a Julius expression\> ) +-- (\\e -> putStrLn $ "There was an error in the Julius evaluation: " ++ (show (e::SomeException)) ) +-- @ +-- +-- Or, similarly +-- +-- @ +-- do +-- p <- (eitherPrintRTable printRTable $ +-- juliusToRTable $ \<a Julius expression\> +-- ) :: IO (Either SomeException ()) +-- case p of +-- Left exc -> putStrLn $ "There was an error in the Julius evaluation: " ++ (show exc) +-- Right _ -> return () +-- @ +-- +juliusToRTable :: ETLMappingExpr -> RTable +juliusToRTable = CDS.force $ (etl . evalJulius) + + + +-- | Evaluate a Julius expression within the IO Monad. +-- I.e., Effectful code to evaluate the \"ETL-logic\" of a Julius expression and generate the corresponding target RTable. +-- +-- The evaluation of a Julius expression (i.e., a 'ETLMappingExpr') to an RTable is strict. It evaluates fully to Normal Form (NF) +-- as opposed to a lazy evaluation (i.e., only during IO), or evaluation to a WHNF. +-- This is for efficiency reasons (e.g., avoid space leaks and excessive memory usage). It also has the impact that exceptions will be thrown +-- at the same line of code that 'runJulius' is called. Thus one should wrap this call with a 'catch' handler, or use 'eitherRunJulius', +-- if he wants to handle the exception gracefully. +-- +-- Example: +-- +-- @ +-- do +-- result <- catch (runJulius $ \<a Julius expression\>) +-- (\e -> do +-- putStrLn $ "there was an error in Julius evaluation: " ++ (show (e::SomeException)) +-- return emptyRTable +-- ) +-- @ +-- +runJulius :: ETLMappingExpr -> IO RTable +runJulius jul = return $!! juliusToRTable jul + + +-- | Evaluate a Julius expression and return the corresponding target 'RTable' or an exception. +-- One can define custom exceptions to be thrown within a Julius expression. This function will catch any +-- exceptions that are instances of the 'Exception' type class. +-- +-- The evaluation of a Julius expression (i.e., a 'ETLMappingExpr') to an 'RTable' is strict. It evaluates fully to Normal Form (NF) +-- as opposed to a lazy evaluation (i.e., only during IO), or evaluation to a WHNF. +-- This is for efficiency reasons (e.g., avoid space leaks and excessive memory usage). +-- +-- Example: +-- +-- @ +-- do +-- res <- (eitherRunJulius $ \<a Julius expression\>) :: IO (Either SomeException RTable) +-- resultRTab <- case res of +-- Right t -> return t +-- Left exc -> do +-- putStrLn $ "there was an error in Julius evaluation: " ++ (show exc) +-- return emptyRTable +-- +-- @ +-- +eitherRunJulius :: Exception e => ETLMappingExpr -> IO (Either e RTable) +eitherRunJulius jul = try $ runJulius jul + +-- | Receives an input Julius expression, evaluates it to an ETL Mapping ('ETLMapping') and executes it, +-- in order to return an 'RTabResult' containing an 'RTable' storing the result of the ETL Mapping, as well as the number of 'RTuple's returned +juliusToResult :: ETLMappingExpr -> RTabResult +juliusToResult = CDS.force $ (etlRes . evalJulius) + +-- | Evaluate a Julius expression within the IO Monad and return an 'RTabResult'. +runJuliusToResult :: ETLMappingExpr -> IO RTabResult +runJuliusToResult jul = return $ juliusToResult jul + +-- | Evaluate a Julius expression within the IO Monad and return either an 'RTabResult', or an exception, in case of an error during evaluation. +eitherRunJuliusToResult :: Exception e => ETLMappingExpr -> IO (Either e RTabResult) +eitherRunJuliusToResult jul = try $ runJuliusToResult jul + +-- | Generic ETL execution function. It receives a list of input (aka \"source\") 'RTable's and an ETL function that +-- produces a list of output (aka \"target\") 'RTable's. The ETL function should embed all the \"transformation-logic\" +-- from the source 'RTable's to the target 'RTable's. +runETL :: ([RTable] -> [RTable]) -> [RTable] -> IO [RTable] +runETL etlf inRTabs = return $!! etlf inRTabs + +-- | Generic ETL execution function that returns either the target list of 'RTable's, or an exception in case of a problem +-- during the ETL code execution. +-- It receives a list of input (aka \"source\") 'RTable's and an ETL function that +-- produces a list of output (aka \"target\") 'RTable's. The ETL function should embed all the \"transformation-logic\" +-- from the source 'RTable's to the target 'RTable's. +eitherRunETL :: Exception e => ([RTable] -> [RTable]) -> [RTable] -> IO (Either e [RTable]) +eitherRunETL etlf inRTabs = try $ (runETL etlf inRTabs) + + +-- | Internal type: We use this data type in order to identify unary vs binary operations and if the table is coming from the left or right branch +data TabExprEnhanced = TXE TabExpr | EmptyTab + +-- | Evaluates (parses) a Relational Operation Expression of the form +-- +-- @ +-- ROp :. ROp :. ... :. ROpStart +-- @ +-- +-- and produces the corresponding ROperation data type. +-- This will be an RCombinedOp relational operation that will be the composition of all relational operators +-- in the ROpExpr. In the returned result the TabExpr corresponding to the left and right RTable inputs to the ROperation +-- respectively, are also returned. +evalROpExpr :: ROpExpr -> (ROperation, TabExprEnhanced, TabExprEnhanced) +evalROpExpr ROpStart = (ROperationEmpty, EmptyTab, EmptyTab) +evalROpExpr (restExpression :. rop) = + case rop of + Filter (From tabExpr) (FilterBy filterPred) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = f filterPred -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is produced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + Select colNameList (From tabExpr) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = p colNameList -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is produced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + Agg (AggOn aggOpList (From tabExpr)) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = rAgg $ aggOpExprToAggOp aggOpList -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is produced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + GroupBy colNameList (AggOn aggOpList (From tabExpr)) (GroupOn grpPred) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = rG grpPred (aggOpExprToAggOp aggOpList) colNameList -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is produced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + OrderBy colOrderingSpecList (From tabExpr) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = rO colOrderingSpecList -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is produced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + Join (TabL tabl) tabExpr (JoinOn joinPred) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = iJ joinPred tabl -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is porduced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + LJoin (TabL tabl) tabExpr (JoinOn joinPred) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = lJ joinPred tabl -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is porduced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + RJoin (TabL tabl) tabExpr (JoinOn joinPred) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = rJ joinPred tabl -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is porduced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + FOJoin (TabL tabl) tabExpr (JoinOn joinPred) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = foJ joinPred tabl -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is porduced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + Intersect (TabL tabl) tabExpr -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = i tabl -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is porduced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + Union (TabL tabl) tabExpr -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = u tabl -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is porduced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + Minus (TabL tabl) tabExpr -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = d tabl -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is porduced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + -- TabExpr `MinusP` TabLiteral + MinusP tabExpr (TabL tabl) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = (flip d) tabl -- this returns a RTable -> RTable function, note that flip ensures that left table will be the second argument in d function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is porduced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + -- this is a generic unary operation on a RTable + GenUnaryOp (On tabExpr) (ByUnaryOp unRTabOp) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = unRTabOp -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is porduced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + -- this is a generic binary operation on a RTable + GenBinaryOp (TabL tabl) tabExpr (ByBinaryOp binRTabOp) -> + let -- create current function to be included in a RCombinedOp operation + currfunc :: UnaryRTableOperation + currfunc = binRTabOp tabl -- this returns a RTable -> RTable function + -- get previous RCombinedOp operation and table expressions + (prevOperation, prevTXEleft, prevTXEright) = evalROpExpr restExpression + + -- the current RCombinedOp is produced by composing the current function with the previous function + in case prevOperation of + -- in this case the previous operation is a valid non-empty operation and must be composed with the current one + RCombinedOp {rcombOp = prevfunc} -> (RCombinedOp {rcombOp = currfunc . prevfunc}, prevTXEleft, EmptyTab) + -- in this case the current Operation is the last one (the previous is just empty and must be ignored) + ROperationEmpty -> (RCombinedOp {rcombOp = currfunc}, TXE tabExpr, EmptyTab) + + +-- | turns the list of agg operation expressions to a list of RAggOperation data type +aggOpExprToAggOp :: [AggOp] -> [RAggOperation] +aggOpExprToAggOp [] = [] +aggOpExprToAggOp (aggopExpr : rest) = + let aggop = case aggopExpr of + Sum srcCol (As trgCol) -> (raggSum srcCol trgCol) + Count srcCol (As trgCol) -> (raggCount srcCol trgCol) + Min srcCol (As trgCol) -> (raggMin srcCol trgCol) + Max srcCol (As trgCol) -> (raggMax srcCol trgCol) + Avg srcCol (As trgCol) -> (raggAvg srcCol trgCol) + GenAgg srcCol (As trgCol) (AggBy aggf) -> (raggGenericAgg aggf srcCol trgCol) + in aggop : (aggOpExprToAggOp rest) + + + +-- and then run the produced ETLMapping +finalRTable = etl $ evalJulius myEtlExpr + +-- ############## +-- Various ETL Operations, defined as Generic Unary/Binary RTable Operations +-- ############## + +-- | Returns an 'ETLOperation' that adds a surrogate key (SK) column to an 'RTable' and +-- fills each row with a SK value. +-- This function is only exposed for backward compatibility reasons. The recommended function to use instead +-- is 'addSurrogateKeyJ', which can be embedded directly into a Julius expression as a 'UnaryRTableOperation'. +addSurrogateKey :: Integral a => + ColumnName -- ^ The name of the surrogate key column + -- -> Integer -- ^ The initial value of the Surrogate Key will be the value of this parameter + -> a -- ^ The initial value of the Surrogate Key will be the value of this parameter + -> ETLOperation -- ^ Output ETL operation which encapsulates the add surrogate key column mapping +addSurrogateKey cname initVal = + let combOp = RCombinedOp { rcombOp = updateSKvalue . (addColumn cname (RInt (fromIntegral initVal))) } + where + -- updateSKvalue :: RTable -> RTable + -- updateSKvalue rt = V.foldr' ( \rtup trgRtab -> let + -- newTuple = updateRTuple cname (rtup<!>cname + RInt 1) rtup + -- in appendRTuple newTuple trgRtab + -- ) emptyRTable rt + updateSKvalue :: RTable -> RTable + updateSKvalue rt = + let indexedRTab = V.indexed rt -- this returns a: Vector (Int, RTuple) (pairs each RTuple with its index in the RTable) + in V.zipWith (\tupsrc (val, _) -> upsertRTuple cname (RInt (fromIntegral initVal) + RInt (fromIntegral val)) tupsrc ) rt indexedRTab + in ETLrOp combOp + +-- | Returns an 'UnaryRTableOperation' ('RTable' -> 'RTable') that adds a surrogate key (SK) column to an 'RTable' and +-- fills each row with a SK value. It primarily is intended to be used within a Julius expression. For example: +-- +-- @ +-- GenUnaryOp (On Tab rtab1) $ ByUnaryOp (addSurrogateKeyJ "TxSK" 0) +-- @ +-- +addSurrogateKeyJ :: Integral a => + ColumnName -- ^ The name of the surrogate key column + -- -> Integer -- ^ The initial value of the Surrogate Key will be the value of this parameter + -> a -- ^ The initial value of the Surrogate Key will be the value of this parameter + -> RTable -- ^ Input RTable + -> RTable -- ^ Output RTable +addSurrogateKeyJ cname initVal = + updateSKvalue . (addColumn cname (RInt (fromIntegral initVal))) + where + -- updateSKvalue :: RTable -> RTable + -- updateSKvalue rt = V.foldr' ( \rtup trgRtab -> let + -- newTuple = updateRTuple cname (rtup<!>cname + RInt 1) rtup + -- in appendRTuple newTuple trgRtab + -- ) emptyRTable rt + updateSKvalue :: RTable -> RTable + updateSKvalue rt = + let indexedRTab = V.indexed rt -- this returns a: Vector (Int, RTuple) (pairs each RTuple with its index in the RTable) + in V.zipWith (\tupsrc (val, _) -> upsertRTuple cname (RInt (fromIntegral initVal) + RInt (fromIntegral val)) tupsrc ) rt indexedRTab + + +-- | Returns an 'ETLOperation' that Appends an 'RTable' to a target 'RTable' +-- This function is only exposed for backward compatibility reasons. The recommended function to use instead +-- is 'appendRTableJ', which can be embedded directly into a Julius expression as a 'BinaryRTableOperation'. +appendRTable :: + ETLOperation -- ^ Output ETL Operation +appendRTable = + let binOp = RBinOp { rbinOp = flip (V.++) } -- we need to flip the input parameters so that when we embed this operation in an ETL mapping + -- then the delta table will be appended to the target table. + in ETLrOp binOp + + +-- | Returns a 'BinaryRTableOperation' ('RTable' -> 'RTable' -> 'RTable') that Appends an 'RTable' to a target 'RTable'. +-- It is primarily intended to be used within a Julius expression. For example: +-- +-- @ +-- GenBinaryOp (TabL rtab1) (Tab $ rtab2) $ ByBinaryOp appendRTableJ +-- @ +-- +appendRTableJ :: + RTable -- ^ Target RTable + -> RTable -- ^ Input RTable + -> RTable -- ^ Output RTable +appendRTableJ = (V.++)
+ src/RTable/Core.hs view
@@ -0,0 +1,3726 @@+{-| +Module : RTable +Description : Implements the relational Table concept. Defines all necessary data types like RTable and RTuple as well as basic relational algebra operations on RTables. +Copyright : (c) Nikos Karagiannidis, 2018 + +License : BSD3 +Maintainer : nkarag@gmail.com +Stability : stable +Portability : POSIX + + +This is the core module that implements the relational Table concept with the 'RTable' data type. +It defines all necessary data types like 'RTable' and 'RTuple' as well as all the basic relational algebra operations (selection -i.e., filter- +, projection, inner/outer join, aggregation, grouping etc.) on 'RTable's. + + += When to use this module +This module should be used whenever one has "tabular data" (e.g., some CSV files, or any type of data that can be an instance of the 'RTabular' +type class and thus define the 'toRTable' and 'fromRTable' functions) and wants to analyze them in-memory with the well-known relational algebra operations +(selection, projection, join, groupby, aggregations etc) that lie behind SQL. +This data analysis takes place within your haskell code, without the need to import the data into a database (database-less +data processing) and the result can be turned into the original format (e.g., CSV) with a simple call to the 'fromRTable' function. + +"RTable.Core" gives you an interface for all common relational algebra operations, which are expressed as functions over +the basic 'RTable' data type. Of course, since each relational algebra operation is a function that returns a new RTable (immutability), one +can compose these operations and thus express an arbitrary complex query. Immutability also holds for DML operations also (e.g., 'updateRTab'). This +means that any update on an RTable operates like a @CREATE AS SELECT@ statement in SQL, creating a new 'RTable' and not modifying an existing one. + +Note that the recommended method in order to perform data analysis via relational algebra operations is to use the type-level __Embedded Domain Specific Language__ +__(EDSL) Julius__, defined in module "Etl.Julius", which exports the "RTable.Core" module. This provides a standard way of expressing queries and is +simpler for expressing more complex queries (with many relational algebra operations). Moreover it supports intermediate results (i.e., subqueries). Finally, +if you need to implement some __ETL/ELT data flows__, that will use the relational operations defined in "RTable.Core" to analyze data but also +to combine them with various __Column Mappings__ ('RColMapping'), in order to achieve various data transformations, then Julius is the appropriate tool for this job. + +See this [Julius Tutorial] (https://github.com/nkarag/haskell-DBFunctor/blob/master/doc/JULIUS-TUTORIAL.md) + += Overview +An 'RTable' is logically a container of 'RTuple's (similar to the concept of a Relation being a set of Tuples) and is the core data type in this +module. The 'RTuple' is a map of (Column-Name, Column-Value) pairs. A Column-Name is modeled with the 'ColumnName' data type, while the +Column-Value is modelled with the 'RDataType', which is a wrapper over the most common data types that one would expect to find in a column +of a Table (e.g., integers, rational numbers, strings, dates etc.). + +We said that the 'RTable' is a container of 'RTuple's and thus the 'RTable' is a 'Monad'! So one can write monadic code to implement RTable operations. For example: + + @ + -- | Return an new RTable after modifying each RTuple of the input RTable. + myRTableOperation :: RTable -> RTable + myRTableOperation rtab = do + rtup <- rtab + let new_rtup = doStuff rtup + return new_rtup + where + doStuff :: RTuple -> RTuple + doStuff = ... -- to be defined + @ + +Many different types of data can be turned into an 'RTable'. For example, CSV data can be easily turn into an 'RTable' via the 'toRTable' function. Many other types of data +could be represented as "tabular data" via the 'RTable' data type, as long as they adhere to the interface posed by the 'RTabular' type class. In other words, any data type +that we want to convert into an RTable and vice-versa, must become an instance of the 'RTabular' type class and thus define the basic 'toRTable' +and 'fromRTable' functions. + +== An Example +In this example we read a CSV file with the use of the 'readCSV' function from the "RTable.Data.CSV" module. Then, with the use of the 'toRTable' function, implemented in the +'RTabular' instance of the 'CSV' data type, we convert the CSV file into an 'RTable'. The data of the CSV file consist of metadata from an imaginary Oracle database and each +row represents an entry for a table stored in this database, with information (i.e., columns) pertaining to the owner of the table, the tablespace name, the status of the table +and various statistics, such as the number of rows and number of blocks. + +In this example, we apply three \"transformations\" to the input data and we print the result after each one, with the use of the 'printfRTable' function. The transfomrations +are: + +1. a 'limit' operation, where we return the first N number of 'RTuple's, +2. an 'RFilter' operation that returns only the tables that start with a \'B\', followed by a projection operation ('RPrj') +3. an inner-join ('RInJoin'), where we pair the 'RTuple's from the previous results based on a join predicate ('RJoinPredicate'): the tables that have been analyzed the same day + +Finally, we store the results of the 2nd operation into a new CSV file, with the use of the 'fromRTable' function implemented for the 'RTabular' instance of the 'CSV' data type. + +@ +{-# LANGUAGE OverloadedStrings #-} + +import RTable.Core +import RTable.Data.CSV (CSV, readCSV, toRTable) +import Data.Text as T (take, pack) + +-- This is the input source table metadata +src_DBTab_MData :: RTableMData +src_DBTab_MData = + createRTableMData ( \"sourceTab\" -- table name + ,[ (\"OWNER\", Varchar) -- Owner of the table + ,(\"TABLE_NAME\", Varchar) -- Name of the table + ,(\"TABLESPACE_NAME\", Varchar) -- Tablespace name + ,(\"STATUS\",Varchar) -- Status of the table object (VALID/IVALID) + ,(\"NUM_ROWS\", Integer) -- Number of rows in the table + ,(\"BLOCKS\", Integer) -- Number of Blocks allocated for this table + ,(\"LAST_ANALYZED\", Timestamp "MM/DD/YYYY HH24:MI:SS") -- Timestamp of the last time the table was analyzed (i.e., gathered statistics) + ] + ) + [\"OWNER\", \"TABLE_NAME\"] -- primary key + [] -- (alternative) unique keys + + +-- Result RTable metadata +result_tab_MData :: RTableMData +result_tab_MData = + createRTableMData ( \"resultTab\" -- table name + ,[ (\"OWNER\", Varchar) -- Owner of the table + ,(\"TABLE_NAME\", Varchar) -- Name of the table + ,(\"LAST_ANALYZED\", Timestamp \"MM/DD/YYYY HH24:MI:SS\") -- Timestamp of the last time the table was analyzed (i.e., gathered statistics) + ] + ) + [\"OWNER\", \"TABLE_NAME\"] -- primary key + [] -- (alternative) unique keys + + +main :: IO() +main = do + -- read source csv file + srcCSV <- readCSV ".\/app\/test-data.csv" + + putStrLn "\\nHow many rows you want to print from the source table? :\\n" + n <- readLn :: IO Int + + -- RTable A + printfRTable ( -- define the order by which the columns will appear on screen. Use the default column formatting. + genRTupleFormat [\"OWNER\", \"TABLE_NAME\", \"TABLESPACE_NAME\", \"STATUS\", \"NUM_ROWS\", \"BLOCKS\", \"LAST_ANALYZED\"] genDefaultColFormatMap) $ + limit n $ toRTable src_DBTab_MData srcCSV + + putStrLn "\\nThese are the tables that start with a \"B\":\\n" + + -- RTable B + printfRTable ( genRTupleFormat [\"OWNER\", \"TABLE_NAME\",\"LAST_ANALYZED\"] genDefaultColFormatMap) $ + tabs_start_with_B $ toRTable src_DBTab_MData srcCSV + + putStrLn "\\nThese are the tables that were analyzed the same day:\\n" + + -- RTable C = A InnerJoin B + printfRTable ( genRTupleFormat [\"OWNER\", \"TABLE_NAME\", \"LAST_ANALYZED\", \"OWNER_1\", \"TABLE_NAME_1\", \"LAST_ANALYZED_1\"] genDefaultColFormatMap) $ + ropB myJoin + (limit n $ toRTable src_DBTab_MData srcCSV) + (tabs_start_with_B $ toRTable src_DBTab_MData srcCSV) + + -- save result of 2nd operation to CSV file + writeCSV "./app/result-data.csv" $ + fromRTable result_tab_MData $ + tabs_start_with_B $ + toRTable src_DBTab_MData srcCSV + + where + -- Return RTuples with a table_name starting with a 'B' + tabs_start_with_B :: RTable -> RTable + tabs_start_with_B rtab = (ropU myProjection) . (ropU myFilter) $ rtab + where + -- Create a Filter Operation to return only RTuples with table_name starting with a 'B' + myFilter = RFilter ( \t -> let + tbname = case toText (t \<!\> \"TABLE_NAME\") of + Just t -> t + Nothing -> pack \"\" + in (T.take 1 tbname) == (pack \"B\") + ) + -- Create a Projection Operation that projects only two columns + myProjection = RPrj [\"OWNER\", \"TABLE_NAME\", \"LAST_ANALYZED\"] + + -- Create an Inner Join for tables analyzed in the same day + myJoin :: ROperation + myJoin = RInJoin ( \t1 t2 -> + let + RTime {rtime = RTimestampVal {year = y1, month = m1, day = d1, hours24 = hh1, minutes = mm1, seconds = ss1}} = t1\<!\>\"LAST_ANALYZED\" + RTime {rtime = RTimestampVal {year = y2, month = m2, day = d2, hours24 = hh2, minutes = mm2, seconds = ss2}} = t2\<!\>\"LAST_ANALYZED\" + in y1 == y2 && m1 == m2 && d1 == d2 + ) +@ + +And here is the output: + +@ +:l ./src/RTable/example.hs +:set -XOverloadedStrings +main +@ + +@ +How many rows you want to print from the source table? : + +10 +--------------------------------------------------------------------------------------------------------------------------------- +OWNER TABLE_NAME TABLESPACE_NAME STATUS NUM_ROWS BLOCKS LAST_ANALYZED +~~~~~ ~~~~~~~~~~ ~~~~~~~~~~~~~~~ ~~~~~~ ~~~~~~~~ ~~~~~~ ~~~~~~~~~~~~~ +APEX_030200 SYS_IOT_OVER_71833 SYSAUX VALID 0 0 06/08/2012 16:22:36 +APEX_030200 WWV_COLUMN_EXCEPTIONS SYSAUX VALID 3 3 06/08/2012 16:22:33 +APEX_030200 WWV_FLOWS SYSAUX VALID 10 3 06/08/2012 22:01:21 +APEX_030200 WWV_FLOWS_RESERVED SYSAUX VALID 0 0 06/08/2012 16:22:33 +APEX_030200 WWV_FLOW_ACTIVITY_LOG1$ SYSAUX VALID 1 29 07/20/2012 19:07:57 +APEX_030200 WWV_FLOW_ACTIVITY_LOG2$ SYSAUX VALID 14 29 07/20/2012 19:07:57 +APEX_030200 WWV_FLOW_ACTIVITY_LOG_NUMBER$ SYSAUX VALID 1 3 07/20/2012 19:08:00 +APEX_030200 WWV_FLOW_ALTERNATE_CONFIG SYSAUX VALID 0 0 06/08/2012 16:22:33 +APEX_030200 WWV_FLOW_ALT_CONFIG_DETAIL SYSAUX VALID 0 0 06/08/2012 16:22:33 +APEX_030200 WWV_FLOW_ALT_CONFIG_PICK SYSAUX VALID 37 3 06/08/2012 16:22:33 + + +10 rows returned +--------------------------------------------------------------------------------------------------------------------------------- + +These are the tables that start with a "B": + +------------------------------------------------------------- +OWNER TABLE_NAME LAST_ANALYZED +~~~~~ ~~~~~~~~~~ ~~~~~~~~~~~~~ +DBSNMP BSLN_BASELINES 04/15/2018 16:14:51 +DBSNMP BSLN_METRIC_DEFAULTS 06/08/2012 16:06:41 +DBSNMP BSLN_STATISTICS 04/15/2018 17:41:33 +DBSNMP BSLN_THRESHOLD_PARAMS 06/08/2012 16:06:41 +SYS BOOTSTRAP$ 04/14/2014 13:53:43 + + +5 rows returned +------------------------------------------------------------- + +These are the tables that were analyzed the same day: + +------------------------------------------------------------------------------------------------------------------------------------- +OWNER TABLE_NAME LAST_ANALYZED OWNER_1 TABLE_NAME_1 LAST_ANALYZED_1 +~~~~~ ~~~~~~~~~~ ~~~~~~~~~~~~~ ~~~~~~~ ~~~~~~~~~~~~ ~~~~~~~~~~~~~~~ +APEX_030200 SYS_IOT_OVER_71833 06/08/2012 16:22:36 DBSNMP BSLN_THRESHOLD_PARAMS 06/08/2012 16:06:41 +APEX_030200 SYS_IOT_OVER_71833 06/08/2012 16:22:36 DBSNMP BSLN_METRIC_DEFAULTS 06/08/2012 16:06:41 +APEX_030200 WWV_COLUMN_EXCEPTIONS 06/08/2012 16:22:33 DBSNMP BSLN_THRESHOLD_PARAMS 06/08/2012 16:06:41 +APEX_030200 WWV_COLUMN_EXCEPTIONS 06/08/2012 16:22:33 DBSNMP BSLN_METRIC_DEFAULTS 06/08/2012 16:06:41 +APEX_030200 WWV_FLOWS 06/08/2012 22:01:21 DBSNMP BSLN_THRESHOLD_PARAMS 06/08/2012 16:06:41 +APEX_030200 WWV_FLOWS 06/08/2012 22:01:21 DBSNMP BSLN_METRIC_DEFAULTS 06/08/2012 16:06:41 +APEX_030200 WWV_FLOWS_RESERVED 06/08/2012 16:22:33 DBSNMP BSLN_THRESHOLD_PARAMS 06/08/2012 16:06:41 +APEX_030200 WWV_FLOWS_RESERVED 06/08/2012 16:22:33 DBSNMP BSLN_METRIC_DEFAULTS 06/08/2012 16:06:41 +APEX_030200 WWV_FLOW_ALTERNATE_CONFIG 06/08/2012 16:22:33 DBSNMP BSLN_THRESHOLD_PARAMS 06/08/2012 16:06:41 +APEX_030200 WWV_FLOW_ALTERNATE_CONFIG 06/08/2012 16:22:33 DBSNMP BSLN_METRIC_DEFAULTS 06/08/2012 16:06:41 +APEX_030200 WWV_FLOW_ALT_CONFIG_DETAIL 06/08/2012 16:22:33 DBSNMP BSLN_THRESHOLD_PARAMS 06/08/2012 16:06:41 +APEX_030200 WWV_FLOW_ALT_CONFIG_DETAIL 06/08/2012 16:22:33 DBSNMP BSLN_METRIC_DEFAULTS 06/08/2012 16:06:41 +APEX_030200 WWV_FLOW_ALT_CONFIG_PICK 06/08/2012 16:22:33 DBSNMP BSLN_THRESHOLD_PARAMS 06/08/2012 16:06:41 +APEX_030200 WWV_FLOW_ALT_CONFIG_PICK 06/08/2012 16:22:33 DBSNMP BSLN_METRIC_DEFAULTS 06/08/2012 16:06:41 + + +14 rows returned +------------------------------------------------------------------------------------------------------------------------------------- +@ + +Check the output CSV file + +@ +$ head .\/app\/result-data.csv +OWNER,TABLE_NAME,LAST_ANALYZED +DBSNMP,BSLN_BASELINES,04/15/2018 16:14:51 +DBSNMP,BSLN_METRIC_DEFAULTS,06/08/2012 16:06:41 +DBSNMP,BSLN_STATISTICS,04/15/2018 17:41:33 +DBSNMP,BSLN_THRESHOLD_PARAMS,06/08/2012 16:06:41 +SYS,BOOTSTRAP$,04/14/2014 13:53:43 +@ + +-} + +{-# LANGUAGE OverloadedStrings #-} +-- :set -XOverloadedStrings +-- :set -XRecordWildCards +{-# LANGUAGE GeneralizedNewtypeDeriving -- In order to be able to derive from non-standard derivable classes (such as Num) + ,BangPatterns + ,RecordWildCards + ,DeriveGeneric -- Allow automatic deriving of instances for the Generic typeclass (see Text.PrettyPrint.Tabulate.Example) + ,DeriveDataTypeable -- Enable automatic deriving of instances for the Data typeclass (see Text.PrettyPrint.Tabulate.Example) + {-- + :set -XDeriveGeneric + :set -XDeriveDataTypeable + --} + -- Allow definition of type class instances for type synonyms. (used for RTuple instance of Tabulate) + --,TypeSynonymInstances + --,FlexibleInstances +#-} + +-- {-# LANGUAGE DuplicateRecordFields #-} + +module RTable.Core ( + + -- * The Relational Table Concept + -- ** RTable Data Types + RTable (..) + ,RTuple (..) + ,RDataType (..) + ,RTimestamp (..) + -- ** RTable Metadata Data Types + ,RTableMData (..) + ,RTupleMData (..) + ,ColumnInfo (..) + ,Name + ,ColumnName + ,RTableName + ,ColumnDType (..) + + -- * Type Classes for "Tabular Data" + ,RTabular (..) + + -- * Relational Algebra Operations + -- ** Operations Data Types + ,ROperation (..) + ,UnaryRTableOperation + ,BinaryRTableOperation + ,RAggOperation (..) + -- *** Available Aggregate Operations + ,AggFunction (..) + ,raggGenericAgg + ,raggSum + ,raggCount + ,raggAvg + ,raggMax + ,raggMin + + -- ** Predicates + ,RPredicate + ,RGroupPredicate + ,RJoinPredicate + + -- ** Operation Execution + ,runUnaryROperation + ,ropU + ,runUnaryROperationRes + ,ropUres + ,runBinaryROperation + ,ropB + ,runBinaryROperationRes + ,ropBres + + -- ** Operation Result + ,RTuplesRet + ,RTabResult + ,rtabResult + ,runRTabResult + ,execRTabResult + ,rtuplesRet + ,getRTuplesRet + -- ** Operation Composition + {-| + === An Example of Operation Composition + >>> -- define a simple RTable with four RTuples of a single column "col1" + >>> let tab1 = rtableFromList [rtupleFromList [("col1", RInt 1)], rtupleFromList [("col1", RInt 2)], rtupleFromList [("col1", RInt 3)], rtupleFromList [("col1", RInt 4)] ] + + >>> printRTable tab1 + + @ + col1 + ~~~~ + 1 + 2 + 3 + 4 + + + 4 rows returned + --------- + @ + >>> -- define a filter operation col1 > 2 + >>> let rop1 = RFilter (\t-> t<!>"col1" > 2) + + >>> -- define another filter operation col1 > 3 + >>> let rop2 = RFilter (\t-> t<!>"col1" > 3) + + >>> -- Composition of RTable operations via (.) (rop1 returns 2 RTuples and rop2 returns 1 RTuple) + >>> printRTable $ (ropU rop2) . (ropU rop1) $ tab1 + + @ + col1 + ~~~~ + 4 + + + 1 row returned + --------- + @ + >>> -- Composition of RTabResult operations via (<=<) (Note: that the result includes the sum of the returned RTuples in each operation, i.e., 2+1 = 3) + >>> execRTabResult $ (ropUres rop2) <=< (ropUres rop1) $ tab1 + Sum {getSum = 3} + >>> printRTable $ fst.runRTabResult $ (ropUres rop2) <=< (ropUres rop1) $ tab1 + + @ + col1 + ~~~~ + 4 + + + 1 row returned + --------- + @ + -} + , (.) + , (<=<) + + -- * RTable Functions + -- ** Relational Algebra Functions + ,runRfilter + ,f + ,runInnerJoinO + ,iJ + ,runLeftJoin + ,lJ + ,runRightJoin + ,rJ + ,runFullOuterJoin + ,foJ + ,joinRTuples + ,runUnion + ,u + ,runIntersect + ,i + ,runDiff + ,d + ,runProjection + ,runProjectionMissedHits + ,p + ,runAggregation + ,rAgg + ,runGroupBy + ,rG + ,groupNoAggList + ,groupNoAgg + ,runOrderBy + ,rO + ,runCombinedROp + ,rComb + -- ** Decoding + ,IgnoreDefault (..) + ,decodeRTable + ,decodeColValue + -- ** Date/Time + ,toRTimestamp + ,createRTimestamp + ,rTimestampToRText + ,stdTimestampFormat + ,stdDateFormat + -- ** Character/Text + ,instrRText + ,instr + ,instrText + ,rdtappend + ,stripRText + ,removeCharAroundRText + ,isText + -- ** NULL-Related + ,nvlRTable + ,nvlRTuple + ,isNullRTuple + ,isNull + ,isNotNull + ,nvl + ,nvlColValue + -- ** Access RTable + ,isRTabEmpty + ,headRTup + ,limit + --,restrictNrows + ,isRTupEmpty + ,getRTupColValue + ,rtupLookup + ,rtupLookupDefault + , (<!>) + , (<!!>) + + -- ** Conversions + ,rtableToList + ,concatRTab + ,rtupleToList + ,toListRDataType + ,toText + ,fromText + -- ** Container Functions + ,rtabMap + ,rtabFoldr' + ,rtabFoldl' + ,rdatatypeFoldr' + ,rdatatypeFoldl' + -- * Modify RTable (DML) + ,insertAppendRTab + ,insertPrependRTab + ,updateRTab + ,upsertRTuple + -- * Create/Alter RTable (DDL) + ,emptyRTable + ,createSingletonRTable + ,rtableFromList + ,addColumn + ,removeColumn + ,emptyRTuple + ,createNullRTuple + ,createRtuple + ,rtupleFromList + ,createRDataType + -- * Metadata Functions + ,createRTableMData + ,getColumnNamesfromRTab + ,getColumnNamesfromRTuple + ,listOfColInfoRDataType + ,toListColumnName + ,toListColumnInfo + -- * Exceptions + ,ColumnDoesNotExist (..) + ,UnsupportedTimeStampFormat (..) + --,RTimestampFormatLengthMismatch (..) + ,EmptyInputStringsInToRTimestamp (..) + + -- * RTable IO Operations + -- ** RTable Printing and Formatting + {-| + === An Example of RTable printing + >>> -- define a simple RTable from a list + >>> :set -XOverloadedStrings + >>> :{ + let tab1 = rtableFromList [ rtupleFromList [("ColInteger", RInt 1), ("ColDouble", RDouble 2.3), ("ColText", RText "We dig dig dig dig dig dig dig")] + ,rtupleFromList [("ColInteger", RInt 2), ("ColDouble", RDouble 5.36879), ("ColText", RText "From early morn to night")] + ,rtupleFromList [("ColInteger", RInt 3), ("ColDouble", RDouble 999.9999), ("ColText", RText "In a mine the whole day through")] + ,rtupleFromList [("ColInteger", RInt 4), ("ColDouble", RDouble 0.9999), ("ColText", RText "Is what we like to do")] + ] + :} + >>> -- print without format specification + >>> printRTable tab1 + + @ + ----------------------------------------------------------------- + ColInteger ColText ColDouble + ~~~~~~~~~~ ~~~~~~~ ~~~~~~~~~ + 1 We dig dig dig dig dig dig dig 2.30 + 2 From early morn to night 5.37 + 3 In a mine the whole day through 1000.00 + 4 Is what we like to do 1.00 + + 4 rows returned + ----------------------------------------------------------------- + @ + >>> -- print with format specification (define column printing order and value formatting per column) + >>> printfRTable (genRTupleFormat ["ColInteger","ColDouble","ColText"] $ genColFormatMap [("ColInteger", Format "%d"),("ColDouble", Format "%1.1e"),("ColText", Format "%50s\n")]) tab1 + + @ + ----------------------------------------------------------------- + ColInteger ColDouble ColText + ~~~~~~~~~~ ~~~~~~~~~ ~~~~~~~ + 1 2.3e0 We dig dig dig dig dig dig dig + + 2 5.4e0 From early morn to night + + 3 1.0e3 In a mine the whole day through + + 4 1.0e0 Is what we like to do + + + 4 rows returned + ----------------------------------------------------------------- + @ + -} + ,printRTable + ,eitherPrintRTable + ,printfRTable + ,eitherPrintfRTable + ,RTupleFormat (..) + ,ColFormatMap + ,FormatSpecifier (..) + ,OrderingSpec (..) + ,genRTupleFormat + ,genRTupleFormatDefault + ,genColFormatMap + ,genDefaultColFormatMap + + ) where + +import Debug.Trace + +-- Data.Serialize (Cereal package) +-- https://hackage.haskell.org/package/cereal +-- https://hackage.haskell.org/package/cereal-0.5.4.0/docs/Data-Serialize.html +-- http://stackoverflow.com/questions/2283119/how-to-convert-a-integer-to-a-bytestring-in-haskell +import Data.Serialize (decode, encode) + +-- Vector +import qualified Data.Vector as V + +-- HashMap -- https://hackage.haskell.org/package/unordered-containers-0.2.7.2/docs/Data-HashMap-Strict.html +import Data.HashMap.Strict as HM + +-- Text +import Data.Text as T + +--import Data.Text.IO as TIO + +-- ByteString +import qualified Data.ByteString as BS + +-- Typepable -- https://hackage.haskell.org/package/base-4.9.1.0/docs/Data-Typeable.html + -- http://stackoverflow.com/questions/6600380/what-is-haskells-data-typeable + -- http://alvinalexander.com/source-code/haskell/how-determine-type-object-haskell-program +import qualified Data.Typeable as TB --(typeOf, Typeable) + +-- Dynamic +import qualified Data.Dynamic as D -- https://hackage.haskell.org/package/base-4.9.1.0/docs/Data-Dynamic.html + +-- Data.List +import Data.List (last, all, elem, break, span, map, null, zip, zipWith, elemIndex, sortOn, union, intersect, (\\), take, length, repeat, groupBy, sort, sortBy, foldl', foldr, foldr1, foldl',head, findIndex, tails, isPrefixOf) +-- Data.Maybe +import Data.Maybe (fromJust, fromMaybe) +-- Data.Char +import Data.Char (toUpper,digitToInt, isDigit, isAlpha) +-- Data.Monoid +import Data.Monoid as M +-- Control.Monad +import Control.Monad ((<=<)) +-- Control.Monad.Trans.Writer.Strict +import Control.Monad.Trans.Writer.Strict (Writer, writer, runWriter, execWriter) +-- Text.Printf +import Text.Printf (printf) + +import Control.Exception + +import GHC.Generics (Generic) +import Control.DeepSeq +import Data.String.Utils (replace) + +-- import Control.Monad.IO.Class (liftIO) + + +{--- Text.PrettyPrint.Tabulate +import qualified Text.PrettyPrint.Tabulate as PP +import qualified GHC.Generics as G +import Data.Data +-} +--import qualified Text.PrettyPrint.Boxes as BX +--import Data.Map (fromList) + + +--import qualified Data.Map.Strict as Map -- Data.Map.Strict https://www.stackage.org/haddock/lts-7.4/containers-0.5.7.1/Data-Map-Strict.html +--import qualified Data.Set as Set -- https://www.stackage.org/haddock/lts-7.4/containers-0.5.7.1/Data-Set.html#t:Set +--import qualified Data.ByteString as BS -- Data.ByteString https://www.stackage.org/haddock/lts-7.4/bytestring-0.10.8.1/Data-ByteString.html + +{-- +-- | Definition of the Relation entity +data Relation +-- = RelToBeDefined deriving (Show) + = Relation -- ^ A Relation is essentially a set of tuples + { + relname :: String -- ^ The name of the Relation (metadata) + ,fields :: [RelationField] -- ^ The list of fields (i.e., attributes) of the relation (metadata) + ,tuples :: Set.Set Rtuple -- ^ A relation is essentially a set o tuples (data) + } + | EmptyRel -- ^ An empty relation + deriving Show +--} + + +myRTableOperation :: RTable -> RTable +myRTableOperation rtab = do + rtup <- rtab + let new_rtup = doStuff rtup + return new_rtup + where + doStuff :: RTuple -> RTuple + doStuff = undefined + +-- * ########## Type Classes ############## + +-- | Basic class to represent a data type that can be turned into an 'RTable'. +-- It implements the concept of "tabular data" +class RTabular a where + + toRTable :: RTableMData -> a -> RTable + + fromRTable :: RTableMData -> RTable -> a + + {-# MINIMAL toRTable, fromRTable #-} + +-- * ########## Data Types ############## + +-- | Definition of the Relational Table entity +-- An 'RTable' is a "container" of 'RTuple's. +type RTable = V.Vector RTuple + + +-- | Definition of the Relational Tuple. +-- An 'RTuple' is implemented as a 'HashMap' of ('ColumnName', 'RDataType') pairs. This ensures fast access of the column value by column name. +-- Note that this implies that the 'RTuple' CANNOT have more than one columns with the same name (i.e. hashmap key) and more importantly that +-- it DOES NOT have a fixed order of columns, as it is usual in RDBMS implementations. +-- This gives us the freedom to perform column change operations very fast. +-- The only place were we need fixed column order is when we try to load an 'RTable' from a fixed-column structure such as a CSV file. +-- For this reason, we have embedded the notion of a fixed column-order in the 'RTuple' metadata. See 'RTupleMData'. +-- +type RTuple = HM.HashMap ColumnName RDataType + +-- | Turns an 'RTable' to a list of 'RTuple's +rtableToList :: RTable -> [RTuple] +rtableToList = V.toList + +-- | Creates an RTable from a list of RTuples +rtableFromList :: [RTuple] -> RTable +rtableFromList = V.fromList + +-- | Turns an RTuple to a List +rtupleToList :: RTuple -> [(ColumnName, RDataType)] +rtupleToList = HM.toList + +-- | Create an RTuple from a list +rtupleFromList :: [(ColumnName, RDataType)] -> RTuple +rtupleFromList = HM.fromList + +{- +instance Data RTuple +instance G.Generic RTuple +instance PP.Tabulate RTuple +-} + +-- | Definition of the Name type +type Name = Text + +-- | Definition of the Column Name +type ColumnName = Name + +-- instance PP.Tabulate ColumnName + +-- | Definition of the Table Name +type RTableName = Name + +-- | This is used only for metadata purposes (see 'ColumnInfo'). The actual data type of a value is an RDataType +-- The Text component of Date and Timestamp data constructors is the date format e.g., "DD\/MM\/YYYY", "DD\/MM\/YYYY HH24:MI:SS" +data ColumnDType = Integer | Varchar | Date Text | Timestamp Text | Double deriving (Show, Eq) + +-- | Definition of the Relational Data Type. This is the data type of the values stored in each 'RTable'. +-- This is a strict data type, meaning whenever we evaluate a value of type 'RDataType', +-- there must be also evaluated all the fields it contains. +data RDataType = + RInt { rint :: !Integer } + -- RChar { rchar :: Char } + | RText { rtext :: !T.Text } + -- RString {rstring :: [Char]} + | RDate { + rdate :: !T.Text + ,dtformat :: !Text -- ^ e.g., "DD\/MM\/YYYY" + } + | RTime { rtime :: !RTimestamp } + | RDouble { rdouble :: !Double } + -- RFloat { rfloat :: Float } + | Null + deriving (Show,TB.Typeable, Read, Generic) -- http://stackoverflow.com/questions/6600380/what-is-haskells-data-typeable + +-- | In order to be able to force full evaluation up to Normal Form (NF) +-- https://www.fpcomplete.com/blog/2017/09/all-about-strictness +instance NFData RDataType + + +-- | We need to explicitly specify equation of RDataType due to SQL NULL logic (i.e., anything compared to NULL returns false): +-- @ +-- Null == _ = False, +-- _ == Null = False, +-- Null /= _ = False, +-- _ /= Null = False. +-- @ +-- IMPORTANT NOTE: +-- Of course this means that anywhere in your code where you have something like this: +-- @ +-- x == Null or x /= Null, +-- @ +-- will always return False and thus it is futile to do this comparison. +-- You have to use the is 'isNull' function instead. +-- +instance Eq RDataType where + + RInt i1 == RInt i2 = i1 == i2 + -- RInt i == _ = False + RText t1 == RText t2 = t1 == t2 + -- RText t1 == _ = False + RDate t1 s1 == RDate t2 s2 = (t1 == t1) && (s1 == s2) + -- RDate t1 s1 == _ = False + RTime t1 == RTime t2 = t1 == t2 + -- RTime t1 == _ = False + RDouble d1 == RDouble d2 = d1 == d2 + -- RDouble d1 == _ = False + -- Watch out: NULL logic (anything compared to NULL returns false) + Null == Null = False + _ == Null = False + Null == _ = False + -- anything else is just False + _ == _ = False + + Null /= Null = False + _ /= Null = False + Null /= _ = False + x /= y = not (x == y) + +-- Need to explicitly specify due to "Null logic" (see Eq) +instance Ord RDataType where + Null <= _ = False + _ <= Null = False + -- Null <= Null = False -- Comment out due to redundant warning + RInt i1 <= RInt i2 = i1 <= i2 + RText t1 <= RText t2 = t1 <= t2 + RDate t1 s1 <= RDate t2 s2 = (t1 <= t1) && (s1 == s2) + RTime t1 <= RTime t2 = t1 <= t2 + RTime t1 <= _ = False + RDouble d1 <= RDouble d2 = d1 <= d2 + -- anything else is just False + _ <= _ = False + + +-- | Use this function to compare an RDataType with the Null value because due to Null logic +-- x == Null or x /= Null, will always return False. +-- It returns True if input value is Null +isNull :: RDataType -> Bool +isNull x = + case x of + Null -> True + _ -> False + +-- | Use this function to compare an RDataType with the Null value because deu to Null logic +-- x == Null or x /= Null, will always return False. +-- It returns True if input value is Not Null +isNotNull = not . isNull + +instance Num RDataType where + (+) (RInt i1) (RInt i2) = RInt (i1 + i2) + (+) (RDouble d1) (RDouble d2) = RDouble (d1 + d2) + (+) (RDouble d1) (RInt i2) = RDouble (d1 + fromIntegral i2) + (+) (RInt i1) (RDouble d2) = RDouble (fromIntegral i1 + d2) + -- (+) (RInt i1) (Null) = RInt i1 -- ignore Null - just like in SQL + -- (+) (Null) (RInt i2) = RInt i2 -- ignore Null - just like in SQL + -- (+) (RDouble d1) (Null) = RDouble d1 -- ignore Null - just like in SQL + -- (+) (Null) (RDouble d2) = RDouble d2 -- ignore Null - just like in SQL + (+) (RInt i1) (Null) = Null + (+) (Null) (RInt i2) = Null + (+) (RDouble d1) (Null) = Null + (+) (Null) (RDouble d2) = Null + (+) _ _ = Null + (*) (RInt i1) (RInt i2) = RInt (i1 * i2) + (*) (RDouble d1) (RDouble d2) = RDouble (d1 * d2) + (*) (RDouble d1) (RInt i2) = RDouble (d1 * fromIntegral i2) + (*) (RInt i1) (RDouble d2) = RDouble (fromIntegral i1 * d2) + -- (*) (RInt i1) (Null) = RInt i1 -- ignore Null - just like in SQL + -- (*) (Null) (RInt i2) = RInt i2 -- ignore Null - just like in SQL + -- (*) (RDouble d1) (Null) = RDouble d1 -- ignore Null - just like in SQL + -- (*) (Null) (RDouble d2) = RDouble d2 -- ignore Null - just like in SQL + (*) (RInt i1) (Null) = Null + (*) (Null) (RInt i2) = Null + (*) (RDouble d1) (Null) = Null + (*) (Null) (RDouble d2) = Null + (*) _ _ = Null + abs (RInt i) = RInt (abs i) + abs (RDouble i) = RDouble (abs i) + abs _ = Null + signum (RInt i) = RInt (signum i) + signum (RDouble i) = RDouble (signum i) + signum _ = Null + fromInteger i = RInt i + negate (RInt i) = RInt (negate i) + negate (RDouble i) = RDouble (negate i) + negate _ = Null + +-- | In order to be able to use (/) with RDataType +instance Fractional RDataType where + (/) (RInt i1) (RInt i2) = RDouble $ (fromIntegral i1)/(fromIntegral i2) + (/) (RDouble d1) (RInt i2) = RDouble $ (d1)/(fromIntegral i2) + (/) (RInt i1) (RDouble d2) = RDouble $ (fromIntegral i1)/(d2) + (/) (RDouble d1) (RDouble d2) = RDouble $ d1/d2 + (/) _ _ = Null + + -- In order to be able to turn a Rational number into an RDataType, e.g. in the case: totamnt / 12.0 + -- where totamnt = RDouble amnt + -- fromRational :: Rational -> a + fromRational r = RDouble (fromRational r) + +-- | Standard date format +stdDateFormat = "DD/MM/YYYY" + +-- | Get the Column Names of an RTable +getColumnNamesfromRTab :: RTable -> [ColumnName] +getColumnNamesfromRTab rtab = getColumnNamesfromRTuple $ headRTup rtab + +-- | Get the first RTuple from an RTable +headRTup :: + RTable + -> RTuple +headRTup = V.head + +-- | Returns the Column Names of an RTuple +getColumnNamesfromRTuple :: RTuple -> [ColumnName] +getColumnNamesfromRTuple t = HM.keys t + +-- | Returns the value of an RTuple column based on the ColumnName key +-- if the column name is not found, then it returns Nothing +rtupLookup :: + ColumnName -- ^ ColumnName key + -> RTuple -- ^ Input RTuple + -> Maybe RDataType -- ^ Output value +rtupLookup = HM.lookup + +-- | Returns the value of an RTuple column based on the ColumnName key +-- if the column name is not found, then it returns a default value +rtupLookupDefault :: + RDataType -- ^ Default value to return in the case the column name does not exist in the RTuple + -> ColumnName -- ^ ColumnName key + -> RTuple -- ^ Input RTuple + -> RDataType -- ^ Output value +rtupLookupDefault = HM.lookupDefault + + +-- | getRTupColValue :: Returns the value of an RTuple column based on the ColumnName key +-- if the column name is not found, then it returns Null. +-- !!!Note that this might be confusing since there might be an existing column name with a Null value!!! +getRTupColValue :: + ColumnName -- ^ ColumnName key + -> RTuple -- ^ Input RTuple + -> RDataType -- ^ Output value +getRTupColValue = rtupLookupDefault Null -- HM.lookupDefault Null + + +-- | Operator for getting a column value from an RTuple +-- Throws a 'ColumnDoesNotExist' exception, if this map contains no mapping for the key. +(<!>) :: + RTuple -- ^ Input RTuple + -> ColumnName -- ^ ColumnName key + -> RDataType -- ^ Output value +(<!>) t c = -- flip getRTupColValue + -- (HM.!) + case rtupLookup c t of + Just v -> v + Nothing -> throw $ ColumnDoesNotExist c + -- error $ "*** Error in function Data.RTable.(<!>): Column \"" ++ (T.unpack c) ++ "\" does not exist! ***" + + +-- | Safe Operator for getting a column value from an RTuple +-- if the column name is not found, then it returns Nothing +(<!!>) :: + RTuple -- ^ Input RTuple + -> ColumnName -- ^ ColumnName key + -> Maybe RDataType -- ^ Output value +(<!!>) t c = rtupLookup c t + +-- | Returns the 1st parameter if this is not Null, otherwise it returns the 2nd. +nvl :: + RDataType -- ^ input value + -> RDataType -- ^ default value returned if input value is Null + -> RDataType -- ^ output value +nvl v defaultVal = + if isNull v + then defaultVal + else v + +-- | Returns the value of a specific column (specified by name) if this is not Null. +-- If this value is Null, then it returns the 2nd parameter. +-- If you pass an empty RTuple, then it returns Null. +-- Throws a 'ColumnDoesNotExist' exception, if this map contains no mapping for the key. +nvlColValue :: + ColumnName -- ^ ColumnName key + -> RDataType -- ^ value returned if original value is Null + -> RTuple -- ^ input RTuple + -> RDataType -- ^ output value +nvlColValue col defaultVal tup = + if isRTupEmpty tup + then Null + else + case tup <!> col of + Null -> defaultVal + val -> val + +data IgnoreDefault = Ignore | NotIgnore deriving (Eq, Show) + +-- | It receives an RTuple and lookups the value at a specfic column name. +-- Then it compares this value with the specified search value. If it is equal to the search value +-- then it returns the specified Return Value. If not, then it returns the specified default Value, if the ignore indicator is not set, +-- otherwise (if the ignore indicator is set) it returns the existing value. +-- If you pass an empty RTuple, then it returns Null. +-- Throws a 'ColumnDoesNotExist' exception, if this map contains no mapping for the key. +decodeColValue :: + ColumnName -- ^ ColumnName key + -> RDataType -- ^ Search value + -> RDataType -- ^ Return value + -> RDataType -- ^ Default value + -> IgnoreDefault -- ^ Ignore default indicator + -> RTuple -- ^ input RTuple + -> RDataType +decodeColValue cname searchVal returnVal defaultVal ignoreInd tup = + if isRTupEmpty tup + then Null + else +{- + case tup <!> cname of + searchVal -> returnVal + v -> if ignoreInd == Ignore then v else defaultVal +-} + if tup <!> cname == searchVal + then returnVal + else + if ignoreInd == Ignore + then tup <!> cname + else defaultVal + +-- | It receives an RTuple and a default value. It returns a new RTuple which is identical to the source one +-- but every Null value in the specified colummn has been replaced by a default value +nvlRTuple :: + ColumnName -- ^ ColumnName key + -> RDataType -- ^ Default value in the case of Null column values + -> RTuple -- ^ input RTuple + -> RTuple -- ^ output RTuple +nvlRTuple c defaultVal tup = + if isRTupEmpty tup + then emptyRTuple + else HM.map (\v -> nvl v defaultVal) tup + + +-- | It receives an RTable and a default value. It returns a new RTable which is identical to the source one +-- but for each RTuple, for the specified column every Null value in every RTuple has been replaced by a default value +-- If you pass an empty RTable, then it returns an empty RTable +-- Throws a 'ColumnDoesNotExist' exception, if the column does not exist +nvlRTable :: + ColumnName -- ^ ColumnName key + -> RDataType -- ^ Default value + -> RTable -- ^ input RTable + -> RTable +nvlRTable c defaultVal tab = + if isRTabEmpty tab + then emptyRTable + else + V.map (\t -> upsertRTuple c (nvlColValue c defaultVal t) t) tab + --V.map (\t -> nvlRTuple c defaultVal t) tab + +-- | It receives an RTable, a search value and a default value. It returns a new RTable which is identical to the source one +-- but for each RTuple, for the specified column: +-- if the search value was found then the specified Return Value is returned +-- else the default value is returned (if the ignore indicator is not set), otherwise (if the ignore indicator is set), +-- it returns the existing value for the column for each 'RTuple'. +-- If you pass an empty RTable, then it returns an empty RTable +-- Throws a 'ColumnDoesNotExist' exception, if the column does not exist +decodeRTable :: + ColumnName -- ^ ColumnName key + -> RDataType -- ^ Search value + -> RDataType -- ^ Return value + -> RDataType -- ^ Default value + -> IgnoreDefault -- ^ Ignore default indicator + -> RTable -- ^ input RTable + -> RTable +decodeRTable cName searchVal returnVal defaultVal ignoreInd tab = + if isRTabEmpty tab + then emptyRTable + else + V.map (\t -> upsertRTuple cName (decodeColValue cName searchVal returnVal defaultVal ignoreInd t) t) tab + +-- | Upsert (update/insert) an RTuple at a specific column specified by name with a value +-- If the cname key is not found then the (columnName, value) pair is inserted. If it exists +-- then the value is updated with the input value. +upsertRTuple :: + ColumnName -- ^ key where the upset will take place + -> RDataType -- ^ new value + -> RTuple -- ^ input RTuple + -> RTuple -- ^ output RTuple +upsertRTuple cname newVal tupsrc = HM.insert cname newVal tupsrc + +-- newtype NumericRDT = NumericRDT { getRDataType :: RDataType } deriving (Eq, Ord, Read, Show, Num) + + +-- | stripRText : O(n) Remove leading and trailing white space from a string. +-- If the input RDataType is not an RText, then Null is returned +stripRText :: + RDataType -- ^ input string + -> RDataType +stripRText (RText t) = RText $ T.strip t +stripRText _ = Null + +-- | Concatenates two Text 'RDataTypes', in all other cases of 'RDataType' it returns 'Null'. +rdtappend :: + RDataType + -> RDataType + -> RDataType +rdtappend (RText t1) (RText t2) = RText (t1 `T.append` t2) +rdtappend _ _ = Null + + +-- | Helper function to remove a character around (from both beginning and end) of an (RText t) value +removeCharAroundRText :: Char -> RDataType -> RDataType +removeCharAroundRText ch (RText t) = RText $ T.dropAround (\c -> c == ch) t +removeCharAroundRText ch _ = Null + +-- | Basic data type to represent time. +-- This is a strict data type, meaning whenever we evaluate a value of type 'RTimestamp', +-- there must be also evaluated all the fields it contains. +data RTimestamp = RTimestampVal { + year :: !Int + ,month :: !Int + ,day :: !Int + ,hours24 :: !Int + ,minutes :: !Int + ,seconds :: !Int + } deriving (Show, Read, Generic) + + +-- | In order to be able to force full evaluation up to Normal Form (NF) +instance NFData RTimestamp + + +instance Eq RTimestamp where + RTimestampVal y1 m1 d1 h1 mi1 s1 == RTimestampVal y2 m2 d2 h2 mi2 s2 = + y1 == y2 && m1 == m2 && d1 == d2 && h1 == h2 && mi1 == mi2 && s1 == s2 + +instance Ord RTimestamp where + -- compare :: a -> a -> Ordering + compare (RTimestampVal y1 m1 d1 h1 mi1 s1) (RTimestampVal y2 m2 d2 h2 mi2 s2) = + if compare y1 y2 /= EQ + then compare y1 y2 + else + if compare m1 m2 /= EQ + then compare m1 m2 + else if compare d1 d2 /= EQ + then compare d1 d2 + else if compare h1 h2 /= EQ + then compare h1 h2 + else if compare mi1 mi2 /= EQ + then compare mi1 mi2 + else if compare s1 s2 /= EQ + then compare s1 s2 + else EQ + + +-- | Returns an 'RTimestamp' from an input 'String' and a format 'String'. +-- +-- Valid format patterns are: +-- +-- * For year: @YYYY@, e.g., @"0001"@, @"2018"@ +-- * For month: @MM@, e.g., @"01"@, @"1"@, @"12"@ +-- * For day: @DD@, e.g., @"01"@, @"1"@, @"31"@ +-- * For hours: @HH@, @HH24@ e.g., @"00"@, @"23"@ I.e., hours must be specified in 24 format +-- * For minutes: @MI@, e.g., @"01"@, @"1"@, @"59"@ +-- * For seconds: @SS@, e.g., @"01"@, @"1"@, @"59"@ +-- +-- Example of a typical format string is: @"DD\/MM\/YYYY HH:MI:SS@ +-- +-- If no valid format pattern is found then an 'UnsupportedTimeStampFormat' exception is thrown +-- +toRTimestamp :: + String -- ^ Format string e.g., "DD\/MM\/YYYY HH:MI:SS" + -> String -- ^ Timestamp string + -> RTimestamp +toRTimestamp fmt stime = + -- if (Data.List.length fmt) /= (Data.List.length stime) + -- then throw $ RTimestampFormatLengthMismatch fmt stime + -- else + if fmt == [] || stime == [] + then throw $ EmptyInputStringsInToRTimestamp fmt stime + else + let + -- replace HH24 to HH + formatSpec = Data.String.Utils.replace "HH24" "HH" + + ------ New logic + + -- build a hashmap of "format elements" to "time elements" + elemMap = parseFormat2 fmt stime HM.empty + + -- year + y = case HM.lookup "YYYY" elemMap of + Nothing -> 1 :: Int + Just yyyy -> (abs $ (digitToInt $ (yyyy !! 0)) * 1000) + + (abs $ (digitToInt $ (yyyy !! 1)) * 100) + + (abs $ (digitToInt $ (yyyy !! 2)) * 10) + + (abs $ digitToInt $ (yyyy !! 3)) + -- round to 1 - 9999 + year = case y `rem` 9999 of + 0 -> 9999 + yv -> yv + + -- month + mo = case HM.lookup "MM" elemMap of + Nothing -> 1 :: Int + Just mm -> -- Also take care the case where mm < 10 and is not given as two digits e.g., '03' but '3' + if Data.List.length mm == 1 + then (abs $ (digitToInt $ (mm !! 0)) * 1) + else + (abs $ (digitToInt $ (mm !! 0)) * 10) + + (abs $ digitToInt $ (mm !! 1)) + -- round to 1 - 12 values + month = case mo `rem` 12 of + 0 -> 12 + mv -> mv + + -- day + d = case HM.lookup "DD" elemMap of + Nothing -> 1 :: Int + Just dd -> -- Also take care the case where dd < 10 and is not given as two digits e.g., '03' but '3' + if Data.List.length dd == 1 + then (abs $ (digitToInt $ (dd !! 0)) * 1) + else + (abs $ (digitToInt $ (dd !! 0)) * 10) + + (abs $ digitToInt $ (dd !! 1)) + -- round to 1 - 31 values + day = case d `rem` 31 of + 0 -> 31 + dv -> dv + + -- hour + h = case HM.lookup "HH" elemMap of + Nothing -> 0 :: Int + Just hh -> -- Also take care the case where hh < 10 and is not given as two digits e.g., '03' but '3' + if Data.List.length hh == 1 + then (abs $ (digitToInt $ (hh !! 0)) * 1) + else + (abs $ (digitToInt $ (hh !! 0)) * 10) + + (abs $ digitToInt $ (hh !! 1)) + -- round to 0 - 23 values + hour = h `rem` 24 + + -- minutes + m = case HM.lookup "MI" elemMap of + Nothing -> 0 :: Int + Just mi -> -- Also take care the case where mi < 10 and is not given as two digits e.g., '03' but '3' + if Data.List.length mi == 1 + then (abs $ (digitToInt $ (mi !! 0)) * 1) + else + (abs $ (digitToInt $ (mi !! 0)) * 10) + + (abs $ digitToInt $ (mi !! 1)) + -- round to 0 - 59 values + min = m `rem` 60 + + + -- seconds + s = case HM.lookup "SS" elemMap of + Nothing -> 0 :: Int + Just ss -> -- Also take care the case where mi < 10 and is not given as two digits e.g., '03' but '3' + if Data.List.length ss == 1 + then (abs $ (digitToInt $ (ss !! 0)) * 1) + else + (abs $ (digitToInt $ (ss !! 0)) * 10) + + (abs $ digitToInt $ (ss !! 1)) + -- round to 0 - 59 values + sec = s `rem` 60 + + +-------------- old logic +{- -- parse format string and get positions of key timestamp format fields in the format string + posmap = parseFormat formatSpec + + -- year + posY = fromMaybe (-1) $ posmap ! "YYYY" + y = case posY of + -1 -> 1 :: Int + _ -> (abs $ (digitToInt $ (stime !! posY)) * 1000) + + (abs $ (digitToInt $ (stime !! (posY+1))) * 100) + + (abs $ (digitToInt $ (stime !! (posY+2))) * 10) + + (abs $ digitToInt $ (stime !! (posY+3))) + -- round to 1 - 9999 + year = case y `rem` 9999 of + 0 -> 9999 + yv -> yv + + -- month + posMO = fromMaybe (-1) $ posmap ! "MM" + mo = case posMO of + -1 -> 1 :: Int + _ -> (abs $ (digitToInt $ (stime !! posMO)) * 10) + + (abs $ digitToInt $ (stime !! (posMO+1))) + -- round to 1 - 12 values + month = case mo `rem` 12 of + 0 -> 12 + mv -> mv + + -- day + posD = fromMaybe (-1) $ posmap ! "DD" + d = case posD of + -1 -> 1 :: Int + _ -> (abs $ (digitToInt $ (stime !! posD)) * 10) + + (abs $ digitToInt $ (stime !! (posD+1))) + + + -- round to 1 - 31 values + day = case d `rem` 31 of + 0 -> 31 + dv -> dv + + -- hour + posH = fromMaybe (-1) $ posmap ! "HH" + h = case posH of + -1 -> 0 :: Int + _ -> (abs $ (digitToInt $ (stime !! posH)) * 10) + + (abs $ digitToInt $ (stime !! (posH+1))) + -- round to 0 - 23 values + hour = h `rem` 24 + + -- minutes + posMI = fromMaybe (-1) $ posmap ! "MI" -- subtract 2 positions due to 24 in "HH24" + mi = case posMI of + -1 -> 0 :: Int + _ -> (abs $ (digitToInt $ (stime !! posMI)) * 10) + + (abs $ digitToInt $ (stime !! (posMI+1))) + -- round to 0 - 59 values + min = mi `rem` 60 + + -- seconds + posS = fromMaybe (-1) $ posmap ! "SS" + s = case posS of + -1 -> 0 :: Int + _ -> (abs $ (digitToInt $ (stime !! posS)) * 10) + + (abs $ digitToInt $ (stime !! (posS+1))) + -- round to 0 - 59 values + sec = s `rem` 60 +-} + in RTimestampVal { + year = year + ,month = month + ,day = day + ,hours24 = hour + ,minutes = min + ,seconds = sec + } + where + -- the map returns the position of the first character of the corresponding timestamp element +{- parseFormat :: String -> HashMap String (Maybe Int) + parseFormat fmt = + let + keywords = ["YYYY","MM", "DD", "HH", "MI", "SS"] + positions = Data.List.map (\subs -> instr subs fmt) keywords + in + -- if no keyword found then throw an exception + if Data.List.all (\t -> t == Nothing) $ positions + then throw $ UnsupportedTimeStampFormat fmt + else + HM.fromList $ Data.List.zip keywords positions + +-} + parseFormat2 :: + String -- Format string e.g., "DD/MM/YYYY HH:MI:SS" + -> String -- Timestamp string + -> HashMap String String -- current map + -> HashMap String String -- output map + parseFormat2 [] _ currMap = currMap + parseFormat2 fmt tstamp currMap = + let + -- search for the format keywords (in each iteration) + keywords = ["YYYY","MM", "DD", "HH", "MI", "SS"] + positions = Data.List.map (\subs -> instr subs fmt) keywords + + -- get from format string the first substring of letter characters + (fmtElement, restFormat) = Data.List.span (\c -> isAlpha c) fmt + -- remove prefix non-Alpha characters from rest + restFormatFinal = snd $ Data.List.span (\c -> not $ isAlpha c) restFormat + -- get from tstamp string the first substring of number characters + (tmElement, restTstamp) = Data.List.span (\c -> isDigit c) tstamp + -- remove prefix non-Digit characters from rest + restTstampFinal = snd $ Data.List.span (\c -> not $ isDigit c) restTstamp + -- insert into map the pair + newMap = HM.insert fmtElement tmElement currMap + in + -- if no keyword found then throw an exception + if Data.List.all (\t -> t == Nothing) $ positions + then throw $ UnsupportedTimeStampFormat fmt + else parseFormat2 restFormatFinal restTstampFinal newMap + + +-- | Search for the first occurence of a substring within a 'String' and return the 1st character position, +-- or 'Nothing' if the substring is not found. +---- See : +---- https://stackoverflow.com/questions/24349038/finding-the-position-of-some-substrings-in-a-string +---- https://docs.oracle.com/cd/B28359_01/server.111/b28286/functions073.htm#SQLRF00651 +instr :: Eq a => + [a] -- ^ substring to search for + -> [a] -- ^ string to be searched + -> Maybe Int -- ^ Position within input string of substr 1st character +instr subs s = Data.List.findIndex (Data.List.isPrefixOf subs) $ Data.List.tails s + +-- | Search for the first occurence of a substring within a 'Text' string and return the 1st character position, +-- or 'Nothing' if the substring is not found. +---- See : +---- https://stackoverflow.com/questions/24349038/finding-the-position-of-some-substrings-in-a-string +---- https://docs.oracle.com/cd/B28359_01/server.111/b28286/functions073.htm#SQLRF00651 +instrText :: + Text -- ^ substring to search for + -> Text -- ^ string to be searched + -> Maybe Int -- ^ Position within input string of substr 1st character +instrText subs s = instr (T.unpack subs) $ T.unpack s + + +-- | Search for the first occurence of a substring within a 'RText' string and return the 1st character position, +-- or 'Nothing' if the substring is not found, or if an non-text 'RDataType', is given as input. +---- See : +---- https://stackoverflow.com/questions/24349038/finding-the-position-of-some-substrings-in-a-string +---- https://docs.oracle.com/cd/B28359_01/server.111/b28286/functions073.htm#SQLRF00651 +instrRText :: + RDataType -- ^ substring to search for + -> RDataType -- ^ string to be searched + -> Maybe Int -- ^ Position within input string of substr 1st character +instrRText (RText subs) (RText s) = instrText subs s +instrRText _ _ = Nothing + + +-- | Creates an RTimestamp data type from an input timestamp format string and a timestamp value represented as a `String`. +-- Valid format patterns are: +-- +-- * For year: @YYYY@, e.g., @"0001"@, @"2018"@ +-- * For month: @MM@, e.g., @"01"@, @"1"@, @"12"@ +-- * For day: @DD@, e.g., @"01"@, @"1"@, @"31"@ +-- * For hours: @HH@, @HH24@ e.g., @"00"@, @"23"@ I.e., hours must be specified in 24 format +-- * For minutes: @MI@, e.g., @"01"@, @"1"@, @"59"@ +-- * For seconds: @SS@, e.g., @"01"@, @"1"@, @"59"@ +-- +-- Example of a typical format string is: @"DD\/MM\/YYYY HH:MI:SS@ +-- +-- If no valid format pattern is found then an 'UnsupportedTimeStampFormat' exception is thrown +-- +createRTimestamp :: + String -- ^ Format string e.g., "DD\/MM\/YYYY HH24:MI:SS" + -> String -- ^ Timestamp string + -> RTimestamp +createRTimestamp fmt timeVal = toRTimestamp fmt timeVal + {-case Prelude.map (Data.Char.toUpper) fmt of + "DD/MM/YYYY HH24:MI:SS" -> parseTime timeVal + "\"DD/MM/YYYY HH24:MI:SS\"" -> parseTime timeVal + "MM/DD/YYYY HH24:MI:SS" -> parseTime timeVal + "\"MM/DD/YYYY HH24:MI:SS\"" -> parseTime timeVal + where + parseTime :: String -> RTimestamp + -- DD/MM/YYYY HH24:MI:SS + parseTime (d1:d2:'/':m1:m2:'/':y1:y2:y3:y4:' ':h1:h2:':':mi1:mi2:':':s1:s2:_) = RTimestampVal { + year = (digitToInt y1) * 1000 + (digitToInt y2) * 100 + (digitToInt y3) * 10 + (digitToInt y4) + ,month = (digitToInt m1) * 10 + (digitToInt m2) + ,day = (digitToInt d1) * 10 + (digitToInt d2) + ,hours24 = (digitToInt h1) * 10 + (digitToInt h2) + ,minutes = (digitToInt mi1) * 10 + (digitToInt mi2) + ,seconds = (digitToInt s1) * 10 + (digitToInt s2) + } + parseTime (d1:'/':m1:m2:'/':y1:y2:y3:y4:' ':h1:h2:':':mi1:mi2:':':s1:s2:_) = RTimestampVal { + year = (digitToInt y1) * 1000 + (digitToInt y2) * 100 + (digitToInt y3) * 10 + (digitToInt y4) + ,month = (digitToInt m1) * 10 + (digitToInt m2) + ,day = (digitToInt d1) + ,hours24 = (digitToInt h1) * 10 + (digitToInt h2) + ,minutes = (digitToInt mi1) * 10 + (digitToInt mi2) + ,seconds = (digitToInt s1) * 10 + (digitToInt s2) + } + parseTime (d1:'/':m1:'/':y1:y2:y3:y4:' ':h1:h2:':':mi1:mi2:':':s1:s2:_) = RTimestampVal { + year = (digitToInt y1) * 1000 + (digitToInt y2) * 100 + (digitToInt y3) * 10 + (digitToInt y4) + ,month = (digitToInt m1) + ,day = (digitToInt d1) + ,hours24 = (digitToInt h1) * 10 + (digitToInt h2) + ,minutes = (digitToInt mi1) * 10 + (digitToInt mi2) + ,seconds = (digitToInt s1) * 10 + (digitToInt s2) + } + parseTime (d1:d2:'/':m1:'/':y1:y2:y3:y4:' ':h1:h2:':':mi1:mi2:':':s1:s2:_) = RTimestampVal { + year = (digitToInt y1) * 1000 + (digitToInt y2) * 100 + (digitToInt y3) * 10 + (digitToInt y4) + ,month = (digitToInt m1) + ,day = (digitToInt d1) * 10 + (digitToInt d2) + ,hours24 = (digitToInt h1) * 10 + (digitToInt h2) + ,minutes = (digitToInt mi1) * 10 + (digitToInt mi2) + ,seconds = (digitToInt s1) * 10 + (digitToInt s2) + } + + -- -- MM/DD/YYYY HH24:MI:SS + parseTime (m1:m2:'/':d1:d2:'/':y1:y2:y3:y4:' ':h1:h2:':':mi1:mi2:':':s1:s2:_) = RTimestampVal { + year = (digitToInt y1) * 1000 + (digitToInt y2) * 100 + (digitToInt y3) * 10 + (digitToInt y4) + ,month = (digitToInt m1) * 10 + (digitToInt m2) + ,day = (digitToInt d1) * 10 + (digitToInt d2) + ,hours24 = (digitToInt h1) * 10 + (digitToInt h2) + ,minutes = (digitToInt mi1) * 10 + (digitToInt mi2) + ,seconds = (digitToInt s1) * 10 + (digitToInt s2) + } + parseTime (m1:'/':d1:d2:'/':y1:y2:y3:y4:' ':h1:h2:':':mi1:mi2:':':s1:s2:_) = RTimestampVal { + year = (digitToInt y1) * 1000 + (digitToInt y2) * 100 + (digitToInt y3) * 10 + (digitToInt y4) + ,day = (digitToInt d1) * 10 + (digitToInt d2) + ,month = (digitToInt m1) + ,hours24 = (digitToInt h1) * 10 + (digitToInt h2) + ,minutes = (digitToInt mi1) * 10 + (digitToInt mi2) + ,seconds = (digitToInt s1) * 10 + (digitToInt s2) + } + parseTime (m1:'/':d1:'/':y1:y2:y3:y4:' ':h1:h2:':':mi1:mi2:':':s1:s2:_) = RTimestampVal { + year = (digitToInt y1) * 1000 + (digitToInt y2) * 100 + (digitToInt y3) * 10 + (digitToInt y4) + ,month = (digitToInt m1) + ,day = (digitToInt d1) + ,hours24 = (digitToInt h1) * 10 + (digitToInt h2) + ,minutes = (digitToInt mi1) * 10 + (digitToInt mi2) + ,seconds = (digitToInt s1) * 10 + (digitToInt s2) + } + parseTime (m1:m2:'/':d1:'/':y1:y2:y3:y4:' ':h1:h2:':':mi1:mi2:':':s1:s2:_) = RTimestampVal { + year = (digitToInt y1) * 1000 + (digitToInt y2) * 100 + (digitToInt y3) * 10 + (digitToInt y4) + ,day = (digitToInt d1) + ,month = (digitToInt m1) * 10 + (digitToInt m2) + ,hours24 = (digitToInt h1) * 10 + (digitToInt h2) + ,minutes = (digitToInt mi1) * 10 + (digitToInt mi2) + ,seconds = (digitToInt s1) * 10 + (digitToInt s2) + } + + parseTime _ = RTimestampVal {year = 2999, month = 12, day = 31, hours24 = 11, minutes = 59, seconds = 59} +-} + +-- Convert from an RDate or RTimestamp to a UTCTime +{- +toUTCTime :: RDataType -> Maybe UTCTime +toUTCTime rdt = + case rdt of + RDate { rdate = dt, dtformat = fmt } -> + RTime { rtime = RTimestamp {year = y, month = m, day = d, hours24 = hh, minutes = m } } + +fromUTCTime :: UTCTime -> RDataType +-} + +-- | Return the Text out of an RDataType +-- If a non-text RDataType is given then Nothing is returned. +toText :: RDataType -> Maybe T.Text +toText (RText t) = Just t +toText _ = Nothing + +-- | Return an 'RDataType' from 'Text' +fromText :: T.Text -> RDataType +fromText t = RText t + +-- | Returns 'True' only if this is an 'RText' +isText :: RDataType -> Bool +isText (RText t) = True +isText _ = False + +-- | Standard timestamp format. For example: \"DD/MM/YYYY HH24:MI:SS\" +stdTimestampFormat = "DD/MM/YYYY HH24:MI:SS" + +-- | rTimeStampToText: converts an RTimestamp value to RText +-- Valid input formats are: +-- +-- * 1. @ "DD\/MM\/YYYY HH24:MI:SS" @ +-- * 2. @ \"YYYYMMDD-HH24.MI.SS\" @ +-- * 3. @ \"YYYYMMDD\" @ +-- * 4. @ \"YYYYMM\" @ +-- * 5. @ \"YYYY\" @ +-- +rTimestampToRText :: + String -- ^ Output format e.g., "DD\/MM\/YYYY HH24:MI:SS" + -> RTimestamp -- ^ Input RTimestamp + -> RDataType -- ^ Output RText +rTimestampToRText "DD/MM/YYYY HH24:MI:SS" ts = let -- timeString = show (day ts) ++ "/" ++ show (month ts) ++ "/" ++ show (year ts) ++ " " ++ show (hours24 ts) ++ ":" ++ show (minutes ts) ++ ":" ++ show (seconds ts) + timeString = expand (day ts) ++ "/" ++ expand (month ts) ++ "/" ++ expand (year ts) ++ " " ++ expand (hours24 ts) ++ ":" ++ expand (minutes ts) ++ ":" ++ expand (seconds ts) + expand i = if i < 10 then "0"++ (show i) else show i + in RText $ T.pack timeString +rTimestampToRText "YYYYMMDD-HH24.MI.SS" ts = let -- timeString = show (year ts) ++ show (month ts) ++ show (day ts) ++ "-" ++ show (hours24 ts) ++ "." ++ show (minutes ts) ++ "." ++ show (seconds ts) + timeString = expand (year ts) ++ expand (month ts) ++ expand (day ts) ++ "-" ++ expand (hours24 ts) ++ "." ++ expand (minutes ts) ++ "." ++ expand (seconds ts) + expand i = if i < 10 then "0"++ (show i) else show i + {- + !dummy1 = trace ("expand (year ts) : " ++ expand (year ts)) True + !dummy2 = trace ("expand (month ts) : " ++ expand (month ts)) True + !dummy3 = trace ("expand (day ts) : " ++ expand (day ts)) True + !dummy4 = trace ("expand (hours24 ts) : " ++ expand (hours24 ts)) True + !dummy5 = trace ("expand (minutes ts) : " ++ expand (minutes ts)) True + !dummy6 = trace ("expand (seconds ts) : " ++ expand (seconds ts)) True-} + in RText $ T.pack timeString +rTimestampToRText "YYYYMMDD" ts = let + timeString = expand (year ts) ++ expand (month ts) ++ expand (day ts) + expand i = if i < 10 then "0"++ (show i) else show i + in RText $ T.pack timeString +rTimestampToRText "YYYYMM" ts = let + timeString = expand (year ts) ++ expand (month ts) + expand i = if i < 10 then "0"++ (show i) else show i + in RText $ T.pack timeString +rTimestampToRText "YYYY" ts = let + timeString = show $ year ts -- expand (year ts) + -- expand i = if i < 10 then "0"++ (show i) else show i + in RText $ T.pack timeString + +rTimestampToRText _ ts = let -- timeString = show (day ts) ++ "/" ++ show (month ts) ++ "/" ++ show (year ts) ++ " " ++ show (hours24 ts) ++ ":" ++ show (minutes ts) ++ ":" ++ show (seconds ts) + timeString = expand (day ts) ++ "/" ++ expand (month ts) ++ "/" ++ expand (year ts) ++ " " ++ expand (hours24 ts) ++ ":" ++ expand (minutes ts) ++ ":" ++ expand (seconds ts) + expand i = if i < 10 then "0"++ (show i) else show i + in RText $ T.pack timeString + + +-- | Metadata for an RTable +data RTableMData = RTableMData { + rtname :: RTableName -- ^ Name of the 'RTable' + ,rtuplemdata :: RTupleMData -- ^ Tuple-level metadata + -- other metadata + ,pkColumns :: [ColumnName] -- ^ Primary Key + ,uniqueKeys :: [[ColumnName]] -- ^ List of unique keys i.e., each sublist is a unique key column combination + } deriving (Show, Eq) + + +-- | createRTableMData : creates RTableMData from input given in the form of a list +-- We assume that the column order of the input list defines the fixed column order of the RTuple. +createRTableMData :: + (RTableName, [(ColumnName, ColumnDType)]) + -> [ColumnName] -- ^ Primary Key. [] if no PK exists + -> [[ColumnName]] -- ^ list of unique keys. [] if no unique keys exists + -> RTableMData +createRTableMData (n, cdts) pk uks = + RTableMData { rtname = n, rtuplemdata = createRTupleMdata cdts, pkColumns = pk, uniqueKeys = uks } + + +-- | createRTupleMdata : Creates an RTupleMData instance based on a list of (Column name, Column Data type) pairs. +-- The order in the input list defines the fixed column order of the RTuple +createRTupleMdata :: [(ColumnName, ColumnDType)] -> RTupleMData +-- createRTupleMdata clist = Prelude.map (\(n,t) -> (n, ColumnInfo{name = n, colorder = fromJust (elemIndex (n,t) clist), dtype = t })) clist +--HM.fromList $ Prelude.map (\(n,t) -> (n, ColumnInfo{name = n, colorder = fromJust (elemIndex (n,t) clist), dtype = t })) clist +createRTupleMdata clist = + let colNamecolInfo = Prelude.map (\(n,t) -> (n, ColumnInfo{ name = n + --,colorder = fromJust (elemIndex (n,t) clist) + ,dtype = t + })) clist + colOrdercolName = Prelude.map (\(n,t) -> (fromJust (elemIndex (n,t) clist), n)) clist + in (HM.fromList colOrdercolName, HM.fromList colNamecolInfo) + + + + +-- Old - Obsolete: +-- Basic Metadata of an RTuple +-- Initially design with a HashMap, but HashMaps dont guarantee a specific ordering when turned into a list. +-- We implement the fixed column order logic for an RTuple, only at metadata level and not at the RTuple implementation, which is a HashMap (see @ RTuple) +-- So the fixed order of this list equals the fixed column order of the RTuple. +--type RTupleMData = [(ColumnName, ColumnInfo)] -- HM.HashMap ColumnName ColumnInfo + + + + +-- | Basic Metadata of an 'RTuple'. +-- The 'RTuple' metadata are accessed through a 'HashMap' 'ColumnName' 'ColumnInfo' structure. I.e., for each column of the 'RTuple', +-- we access the 'ColumnInfo' structure to get Column-level metadata. This access is achieved by 'ColumnName'. +-- However, in order to provide the "impression" of a fixed column order per tuple (see 'RTuple' definition), we provide another 'HashMap', +-- the 'HashMap' 'ColumnOrder' 'ColumnName'. So in the follwoing example, if we want to access the 'RTupleMData' tupmdata ColumnInfo by column order, +-- (assuming that we have N columns) we have to do the following: +-- +-- @ +-- (snd tupmdata)!((fst tupmdata)!0) +-- (snd tupmdata)!((fst tupmdata)!1) +-- ... +-- (snd tupmdata)!((fst tupmdata)!(N-1)) +-- @ +-- +-- In the same manner in order to access the column of an 'RTuple' (e.g., tup) by column order, we do the following: +-- +-- @ +-- tup!((fst tupmdata)!0) +-- tup!((fst tupmdata)!1) +-- ... +-- tup!((fst tupmdata)!(N-1)) +-- @ +-- +type RTupleMData = (HM.HashMap ColumnOrder ColumnName, HM.HashMap ColumnName ColumnInfo) + +type ColumnOrder = Int + +-- | toListColumnName: returns a list of RTuple column names, in the fixed column order of the RTuple. +toListColumnName :: + RTupleMData + -> [ColumnName] +toListColumnName rtupmd = + let mapColOrdColName = fst rtupmd + listColOrdColName = HM.toList mapColOrdColName -- generate a list of [ColumnOrdr, ColumnName] in random order + -- order list based on ColumnOrder + ordlistColOrdColName = sortOn (\(o,c) -> o) listColOrdColName -- Data.List.sortOn :: Ord b => (a -> b) -> [a] -> [a]. Sort a list by comparing the results of a key function applied to each element. + in Prelude.map (snd) ordlistColOrdColName + +-- | toListColumnInfo: returns a list of RTuple columnInfo, in the fixed column order of the RTuple +toListColumnInfo :: + RTupleMData + -> [ColumnInfo] +toListColumnInfo rtupmd = + let mapColNameColInfo = snd rtupmd + in Prelude.map (\cname -> mapColNameColInfo HM.! cname) (toListColumnName rtupmd) + + +-- | toListRDataType: returns a list of RDataType values of an RTuple, in the fixed column order of the RTuple +toListRDataType :: + RTupleMData + -> RTuple + -> [RDataType] +toListRDataType rtupmd rtup = Prelude.map (\cname -> rtup <!> cname) (toListColumnName rtupmd) + + +-- | Basic metadata for a column of an RTuple +data ColumnInfo = ColumnInfo { + name :: ColumnName + -- ,colorder :: Int -- ^ ordering of column within the RTuple (each new column added takes colorder+1) + -- Since an RTuple is implemented as a HashMap ColumnName RDataType, ordering of columns has no meaning. + -- However, with this columns we can "pretend" that there is a fixed column order in each RTuple. + ,dtype :: ColumnDType + } deriving (Show, Eq) + + +-- | Creates a list of the form [(ColumnInfo, RDataType)] from a list of ColumnInfo and an RTuple. The returned list respects the order of the [ColumnInfo] + -- Prelude.zip listOfColInfo (Prelude.map (snd) $ HM.toList rtup) -- this code does NOT guarantee that HM.toList will return the same column order as [ColumnInfo] +listOfColInfoRDataType :: [ColumnInfo] -> RTuple -> [(ColumnInfo, RDataType)] -- this code does guarantees that RDataTypes will be in the same column order as [ColumnInfo], i.e., the correct RDataType for the correct column +listOfColInfoRDataType (ci:[]) rtup = [(ci, rtup HM.!(name ci))] -- rt HM.!(name ci) -> this returns the RDataType by column name +listOfColInfoRDataType (ci:colInfos) rtup = (ci, rtup HM.!(name ci)):listOfColInfoRDataType colInfos rtup + + +-- | createRDataType: Get a value of type a and return the corresponding RDataType. +-- The input value data type must be an instance of the Typepable typeclass from Data.Typeable +createRDataType :: + TB.Typeable a + => a -- ^ input value + -> RDataType -- ^ output RDataType +createRDataType val = + case show (TB.typeOf val) of + --"Int" -> RInt $ D.fromDyn (D.toDyn val) 0 + "Int" -> case (D.fromDynamic (D.toDyn val)) of -- toDyn :: Typeable a => a -> Dynamic + Just v -> RInt v -- fromDynamic :: Typeable a => Dynamic -> Maybe a + Nothing -> Null + --"Char" -> RChar $ D.fromDyn (D.toDyn val) 'a' + {-- "Char" -> case (D.fromDynamic (D.toDyn val)) of + Just v -> RChar v + Nothing -> Null --} + --"Text" -> RText $ D.fromDyn (D.toDyn val) "" + "Text" -> case (D.fromDynamic (D.toDyn val)) of + Just v -> RText v + Nothing -> Null + --"[Char]" -> RString $ D.fromDyn (D.toDyn val) "" + {-- "[Char]" -> case (D.fromDynamic (D.toDyn val)) of + Just v -> RString v + Nothing -> Null --} + --"Double" -> RDouble $ D.fromDyn (D.toDyn val) 0.0 + "Double" -> case (D.fromDynamic (D.toDyn val)) of + Just v -> RDouble v + Nothing -> Null + --"Float" -> RFloat $ D.fromDyn (D.toDyn val) 0.0 + {-- "Float" -> case (D.fromDynamic (D.toDyn val)) of + Just v -> RFloat v + Nothing -> Null --} + _ -> Null + + +{--createRDataType :: + TB.Typeable a + => a -- ^ input value + -> RDataType -- ^ output RDataType +createRDataType val = + case show (TB.typeOf val) of + --"Int" -> RInt $ D.fromDyn (D.toDyn val) 0 + "Int" -> case (D.fromDynamic (D.toDyn val)) of -- toDyn :: Typeable a => a -> Dynamic + Just v -> v -- fromDynamic :: Typeable a => Dynamic -> Maybe a + Nothing -> Null + --"Char" -> RChar $ D.fromDyn (D.toDyn val) 'a' + "Char" -> case (D.fromDynamic (D.toDyn val)) of + Just v -> v + Nothing -> Null + --"Text" -> RText $ D.fromDyn (D.toDyn val) "" + "Text" -> case (D.fromDynamic (D.toDyn val)) of + Just v -> v + Nothing -> Null + --"[Char]" -> RString $ D.fromDyn (D.toDyn val) "" + "[Char]" -> case (D.fromDynamic (D.toDyn val)) of + Just v -> v + Nothing -> Null + --"Double" -> RDouble $ D.fromDyn (D.toDyn val) 0.0 + "Double" -> case (D.fromDynamic (D.toDyn val)) of + Just v -> v + Nothing -> Null + --"Float" -> RFloat $ D.fromDyn (D.toDyn val) 0.0 + "Float" -> case (D.fromDynamic (D.toDyn val)) of + Just v -> v + Nothing -> Null + _ -> Null +--} + + +{-- +-- | Definition of a relational tuple +data Rtuple +-- = TupToBeDefined deriving (Show) + = Rtuple { + fieldMap :: Map.Map RelationField Int -- ^ provides a key,value mapping between the field and the Index (i.e., the offset) in the bytestring + ,fieldValues :: BS.ByteString -- ^ tuple values are stored in a bytestring + } + deriving Show +--} + + +{-- + +-- | Definition of a relation's field +data RelationField + = RelationField { + fldname :: String + ,dataType :: DataType + } + deriving Show + +-- | Definition of a data type +data DataType + = Rinteger -- ^ an integer data type + | Rstring -- ^ a string data type + | Rdate -- ^ a date data type + deriving Show + + + +-- | Definition of a predicate +type Predicate a + = a -> Bool -- ^ a predicate is a polymorphic type, which is a function that evaluates an expression over an 'a' + -- (e.g., a can be an Rtuple, thus Predicate Rtuple) and returns either true or false. + + +-- | The selection operator. +-- It filters the tuples of a relation based on a predicate +-- and returns a new relation with the tuple that satisfy the predicate +selection :: + Relation -- ^ input relation + -> Predicate Rtuple -- ^ input predicate + -> Relation -- ^ output relation +selection r p = undefined + +--} + +-- | A Predicate. It defines an arbitrary condition over the columns of an 'RTuple'. It is used primarily in the filter 'RFilter' operation and used in the filter function 'f'. +type RPredicate = RTuple -> Bool + +-- | Definition of Relational Algebra operations. +-- These are the valid operations between RTables +data ROperation = + ROperationEmpty + | RUnion -- ^ Union + | RInter -- ^ Intersection + | RDiff -- ^ Difference + | RPrj { colPrjList :: [ColumnName] } -- ^ Projection + | RFilter { fpred :: RPredicate } -- ^ Filter operation (an 'RPredicate' can be any function of the signature + -- @ + -- RTuple -> Bool + -- @ + -- so it is much more powerful than a typical SQL filter expression, which is a boolean expression of comparison operators) + | RInJoin { jpred :: RJoinPredicate } -- ^ Inner Join (any type of join predicate allowed. Any function with a signature of the form: + -- @ + -- RTuple -> RTuple -> Bool + -- @ + -- is a valid join predicate. I.e., a function which returns 'True' when two 'RTuples' must be paired) + | RLeftJoin { jpred :: RJoinPredicate } -- ^ Left Outer Join + | RRightJoin { jpred :: RJoinPredicate } -- ^ Right Outer Join + | RAggregate { aggList :: [RAggOperation] -- ^ list of aggregates + } -- ^ Performs aggregation operations on specific columns and returns a singleton RTable + | RGroupBy { + gpred :: RGroupPredicate -- ^ the grouping predicate + ,aggList :: [RAggOperation] -- ^ the list of aggregates + ,colGrByList :: [ColumnName] -- ^ the Group By list of columns + } -- ^ A Group By operation + -- The SQL equivalent is: + -- @ + -- SELECT colGrByList, aggList FROM... GROUP BY colGrByList + -- @ + -- Note that compared to SQL, we can have a more generic grouping predicate (i.e., + -- when two 'RTuple's should belong in the same group) than just the equality of + -- values on the common columns between two 'RTuple's. + -- Also note, that in the case of an aggregation without grouping (equivalent to + -- a single-group group by), then the grouping predicate should be: + -- @ + -- \_ _ -> True + -- @ + | RCombinedOp { rcombOp :: UnaryRTableOperation } -- ^ A combination of unary 'ROperation's e.g., + -- @ + -- (p plist).(f pred) (i.e., RPrj . RFilter) + -- @ + -- , in the form of an + -- @ + -- RTable -> RTable function. + -- @ + -- In this sense we can also include a binary operation (e.g. join), if we partially apply the join to one 'RTable', e.g., + -- + -- @ + -- (ij jpred rtab) . (p plist) . (f pred) + -- @ + | RBinOp { rbinOp :: BinaryRTableOperation } -- ^ A generic binary 'ROperation'. + | ROrderBy { colOrdList :: [(ColumnName, OrderingSpec)] } -- ^ Order the 'RTuple's of the 'RTable' acocrding to the specified list of Columns. + -- First column in the input list has the highest priority in the sorting order. + +-- | A sum type to help the specification of a column ordering (Ascending, or Descending) +data OrderingSpec = Asc | Desc deriving (Show, Eq) + +-- | A generic unary operation on a RTable +type UnaryRTableOperation = RTable -> RTable + +-- | A generic binary operation on RTable +type BinaryRTableOperation = RTable -> RTable -> RTable + + +-- | The Join Predicate. It defines when two 'RTuple's should be paired. +type RJoinPredicate = RTuple -> RTuple -> Bool + +-- | The Group By Predicate +-- It defines the condition for two 'RTuple's to be included in the same group. +type RGroupPredicate = RTuple -> RTuple -> Bool + + +-- | This data type represents all possible aggregate operations over an RTable. +-- Examples are : Sum, Count, Average, Min, Max but it can be any other "aggregation". +-- The essential property of an aggregate operation is that it acts on an RTable (or on +-- a group of RTuples - in the case of the RGroupBy operation) and produces a single RTuple. +-- +-- An aggregate operation is applied on a specific column (source column) and the aggregated result +-- will be stored in the target column. It is important to understand that the produced aggregated RTuple +-- is different from the input RTuples. It is a totally new RTuple, that will consist of the +-- aggregated column(s) (and the grouping columns in the case of an RGroupBy). + +-- Also, note that following SQL semantics, an aggregate operation ignores Null values. +-- So for example, a SUM(column) will just ignore them and also will COUNT(column), i.e., it +-- will not sum or count the Nulls. If all columns are Null, then a Null will be returned. +-- +-- With this data type one can define his/her own aggregate operations and then execute them +-- with the 'runAggregation' (or 'rAgg') functions. +-- +data RAggOperation = RAggOperation { + sourceCol :: ColumnName -- ^ Source column + ,targetCol :: ColumnName -- ^ Target column + ,aggFunc :: RTable -> RTuple -- ^ here we define the aggegate function to be applied on an RTable + } + +-- | Aggregation Function type. +-- An aggregation function receives as input a source column (i.e., a 'ColumnName') of a source 'RTable' and returns +-- an aggregated value, which is the result of the aggregation on the values of the source column. +type AggFunction = ColumnName -> RTable -> RDataType + +-- | Returns an 'RAggOperation' with a custom aggregation function provided as input +raggGenericAgg :: + AggFunction -- ^ custom aggregation function + -> ColumnName -- ^ source column + -> ColumnName -- ^ target column + -> RAggOperation +raggGenericAgg aggf src trg = RAggOperation { + sourceCol = src + ,targetCol = trg + ,aggFunc = \rtab -> createRtuple [(trg, aggf src rtab)] + } + +-- | The Sum aggregate operation +raggSum :: + ColumnName -- ^ source column + -> ColumnName -- ^ target column + -> RAggOperation +raggSum src trg = RAggOperation { + sourceCol = src + ,targetCol = trg + ,aggFunc = \rtab -> createRtuple [(trg, sumFold src rtab)] + } + +-- | A helper function in raggSum that implements the basic fold for sum aggregation +sumFold :: AggFunction --ColumnName -> ColumnName -> RTable -> RDataType +sumFold src rtab = + V.foldr' ( \rtup accValue -> + --if (getRTupColValue src) rtup /= Null && accValue /= Null + if (isNotNull $ (getRTupColValue src) rtup) && (isNotNull accValue) + then + (getRTupColValue src) rtup + accValue + else + --if (getRTupColValue src) rtup == Null && accValue /= Null + if (isNull $ (getRTupColValue src) rtup) && (isNotNull accValue) + then + accValue -- ignore Null value + else + --if (getRTupColValue src) rtup /= Null && accValue == Null + if (isNotNull $ (getRTupColValue src) rtup) && (isNull accValue) + then + (getRTupColValue src) rtup + RInt 0 -- ignore so far Null agg result + -- add RInt 0, so in the case of a non-numeric rtup value, the result will be a Null + -- while if rtup value is numeric the addition of RInt 0 does not cause a problem + else + Null -- agg of Nulls is Null + ) (Null) rtab + + +-- | The Count aggregate operation +raggCount :: + ColumnName -- ^ source column + -> ColumnName -- ^ target column + -> RAggOperation +raggCount src trg = RAggOperation { + sourceCol = src + ,targetCol = trg + ,aggFunc = \rtab -> createRtuple [(trg, countFold src rtab)] + } + +-- | A helper function in raggCount that implements the basic fold for Count aggregation +countFold :: AggFunction -- ColumnName -> ColumnName -> RTable -> RDataType +countFold src rtab = + V.foldr' ( \rtup accValue -> + --if (getRTupColValue src) rtup /= Null && accValue /= Null + if (isNotNull $ (getRTupColValue src) rtup) && (isNotNull accValue) + then + RInt 1 + accValue + else + --if (getRTupColValue src) rtup == Null && accValue /= Null + if (isNull $ (getRTupColValue src) rtup) && (isNotNull accValue) + then + accValue -- ignore Null value + else + --if (getRTupColValue src) rtup /= Null && accValue == Null + if (isNotNull $ (getRTupColValue src) rtup) && (isNull accValue) + then + RInt 1 -- ignore so far Null agg result + else + Null -- agg of Nulls is Null + ) (Null) rtab + + +-- | The Average aggregate operation +raggAvg :: + ColumnName -- ^ source column + -> ColumnName -- ^ target column + -> RAggOperation +raggAvg src trg = RAggOperation { + sourceCol = src + ,targetCol = trg + ,aggFunc = \rtab -> createRtuple [(trg, let + sum = sumFold src rtab + cnt = countFold src rtab + in case (sum,cnt) of + (RInt s, RInt c) -> RDouble (fromIntegral s / fromIntegral c) + (RDouble s, RInt c) -> RDouble (s / fromIntegral c) + (_, _) -> Null + )] + } + +-- | The Max aggregate operation +raggMax :: + ColumnName -- ^ source column + -> ColumnName -- ^ target column + -> RAggOperation +raggMax src trg = RAggOperation { + sourceCol = src + ,targetCol = trg + ,aggFunc = \rtab -> createRtuple [(trg, maxFold src rtab)] + } + + +-- | A helper function in raggMax that implements the basic fold for Max aggregation +maxFold :: AggFunction -- ColumnName -> ColumnName -> RTable -> RDataType +maxFold src rtab = + V.foldr' ( \rtup accValue -> + --if (getRTupColValue src) rtup /= Null && accValue /= Null + if (isNotNull $ (getRTupColValue src) rtup) && (isNotNull accValue) + then + max ((getRTupColValue src) rtup) accValue + else + --if (getRTupColValue src) rtup == Null && accValue /= Null + if (isNull $ (getRTupColValue src) rtup) && (isNotNull accValue) + then + accValue -- ignore Null value + else + --if (getRTupColValue src) rtup /= Null && accValue == Null + if (isNotNull $ (getRTupColValue src) rtup) && (isNull accValue) + then + (getRTupColValue src) rtup -- ignore so far Null agg result + else + Null -- agg of Nulls is Null + ) Null rtab + + +-- | The Min aggregate operation +raggMin :: + ColumnName -- ^ source column + -> ColumnName -- ^ target column + -> RAggOperation +raggMin src trg = RAggOperation { + sourceCol = src + ,targetCol = trg + ,aggFunc = \rtab -> createRtuple [(trg, minFold src rtab)] + } + +-- | A helper function in raggMin that implements the basic fold for Min aggregation +minFold :: AggFunction -- ColumnName -> ColumnName -> RTable -> RDataType +minFold src rtab = + V.foldr' ( \rtup accValue -> + --if (getRTupColValue src) rtup /= Null && accValue /= Null + if (isNotNull $ (getRTupColValue src) rtup) && (isNotNull accValue) + then + min ((getRTupColValue src) rtup) accValue + else + --if (getRTupColValue src) rtup == Null && accValue /= Null + if (isNull $ (getRTupColValue src) rtup) && (isNotNull accValue) + then + accValue -- ignore Null value + else + --if (getRTupColValue src) rtup /= Null && accValue == Null + if (isNotNull $ (getRTupColValue src) rtup) && (isNull accValue) + then + (getRTupColValue src) rtup -- ignore so far Null agg result + else + Null -- agg of Nulls is Null + ) Null rtab + +{-- +data RAggOperation = + RSum ColumnName -- ^ sums values in the specific column + | RCount ColumnName -- ^ count of values in the specific column + | RCountDist ColumnName -- ^ distinct count of values in the specific column + | RAvg ColumnName -- ^ average of values in the specific column + | RMin ColumnName -- ^ minimum of values in the specific column + | RMax ColumnName -- ^ maximum of values in the specific column +--} + +-- | ropU operator executes a unary ROperation. A short name for the 'runUnaryROperation' function +ropU = runUnaryROperation + +-- | Execute a Unary ROperation +runUnaryROperation :: + ROperation -- ^ input ROperation + -> RTable -- ^ input RTable + -> RTable -- ^ output RTable +runUnaryROperation rop irtab = + case rop of + RFilter { fpred = rpredicate } -> runRfilter rpredicate irtab + RPrj { colPrjList = colNames } -> runProjection colNames irtab + RAggregate { aggList = aggFunctions } -> runAggregation aggFunctions irtab + RGroupBy { gpred = groupingpred, aggList = aggFunctions, colGrByList = cols } -> runGroupBy groupingpred aggFunctions cols irtab + RCombinedOp { rcombOp = comb } -> runCombinedROp comb irtab + ROrderBy { colOrdList = colist } -> runOrderBy colist irtab + +-- | ropUres operator executes a unary ROperation. A short name for the 'runUnaryROperationRes' function +ropUres = runUnaryROperationRes + +-- | Execute a Unary ROperation and return an 'RTabResult' +runUnaryROperationRes :: + ROperation -- ^ input ROperation + -> RTable -- ^ input RTable + -> RTabResult -- ^ output: Result of operation +runUnaryROperationRes rop irtab = + let resultRtab = runUnaryROperation rop irtab + returnedRtups = rtuplesRet $ V.length resultRtab + in rtabResult (resultRtab, returnedRtups) + +-- | ropB operator executes a binary ROperation. A short name for the 'runBinaryROperation' function +ropB = runBinaryROperation + +-- | Execute a Binary ROperation +runBinaryROperation :: + ROperation -- ^ input ROperation + -> RTable -- ^ input RTable1 + -> RTable -- ^ input RTable2 + -> RTable -- ^ output RTabl +runBinaryROperation rop irtab1 irtab2 = + case rop of + RInJoin { jpred = jpredicate } -> runInnerJoinO jpredicate irtab1 irtab2 + RLeftJoin { jpred = jpredicate } -> runLeftJoin jpredicate irtab1 irtab2 + RRightJoin { jpred = jpredicate } -> runRightJoin jpredicate irtab1 irtab2 + RUnion -> runUnion irtab1 irtab2 + RInter -> runIntersect irtab1 irtab2 + RDiff -> runDiff irtab1 irtab2 + RBinOp { rbinOp = bop } -> bop irtab1 irtab2 + +-- | ropBres operator executes a binary ROperation. A short name for the 'runBinaryROperationRes' function +ropBres = runBinaryROperationRes + +-- | Execute a Binary ROperation and return an 'RTabResult' +runBinaryROperationRes :: + ROperation -- ^ input ROperation + -> RTable -- ^ input RTable1 + -> RTable -- ^ input RTable2 + -> RTabResult -- ^ output: Result of operation +runBinaryROperationRes rop irtab1 irtab2 = + let resultRtab = runBinaryROperation rop irtab1 irtab2 + returnedRtups = rtuplesRet $ V.length resultRtab + in rtabResult (resultRtab, returnedRtups) + + +-- * ######### Construction ########## + +-- | Test whether an RTable is empty +isRTabEmpty :: RTable -> Bool +isRTabEmpty = V.null + +-- | Test whether an RTuple is empty +isRTupEmpty :: RTuple -> Bool +isRTupEmpty = HM.null + +-- | emptyRTable: Create an empty RTable +emptyRTable :: RTable +emptyRTable = V.empty :: RTable + +-- | Creates an empty RTuple (i.e., one with no column,value mappings) +emptyRTuple :: RTuple +emptyRTuple = HM.empty + + +-- | Creates an RTable with a single RTuple +createSingletonRTable :: + RTuple + -> RTable +createSingletonRTable rt = V.singleton rt + +-- | createRTuple: Create an Rtuple from a list of column names and values +createRtuple :: + [(ColumnName, RDataType)] -- ^ input list of (columnname,value) pairs + -> RTuple +createRtuple l = HM.fromList l + + + +-- | Creates a Null 'RTuple' based on a list of input Column Names. +-- A 'Null' 'RTuple' is an 'RTuple' where all column names correspond to a 'Null' value ('Null' is a data constructor of 'RDataType') +createNullRTuple :: + [ColumnName] + -> RTuple +createNullRTuple cnames = HM.fromList $ zipped + where zipped = Data.List.zip cnames (Data.List.take (Data.List.length cnames) (repeat Null)) + +-- | Returns True if the input RTuple is a Null RTuple, otherwise it returns False +isNullRTuple :: + RTuple + -> Bool +isNullRTuple t = + let -- if t is really Null, then the following must return an empty RTuple (since a Null RTuple has all its values equal with Null) + checkt = HM.filter (\v -> isNotNull v) t --v /= Null) t + in if isRTupEmpty checkt + then True + else False + + +-- * ########## RTable "Functional" Operations ############## + +-- | This is a fold operation on a 'RTable' that returns an 'RTable'. +-- It is similar with : +-- @ +-- foldr' :: (a -> b -> b) -> b -> Vector a -> b +-- @ +-- of Vector, which is an O(n) Right fold with a strict accumulator +rtabFoldr' :: (RTuple -> RTable -> RTable) -> RTable -> RTable -> RTable +rtabFoldr' f accum rtab = V.foldr' f accum rtab + +-- | This is a fold operation on a 'RTable' that returns an 'RDataType' value. +-- It is similar with : +-- @ +-- foldr' :: (a -> b -> b) -> b -> Vector a -> b +-- @ +-- of Vector, which is an O(n) Right fold with a strict accumulator +rdatatypeFoldr' :: (RTuple -> RDataType -> RDataType) -> RDataType -> RTable -> RDataType +rdatatypeFoldr' f accum rtab = V.foldr' f accum rtab + +-- | This is a fold operation on 'RTable' that returns an 'RTable'. +-- It is similar with : +-- @ +-- foldl' :: (a -> b -> a) -> a -> Vector b -> a +-- @ +-- of Vector, which is an O(n) Left fold with a strict accumulator +rtabFoldl' :: (RTable -> RTuple -> RTable) -> RTable -> RTable -> RTable +rtabFoldl' f accum rtab = V.foldl' f accum rtab + + +-- | This is a fold operation on 'RTable' that returns an 'RDataType' value +-- It is similar with : +-- @ +-- foldl' :: (a -> b -> a) -> a -> Vector b -> a +-- @ +-- of Vector, which is an O(n) Left fold with a strict accumulator +rdatatypeFoldl' :: (RDataType -> RTuple -> RDataType) -> RDataType -> RTable -> RDataType +rdatatypeFoldl' f accum rtab = V.foldl' f accum rtab + + +-- | Map function over an RTable +rtabMap :: (RTuple -> RTuple) -> RTable -> RTable +rtabMap f rtab = V.map f rtab + +-- * ########## RTable Relational Operations ############## + +-- | Number of RTuples returned by an RTable operation +type RTuplesRet = Sum Int + +-- | Creates an RTuplesRet type +rtuplesRet :: Int -> RTuplesRet +rtuplesRet i = (M.Sum i) :: RTuplesRet + +-- | Return the number embedded in the RTuplesRet data type +getRTuplesRet :: RTuplesRet -> Int +getRTuplesRet = M.getSum + + +-- | RTabResult is the result of an RTable operation and is a Writer Monad, that includes the new RTable, +-- as well as the number of RTuples returned by the operation. +type RTabResult = Writer RTuplesRet RTable + +-- | Creates an RTabResult (i.e., a Writer Monad) from a result RTable and the number of RTuples that it returned +rtabResult :: + (RTable, RTuplesRet) -- ^ input pair + -> RTabResult -- ^ output Writer Monad +rtabResult (rtab, rtupRet) = writer (rtab, rtupRet) + +-- | Returns the info "stored" in the RTabResult Writer Monad +runRTabResult :: + RTabResult + -> (RTable, RTuplesRet) +runRTabResult rtr = runWriter rtr + +-- | Returns the "log message" in the RTabResult Writer Monad, which is the number of returned RTuples +execRTabResult :: + RTabResult + -> RTuplesRet +execRTabResult rtr = execWriter rtr + + +-- | removeColumn : removes a column from an RTable. +-- The column is specified by ColumnName. +-- If this ColumnName does not exist in the RTuple of the input RTable +-- then nothing is happened, the RTuple remains intact. +removeColumn :: + ColumnName -- ^ Column to be removed + -> RTable -- ^ input RTable + -> RTable -- ^ output RTable +removeColumn col rtabSrc = do + srcRtup <- rtabSrc + let targetRtup = HM.delete col srcRtup + return targetRtup + +-- | addColumn: adds a column to an RTable +addColumn :: + ColumnName -- ^ name of the column to be added + -> RDataType -- ^ Default value of the new column. All RTuples will initially have this value in this column + -> RTable -- ^ Input RTable + -> RTable -- ^ Output RTable +addColumn name initVal rtabSrc = do + srcRtup <- rtabSrc + let targetRtup = HM.insert name initVal srcRtup + return targetRtup + + +-- | Filter (i.e. selection operator). A short name for the 'runRFilter' function +f = runRfilter + +-- | Executes an RFilter operation +runRfilter :: + RPredicate + -> RTable + -> RTable +runRfilter rpred rtab = + if isRTabEmpty rtab + then emptyRTable + else + V.filter rpred rtab + +-- | RTable Projection operator. A short name for the 'runProjection' function +p = runProjection + +-- | Implements RTable projection operation. +-- If a column name does not exist, then an empty RTable is returned. +runProjection :: + [ColumnName] -- ^ list of column names to be included in the final result RTable + -> RTable + -> RTable +runProjection colNamList irtab = + if isRTabEmpty irtab + then + emptyRTable + else + do -- RTable is a Monad + srcRtuple <- irtab + let + -- 1. get original column value (in this case it is a list of values :: Maybe RDataType) + srcValueL = Data.List.map (\colName -> rtupLookup colName srcRtuple) colNamList + + -- if there is at least one Nothing value then an non-existing column name has been asked. + if Data.List.elem Nothing srcValueL + then -- return an empty RTable + emptyRTable + else + let + -- 2. create the new RTuple + valList = Data.List.map (\(Just v) -> v) srcValueL -- get rid of Maybe + targetRtuple = rtupleFromList (Data.List.zip colNamList valList) -- HM.fromList + in return targetRtuple + + +-- | Implements RTable projection operation. +-- If a column name does not exist, then the returned RTable includes this column with a Null +-- value. This projection implementation allows missed hits. +runProjectionMissedHits :: + [ColumnName] -- ^ list of column names to be included in the final result RTable + -> RTable + -> RTable +runProjectionMissedHits colNamList irtab = + if isRTabEmpty irtab + then + emptyRTable + else + do -- RTable is a Monad + srcRtuple <- irtab + let + -- 1. get original column value (in this case it is a list of values) + srcValueL = Data.List.map (\src -> HM.lookupDefault Null -- return Null if value cannot be found based on column name + src -- column name to look for (source) - i.e., the key in the HashMap + srcRtuple -- source RTuple (i.e., a HashMap ColumnName RDataType) + ) colNamList + -- 2. create the new RTuple + targetRtuple = HM.fromList (Data.List.zip colNamList srcValueL) + return targetRtuple + +-- | returns the N first 'RTuple's of an 'RTable' +limit :: + Int -- ^ number of N 'RTuple's to return + -> RTable -- ^ input 'RTable' + -> RTable -- ^ output 'RTable' +limit n r1 = V.take n r1 + +{- +-- | restrictNrows: returns the N first rows of an RTable +restrictNrows :: + Int -- ^ number of N rows to select + -> RTable -- ^ input RTable + -> RTable -- ^ output RTable +restrictNrows n r1 = V.take n r1 +-} + +-- | RTable Inner Join Operator. A short name for the 'runInnerJoinO' function +iJ = runInnerJoinO + +-- | Implements an Inner Join operation between two RTables (any type of join predicate is allowed) +-- Note that this operation is implemented as a 'Data.HashMap.Strict' union, which means "the first +-- Map (i.e., the left RTuple) will be prefered when dublicate keys encountered with different values. That is, in the context of +-- joining two RTuples the value of the first (i.e., left) RTuple on the common key will be prefered. +runInnerJoin :: + RJoinPredicate + -> RTable + -> RTable + -> RTable +runInnerJoin jpred irtab1 irtab2 = + if (isRTabEmpty irtab1) || (isRTabEmpty irtab2) + then + emptyRTable + else + do + rtup1 <- irtab1 + rtup2 <- irtab2 + let targetRtuple = + if (jpred rtup1 rtup2) + then HM.union rtup1 rtup2 + else HM.empty + removeEmptyRTuples (return targetRtuple) + where removeEmptyRTuples = f (not.isRTupEmpty) + +-- | Implements an Inner Join operation between two RTables (any type of join predicate is allowed) +-- This Inner Join implementation follows Oracle DB's convention for common column names. +-- When we have two tuples t1 and t2 with a common column name (lets say \"Common\"), then the resulting tuple after a join +-- will be \"Common\", \"Common_1\", so a \"_1\" suffix is appended. The tuple from the left table by convention retains the original column name. +-- So \"Column_1\" is the column from the right table. If \"Column_1\" already exists, then \"Column_2\" is used. +runInnerJoinO :: + RJoinPredicate + -> RTable + -> RTable + -> RTable +runInnerJoinO jpred tabDriver tabProbed = + if isRTabEmpty tabDriver || isRTabEmpty tabProbed + then + emptyRTable + else + do + rtupDrv <- tabDriver + -- this is the equivalent of a nested loop with tabDriver playing the role of the driving table and tabProbed the probed table + V.foldr' (\t accum -> + if (jpred rtupDrv t) + then + -- insert joined tuple to result table (i.e. the accumulator) + insertAppendRTab (joinRTuples rtupDrv t) accum + else + -- keep the accumulator unchanged + accum + ) emptyRTable tabProbed + + +-- | Joins two RTuples into one. +-- In this join we follow Oracle DB's convention when joining two tuples with some common column names. +-- When we have two tuples t1 and t2 with a common column name (lets say "Common"), then the resulitng tuple after a join +-- will be "Common", "Common_1", so a "_1" suffix is appended. The tuple from the left table by convention retains the original column name. +-- So "Column_1" is the column from the right table. +-- If "Column_1" already exists, then "Column_2" is used. +joinRTuples :: RTuple -> RTuple -> RTuple +joinRTuples tleft tright = + let + -- change keys in tright what needs to be renamed because also appear in tleft + -- first keep a copy of the tright pairs that dont need a key change + dontNeedChange = HM.difference tright tleft + changedPart = changeKeys tleft tright + -- create a new version of tright, with no common keys with tleft + new_tright = HM.union dontNeedChange changedPart + in HM.union tleft new_tright + where + -- rename keys of right rtuple until there no more common keys with the left rtuple + changeKeys :: RTuple -> RTuple -> RTuple + changeKeys tleft changedPart = + if isRTupEmpty (HM.intersection changedPart tleft) + then -- we are done, no more common keys + changedPart + else + -- there are still common keys to change + let + needChange = HM.intersection changedPart tleft -- (k,v) pairs that exist in changedPart and the keys also appear in tleft. Thus these keys have to be renamed + dontNeedChange = HM.difference changedPart tleft -- (k,v) pairs that exist in changedPart and the keys dont appear in tleft. Thus these keys DONT have to be renamed + new_changedPart = fromList $ Data.List.map (\(k,v) -> (newKey k, v)) $ toList needChange + in HM.union dontNeedChange (changeKeys tleft new_changedPart) + + -- generate a new key as this: + -- "hello" -> "hello_1" + -- "hello_1" -> "hello_2" + -- "hello_2" -> "hello_3" + newKey :: ColumnName -> ColumnName + newKey nameT = + let + name = T.unpack nameT + lastChar = Data.List.last name + beforeLastChar = name !! (Data.List.length name - 2) + in + if beforeLastChar == '_' && Data.Char.isDigit lastChar + then T.pack $ (Data.List.take (Data.List.length name - 2) name) ++ ( '_' : (show $ (read (lastChar : "") :: Int) + 1) ) + else T.pack $ name ++ "_1" + + +-- | RTable Left Outer Join Operator. A short name for the 'runLeftJoin' function +lJ = runLeftJoin + +-- | Implements a Left Outer Join operation between two RTables (any type of join predicate is allowed), +-- i.e., the rows of the left RTable will be preserved. +-- Note that when dublicate keys encountered that is, since the underlying structure for an RTuple is a Data.HashMap.Strict, +-- only one value per key is allowed. So in the context of joining two RTuples the value of the left RTuple on the common key will be prefered. +{-runLeftJoin :: + RJoinPredicate + -> RTable + -> RTable + -> RTable +runLeftJoin jpred leftRTab rtab = do + rtupLeft <- leftRTab + rtup <- rtab + let targetRtuple = + if (jpred rtupLeft rtup) + then HM.union rtupLeft rtup + else HM.union rtupLeft (createNullRTuple colNamesList) + where colNamesList = HM.keys rtup + --return targetRtuple + + -- remove repeated rtuples and keep just the rtuples of the preserving rtable + iJ (jpred2) (return targetRtuple) leftRTab + where + -- the left tuple is the extended (result of the outer join) + -- the right tuple is from the preserving table + -- we need to return True for those who are equal in the common set of columns + jpred2 tL tR = + let left = HM.toList tL + right = HM.toList tR + -- in order to satisfy the join pred, all elements of right must exist in left + in Data.List.all (\(k,v) -> Data.List.elem (k,v) left) right +-} + +-- | Implements a Left Outer Join operation between two RTables (any type of join predicate is allowed), +-- i.e., the rows of the left RTable will be preserved. +-- A Left Join : +-- @ +-- tabLeft LEFT JOIN tabRight ON joinPred +-- @ +-- where tabLeft is the preserving table can be defined as: +-- the Union between the following two RTables: +-- +-- * The result of the inner join: tabLeft INNER JOIN tabRight ON joinPred +-- * The rows from the preserving table (tabLeft) that DONT satisfy the join condition, enhanced with the columns of tabRight returning Null values. +-- +-- The common columns will appear from both tables but only the left table column's will retain their original name. +runLeftJoin :: + RJoinPredicate + -> RTable + -> RTable + -> RTable +runLeftJoin jpred preservingTab tab = + if isRTabEmpty preservingTab + then + emptyRTable + else + if isRTabEmpty tab + then + -- return the preserved tab + preservingTab + + else + -- we know that both the preservingTab and tab are non empty + let + unionFstPart = iJ jpred preservingTab tab + -- project only the preserving tab's columns + fstPartProj = p (getColumnNamesfromRTab preservingTab) unionFstPart + + -- the second part are the rows from the preserving table that dont join + -- we will use the Difference operations for this + unionSndPart = + let + difftab = d preservingTab fstPartProj -- unionFstPart + -- now enhance the result with the columns of the right table + in iJ (\t1 t2 -> True) difftab (createSingletonRTable $ createNullRTuple $ (getColumnNamesfromRTab tab)) + in u unionFstPart unionSndPart + + +-- | RTable Right Outer Join Operator. A short name for the 'runRightJoin' function +rJ = runRightJoin + +-- | Implements a Right Outer Join operation between two RTables (any type of join predicate is allowed), +-- i.e., the rows of the right RTable will be preserved. +-- A Right Join : +-- @ +-- tabLeft RIGHT JOIN tabRight ON joinPred +-- @ +-- where tabRight is the preserving table can be defined as: +-- the Union between the following two RTables: +-- +-- * The result of the inner join: tabLeft INNER JOIN tabRight ON joinPred +-- * The rows from the preserving table (tabRight) that DONT satisfy the join condition, enhanced with the columns of tabLeft returning Null values. +-- +-- The common columns will appear from both tables but only the right table column's will retain their original name. +runRightJoin :: + RJoinPredicate + -> RTable + -> RTable + -> RTable +runRightJoin jpred tab preservingTab = + if isRTabEmpty preservingTab + then + emptyRTable + else + if isRTabEmpty tab + then + preservingTab + else + -- we know that both the preservingTab and tab are non empty + let + unionFstPart = + iJ (flip jpred) preservingTab tab --tab -- we used the preserving table as the left table in the inner join, + -- in order to retain the original column names for the common columns + -- debug + -- !dummy1 = trace ("unionFstPart:\n" ++ show unionFstPart) True + + -- project only the preserving tab's columns + fstPartProj = + p (getColumnNamesfromRTab preservingTab) unionFstPart + + -- the second part are the rows from the preserving table that dont join + -- we will use the Difference operations for this + unionSndPart = + let + difftab = + d preservingTab fstPartProj -- unionFstPart + -- now enhance the result with the columns of the left table + in iJ (\t1 t2 -> True) difftab (createSingletonRTable $ createNullRTuple $ (getColumnNamesfromRTab tab)) + -- debug + -- !dummy2 = trace ("unionSndPart :\n" ++ show unionSndPart) True + -- !dummy3 = trace ("u unionFstPart unionSndPart :\n" ++ (show $ u unionFstPart unionSndPart)) True + in u unionFstPart unionSndPart + + + +-- | Implements a Right Outer Join operation between two RTables (any type of join predicate is allowed) +-- i.e., the rows of the right RTable will be preserved. +-- Note that when dublicate keys encountered that is, since the underlying structure for an RTuple is a Data.HashMap.Strict, +-- only one value per key is allowed. So in the context of joining two RTuples the value of the right RTuple on the common key will be prefered. +{-runRightJoin :: + RJoinPredicate + -> RTable + -> RTable + -> RTable +runRightJoin jpred rtab rightRTab = do + rtupRight <- rightRTab + rtup <- rtab + let targetRtuple = + if (jpred rtup rtupRight) + then HM.union rtupRight rtup + else HM.union rtupRight (createNullRTuple colNamesList) + where colNamesList = HM.keys rtup + return targetRtuple-} + +-- | RTable Full Outer Join Operator. A short name for the 'runFullOuterJoin' function +foJ = runFullOuterJoin + +-- | Implements a Full Outer Join operation between two RTables (any type of join predicate is allowed) +-- A full outer join is the union of the left and right outer joins respectively. +-- The common columns will appear from both tables but only the left table column's will retain their original name (just by convention). +runFullOuterJoin :: + RJoinPredicate + -> RTable + -> RTable + -> RTable +runFullOuterJoin jpred leftRTab rightRTab = -- (lJ jpred leftRTab rightRTab) `u` (rJ jpred leftRTab rightRTab) -- (note that `u` eliminates dublicates) + let + -- + -- we want to get to this union: + -- (lJ jpred leftRTab rightRTab) `u` (d (rJ jpred leftRTab rightRTab) (ij (flip jpred) rightRTab leftRTab)) + -- + -- The problem is with the change of column names that are common in both tables. In the right part of the union + -- rightTab has preserved its original column names while in the left part the have changed to "_1" suffix. + -- So we cant do the union as is, we need to change the second part of the union (right one) to have the same column names + -- as the firts part, i.e., original names for leftTab and changed names for rightTab. + -- + unionFstPart = lJ jpred leftRTab rightRTab -- in unionFstPart rightTab's columns have changed names + + -- we need to construct the 2nd part of the union with leftTab columns unchanged and rightTab changed + unionSndPartTemp1 = d (rJ jpred leftRTab rightRTab) (iJ (flip jpred) rightRTab leftRTab) + -- isolate the columns of the rightTab + unionSndPartTemp2 = p (getColumnNamesfromRTab rightRTab) unionSndPartTemp1 + -- this join is a trick in order to change names of the rightTab + unionSndPart = iJ (\t1 t2 -> True) (createSingletonRTable $ createNullRTuple $ (getColumnNamesfromRTab leftRTab)) unionSndPartTemp2 + in unionFstPart `u` unionSndPart + +-- | RTable Union Operator. A short name for the 'runUnion' function +u = runUnion + +-- We cannot implement Union like the following (i.e., union of lists) because when two identical RTuples that contain Null values are checked for equality +-- equality comparison between Null returns always false. So we have to implement our own union using the isNull function. + +-- | Implements the union of two RTables as a union of two lists (see 'Data.List'). +-- Duplicates, and elements of the first list, are removed from the the second list, but if the first list contains duplicates, so will the result +{-runUnion :: + RTable + -> RTable + -> RTable +runUnion rt1 rt2 = + let ls1 = V.toList rt1 + ls2 = V.toList rt2 + resultLs = Data.List.union ls1 ls2 + in V.fromList resultLs +-} + +-- | Implements the union of two RTables as a union of two lists (see 'Data.List'). +runUnion :: + RTable + -> RTable + -> RTable +runUnion rt1 rt2 = + if isRTabEmpty rt1 && isRTabEmpty rt2 + then + emptyRTable + else + if isRTabEmpty rt1 + then rt2 + else + if isRTabEmpty rt2 + then rt1 + else + -- construct the union result by concatenating the left table with the subset of tuple from the right table that do + -- not appear in the left table (i.e, remove dublicates) + rt1 V.++ (V.foldr (un) emptyRTable rt2) + where + un :: RTuple -> RTable -> RTable + un tupRight acc = + -- Can we find tupRight in the left table? + if didYouFindIt tupRight rt1 + then acc -- then discard tuplRight ,leave result unchanged + else V.snoc acc tupRight -- else insert tupRight into final result + + + +-- | RTable Intersection Operator. A short name for the 'runIntersect' function +i = runIntersect + +-- | Implements the intersection of two RTables +runIntersect :: + RTable + -> RTable + -> RTable +runIntersect rt1 rt2 = + if isRTabEmpty rt1 || isRTabEmpty rt2 + then + emptyRTable + else + -- construct the intersect result by traversing the left table and checking if each tuple exists in the right table + V.foldr (intsect) emptyRTable rt1 + where + intsect :: RTuple -> RTable -> RTable + intsect tupLeft acc = + -- Can we find tupLeft in the right table? + if didYouFindIt tupLeft rt2 + then V.snoc acc tupLeft -- then insert tupLeft into final result + else acc -- else discard tuplLeft ,leave result unchanged + +{- +runIntersect rt1 rt2 = + let ls1 = V.toList rt1 + ls2 = V.toList rt2 + resultLs = Data.List.intersect ls1 ls2 + in V.fromList resultLs + +-} + +-- | RTable Difference Operator. A short name for the 'runDiff' function +d = runDiff + +-- Test it with this, from ghci: +-- --------------------------------- +-- :set -XOverloadedStrings +-- :m + Data.HashMap.Strict +-- +-- let t1 = fromList [("c1",RInt 1),("c2", Null)] +-- let t2 = fromList [("c1",RInt 2),("c2", Null)] +-- let t3 = fromList [("c1",RInt 3),("c2", Null)] +-- let t4 = fromList [("c1",RInt 4),("c2", Null)] +-- :m + Data.Vector +-- let tab1 = Data.Vector.fromList [t1,t2,t3,t4] +-- let tab2 = Data.Vector.fromList [t1,t2] + +-- > d tab1 tab2 +-- --------------------------------- + +-- | Implements the set Difference of two RTables as the diff of two lists (see 'Data.List'). +runDiff :: + RTable + -> RTable + -> RTable +runDiff rt1 rt2 = + if isRTabEmpty rt1 + then + emptyRTable + else + if isRTabEmpty rt2 + then + rt1 + else + -- construct the diff result by traversing the left table and checking if each tuple exists in the right table + V.foldr (diff) emptyRTable rt1 + where + diff :: RTuple -> RTable -> RTable + diff tupLeft acc = + -- Can we find tupLeft in the right table? + if didYouFindIt tupLeft rt2 + then acc -- then discard tuplLeft ,leave result unchanged + else V.snoc acc tupLeft -- else insert tupLeft into final result + +-- Important Note: +-- we need to implement are own equality comparison function "areTheyEqual" and not rely on the instance of Eq defined for RDataType above +-- because of "Null Logic". If we compare two RTuples that have Null values in any column, then these can never be equal, because +-- Null == Null returns False. +-- However, in SQL when you run a minus or interesection between two tables containing Nulls, it works! For example: +-- with q1 +-- as ( +-- select rownum c1, Null c2 +-- from dual +-- connect by level < 5 +-- ), +-- q2 +-- as ( +-- select rownum c1, Null c2 +-- from dual +-- connect by level < 3 +-- ) +-- select * +-- from q1 +-- minus +-- select * +-- from q2 +-- +-- q1: +-- C1 | C2 +-- --- --- +-- 1 | +-- 2 | +-- 3 | +-- 4 | +-- +-- q2: +-- C1 | C2 +-- --- --- +-- 1 | +-- 2 | +-- +-- And it will return: +-- C1 | C2 +-- --- --- +-- 3 | +-- 4 | +-- So for Minus and Intersection, when we compare RTuples we need to "bypass" the Null Logic +didYouFindIt :: RTuple -> RTable -> Bool +didYouFindIt searchTup tab = + V.foldr (\t acc -> (areTheyEqual searchTup t) || acc) False tab +areTheyEqual :: RTuple -> RTuple -> Bool +areTheyEqual t1 t2 = -- foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a + HM.foldrWithKey (accumulator) True t1 + where + accumulator :: ColumnName -> RDataType -> Bool -> Bool + accumulator colName val acc = + case val of + Null -> + case (t2<!>colName) of + Null -> acc -- -- i.e., True && acc ,if both columns are Null then return equality + _ -> False -- i.e., False && acc + _ -> case (t2<!>colName) of + Null -> False -- i.e., False && acc + _ -> (val == t2<!>colName) && acc -- else compare them as normal + + -- NOTE: + -- the following piece of code does not work because val == Null always returns False !!!! + + -- if (val == Null) && (t2<!>colName == Null) + -- then acc -- i.e., True && acc + -- -- else compare them as normal + -- else (val == t2<!>colName) && acc + +{- +runDiff rt1 rt2 = + let ls1 = V.toList rt1 + ls2 = V.toList rt2 + resultLs = ls1 Data.List.\\ ls2 + in V.fromList resultLs +-} + +-- | Aggregation Operator. A short name for the 'runAggregation' function +rAgg = runAggregation + +-- | Implements the aggregation operation on an RTable +-- It aggregates the specific columns in each AggOperation and returns a singleton RTable +-- i.e., an RTable with a single RTuple that includes only the agg columns and their aggregated value. +runAggregation :: + [RAggOperation] -- ^ Input Aggregate Operations + -> RTable -- ^ Input RTable + -> RTable -- ^ Output singleton RTable +runAggregation [] rtab = rtab +runAggregation aggOps rtab = + if isRTabEmpty rtab + then emptyRTable + else + createSingletonRTable (getResultRTuple aggOps rtab) + where + -- creates the final aggregated RTuple by applying all agg operations in the list + -- and UNIONs all the intermediate agg RTuples to a final aggregated Rtuple + getResultRTuple :: [RAggOperation] -> RTable -> RTuple + getResultRTuple [] _ = emptyRTuple + getResultRTuple (agg:aggs) rt = + let RAggOperation { sourceCol = src, targetCol = trg, aggFunc = aggf } = agg + in (getResultRTuple aggs rt) `HM.union` (aggf rt) -- (aggf rt) `HM.union` (getResultRTuple aggs rt) + +-- | Order By Operator. A short name for the 'runOrderBy' function +rO = runOrderBy + +-- | Implements the ORDER BY operation. +-- First column in the input list has the highest priority in the sorting order +-- We treat Null as the maximum value (anything compared to Null is smaller). +-- This way Nulls are send at the end (i.e., "Nulls Last" in SQL parlance). This is for Asc ordering. +-- For Desc ordering, we have the opposite. Nulls go first and so anything compared to Null is greater. +-- @ +-- SQL example +-- with q +-- as (select case when level < 4 then level else NULL end c1 -- , level c2 +-- from dual +-- connect by level < 7 +-- ) +-- select * +-- from q +-- order by c1 +-- +-- C1 +-- ---- +-- 1 +-- 2 +-- 3 +-- Null +-- Null +-- Null +-- +-- with q +-- as (select case when level < 4 then level else NULL end c1 -- , level c2 +-- from dual +-- connect by level < 7 +-- ) +-- select * +-- from q +-- order by c1 desc + +-- C1 +-- -- +-- Null +-- Null +-- Null +-- 3 +-- 2 +-- 1 +-- @ +runOrderBy :: + [(ColumnName, OrderingSpec)] -- ^ Input ordering specification + -> RTable -- ^ Input RTable + -> RTable -- ^ Output RTable +runOrderBy ordSpec rtab = + if isRTabEmpty rtab + then emptyRTable + else + let unsortedRTupList = rtableToList rtab + sortedRTupList = Data.List.sortBy (\t1 t2 -> compareTuples ordSpec t1 t2) unsortedRTupList + in rtableFromList sortedRTupList + where + compareTuples :: [(ColumnName, OrderingSpec)] -> RTuple -> RTuple -> Ordering + compareTuples [] t1 t2 = EQ + compareTuples ((col, colordspec) : rest) t1 t2 = + -- if they are equal or both Null on the column in question, then go to the next column + if nvl (t1 <!> col) (RText "I am Null baby!") == nvl (t2 <!> col) (RText "I am Null baby!") + then compareTuples rest t1 t2 + else -- Either one of the two is Null or are Not Equal + -- so we need to compare t1 versus t2 + -- the GT, LT below refer to t1 wrt to t2 + -- In the following we treat Null as the maximum value (anything compared to Null is smaller). + -- This way Nulls are send at the end (i.e., the default is "Nulls Last" in SQL parlance) + if isNull (t1 <!> col) + then + case colordspec of + Asc -> GT -- t1 is GT than t2 (Nulls go to the end) + Desc -> LT + else + if isNull (t2 <!> col) + then + case colordspec of + Asc -> LT -- t1 is LT than t2 (Nulls go to the end) + Desc -> GT + else + -- here we cant have Nulls + case compare (t1 <!> col) (t2 <!> col) of + GT -> if colordspec == Asc + then GT else LT + LT -> if colordspec == Asc + then LT else GT + +-- | Group By Operator. A short name for the 'runGroupBy' function +rG = runGroupBy + +-- RGroupBy { gpred :: RGroupPredicate, aggList :: [RAggOperation], colGrByList :: [ColumnName] } + +-- hint: use Data.List.GroupBy for the grouping and Data.List.foldl' for the aggregation in each group +{--type RGroupPredicate = RTuple -> RTuple -> Bool + +data RAggOperation = + RSum ColumnName -- ^ sums values in the specific column + | RCount ColumnName -- ^ count of values in the specific column + | RCountDist ColumnName -- ^ distinct count of values in the specific column + | RAvg ColumnName -- ^ average of values in the specific column + | RMin ColumnName -- ^ minimum of values in the specific column + | RMax ColumnName +--} + +-- | Implement a grouping operation over an 'RTable'. No aggregation takes place. +-- It returns the individual groups as separate 'RTable's in a list. In total the initial set of 'RTuple's is retained. +-- If an empty 'RTable' is provided as input, then a [\"empty RTable\"] is returned. +groupNoAggList :: + RGroupPredicate -- ^ Grouping predicate, in order to form the groups of 'RTuple's (it defines when two 'RTuple's should be included in the same group) + -> [ColumnName] -- ^ List of grouping column names (GROUP BY clause in SQL) + -- We assume that all RTuples in the same group have the same value in these columns + -> RTable -- ^ input 'RTable' + -> [RTable] -- ^ output list of 'RTable's where each one corresponds to a group +groupNoAggList gpred cols rtab = + if isRTabEmpty rtab + then [emptyRTable] + else + let + -- 1. form the groups of RTuples + -- a. first sort the Rtuples based on the grouping columns + -- This is a very important step if we want the groupBy operation to work. This is because grouping on lists is + -- implemented like this: group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] + -- So we have to sort the list first in order to get the right grouping: + -- group (sort "Mississippi") = ["M","iiii","pp","ssss"] + + listOfRTupSorted = rtableToList $ runOrderBy (createOrderingSpec cols) rtab + + -- debug + -- !dummy1 = trace (show listOfRTupSorted) True + + -- b then produce the groups + listOfRTupGroupLists = Data.List.groupBy gpred listOfRTupSorted + + -- debug + -- !dummy2 = trace (show listOfRTupGroupLists) True + + -- 2. turn each (sub)list of RTuples representing a Group into an RTable + -- Note: each RTable in this list will hold a group of RTuples that all have the same values in the input grouping columns + -- (which must be compatible with the input grouping predicate) + listofGroupRtabs = Data.List.map (rtableFromList) listOfRTupGroupLists + in listofGroupRtabs + +-- | Concatenates a list of 'RTable's to a single RTable. Essentially, it unions (see 'runUnion') all 'RTable's of the list. +concatRTab :: [RTable] -> RTable +concatRTab rtabsl = Data.List.foldr1 (u) rtabsl + +-- | Implement a grouping operation over an 'RTable'. No aggregation takes place. +-- The output 'RTable' has exactly the same 'RTuple's, as the input, but these are grouped based on the input grouping predicate. +-- If an empty 'RTable' is provided as input, then an empty 'RTable' is returned. +groupNoAgg :: + RGroupPredicate -- ^ Grouping predicate, in order to form the groups of 'RTuple's (it defines when two 'RTuple's should be included in the same group) + -> [ColumnName] -- ^ List of grouping column names (GROUP BY clause in SQL) + -- We assume that all 'RTuple's in the same group have the same value in these columns + -> RTable -- ^ input 'RTable' + -> RTable -- ^ output 'RTable' +groupNoAgg gpred cols rtab = + if isRTabEmpty rtab + then emptyRTable + else + let + listofGroupRtabs = groupNoAggList gpred cols rtab + in concatRTab listofGroupRtabs -- Data.List.foldr1 (u) listofGroupRtabs + +-- | Implements the GROUP BY operation over an 'RTable'. +runGroupBy :: + RGroupPredicate -- ^ Grouping predicate, in order to form the groups of RTuples (it defines when two RTuples should be included in the same group) + -> [RAggOperation] -- ^ Aggregations to be applied on specific columns + -> [ColumnName] -- ^ List of grouping column names (GROUP BY clause in SQL) + -- We assume that all RTuples in the same group have the same value in these columns + -> RTable -- ^ input RTable + -> RTable -- ^ output RTable +runGroupBy gpred aggOps cols rtab = + if isRTabEmpty rtab + then + emptyRTable + else + let -- rtupList = V.toList rtab + + -- 1. form the groups of RTuples + -- a. first sort the Rtuples based on the grouping columns + -- This is a very important step if we want the groupBy operation to work. This is because grouping on lists is + -- implemented like this: group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] + -- So we have to sort the list first in order to get the right grouping: + -- group (sort "Mississippi") = ["M","iiii","pp","ssss"] + --listOfRTupSorted = rtableToList $ runOrderBy (createOrderingSpec cols) rtab + + -- debug + -- !dummy1 = trace (show listOfRTupSorted) True + + -- b then produce the groups + --listOfRTupGroupLists = Data.List.groupBy gpred listOfRTupSorted + + -- debug + -- !dummy2 = trace (show listOfRTupGroupLists) True + + -- 2. turn each (sub)list of Rtuples representing a Group into an RTable in order to apply aggregation + -- Note: each RTable in this list will hold a group of RTuples that all have the same values in the input grouping columns + -- (which must be compatible with the input grouping predicate) + --listofGroupRtabs = Data.List.map (rtableFromList) listOfRTupGroupLists + + listofGroupRtabs = groupNoAggList gpred cols rtab + + -- 3. We need to keep the values of the grouping columns (e.g., by selecting the fisrt row) from each one of these RTables, + -- in order to "join them" with the aggregated RTuples that will be produced by the aggregation operations + -- The following will produce a list of singleton RTables. + listOfGroupingColumnsRtabs = Data.List.map ( (limit 1) . (p cols) ) listofGroupRtabs + + -- debug + -- !dummy3 = trace (show listOfGroupingColumnsRtabs) True + + -- 4. Aggregate each group according to input and produce a list of (aggregated singleton RTables) + listOfAggregatedRtabs = Data.List.map (rAgg aggOps) listofGroupRtabs + + -- debug + -- !dummy4 = trace (show listOfAggregatedRtabs ) True + + -- 5. Join the two list of singleton RTables + listOfFinalRtabs = + if Data.List.null aggOps -- if the aggregation list is empty + then + listOfGroupingColumnsRtabs -- then returned just the group by columns + else + Data.List.zipWith (iJ (\t1 t2 -> True)) listOfGroupingColumnsRtabs listOfAggregatedRtabs + + -- debug + -- !dummy5 = trace (show listOfFinalRtabs) True + + + -- 6. Union all individual singleton RTables into the final RTable + in Data.List.foldr1 (u) listOfFinalRtabs + + +-- | Helper function to returned a fixed Ordering Specification 'OrderingSpec' from a list of 'ColumnName's +createOrderingSpec :: [ColumnName] -> [(ColumnName, OrderingSpec)] +createOrderingSpec cols = Data.List.zip cols (Data.List.take (Data.List.length cols) $ Data.List.repeat Asc) + +-- | A short name for the 'runCombinedROp' function +rComb = runCombinedROp + +-- | runCombinedROp: A Higher Order function that accepts as input a combination of unary ROperations e.g., (p plist).(f pred) +-- expressed in the form of a function (RTable -> Rtable) and applies this function to the input RTable. +-- In this sense we can also include a binary operation (e.g. join), if we partially apply the join to one RTable +-- e.g., (ij jpred rtab) . (p plist) . (f pred) +runCombinedROp :: + (RTable -> RTable) -- ^ input combined RTable operation + -> RTable -- ^ input RTable that the input function will be applied to + -> RTable -- ^ output RTable +runCombinedROp f rtab = f rtab + + +-- * ########## RTable DML Operations ############## + + +-- | O(n) append an RTuple to an RTable +insertAppendRTab :: RTuple -> RTable -> RTable +insertAppendRTab rtup rtab = V.snoc rtab rtup + +-- | O(n) prepend an RTuple to an RTable +insertPrependRTab :: RTuple -> RTable -> RTable +insertPrependRTab rtup rtab = V.cons rtup rtab + +-- | Update an RTable. Input includes a list of (ColumnName, new Value) pairs. +-- Also a filter predicate is specified in order to restrict the update only to those +-- rtuples that fulfill the predicate +updateRTab :: + [(ColumnName, RDataType)] -- ^ List of column names to be updated with the corresponding new values + -> RPredicate -- ^ An RTuple -> Bool function that specifies the RTuples to be updated + -> RTable -- ^ Input RTable + -> RTable -- ^ Output RTable +updateRTab [] _ inputRtab = inputRtab +updateRTab ((colName, newVal) : rest) rpred inputRtab = + {- + Here is the update algorithm: + + FinalRTable = UNION (Table A) (Table B) + + where + Table A = the subset of input RTable that includes the rtuples that satisfy the input RPredicate, with updated values in the + corresponding columns + Table B = the subset of input RTable that includes all the rtuples that DONT satisfy the input RPredicate + -} + if isRTabEmpty inputRtab + then emptyRTable + else + let + tabA = rtabMap (upsertRTuple colName newVal) (f rpred inputRtab) + tabB = f (not . rpred) inputRtab + in updateRTab rest rpred (u tabA tabB) + +-- * ########## RTable IO Operations ############## + +-- | Basic data type for defining the desired formatting of an 'RTuple' when printing an RTable (see 'printfRTable'). +data RTupleFormat = RTupleFormat { + + colSelectList :: [ColumnName] -- ^ For defining the column ordering (i.e., the SELECT clause in SQL) + ,colFormatMap :: ColFormatMap -- ^ For defining the formating per Column in \"'printf' style\" + +} deriving (Eq, Show) + +-- | A map of ColumnName to Format Specification +type ColFormatMap = HM.HashMap ColumnName FormatSpecifier + +-- | Generates a default Column Format Specification +genDefaultColFormatMap :: ColFormatMap +genDefaultColFormatMap = HM.empty + +-- | Generates a Column Format Specification +genColFormatMap :: + [(ColumnName, FormatSpecifier)] + -> ColFormatMap +genColFormatMap fs = HM.fromList fs + + +-- | Format specifier of 'Text.Printf.printf' style +data FormatSpecifier = DefaultFormat | Format String deriving (Eq, Show) + +-- | Generate an RTupleFormat data type instance +genRTupleFormat :: + [ColumnName] -- ^ Column Select list + -> ColFormatMap -- ^ Column Format Map + -> RTupleFormat -- ^ Output +genRTupleFormat colNames colfMap = RTupleFormat { colSelectList = colNames, colFormatMap = colfMap} + +-- | Generate a default RTupleFormat data type instance. +-- In this case the returned column order (Select list), will be unspecified +-- and dependant only by the underlying structure of the 'RTuple' ('HashMap') +genRTupleFormatDefault :: RTupleFormat +genRTupleFormatDefault = RTupleFormat { colSelectList = [], colFormatMap = genDefaultColFormatMap } + + +-- | Safe 'printRfTable' alternative that returns an 'Either', so as to give the ability to handle exceptions +-- gracefully, during the evaluation of the input RTable. Example: +-- +-- @ +-- do +-- p <- (eitherPrintfRTable printfRTable myFormat myRTab) :: IO (Either SomeException ()) +-- case p of +-- Left exc -> putStrLn $ "There was an error in the Julius evaluation: " ++ (show exc) +-- Right _ -> return () +-- @ +-- +eitherPrintfRTable :: Exception e => (RTupleFormat -> RTable -> IO()) -> RTupleFormat -> RTable -> IO (Either e ()) +eitherPrintfRTable printFunc fmt rtab = try $ printFunc fmt rtab + +-- | prints an RTable with an RTuple format specification. +-- It can be used instead of 'printRTable' when one of the following two is required: +-- +-- * a) When we want to specify the order that the columns will be printed on screen +-- * b) When we want to specify the formatting of the values by using a 'printf'-like 'FormatSpecifier' +-- +printfRTable :: RTupleFormat -> RTable -> IO() +printfRTable rtupFmt rtab = -- undefined + if isRTabEmpty rtab + then + do + putStrLn "-------------------------------------------" + putStrLn " 0 rows returned" + putStrLn "-------------------------------------------" + + else + do + -- find the max value-length for each column, this will be the width of the box for this column + let listOfLengths = getMaxLengthPerColumnFmt rtupFmt rtab + + --debug + --putStrLn $ "List of Lengths: " ++ show listOfLengths + + printContLineFmt rtupFmt listOfLengths '-' rtab + -- print the Header + printRTableHeaderFmt rtupFmt listOfLengths rtab + + -- print the body + printRTabBodyFmt rtupFmt listOfLengths $ V.toList rtab + + -- print number of rows returned + let numrows = V.length rtab + if numrows == 1 + then + putStrLn $ "\n"++ (show $ numrows) ++ " row returned" + else + putStrLn $ "\n"++ (show $ numrows) ++ " rows returned" + + printContLineFmt rtupFmt listOfLengths '-' rtab + where + -- [Int] a List of width per column to be used in the box definition + printRTabBodyFmt :: RTupleFormat -> [Int] -> [RTuple] -> IO() + printRTabBodyFmt _ _ [] = putStrLn "" + printRTabBodyFmt rtupf ws (rtup : rest) = do + printRTupleFmt rtupf ws rtup + printRTabBodyFmt rtupf ws rest + +-- | Safe 'printRTable' alternative that returns an 'Either', so as to give the ability to handle exceptions +-- gracefully, during the evaluation of the input RTable. Example: +-- +-- @ +-- do +-- p <- (eitherPrintRTable printRTable myRTab) :: IO (Either SomeException ()) +-- case p of +-- Left exc -> putStrLn $ "There was an error in the Julius evaluation: " ++ (show exc) +-- Right _ -> return () +-- @ +-- +eitherPrintRTable :: Exception e => (RTable -> IO ()) -> RTable -> IO (Either e ()) +eitherPrintRTable printFunc rtab = try $ printFunc rtab + +-- | printRTable : Print the input RTable on screen +printRTable :: + RTable + -> IO () +printRTable rtab = + if isRTabEmpty rtab + then + do + putStrLn "-------------------------------------------" + putStrLn " 0 rows returned" + putStrLn "-------------------------------------------" + + else + do + -- find the max value-length for each column, this will be the width of the box for this column + let listOfLengths = getMaxLengthPerColumn rtab + + --debug + --putStrLn $ "List of Lengths: " ++ show listOfLengths + + printContLine listOfLengths '-' rtab + -- print the Header + printRTableHeader listOfLengths rtab + + -- print the body + printRTabBody listOfLengths $ V.toList rtab + + -- print number of rows returned + let numrows = V.length rtab + if numrows == 1 + then + putStrLn $ "\n"++ (show $ numrows) ++ " row returned" + else + putStrLn $ "\n"++ (show $ numrows) ++ " rows returned" + + printContLine listOfLengths '-' rtab + where + -- [Int] a List of width per column to be used in the box definition + printRTabBody :: [Int] -> [RTuple] -> IO() + printRTabBody _ [] = putStrLn "" + printRTabBody ws (rtup : rest) = do + printRTuple ws rtup + printRTabBody ws rest + +-- | Returns the max length of the String representation of each value, for each column of the input RTable. +-- It returns the lengths in the column order specified by the input RTupleFormat parameter +getMaxLengthPerColumnFmt :: RTupleFormat -> RTable -> [Int] +getMaxLengthPerColumnFmt rtupFmt rtab = + let + -- Create an RTable where all the values of the columns will be the length of the String representations of the original values + lengthRTab = do + rtup <- rtab + let ls = Data.List.map (\(c, v) -> (c, RInt $ fromIntegral $ Data.List.length . rdataTypeToString $ v) ) (rtupleToList rtup) + -- create an RTuple with the column names lengths + headerLengths = Data.List.zip (getColumnNamesfromRTab rtab) (Data.List.map (\c -> RInt $ fromIntegral $ Data.List.length (T.unpack c)) (getColumnNamesfromRTab rtab)) + -- append to the rtable also the tuple corresponding to the header (i.e., the values will be the names of the column) in order + -- to count them also in the width calculation + (return $ createRtuple ls) V.++ (return $ createRtuple headerLengths) + + -- Get the max length for each column + resultRTab = findMaxLengthperColumn lengthRTab + where + findMaxLengthperColumn :: RTable -> RTable + findMaxLengthperColumn rt = + let colNames = (getColumnNamesfromRTab rt) -- [ColumnName] + aggOpsList = Data.List.map (\c -> raggMax c c) colNames -- [AggOp] + in runAggregation aggOpsList rt + -- get the RTuple with the results + resultRTuple = headRTup resultRTab + in + -- transform it to [Int] + if rtupFmt /= genRTupleFormatDefault + then + -- generate [Int] in the column order specified by the format parameter + Data.List.map (\(RInt i) -> fromIntegral i) $ + Data.List.map (\colname -> resultRTuple <!> colname) $ colSelectList rtupFmt -- [RInt i] + else + -- else just choose the default column order (i.e., unspecified) + Data.List.map (\(colname, RInt i) -> fromIntegral i) (rtupleToList resultRTuple) + +-- | Returns the max length of the String representation of each value, for each column of the input RTable. +getMaxLengthPerColumn :: RTable -> [Int] +getMaxLengthPerColumn rtab = + let + -- Create an RTable where all the values of the columns will be the length of the String representations of the original values + lengthRTab = do + rtup <- rtab + let ls = Data.List.map (\(c, v) -> (c, RInt $ fromIntegral $ Data.List.length . rdataTypeToString $ v) ) (rtupleToList rtup) + -- create an RTuple with the column names lengths + headerLengths = Data.List.zip (getColumnNamesfromRTab rtab) (Data.List.map (\c -> RInt $ fromIntegral $ Data.List.length (T.unpack c)) (getColumnNamesfromRTab rtab)) + -- append to the rtable also the tuple corresponding to the header (i.e., the values will be the names of the column) in order + -- to count them also in the width calculation + (return $ createRtuple ls) V.++ (return $ createRtuple headerLengths) + + -- Get the max length for each column + resultRTab = findMaxLengthperColumn lengthRTab + where + findMaxLengthperColumn :: RTable -> RTable + findMaxLengthperColumn rt = + let colNames = (getColumnNamesfromRTab rt) -- [ColumnName] + aggOpsList = Data.List.map (\c -> raggMax c c) colNames -- [AggOp] + in runAggregation aggOpsList rt + +{- + -- create a Julius expression to evaluate the max length per column + julexpr = EtlMapStart + -- Turn each value to an (RInt i) that correposnd to the length of the String representation of the value + :-> (EtlC $ + Source (getColumnNamesfromRTab rtab) + Target (getColumnNamesfromRTab rtab) + By (\[value] -> [RInt $ Data.List.length . rdataTypeToString $ value] ) + (On $ Tab rtab) + RemoveSrc $ + FilterBy (\rtuple -> True) + ) + -- Get the max length for each column + :-> (EtlR $ + ROpStart + :. (GenUnaryOp (On Previous) $ ByUnaryOp findMaxLengthperColumn) + ) + where + findMaxLengthperColumn :: RTable -> RTable + findMaxLengthperColumn rt = + let colNames = (getColumnNamesfromRTab rt) -- [ColumnName] + aggOpsList = V.map (\c -> raggMax c c) colNames -- [AggOp] + in runAggregation aggOpsList rt + + -- evaluate the xpression and get the result in an RTable + resultRTab = juliusToRTable julexpr +-} + -- get the RTuple with the results + resultRTuple = headRTup resultRTab + in + -- transform it to a [Int] + Data.List.map (\(colname, RInt i) -> fromIntegral i) (rtupleToList resultRTuple) + +spaceSeparatorWidth :: Int +spaceSeparatorWidth = 5 + +-- | helper function in order to format the value of a column +-- It will append at the end of the string n number of spaces. +addSpace :: + Int -- ^ number of spaces to add + -> String -- ^ input String + -> String -- ^ output string +addSpace i s = s ++ Data.List.take i (repeat ' ') + + +-- | helper function in order to format the value of a column +-- It will append at the end of the string n number of spaces. +addCharacter :: + Int -- ^ number of spaces to add + -> Char -- ^ character to add + -> String -- ^ input String + -> String -- ^ output string +addCharacter i c s = s ++ Data.List.take i (repeat c) + +-- | helper function that prints a continuous line adjusted to the size of the input RTable +-- The column order is specified by the input RTupleFormat parameter +printContLineFmt :: + RTupleFormat -- ^ Specifies the appropriate column order + -> [Int] -- ^ a List of width per column to be used in the box definition + -> Char -- ^ the char with which the line will be drawn + -> RTable + -> IO () +printContLineFmt rtupFmt widths ch rtab = do + let listOfColNames = if rtupFmt /= genRTupleFormatDefault + then + colSelectList rtupFmt + else + getColumnNamesfromRTab rtab -- [ColumnName] + listOfLinesCont = Data.List.map (\c -> Data.List.take (Data.List.length (T.unpack c)) (repeat ch)) listOfColNames + --listOfLinesCont = Data.List.map (\c -> T.replicate (T.length c) (T.singleton ch)) listOfColNames + formattedLinesCont = Data.List.map (\(w,l) -> addCharacter (w - (Data.List.length l) + spaceSeparatorWidth) ch l) (Data.List.zip widths listOfLinesCont) + formattedRowOfLinesCont = Data.List.foldr (\line accum -> line ++ accum) "" formattedLinesCont + putStrLn formattedRowOfLinesCont + + +-- | helper function that prints a continuous line adjusted to the size of the input RTable +printContLine :: + [Int] -- ^ a List of width per column to be used in the box definition + -> Char -- ^ the char with which the line will be drawn + -> RTable + -> IO () +printContLine widths ch rtab = do + let listOfColNames = getColumnNamesfromRTab rtab -- [ColumnName] + listOfLinesCont = Data.List.map (\c -> Data.List.take (Data.List.length (T.unpack c)) (repeat ch)) listOfColNames + formattedLinesCont = Data.List.map (\(w,l) -> addCharacter (w - (Data.List.length l) + spaceSeparatorWidth) ch l) (Data.List.zip widths listOfLinesCont) + formattedRowOfLinesCont = Data.List.foldr (\line accum -> line ++ accum) "" formattedLinesCont + putStrLn formattedRowOfLinesCont + + +-- | Prints the input RTable's header (i.e., column names) on screen. +-- The column order is specified by the corresponding RTupleFormat parameter. +printRTableHeaderFmt :: + RTupleFormat -- ^ Specifies Column order + -> [Int] -- ^ a List of width per column to be used in the box definition + -> RTable + -> IO () +printRTableHeaderFmt rtupFmt widths rtab = do -- undefined + let listOfColNames = if rtupFmt /= genRTupleFormatDefault then colSelectList rtupFmt else getColumnNamesfromRTab rtab -- [ColumnName] + -- format each column name according the input width and return a list of Boxes [Box] + -- formattedList = Data.List.map (\(w,c) -> BX.para BX.left (w + spaceSeparatorWidth) c) (Data.List.zip widths listOfColNames) -- listOfColNames -- map (\c -> BX.render . BX.text $ c) listOfColNames + formattedList = Data.List.map (\(w,c) -> addSpace (w - (Data.List.length (T.unpack c)) + spaceSeparatorWidth) (T.unpack c)) (Data.List.zip widths listOfColNames) + -- Paste all boxes together horizontally + -- formattedRow = BX.render $ Data.List.foldr (\colname_box accum -> accum BX.<+> colname_box) BX.nullBox formattedList + formattedRow = Data.List.foldr (\colname accum -> colname ++ accum) "" formattedList + + listOfLines = Data.List.map (\c -> Data.List.take (Data.List.length (T.unpack c)) (repeat '~')) listOfColNames + -- listOfLinesCont = Data.List.map (\c -> Data.List.take (Data.List.length c) (repeat '-')) listOfColNames + --formattedLines = Data.List.map (\(w,l) -> BX.para BX.left (w +spaceSeparatorWidth) l) (Data.List.zip widths listOfLines) + formattedLines = Data.List.map (\(w,l) -> addSpace (w - (Data.List.length l) + spaceSeparatorWidth) l) (Data.List.zip widths listOfLines) + -- formattedLinesCont = Data.List.map (\(w,l) -> addCharacter (w - (Data.List.length l) + spaceSeparatorWidth) '-' l) (Data.List.zip widths listOfLinesCont) + -- formattedRowOfLines = BX.render $ Data.List.foldr (\line_box accum -> accum BX.<+> line_box) BX.nullBox formattedLines + formattedRowOfLines = Data.List.foldr (\line accum -> line ++ accum) "" formattedLines + --- formattedRowOfLinesCont = Data.List.foldr (\line accum -> line ++ accum) "" formattedLinesCont + + -- printUnderlines formattedRowOfLinesCont + printHeader formattedRow + printUnderlines formattedRowOfLines + where + printHeader :: String -> IO() + printHeader h = putStrLn h + + printUnderlines :: String -> IO() + printUnderlines l = putStrLn l + +-- | printRTableHeader : Prints the input RTable's header (i.e., column names) on screen +printRTableHeader :: + [Int] -- ^ a List of width per column to be used in the box definition + -> RTable + -> IO () +printRTableHeader widths rtab = do -- undefined + let listOfColNames = getColumnNamesfromRTab rtab -- [ColumnName] + -- format each column name according the input width and return a list of Boxes [Box] + -- formattedList = Data.List.map (\(w,c) -> BX.para BX.left (w + spaceSeparatorWidth) c) (Data.List.zip widths listOfColNames) -- listOfColNames -- map (\c -> BX.render . BX.text $ c) listOfColNames + formattedList = Data.List.map (\(w,c) -> addSpace (w - (Data.List.length (T.unpack c)) + spaceSeparatorWidth) (T.unpack c)) (Data.List.zip widths listOfColNames) + -- Paste all boxes together horizontally + -- formattedRow = BX.render $ Data.List.foldr (\colname_box accum -> accum BX.<+> colname_box) BX.nullBox formattedList + formattedRow = Data.List.foldr (\colname accum -> colname ++ accum) "" formattedList + + listOfLines = Data.List.map (\c -> Data.List.take (Data.List.length (T.unpack c)) (repeat '~')) listOfColNames + --listOfLines = Data.List.map (\c -> T.replicate (T.length c) "~") listOfColNames + -- listOfLinesCont = Data.List.map (\c -> Data.List.take (Data.List.length c) (repeat '-')) listOfColNames + --formattedLines = Data.List.map (\(w,l) -> BX.para BX.left (w +spaceSeparatorWidth) l) (Data.List.zip widths listOfLines) + formattedLines = Data.List.map (\(w,l) -> addSpace (w - (Data.List.length l) + spaceSeparatorWidth) l) (Data.List.zip widths listOfLines) + --formattedLines = Data.List.map (\(w,l) -> T.pack $ addSpace (w - (T.length l) + spaceSeparatorWidth) (T.unpack l)) (Data.List.zip widths listOfLines) + -- formattedLinesCont = Data.List.map (\(w,l) -> addCharacter (w - (Data.List.length l) + spaceSeparatorWidth) '-' l) (Data.List.zip widths listOfLinesCont) + -- formattedRowOfLines = BX.render $ Data.List.foldr (\line_box accum -> accum BX.<+> line_box) BX.nullBox formattedLines + formattedRowOfLines = Data.List.foldr (\line accum -> line ++ accum) "" formattedLines + --- formattedRowOfLinesCont = Data.List.foldr (\line accum -> line ++ accum) "" formattedLinesCont + + -- printUnderlines formattedRowOfLinesCont + printHeader formattedRow + printUnderlines formattedRowOfLines + where + printHeader :: String -> IO() + printHeader h = putStrLn h + + printUnderlines :: String -> IO() + printUnderlines l = putStrLn l +{- printHeader :: [String] -> IO () + printHeader [] = putStrLn "" + printHeader (x:xs) = do + putStr $ x ++ "\t" + printHeader xs + + printUnderlines :: [String] -> IO () + printUnderlines [] = putStrLn "" + printUnderlines (x:xs) = do + putStr $ (Data.List.take (Data.List.length x) (repeat '~')) ++ "\t" + printUnderlines xs +-} + +-- | Prints an RTuple on screen (only the values of the columns) +-- [Int] is a List of width per column to be used in the box definition +-- The column order as well as the formatting specifications are specified by the first parameter. +-- We assume that the order in [Int] corresponds to that of the RTupleFormat parameter. +printRTupleFmt :: RTupleFormat -> [Int] -> RTuple -> IO() +printRTupleFmt rtupFmt widths rtup = do + -- take list of values of each column and convert to String + let rtupList = if rtupFmt == genRTupleFormatDefault + then -- then no column ordering is specified nore column formatting + Data.List.map (rdataTypeToString . snd) (rtupleToList rtup) -- [RDataType] --> [String] + else + if (colFormatMap rtupFmt) == genDefaultColFormatMap + then -- col ordering is specified but no formatting per column + Data.List.map (\colname -> rdataTypeToStringFmt DefaultFormat $ rtup <!> colname ) $ colSelectList rtupFmt + else -- both column ordering, as well as formatting per column is specified + Data.List.map (\colname -> rdataTypeToStringFmt ((colFormatMap rtupFmt) ! colname) $ rtup <!> colname ) $ colSelectList rtupFmt + + -- format each column value according the input width and return a list of [Box] + -- formattedValueList = Data.List.map (\(w,v) -> BX.para BX.left w v) (Data.List.zip widths rtupList) + formattedValueList = Data.List.map (\(w,v) -> addSpace (w - (Data.List.length v) + spaceSeparatorWidth) v) (Data.List.zip widths rtupList) + -- Data.List.map (\(c,r) -> BX.text . rdataTypeToString $ r) rtupList + -- Data.List.map (\(c,r) -> rdataTypeToString $ r) rtupList -- -- [String] + -- Paste all boxes together horizontally + -- formattedRow = BX.render $ Data.List.foldr (\value_box accum -> accum BX.<+> value_box) BX.nullBox formattedValueList + formattedRow = Data.List.foldr (\value_box accum -> value_box ++ accum) "" formattedValueList + putStrLn formattedRow + +-- | Prints an RTuple on screen (only the values of the columns) +-- [Int] is a List of width per column to be used in the box definition +printRTuple :: [Int] -> RTuple -> IO() +printRTuple widths rtup = do + -- take list of values of each column and convert to String + let rtupList = Data.List.map (rdataTypeToString . snd) (rtupleToList rtup) -- [RDataType] --> [String] + + -- format each column value according the input width and return a list of [Box] + -- formattedValueList = Data.List.map (\(w,v) -> BX.para BX.left w v) (Data.List.zip widths rtupList) + formattedValueList = Data.List.map (\(w,v) -> addSpace (w - (Data.List.length v) + spaceSeparatorWidth) v) (Data.List.zip widths rtupList) + -- Data.List.map (\(c,r) -> BX.text . rdataTypeToString $ r) rtupList + -- Data.List.map (\(c,r) -> rdataTypeToString $ r) rtupList -- -- [String] + -- Paste all boxes together horizontally + -- formattedRow = BX.render $ Data.List.foldr (\value_box accum -> accum BX.<+> value_box) BX.nullBox formattedValueList + formattedRow = Data.List.foldr (\value_box accum -> value_box ++ accum) "" formattedValueList + putStrLn formattedRow + +{- printList formattedValueList + where + printList :: [String] -> IO() + printList [] = putStrLn "" + printList (x:xs) = do + putStr $ x ++ "\t" + printList xs +-} + +-- | Turn the value stored in a RDataType into a String in order to be able to print it wrt to the specified format +rdataTypeToStringFmt :: FormatSpecifier -> RDataType -> String +rdataTypeToStringFmt fmt rdt = + case fmt of + DefaultFormat -> rdataTypeToString rdt + Format fspec -> + case rdt of + RInt i -> printf fspec i + RText t -> printf fspec (unpack t) + RDate {rdate = d, dtformat = f} -> printf fspec (unpack d) + RTime t -> printf fspec $ unpack $ rtext (rTimestampToRText "DD/MM/YYYY HH24:MI:SS" t) + -- Round to only two decimal digits after the decimal point + RDouble db -> printf fspec db -- show db + Null -> "NULL" + +-- | Turn the value stored in a RDataType into a String in order to be able to print it +-- Values are transformed with a default formatting. +rdataTypeToString :: RDataType -> String +rdataTypeToString rdt = + case rdt of + RInt i -> show i + RText t -> unpack t + RDate {rdate = d, dtformat = f} -> unpack d + RTime t -> unpack $ rtext (rTimestampToRText "DD/MM/YYYY HH24:MI:SS" t) + -- Round to only two decimal digits after the decimal point + RDouble db -> printf "%.2f" db -- show db + Null -> "NULL" + + + +{- + +-- | This data type is used in order to be able to print the value of a column of an RTuple +data ColPrint = ColPrint { colName :: String, val :: String } deriving (Data, G.Generic) +instance PP.Tabulate ColPrint + +data PrintableRTuple = PrintableRTuple [ColPrint] deriving (Data, G.Generic) +instance PP.Tabulate PrintableRTuple + +instance PP.CellValueFormatter PrintableRTuple where + -- ppFormatter :: a -> String + ppFormatter [] = "" + ppFormatter (colpr:rest) = (BX.render $ BX.text (val colpr)) ++ "\t" ++ ppFormatter rest + +-- | Turn an RTuple to a list of RTuplePrint +rtupToPrintableRTup :: RTuple -> PrintableRTuple +rtupToPrintableRTup rtup = + let rtupList = rtupleToList rtup -- [(ColumnName, RDataType)] + in PrintableRTuple $ Data.List.map (\(c,r) -> ColPrint { colName = c, val = rdataTypeToString r }) rtupList -- [ColPrint] + +-- | Turn the value stored in a RDataType into a String in order to be able to print it +rdataTypeToString :: RDataType -> String +rdataTypeToString rdt = undefined + +-- | printRTable : Print the input RTable on screen +printRTable :: + RTable + -> IO () +printRTable rtab = -- undefined + do + let vectorOfprintableRTups = do + rtup <- rtab + let rtupPrint = rtupToPrintableRTup rtup + return rtupPrint +{- + + let rtupList = rtupleToList rtup -- [(ColumnName, RDataType)] + colNamesList = Data.List.map (show . fst) rtupList -- [String] + rdatatypesStringfied = Data.List.map (rdataTypeToString . snd) rtupList -- [String] + map = Data.Map.fromList $ Data.List.zip colNamesList rdatatypesStringfied -- [(String, String)] + return colNamesList -- map -} + PP.ppTable vectorOfprintableRTups + +-} + +-- ##### Exceptions Definitions + +-- | This exception is thrown whenever we try to access a specific column (i.e., 'ColumnName') of an 'RTuple' and the column does not exist. +data ColumnDoesNotExist = ColumnDoesNotExist ColumnName deriving(Eq,Show) +instance Exception ColumnDoesNotExist + +-- | This exception is thrown whenever we provide a Timestamp format with not even one valid format pattern +data UnsupportedTimeStampFormat = UnsupportedTimeStampFormat String deriving(Eq,Show) +instance Exception UnsupportedTimeStampFormat + +-- | Length mismatch between the format 'String' and the input 'String' +-- data RTimestampFormatLengthMismatch = RTimestampFormatLengthMismatch String String deriving(Eq,Show) +-- instance Exception RTimestampFormatLengthMismatch + +-- | One (or both) of the input 'String's to function 'toRTimestamp' are empty +data EmptyInputStringsInToRTimestamp = EmptyInputStringsInToRTimestamp String String deriving(Eq,Show) +instance Exception EmptyInputStringsInToRTimestamp + +
+ src/RTable/Data/CSV.hs view
@@ -0,0 +1,745 @@+{-| +Module : CSVdb.Base +Description : Implements 'RTable' over CSV (TSV, or any other delimiter) files logic +Copyright : (c) Nikos Karagiannidis, 2018 + +License : BSD3 +Maintainer : nkarag@gmail.com +Stability : stable +Portability : POSIX + +This module implements the 'RTabular' instance of the 'CSV' data type, i.e., implements the interface by which a CSV file can be transformed to/from an 'RTable'. +It is required when we want to do ETL\/ELT over CSV files with the "DBFunctor" package (i.e., with the __Julius__ EDSL for ETL/ELT found in the "Etl.Julius" module). + +The minimum requirement for implementing an 'RTabular' instance for a data type is to implement the 'toRTable' and 'fromRTable' functions. Apart from these two functions, this +module also exports functions for reading and writing 'CSV' data from/to CSV files. Also it supports all types of delimiters (not only commas) and CSVs with or without headers. +(see 'CSVOptions') + +For the 'CSV' data type this module uses the Cassava library ("Data.Csv") +-} + +{-# LANGUAGE OverloadedStrings #-} +-- :set -XOverloadedStrings +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NoMonomorphismRestriction #-} + + +module RTable.Data.CSV + ( + -- * The CSV data type + CSV + ,Row + ,Column + ,CSVOptions(..) + ,YesNo (..) + -- * Read/Write CSV + ,readCSV + ,readCSVwithOptions + ,readCSVFile + ,writeCSV + ,writeCSVFile + -- * CSV as Tabular data + ,toRTable + ,fromRTable + -- * CSV I/O + ,printCSV + ,printCSVFile + -- * Basic CSV processing + ,copyCSV + ,selectNrows + ,projectByIndex + ,headCSV + ,tailCSV + -- * Misc + ,csvHeaderFromRtable + -- * Exceptions + ,CsvFileDecodingError (..) + ,CSVColumnToRDataTypeError (..) + ) where + +import Debug.Trace + +import RTable.Core + +-- CSV-conduit +--import qualified Data.CSV.Conduit as CC -- http://hackage.haskell.org/package/csv-conduit , https://www.stackage.org/haddock/lts-6.27/csv-conduit-0.6.6/Data-CSV-Conduit.html + +-- Cassava (CSV parsing Library) + -- https://github.com/hvr/cassava + -- https://www.stackbuilders.com/tutorials/haskell/csv-encoding-decoding/ + -- https://www.stackage.org/lts-7.15/package/cassava-0.4.5.1 + -- https://hackage.haskell.org/package/cassava-0.4.5.1/docs/Data-Csv.html +import qualified Data.Csv as CV + + +-- HashMap -- https://hackage.haskell.org/package/unordered-containers-0.2.7.2/docs/Data-HashMap-Strict.html +import qualified Data.HashMap.Strict as HM + +-- Data.List +import Data.List (map) + +-- ByteString +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString as BS +import Data.ByteString.Char8 (pack,unpack) -- as BSW --(pack) +import Prelude hiding (putStr) +import Data.ByteString.Lazy.Char8 (putStr)--as BLW + +-- Text +import Data.Text as T +import Data.Text.Encoding (decodeUtf8, encodeUtf8, decodeUtf8', decodeUtf16LE) + +-- Vector +import qualified Data.Vector as V + +-- Data.Maybe +import Data.Maybe (fromJust) + +-- Data.Serialize (Cereal package) +-- https://hackage.haskell.org/package/cereal +-- https://hackage.haskell.org/package/cereal-0.5.4.0/docs/Data-Serialize.html +-- http://stackoverflow.com/questions/2283119/how-to-convert-a-integer-to-a-bytestring-in-haskell +import Data.Serialize (decode, encode) + +-- Typepable -- https://hackage.haskell.org/package/base-4.9.1.0/docs/Data-Typeable.html + -- http://stackoverflow.com/questions/6600380/what-is-haskells-data-typeable + -- http://alvinalexander.com/source-code/haskell/how-determine-type-object-haskell-program +import qualified Data.Typeable as TB --(typeOf, Typeable) + +import Data.Either.Combinators (fromRight') + +import Data.Char (ord) + +import Text.Printf (printf) + +import Control.Exception + +{-- + +-- Example code from: https://github.com/hvr/cassava + +{-- +Sample CSV: + +name,salary +John Doe,50000 +Jane Doe,60000 + +--} + +data Person = Person + { name :: !String + , salary :: !Int + } + +instance FromNamedRecord Person where + parseNamedRecord r = Person <$> r .: "name" <*> r .: "salary" + +main :: IO () +main = do + csvData <- BL.readFile "salaries.csv" + case decodeByName csvData of + Left err -> putStrLn err + Right (_, v) -> V.forM_ v $ \ p -> + putStrLn $ name p ++ " earns " ++ show (salary p) ++ " dollars" +--} + +-- ################################################## +-- * Data Types +-- ################################################## + +{-data MyType = MyType Int + +instance RTabular MyType where + toRTable md t = emptyRTable + fromRTable mf rt = MyType (5::Int)-} + +-- | Definition of a CSV file. +-- Treating CSV data as opaque byte strings (see 'Csv' type in Cassava library - "Data.Csv": type Csv = Vector Record) +type CSV = V.Vector Row -- i.e., CV.Csv + +-- | CSV data are \"Tabular\" data thus implement the 'RTabular' interface +instance RTabular CSV where + toRTable = csvToRTable + fromRTable = rtableToCSV + + +-- | Definition of a CSV Row. +-- Essentially a Row is just a Vector of ByteString +-- (type Record = Vector Field) +type Row = V.Vector Column -- i.e., CV.Record + +-- | Definition of a CSV Record column. +-- (type Field = ByteString) +type Column = CV.Field + +-- This typeclass instance is required by CV.decodeByName +--instance CV.FromNamedRecord (V.Vector BS.ByteString) + +-- ################################################## +-- * IO operations +-- ################################################## + +-- | reads a CSV file and returns a lazy bytestring +readCSVFile :: + FilePath -- ^ the CSV file + -> IO BL.ByteString -- ^ the output CSV +readCSVFile f = BL.readFile f + + +-- | reads a CSV file and returns a 'CSV' data type (Treating CSV data as opaque byte strings) +readCSV :: + FilePath -- ^ the CSV file + -> IO CSV -- ^ the output CSV type +readCSV f = do + csvData <- BL.readFile f +{- csvDataBS <- BL.readFile f + let + --decodeUtf8' :: ByteString -> Either UnicodeException Text + utf8text = case decodeUtf8' (BL.toStrict csvDataBS) of + Left exc -> error $ "Error in decodeUtf8' the whole ByteString from Data.ByteString.Lazy.readFile: " ++ (show exc) + Right t -> t + -- Note that I had to make sure to use encodeUtf8 on a literal of type Text rather than just using a ByteString literal directly to Cassava + -- because The IsString instance for ByteStrings, which is what's used to convert the literal to a ByteString, truncates each Unicode code point + -- see : https://stackoverflow.com/questions/26499831/parse-csv-tsv-file-in-haskell-unicode-characters + csvData = encodeUtf8 utf8text -- encodeUtf8 :: Text -> ByteString +-} + let + csvResult = -- fromRight' $ CV.decode CV.HasHeader csvData + case CV.decode CV.HasHeader csvData of + Left str -> throw $ CsvFileDecodingError f $ T.pack str -- error $ "Error in decoding CSV file " ++ f ++ ": " ++ str + Right res -> res + {-- + case CV.decode CV.HasHeader csvData of --CV.decodeByName csvData of + Left err -> let errbs = encode (err::String) -- BL.pack err -- convert String to ByteString + record = V.singleton (errbs) + csv = V.singleton (record) + in csv + Right csv -> csv --Right (hdr, csv) -> csv + --} + return csvResult + +-- | Yes or No sum type +data YesNo = Yes | No + +-- | Options for a CSV file (e.g., delimiter specification, header specification etc.) +data CSVOptions = CSVOptions { + delimiter :: Char + ,hasHeader :: YesNo +} + +-- | reads a CSV file based on input options (delimiter and header option) and returns a 'CSV' data type (Treating CSV data as opaque byte strings) +readCSVwithOptions :: + CSVOptions + -> FilePath -- ^ the CSV file + -> IO CSV -- ^ the output CSV type +readCSVwithOptions opt f = do + csvData <- BL.readFile f + let csvoptions = CV.defaultDecodeOptions { + CV.decDelimiter = fromIntegral $ ord (delimiter opt) + } + csvResult = case CV.decodeWith csvoptions + + (case (hasHeader opt) of + Yes -> CV.HasHeader + No -> CV.NoHeader) + + csvData of + Left str -> throw $ CsvFileDecodingError f $ T.pack str -- error $ "Error in decoding CSV file " ++ f ++ ": " ++ str + Right res -> res + +{- csvResult = fromRight' $ + CV.decodeWith csvoptions + + (case (hasHeader opt) of + Yes -> CV.HasHeader + No -> CV.NoHeader) + + csvData +-} + return csvResult + + + +-- | write a CSV (bytestring) to a newly created csv file +writeCSVFile :: + FilePath -- ^ the csv file to be created + -> BL.ByteString -- ^ input CSV + -> IO() +writeCSVFile f csv = BL.writeFile f csv + + +-- | write a 'CSV' to a newly created csv file +writeCSV :: + FilePath -- ^ the csv file to be created + -> CSV -- ^ input 'CSV' + -> IO() +writeCSV f csv = do + let csvBS = CV.encode (V.toList csv) + BL.writeFile f csvBS + + +-- | print input CSV on screen +printCSVFile :: + BL.ByteString -- ^ input CSV to be printed on screen + -> IO() +printCSVFile csv = putStr csv + + +-- | print input 'CSV' on screen +printCSV :: + CSV -- ^ input 'CSV' to be printed on screen + -> IO() +printCSV csv = do + -- convert each ByteString field to Text + {--let csvText = V.map (\r -> V.map (decodeUtf32LE) r) csv + let csvBS = CV.encode (V.toList csvText)--} + let csvBS = CV.encode (V.toList csv) + putStr csvBS + +-- | copy input csv file to specified output csv file +copyCSV :: + FilePath -- ^ input csv file + ->FilePath -- ^ output csv file + -> IO() +copyCSV fi fo = do + csv <- readCSV fi + writeCSV fo csv + + +-- ################################################## +-- * CSV to RTable integration +-- ################################################## + +-- | csvToRTable: Creates an RTable from a CSV and a set of RTable Metadata. +-- The RTable metadata essentially defines the data type of each column so as to +-- call the appropriate data constructor of RDataType and turn the ByteString values of CSV to RDataTypes values of RTable +-- We assume that the order of the columns in the CSV is identical with the order of the columns in the RTable metadata +csvToRTable :: + RTableMData + -> CSV + -> RTable +csvToRTable m c = + V.map (row2RTuple m) c + where + row2RTuple :: RTableMData -> Row -> RTuple + row2RTuple md row = + let + -- create a list of ColumnInfo. The order of the list correpsonds to the fixed column order and it is identical to the CSV column order + listOfColInfo = toListColumnInfo (rtuplemdata md) --Prelude.map (snd) $ (rtuplemdata md) -- HM.toList (rtuplemdata md) + -- create a list of the form [(ColumnInfo, Column)] + listOfColInfoColumn = Prelude.zip listOfColInfo (V.toList row) + -- create a list of ColumnNames + listOfColNames = toListColumnName (rtuplemdata md) --Prelude.map (fst) $ (rtuplemdata md) --HM.toList (rtuplemdata md) + -- create a list of RDataTypes + listOfRDataTypes = Prelude.map (\(ci,co) -> column2RDataType ci co) $ listOfColInfoColumn + where + column2RDataType :: ColumnInfo -> Column -> RDataType + column2RDataType ci col = + if col == BS.empty + then -- this is an empty ByteString + Null + else + -- Data.ByteString.Char8.unpack :: ByteString -> [Char] + case (dtype ci) of + Integer -> RInt (val::Integer) -- (read (Data.ByteString.Char8.unpack col) :: Int) --((read $ show val) :: Int) + Varchar -> RText $ if False then trace ("Creating RText for column " ++ (T.unpack $ name ci)) $ (val::T.Text) else (val::T.Text) + Date fmt -> RDate { rdate = (val::T.Text) {-decodeUtf8 col-} , dtformat = fmt } -- (val::T.Text) + --getDateFormat (val::String)} + Timestamp fmt -> RTime $ createRTimestamp (T.unpack fmt) (Data.ByteString.Char8.unpack col) -- Data.ByteString.Char8.unpack :: ByteString -> [Char] + Double -> RDouble (val::Double) --(read (Data.ByteString.Char8.unpack col) :: Double) -- ((read $ show val) :: Double) + where + + -- Use Data.Serialize for the decoding from ByteString to a known data type + -- decode :: Serialize a => ByteString -> Either String a + -- val = fromRight' (decode col) + {-- + val = case decode col of + Left e -> e -- you should throw an exception here! + Right v -> v + --} + + -- use Data.Csv parsing capabilities in order to turn a Column (i.e. a Field, i.e., a ByteString) + -- into a known data type. + -- For this reason we are going to use : CV.parseField :: Field -> Parser a + --val = fromRight' $ CV.runParser $ CV.parseField col + val = case CV.runParser $ CV.parseField col of + Left str -> throw $ CSVColumnToRDataTypeError (name ci) $ T.pack str + -- error $ "Error in parsing column " ++ (T.unpack $ name ci) ++ ":" ++ str + Right v -> v + + {-- + val = case CV.runParser $ CV.parseField col of + Left e -> e -- you should throw an exception here! + Right v -> v + --} + {-- + getDateFormat :: String -> String + getDateFormat _ = "DD/MM/YYYY"-- parse and return date format + --} + in HM.fromList $ Prelude.zip listOfColNames listOfRDataTypes + + +-- | rtableToCSV : Retunrs a CSV from an RTable +-- The first line of the CSV will be the header line, taken from the RTable metadata. +-- Note that the driver for creating the output CSV file is the input RTableMData descrbing the columns and RDataTypes of each RTuple. +-- This means, that if the RTableMData include a subset of the actual columns of the input RTable, then no eror will occure and the +-- output CSV will include only this subset. +-- In the same token, if in the RTableMData there is a column name that is not present in the input RTable, then an error will occur. +rtableToCSV :: + RTableMData -- ^ input RTable metadata describing the RTable + -> RTable -- ^ input RTable + -> CSV -- ^ output CSV +rtableToCSV m t = + (createCSVHeader m) V.++ (V.map (rtuple2row m) t) + where + rtuple2row :: RTableMData -> RTuple -> Row + rtuple2row md rt = + -- check that the RTuple is not empty. Otherwise the HM.! operator will cause an exception + if not $ isRTupEmpty rt + then + let listOfColInfo = toListColumnInfo (rtuplemdata md) --Prelude.map (snd) $ (rtuplemdata md) --HM.toList (rtuplemdata md) + + -- create a list of the form [(ColumnInfo, RDataType)] + -- Prelude.zip listOfColInfo (Prelude.map (snd) $ HM.toList rt) -- this code does NOT guarantee that HM.toList will return the same column order as [ColumnInfo] + listOfColInfoRDataType :: [ColumnInfo] -> RTuple -> [(ColumnInfo, RDataType)] -- this code does guarantees that RDataTypes will be in the same column order as [ColumnInfo], i.e., the correct RDataType for the correct column + listOfColInfoRDataType (ci:[]) rtup = [(ci, rtup HM.!(name ci))] -- rt HM.!(name ci) -> this returns the RDataType by column name + listOfColInfoRDataType (ci:colInfos) rtup = (ci, rtup HM.!(name ci)):listOfColInfoRDataType colInfos rtup + + listOfColumns = Prelude.map (\(ci,rdt) -> rDataType2Column ci rdt) $ listOfColInfoRDataType listOfColInfo rt + where + rDataType2Column :: ColumnInfo -> RDataType -> Column + rDataType2Column _ rdt = + {-- + -- encode :: Serialize a => a -> ByteString + case rdt of + RInt i -> encode i + RText t -> encodeUtf8 t -- encodeUtf8 :: Text -> ByteString + RDate {rdate = d, dtformat = f} -> encode d + RDouble db -> encode db + --} + -- toField :: a -> Field (from Data.Csv) + case rdt of + RInt i -> CV.toField i + RText t -> CV.toField t + RDate {rdate = d, dtformat = f} -> CV.toField d + RDouble db -> CV.toField ((printf "%.2f" db)::String) + RTime { rtime = RTimestampVal {year = y, month = m, day = d, hours24 = h, minutes = mi, seconds = s} } -> let timeText = (digitToText d) `mappend` T.pack "/" `mappend` (digitToText m) `mappend` T.pack "/" `mappend` (digitToText y) `mappend` T.pack " " `mappend` (digitToText h) `mappend` T.pack ":" `mappend` (digitToText mi) `mappend` T.pack ":" `mappend` (digitToText s) + -- T.pack . removeQuotes . T.unpack $ (showText d) `mappend` T.pack "/" `mappend` (showText m) `mappend` T.pack "/" `mappend` (showText y) `mappend` T.pack " " `mappend` (showText h) `mappend` T.pack ":" `mappend` (showText mi) `mappend` T.pack ":" `mappend` (showText s) + -- removeQuotes $ (show d) ++ "/" ++ (show m) ++ "/" ++ (show y) ++ " " ++ (show h) ++ ":" ++ (show mi) ++ ":" ++ (show s) + where digitToText :: Int -> T.Text + digitToText d = + if d > 9 then showText d + else "0" `mappend` (showText d) + + showText :: Show a => a -> Text + showText = T.pack . show + + -- removeQuotes ('"' : [] ) = "" + -- removeQuotes ('"' : xs ) = removeQuotes xs + -- removeQuotes ( x : xs ) = x:removeQuotes xs + -- removeQuotes _ = "" + --noQuotesText = fromJust $ T.stripSuffix "\"" (fromJust $ T.stripPrefix "\"" timeText) + in CV.toField timeText --noQuotesText + -- CV.toField $ (show d) ++ "/" ++ (show m) ++ "/" ++ (show y) ++ " " ++ (show h) ++ ":" ++ (show mi) ++ ":" ++ (show s) + Null -> CV.toField (""::T.Text) + in V.fromList $ listOfColumns + else V.empty::Row + createCSVHeader :: RTableMData -> CSV + createCSVHeader md = + let listOfColNames = toListColumnName (rtuplemdata md) --Prelude.map (fst) $ (rtuplemdata md) --HM.toList (rtuplemdata md) + listOfByteStrings = Prelude.map (\n -> CV.toField n) listOfColNames + headerRow = V.fromList listOfByteStrings + in V.singleton headerRow + + +-- In order to be able to decode a CSV bytestring into an RTuple, +-- we need to make Rtuple an instance of the FromNamedRecord typeclass and +-- implement the parseNamesRecord function. But this is not necessary, since there is already an instance for CV.FromNamedRecord (HM.HashMap a b), which is the same, +-- since an RTuple is a HashMap. +-- +-- type RTuple = HM.HashMap ColumnName RDataType +-- type ColumnName = String +-- data RDataType = +-- RInt { rint :: Int } +-- | RChar { rchar :: Char } +-- | RText { rtext :: T.Text } +-- | RString {rstring :: [Char]} +-- | RDate { +-- rdate :: String +-- ,dtformat :: String -- ^ e.g., "DD/MM/YYYY" +-- } +-- | RDouble { rdouble :: Double } +-- | RFloat { rfloat :: Float } +-- | Null +-- deriving (Show, Eq) +-- +-- +-- parseNamedRecord :: NamedRecord -> Parser a +-- type NamedRecord = HashMap ByteString ByteString +-- +-- Instance of class FromNamedRecord: +-- (Eq a, FromField a, FromField b, Hashable a) => FromNamedRecord (HashMap a b) +-- +-- From this we understand that we need to make RDataType (which is "b" in HashMap a b) an instance of FormField ((CV.FromField RDataType)) by implementing parseField +-- where: +-- @ +-- parseField :: Field -> Parser a +-- type Field = ByteString +-- @ +{--instance CV.FromNamedRecord RTuple where + parseNamedRecord r = do + let listOfcolNames = map (fst) $ HM.toList r -- get the first element of each pair which is the name of the column (list of ByteStrings) + listOfParserValues = map (\c -> r CV..: c) listOfcolNames -- this retuns a list of the form [Parser RDataType] + listOfValues = map (\v -> right (CV.runParser v)) listOfParserValues -- this returns a list of the form [RDataType] + rtup = createRtuple $ zip listOfcolNames listOfValues + return rtup +--} + +-- | Necessary instance in order to convert a CSV file column value to an 'RDataType' value. +instance CV.FromField RDataType where + parseField dt = do + -- dt is a ByteString (i.e., a Field) representing some value that we have read from the CSV file (we dont know its type) + -- we need to construct an RDataType from this value and then wrap it into a Parser Monad and return it + -- + + -- ### Note: the following line does not work ### + -- 1. parse the input ByteString using Cassavas' parsing capabilities for known data types +-- val <- CV.parseField dt + + -- 1. We dont know the type of dt. OK lets wrap it into a generic type, that of Data.Typeable.TypeRep + let valTypeRep = TB.typeOf dt + + -- 2. wrap this value into a RDataType + let rdata = createRDataType valTypeRep --val + + -- wrap the RDataType into a Parser Monad and return it + pure rdata + + +{-- + -- #### NOTE ### + -- + -- if the following does not work (val is always a String, then try to use Data.Serialize.decode instead in order to get the original value from a bytestring) + + -- get the value inside the Parser Monad (FromField has instances from all common haskell data types) + let val = case CV.runParser (CV.parseField dt) of -- runParser :: Parser a -> Either String a + Left e -> e + Right v -> v +--} + -- Lets try to use Data.Serialize.decode to get the vlaue from the bytestring (decode :: Serialize a => ByteString -> Either String a) +{-- let val = case decode dt of + Left e -> e + Right v -> v + + -- wrap this value into a RDataType + let rdata = createRDataType val + -- wrap the RDataType into a Parser Monad + pure rdata +--} + +-- | In order to encode an input RTable into a CSV bytestring +-- we need to make Rtuple an instance of the ToNamedRecord typeclass and +-- implement the toNamedRecord function. +-- Where: +-- +-- @ +-- toNamedRecord :: a -> NamedRecord +-- type NamedRecord = HashMap ByteString ByteString +-- +-- namedRecord :: [(ByteString, ByteString)] -> NamedRecord +-- Construct a named record from a list of name-value ByteString pairs. Use .= to construct such a pair from a name and a value. +-- +-- (.=) :: ToField a => ByteString -> a -> (ByteString, ByteString) +-- @ +-- +-- In our case, we dont need to do this because an RTuple is just a synonym for HM.HashMap ColumnName RDataType and the data type HashMap a b is +-- already an instance of ToNamedRecord. +-- +-- Also we need to make RDataType an instance of ToField ((CV.ToField RDataType)) by implementing toField, so as to be able +-- to convert an RDataType into a ByteString +-- where: +-- +-- @ +-- toField :: a -> Field +-- type Field = ByteString +-- @ +-- +instance CV.ToField RDataType where + toField rdata = case rdata of + RInt i -> encode (i::Integer) + --RChar c -> encode (c::Char) + -- RText t -> encode (t::String) + RText t -> encodeUtf8 t -- encodeUtf8 :: Text -> ByteString + --RString s -> encode (s::String) + --RFloat f -> encode (f::Float) + RDouble d -> encode (d::Double) + Null -> encode (""::String) + RDate d f -> encodeUtf8 d -- encode (d::String) + +{--instance CV.ToField RDataType where + toField rdata = case rdata of + (i::Int) -> encode (i::Int) + -- RText t -> encode (t::String) + (t::T.Text) -> encodeUtf8 t -- encodeUtf8 :: Text -> ByteString + (d::Double) -> encode (d::Double) + Null -> encode (""::String) +--} + +-- | csv2rtable : turn a input CSV to an RTable. +-- The input CSV will be a ByteString. We assume that the first line is the CSV header, +-- including the Column Names. The RTable that will be created will have as column names the headers appearing +-- in the first line of the CSV. +-- Internally we use CV.decodeByName to achieve this decoding +-- where: +-- @ +-- decodeByName +-- :: FromNamedRecord a +-- => ByteString +-- -> Either String (Header, Vector a) +-- @ +-- Essentially, decodeByName will return a @Vector RTuples@ +-- +-- In order to be able to decode a CSV bytestring into an RTuple, +-- we need to make Rtuple an instance of the FromNamesRecrd typeclass and +-- implement the parseNamesRecord function. But this is not necessary, since there is already an instance for CV.FromNamedRecord (HM.HashMap a b), which is the same, +-- since an RTuple is a HashMap. +-- Also we need to make RDataType an instance of FormField ((CV.FromField RDataType)) by implementing parseField +-- where: +-- @ +-- parseField :: Field -> Parser a +-- type Field = ByteString +-- @ +-- See RTable module for these instance +csv2rtable :: + BL.ByteString -- ^ input CSV (we asume that this CSV has a header in the 1st line) + -> RTable -- ^ output RTable +csv2rtable csv = + case CV.decodeByName csv of + Left e -> emptyRTable + Right (h, v) -> v + + +-- | rtable2csv: encode an RTable into a CSV bytestring +-- The first line of the CSV will be the header, which compirses of the column names. +-- +-- Internally we use CV.encodeByName to achieve this decoding +-- where: +-- @ +-- encodeByName :: ToNamedRecord a => Header -> [a] -> ByteString +-- Efficiently serialize CSV records as a lazy ByteString. The header is written before any records and dictates the field order. +-- +-- type Header = Vector Name +-- type Name = ByteString +-- @ +-- +-- In order to encode an input RTable into a CSV bytestring +-- we need to make Rtuple an instance of the ToNamedRecord typeclass and +-- implement the toNamedRecord function. +-- Where: +-- @ +-- toNamedRecord :: a -> NamedRecord +-- type NamedRecord = HashMap ByteString ByteString +-- +-- namedRecord :: [(ByteString, ByteString)] -> NamedRecord +-- Construct a named record from a list of name-value ByteString pairs. Use .= to construct such a pair from a name and a value. +-- +-- (.=) :: ToField a => ByteString -> a -> (ByteString, ByteString) +-- @ +-- In our case, we dont need to do this because an RTuple is just a synonym for HM.HashMap ColumnName RDataType and the data type HashMap a b is +-- already an instance of ToNamedRecord. +-- +-- Also we need to make RDataType an instance of ToField ((CV.ToField RDataType)) by implementing toField, so as to be able +-- to convert an RDataType into a ByteString +-- where: +-- @ +-- toField :: a -> Field +-- type Field = ByteString +-- @ +-- See 'RTable' module for these instance +rtable2csv :: + RTable -- ^ input RTable + -> BL.ByteString -- ^ Output ByteString +rtable2csv rtab = + CV.encodeByName (csvHeaderFromRtable rtab) (V.toList rtab) + +-- | creates a 'Data.Csv.Header' (as defined in "Data.Csv") from an 'RTable' +-- type Header = Vector Name +-- type Name = ByteString +csvHeaderFromRtable :: + RTable + -> CV.Header +csvHeaderFromRtable rtab = + let fstRTuple = V.head rtab -- just get any tuple, e.g., the 1st one + colList = HM.keys fstRTuple -- get a list of the columnNames ([ColumnName]) + colListPacked = Prelude.map (encode . T.unpack) colList -- turn it into a list of ByteStrings ([ByteString]) + header = V.fromList colListPacked + in header +-- ################################################## +-- * Vector oprtations on CSV +-- ################################################## + +-- | O(1) First row +headCSV :: CSV -> Row +headCSV = V.head + +-- | O(1) Yield all but the first row without copying. The CSV may not be empty. +tailCSV :: CSV -> CSV +tailCSV = V.tail + + +-- ################################################## +-- * DDL on CSV +-- ################################################## + + +-- ################################################## +-- * DML on CSV +-- ################################################## + + +-- ################################################## +-- * Filter, Join, Projection +-- ################################################## + +-- | selectNrows: Returns the first N rows from a CSV file +selectNrows:: + Int -- ^ Number of rows to select + -> BL.ByteString -- ^ Input csv + -> BL.ByteString -- ^ Output csv +selectNrows n csvi = + let rtabi = csv2rtable csvi + rtabo = limit n rtabi -- restrictNrows n rtabi + in rtable2csv rtabo + +-- | Column projection on an input CSV file where +-- desired columns are defined by position (index) +-- in the CSV. +projectByIndex :: + [Int] -- ^ input list of column indexes + -> CSV -- ^ input csv + -> CSV -- ^ output CSV +projectByIndex inds icsv = + V.foldr (prj) V.empty icsv + where + prj :: Row -> CSV -> CSV + prj row acc = + let + -- construct new row including only projected columns + newrow = V.fromList $ Data.List.map (\i -> row V.! i) inds + in -- add new row in result vector + V.snoc acc newrow + +-- ##### Exceptions Definitions + +-- | Exception to signify an error in decoding a CSV file into a 'CSV' data type +data CsvFileDecodingError = CsvFileDecodingError FilePath Text deriving(Eq,Show) + +instance Exception CsvFileDecodingError + +-- | This exception signifies an error in parsing a 'CSV' 'Column' to an 'RDataType' value +data CSVColumnToRDataTypeError = CSVColumnToRDataTypeError ColumnName Text deriving(Eq,Show) + +instance Exception CSVColumnToRDataTypeError
+ test/DBFTests.hs view
@@ -0,0 +1,953 @@+{- +main :: IO () +main = putStrLn "Test suite not yet implemented" +-} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +--{-# LANGUAGE BangPatterns #-} + +module Main where + +import qualified RTable.Data.CSV as C +import qualified RTable.Core as T +import qualified Etl.Internal.Core as E +import Etl.Julius + +--import RTable +--import QProcessor +--import System.IO +import System.Environment (getArgs, setEnv) +import Data.Char (toLower) +import Data.HashMap.Strict ((!)) +-- Data.Maybe +import Data.Maybe (fromJust) +-- Text +import Data.Text (Text,stripSuffix, pack, unpack, append,take, takeEnd) +-- Vector +import Data.Vector (toList) +-- List +import Data.List (groupBy) + + +-- Test command: stack exec -- csvdb ./misc/test.csv 20 ./misc/testo.csv +-- or, if you want to test with non-default csv options: +-- stack exec -- csvdb ./misc/test_options.csv 20 ./misc/testo.csv + +main :: IO () +main = do + --setEnv "NLS_LANG" "Greek_Greece.UTF8" + + {-args <- getArgs + let fi = args!!0 + n = args!!1 + fo = args!!2-} + let fi = "./test/data/test_options.csv" + n = "20" + fo = "./test/data/testo.csv" + + --csv <- C.readCSVFile fi + + --csv <- C.readCSV fi + let myoptions = C.CSVOptions { C.delimiter = ';', C.hasHeader = C.Yes} + csv <- C.readCSVwithOptions myoptions fi + + + -- debug + {-- + C.writeCSV fo csv + C.printCSV csv + --} + + --let newcsv = selectNrows (read n) csv + let rtmdata = T.createRTableMData ( "TestTable", + [ ("Name", T.Varchar), + ("MyDate", T.Date "DD/MM/YYYY"), + ("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS"), + ("Number", T.Integer), + ("DNumber", T.Double) + ] + ) + [] -- primary key + [] -- list of unique keys + -- *** test CSV to RTable conversion + rtab = C.toRTable rtmdata csv + rtabNew = T.limit (read n) rtab + csvNew = C.fromRTable rtmdata rtabNew + + -- *** test RFilter & RProjection operation + rtabNew2 = let + myfilter = T.f (\t -> t!"Name" == T.RText {T.rtext = "Karagiannidis"}) + myprojection = T.p ["Name","MyTime","Number"] + myfilter2 = T.f (\t -> t!"Number" > T.RInt {T.rint = 30 }) + myprojection2 = T.p ["Name","Number"] + in myprojection2.myfilter2.myprojection.myfilter $ rtab -- ***** THIS IS AN ETL PIPELINE IMPLEMENTED AS FUNCTION COMPOSITION !!!! ***** + rtmdata2 = T.createRTableMData ( "TestTable2", + [ ("Name", T.Varchar), + --("MyDate", T.Date "DD/MM/YYYY"), + -- ("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS"), + ("Number", T.Integer) + --("DNumber", T.Double) + ] + ) + [] -- primary key + [] -- list of unique keys + csvNew2 = C.fromRTable rtmdata2 rtabNew2 + + -- Test Julius + rtabNew2_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (Filter (From $ Tab rtab) $ FilterBy (\t -> t!"Name" == T.RText {T.rtext = "Karagiannidis"})) + :. (Select ["Name","MyTime","Number"] $ From Previous) + :. (Filter (From Previous) $ FilterBy (\t -> t!"Number" > T.RInt {T.rint = 30 })) + :. (Select ["Name","Number"] $ From Previous) + ) + +{- rtabNew2_J = E.etl $ evalJulius $ + (EtlR $ + (Select ["Name","Number"] $ From Previous) + :. (Filter (From Previous) $ FilterBy (\t -> t!"Number" > T.RInt {T.rint = 30 })) + :. (Select ["Name","MyTime","Number"] $ From Previous) + :. (Filter (From $ Tab rtab) $ FilterBy (\t -> t!"Name" == T.RText {T.rtext = "Karagiannidis"}) ) + :. ROpEmpty) + :-> EtlMapEmpty +-} + csvNew2_J = C.fromRTable rtmdata2 rtabNew2_J + + + --print / write to file + C.writeCSV fo csvNew + C.printCSV csvNew + T.printRTable rtabNew + let foName2 = (fromJust (stripSuffix ".csv" (pack fo))) `mappend` "_t2.csv" + C.writeCSV (unpack foName2) csvNew2 + C.printCSV csvNew2 + let foName2_J = (fromJust (stripSuffix ".csv" (pack fo))) `mappend` "_t2_J.csv" + C.writeCSV (unpack foName2_J) csvNew2_J + C.printCSV csvNew2_J + T.printRTable rtabNew2_J + + + -- *** test Column Mapping + -- create a new column holding the doubled value from the source column + let cmap1 = E.RMap1x1 {E.srcCol = "Number", E.removeSrcCol = E.No, E.trgCol = "NewNumber", E.transform1x1 = \x -> 2*x, E.srcRTupleFilter = \_ -> True} + rtabNew3 = E.runCM cmap1 rtabNew2 + rtmdata3 = T.createRTableMData ( "TestTable3", + [ ("Name", T.Varchar) + ,("Number", T.Integer) + ,("NewNumber", T.Integer) + ] + ) + [] -- primary key + [] -- list of unique keys + + -- Test Julius + rtabNew3_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlC $ + Source ["Number"] $ + Target ["NewNumber"] $ + By (\[x] -> [2*x]) (On $ Tab rtabNew2) + DontRemoveSrc $ + FilterBy (\_ -> True) ) + +{- rtabNew3_J = E.etl $ evalJulius $ + (EtlC $ + Source ["Number"] $ + Target ["NewNumber"] $ + By (\[x] -> [2*x]) (On $ Tab rtabNew2) + DontRemoveSrc $ + FilterBy (\_ -> True) ) + :-> EtlMapEmpty +-} + + writeResult fo "_t3.csv" rtmdata3 rtabNew3 + writeResult fo "_t3_J.csv" rtmdata3 rtabNew3_J + T.printRTable rtabNew3_J + + -- foName3 = (fromJust (stripSuffix ".csv" (pack fo))) `mappend` "_t3.csv" + -- csvNew3 = C.fromRTable rtmdata3 rtabNew3 + -- C.writeCSV (unpack foName3) csvNew3 + -- C.printCSV csvNew3 + + -- *** test inner join operation + let rtabNew4 = T.iJ (\t1 t2 -> t1!"Number" == t2!"Number") rtabNew3 rtab + rtmdata4 = T.createRTableMData ( "TestTable4", + [ ("Name", T.Varchar), + ("MyDate", T.Date "DD/MM/YYYY"), + ("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS"), + ("Number", T.Integer), + ("DNumber", T.Double), + ("NewNumber", T.Integer) + ] + ) + [] -- primary key + [] -- list of unique keys + -- Test Julius + rtabNew4_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (Join (TabL rtabNew3) (Tab rtab) $ JoinOn (\t1 t2 -> t1!"Number" == t2!"Number")) + ) + +{- rtabNew4_J = E.etl $ evalJulius $ + (EtlR $ + (Join (TabL rtabNew3) (Tab rtab) $ JoinOn (\t1 t2 -> t1!"Number" == t2!"Number")) + :. ROpEmpty) + :-> EtlMapEmpty +-} + + writeResult fo "_t4.csv" rtmdata4 rtabNew4 + writeResult fo "_t4_J.csv" rtmdata4 rtabNew4_J + putStrLn "TEST INNER JOIN" + T.printRTable rtabNew4_J + + -- *** Test union, interesection, diff + let -- change the value in column NewNumber + cmap2 = E.RMap1x1 {E.srcCol = "NewNumber", E.removeSrcCol = E.No, E.trgCol = "NewNumber", E.transform1x1 = \x -> x + 100, E.srcRTupleFilter = \_ -> True} + -- now union the two rtables + rtabNew5 = rtabNew4 `T.u` (E.runCM cmap2 rtabNew4) + rtmdata5 = T.createRTableMData ( "TestTable5", + [ ("Name", T.Varchar), + ("MyDate", T.Date "DD/MM/YYYY"), + ("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS"), + ("Number", T.Integer), + ("DNumber", T.Double), + ("NewNumber", T.Integer) + ] + ) + [] -- primary key + [] -- list of unique keys + + rtabNew6 = rtabNew5 `T.i` rtabNew4 + rtabNew7 = rtabNew5 `T.d` rtabNew6 + + -- Test Julius + rtabNew7_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlC $ + Source ["NewNumber"] $ + Target ["NewNumber"] $ + By (\[x] -> [x + 100]) (On $ Tab rtabNew4) + DontRemoveSrc $ + FilterBy (\_ -> True)) + :-> (EtlR $ -- rtabNew5 + ROpStart + :. (Union (TabL rtabNew4) (Previous)) + ) + :-> (EtlR $ -- rtabNew6 + ROpStart + :. (Intersect (TabL rtabNew4) (Previous)) + ) + :-> (EtlR $ + ROpStart + :. (Minus + (TabL $ -- this is the rtabNew5 repeated + E.etl $ evalJulius $ + EtlMapStart + :-> (EtlC $ + Source ["NewNumber"] $ + Target ["NewNumber"] $ + By (\[x] -> [x + 100]) (On $ Tab rtabNew4) + DontRemoveSrc $ + FilterBy (\_ -> True)) + :-> (EtlR $ -- rtabNew5 + ROpStart + :. (Union (TabL rtabNew4) (Previous)) + ) + ) + (Previous)) + ) + + + rtabNew7_J2 = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ -- rtabNew5 + ROpStart + :. (Minus (TabL rtabNew5) (Tab rtabNew6)) + ) + + + rtabNew7_J3 = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ -- rtabNew5 + ROpStart + :. (MinusP (Tab rtabNew5) (TabL rtabNew6)) + ) + +-- test Intermediate named results + rtabNew7a_J = E.etl $ evalJulius $ etlXpression + + etlXpression = + EtlMapStart + :-> (EtlC $ + Source ["NewNumber"] $ + Target ["NewNumber"] $ + By (\[x] -> [x + 100]) (On $ Tab rtabNew4) + DontRemoveSrc $ + FilterBy (\_ -> True)) + :=> NamedResult "rtabNew5" (EtlR $ -- rtabNew5 + ROpStart + :. (Union (TabL rtabNew4) (Previous)) + ) + :-> (EtlR $ -- rtabNew6 + ROpStart + :. (Intersect (TabL rtabNew4) (Previous)) + ) + :-> (EtlR $ + ROpStart + :. (Minus + (TabL $ -- this is the rtabNew5 repeated + juliusToRTable $ takeNamedResult "rtabNew5" etlXpression --- THIS IS THE POINT TO BE TESTED!!! + ) + (Previous)) + ) + + writeResult fo "_t7a_J.csv" rtmdata5 rtabNew7a_J + T.printRTable rtabNew7a_J + + +{- rtabNew5_J = E.etl $ evalJulius $ + (EtlR $ -- rtabNew5 + (Union (TabL rtabNew4) (Previous)) + :. ROpEmpty) + :-> (EtlC $ + Source ["NewNumber"] $ + Target ["NewNumber"] $ + By (\[x] -> [x + 100]) (On $ Tab rtabNew4) + DontRemoveSrc $ + FilterBy (\_ -> True)) + :-> EtlMapEmpty + + rtabNew6_J = E.etl $ evalJulius $ + (EtlR $ -- rtabNew6 + (Intersect (TabL rtabNew4) (Tab rtabNew5)) + :. ROpEmpty) + :-> EtlMapEmpty + + -- Build rtabNew7 with a single ETL Mapping + rtabNew7_J = E.etl $ evalJulius $ + (EtlR $ + (Minus (TabL rtabNew4) (Previous)) + :. ROpEmpty) + :-> (EtlR $ -- rtabNew6 + (Intersect (TabL rtabNew4) (Previous)) + :. ROpEmpty) + :-> (EtlR $ -- rtabNew5 + (Union (TabL rtabNew4) (Previous)) + :. ROpEmpty) + :-> (EtlC $ + Source ["NewNumber"] $ + Target ["NewNumber"] $ + By (\[x] -> [x + 100]) (On $ Tab rtabNew4) + DontRemoveSrc $ + FilterBy (\_ -> True)) + :-> EtlMapEmpty +-} + + ---- DEBUG + -- putStrLn "------rtabNew3-------" + -- print rtabNew3 + -- putStrLn "------rtab-------" + -- print rtab + -- putStrLn "------rtabNew4-------" + -- print rtabNew4 + -- putStrLn "------rtmdata5-------" + -- print rtmdata5 + -- putStrLn "------rtabNew5-------" + -- print rtabNew5 + ---- + + writeResult fo "_t5.csv" rtmdata5 rtabNew5 + --writeResult fo "_t5_J.csv" rtmdata5 rtabNew5_J + writeResult fo "_t6.csv" rtmdata5 rtabNew6 + --writeResult fo "_t6_J.csv" rtmdata5 rtabNew6_J + writeResult fo "_t7.csv" rtmdata5 rtabNew7 + writeResult fo "_t7_J.csv" rtmdata5 rtabNew7_J + writeResult fo "_t7_J2.csv" rtmdata5 rtabNew7_J2 + writeResult fo "_t7_J3.csv" rtmdata5 rtabNew7_J3 + + -- *** Change existing column name + let -- change the value in column NewNumber + cmap3 = E.RMap1x1 {E.srcCol = "NewNumber", E.removeSrcCol = E.Yes, E.trgCol = "NewNewNumber", E.transform1x1 = \x -> x, E.srcRTupleFilter = \_ -> True} + rtabNew8 = E.runCM cmap3 rtabNew5 + rtmdata8 = T.createRTableMData ( "TestTable8", + [ ("Name", T.Varchar), + ("MyDate", T.Date "DD/MM/YYYY"), + ("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS"), + ("Number", T.Integer), + ("DNumber", T.Double), + ("NewNewNumber", T.Integer) + ] + ) + [] -- primary key + [] -- list of unique keys + + -- Test Julius + rtabNew8_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlC $ + Source ["NewNumber"] $ + Target ["NewNewNumber"] $ + By (\[x] -> [x]) (On $ Tab rtabNew5) + RemoveSrc $ + FilterBy (\_ -> True) + ) + + + writeResult fo "_t8.csv" rtmdata8 rtabNew8 + writeResult fo "_t8_J.csv" rtmdata8 rtabNew8_J + T.printRTable rtabNew8_J + + -- Test a RMapNx1 column mapping + let + cmap4 = E.RMapNx1 {E.srcColGrp = ["Name","MyTime"], E.removeSrcCol = E.Yes, E.trgCol = "New_Nx1_Col", E.transformNx1 = (\[n, T.RTime{T.rtime = t}] -> n `rdtappend` (T.RText "<---->") `rdtappend` (T.rTimestampToRText T.stdTimestampFormat t)), E.srcRTupleFilter = \_ -> True} + rtabNew9 = E.runCM cmap4 rtabNew8 + rtmdata9 = T.createRTableMData ( "TestTable9", + [ -- ("Name", T.Varchar), + ("New_Nx1_Col", T.Varchar), + ("MyDate", T.Date "DD/MM/YYYY"), + -- ("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS"), + ("Number", T.Integer), + ("DNumber", T.Double), + ("NewNewNumber", T.Integer) + ] + ) + [] -- primary key + [] -- list of unique keys + + -- Test Julius + rtabNew9_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlC $ + Source ["Name","MyTime"] $ + Target ["New_Nx1_Col"] $ + By (\[n, T.RTime{T.rtime = t}] -> [n `rdtappend` (T.RText "<---->") `rdtappend` (T.rTimestampToRText T.stdTimestampFormat t)]) (On $ Tab rtabNew8) + RemoveSrc $ + FilterBy (\_ -> True) + ) + + writeResult fo "_t9.csv" rtmdata9 rtabNew9 + writeResult fo "_t9_J.csv" rtmdata9 rtabNew9_J + T.printRTable rtabNew9_J + + -- Test a RMap1xN column mapping + let + cmap5 = E.RMap1xN {E.srcCol = "New_Nx1_Col", E.removeSrcCol = E.No, E.trgColGrp = ["1xN_A","1xN_B","1xN_C"], E.transform1xN = (\(T.RText txt) -> [T.RText (Data.Text.take 5 txt), T.RText "<-|-|-|->", T.RText (Data.Text.takeEnd 10 txt)]), E.srcRTupleFilter = \_ -> True} + rtabNew10 = E.runCM cmap5 rtabNew9 + rtmdata10 = T.createRTableMData ( "TestTable10", + [ -- ("Name", T.Varchar), + ("New_Nx1_Col", T.Varchar) + ,("MyDate", T.Date "DD/MM/YYYY") + -- ,("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS") + ,("Number", T.Integer) + ,("DNumber", T.Double) + ,("NewNewNumber", T.Integer) + ,("1xN_A", T.Varchar) + ,("1xN_B", T.Varchar) + ,("1xN_C", T.Varchar) + ] + ) + [] -- primary key + [] -- list of unique keys + + -- Test Julius + rtabNew10_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlC $ + Source ["New_Nx1_Col"] $ + Target ["1xN_A","1xN_B","1xN_C"] $ + By (\[(T.RText txt)] -> [T.RText (Data.Text.take 5 txt), T.RText "<-|-|-|->", T.RText (Data.Text.takeEnd 10 txt)]) (On $ Tab rtabNew9) + DontRemoveSrc $ + FilterBy (\_ -> True) + ) + + writeResult fo "_t10.csv" rtmdata10 rtabNew10 + writeResult fo "_t10_J.csv" rtmdata10 rtabNew10_J + T.printRTable rtabNew10_J + +-- Test a RMapNxM column mapping + let + cmap6 = E.RMapNxM {E.srcColGrp = ["1xN_A","1xN_B","1xN_C"], E.removeSrcCol = E.Yes, E.trgColGrp = ["ColNew1","ColNew2"], E.transformNxM = transformation, E.srcRTupleFilter = \_ -> True} + where + transformation [T.RText t1, T.RText t2, T.RText t3] = [T.RText (t1 `append` t3), T.RText t2] + rtabNew11 = E.runCM cmap6 rtabNew10 + rtmdata11 = T.createRTableMData ( "TestTable11", + [ -- ("Name", T.Varchar), + ("New_Nx1_Col", T.Varchar) + ,("MyDate", T.Date "DD/MM/YYYY") + -- ,("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS") + ,("Number", T.Integer) + ,("DNumber", T.Double) + ,("NewNewNumber", T.Integer) + ,("ColNew1", T.Varchar) + ,("ColNew2", T.Varchar) + ] + ) + [] -- primary key + [] -- list of unique keys + + -- Test Julius + rtabNew11_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlC $ + Source ["1xN_A","1xN_B","1xN_C"] $ + Target ["ColNew1","ColNew2"] $ + By transformation (On $ Tab rtabNew10) + RemoveSrc $ + FilterBy (\_ -> True) + ) + where + transformation [T.RText t1, T.RText t2, T.RText t3] = [T.RText (t1 `append` t3), T.RText t2] + + writeResult fo "_t11.csv" rtmdata11 rtabNew11 + writeResult fo "_t11_J.csv" rtmdata11 rtabNew11_J + T.printRTable rtabNew11_J + +-- Test removeColumn operation + let + rtabNew12 = T.removeColumn "NewNewNumber" (T.removeColumn "MyDate" rtabNew11) + rtmdata12 = T.createRTableMData ( "TestTable12", + [ -- ("Name", T.Varchar), + ("New_Nx1_Col", T.Varchar) + -- ,("MyDate", T.Date "DD/MM/YYYY") + -- ,("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS") + ,("Number", T.Integer) + ,("DNumber", T.Double) + -- ,("NewNewNumber", T.Integer) + ,("ColNew1", T.Varchar) + ,("ColNew2", T.Varchar) + ] + ) + [] -- primary key + [] -- list of unique keys + + -- Test Julius + rtabNew12_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (GenUnaryOp (On $ Tab rtabNew11) (ByUnaryOp myfunc)) + ) + where + myfunc = (T.removeColumn "NewNewNumber") . (T.removeColumn "MyDate") + + + writeResult fo "_t12.csv" rtmdata12 rtabNew12 -- this calls internally C.fromRTable and thus it cannot actually test the column removal (because the column removal is hidden + -- by the RTable metadata). An explicit print of the new RTable is required in order to check correctness. + + writeResult fo "_t12_J.csv" rtmdata12 rtabNew12_J + + print rtabNew12 + print rtabNew12_J + T.printRTable rtabNew12_J + +-- Test combined Roperations + let + myfilter = T.f (\t -> t!"Name" == T.RText {T.rtext = "Karagiannidis"}) + myprojection = T.p ["Name","MyTime","Number", "ColNew2"] + myjoin = T.iJ (\t1 t2 -> t1!"Number" == t2!"Number") rtabNew12 -- !!! Check that the other table participating in the join is embedded in the myjoin operation + rcombined = myprojection . myjoin . myfilter + rtabNew13 = T.rComb rcombined rtab + rtmdata13 = T.createRTableMData ( "TestTable13", + [ ("Name", T.Varchar) + --,("MyDate", T.Date "DD/MM/YYYY") + ,("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS") + ,("Number", T.Integer) + --,("DNumber", T.Double) + ,("ColNew2", T.Varchar) + ] + ) + [] -- primary key + [] -- list of unique keys + + -- Test Julius + rtabNew13_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (Filter (From $ Tab rtab) $ FilterBy (\t -> t!"Name" == T.RText {T.rtext = "Karagiannidis"})) + :. (Join (TabL rtabNew12) (Previous) $ JoinOn (\t1 t2 -> t1!"Number" == t2!"Number")) + :. (Select ["Name","MyTime","Number", "ColNew2"] $ From Previous) + ) + + + writeResult fo "_t13.csv" rtmdata13 rtabNew13 + writeResult fo "_t13_J.csv" rtmdata13 rtabNew13_J + + print rtabNew13 + print rtabNew13_J + T.printRTable rtabNew13_J + +-- Test Left Outer Join + let rtabNew14 = T.lJ (\t1 t2 -> t1!"Number" == t2!"Number") rtab rtabNew3 + rtmdata14 = T.createRTableMData ( "TestTable14", + [ ("Name", T.Varchar), + ("MyDate", T.Date "DD/MM/YYYY"), + ("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS"), + ("Number", T.Integer), + ("DNumber", T.Double), + ("NewNumber", T.Integer) + ] + ) + [] -- primary key + [] -- list of unique keys + +-- debug left join + -- the first part is the join + let rtabNew14_dbg_1part = T.iJ (\t1 t2 -> t1!"Number" == t2!"Number") rtab rtabNew3 -- these are the rows of the left tab (enhanced with new columns) that satisfy the join + -- project only left tab's columns + rtabNew14_dbg_1part_proj = T.p (T.getColumnNamesfromRTab rtab) rtabNew14_dbg_1part + + + -- enhance the left tab with the new columns with NULL values +-- left_tab_enhanced = T.iJ (\t1 t2 -> True) rtab (T.createSingletonRTable $ T.createNullRTuple ["Name","Number","NewNumber"]) + + -- the second part are the rows from the preserving table that dont join + rtabNew14_dbg_2part_a = + let + leftTab = rtab --T.nvlRTable "DNumber" (T.RText "x") rtab -- need to eliminate the Null values because Null == Null gives False. + rightTab = rtabNew14_dbg_1part_proj --T.nvlRTable "DNumber" (T.RText "x") rtabNew14_dbg_1part_proj + in T.d leftTab rightTab --diffTab = T.d leftTab rightTab -- get the rows from left tab that dont join + -- in -- remove "x" and turn it back to Null + -- T.decodeRTable "DNumber" (T.RText "x") T.Null T.Null T.Ignore diffTab + + -- enhance this with null columns from the non-preserving table + rtabNew14_dbg_2part = T.iJ (\t1 t2 -> True) rtabNew14_dbg_2part_a (T.createSingletonRTable $ T.createNullRTuple $ (T.getColumnNamesfromRTab rtabNew3)) + + -- finally, union the two parts + rtabNew14_dbg = T.u rtabNew14_dbg_1part rtabNew14_dbg_2part + + -- Test Julius + rtabNew14_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (LJoin (TabL rtab) (Tab rtabNew3) $ JoinOn (\t1 t2 -> t1!"Number" == t2!"Number")) + ) + + + writeResult fo "_t14.csv" rtmdata14 rtabNew14 + writeResult fo "_t14_dbg_1part.csv" rtmdata14 rtabNew14_dbg_1part + writeResult fo "_t14_dbg_1part_proj.csv" rtmdata rtabNew14_dbg_1part_proj + writeResult fo "_t14_dbg_dbg_2part_a.csv" rtmdata rtabNew14_dbg_2part_a + --writeResult fo "_t14_left_tab_enhanced.csv" rtmdata14 left_tab_enhanced + writeResult fo "_t14_dbg_2part.csv" rtmdata14 rtabNew14_dbg_2part + writeResult fo "_t14_dbg.csv" rtmdata14 rtabNew14_dbg + writeResult fo "_t14_J.csv" rtmdata14 rtabNew14_J + putStrLn "Test LEFT JOIN" + T.printRTable rtabNew14_J + +-- Test Right Outer Join + let rtabNew15 = T.rJ (\t1 t2 -> t1!"Number" == t2!"Number") rtab rtabNew3 + rtmdata15 = T.createRTableMData ( "TestTable15", + [ ("Name", T.Varchar), + ("MyDate", T.Date "DD/MM/YYYY"), + ("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS"), + ("Number", T.Integer), + ("DNumber", T.Double), + ("NewNumber", T.Integer) + ] + ) + [] -- primary key + [] -- list of unique keys + + -- Test Julius + rtabNew15_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (RJoin (TabL rtab) (Tab rtabNew3) $ JoinOn (\t1 t2 -> t1!"Number" == t2!"Number")) + ) + + writeResult fo "_t15.csv" rtmdata15 rtabNew15 + writeResult fo "_t15_J.csv" rtmdata15 rtabNew15_J + putStrLn "Test RIGHT JOIN" + T.printRTable rtabNew15_J + +-- Test Full Outer Join + let rtabNew15fo = T.foJ (\t1 t2 -> t1!"Number" == t2!"Number") rtab rtabNew3 + rtabNew15fo2 = T.foJ (\t1 t2 -> t1!"Number" == t2!"Number") rtabNew3 rtab + rtmdata15 = T.createRTableMData ( "TestTable15", + [ ("Name", T.Varchar), + ("MyDate", T.Date "DD/MM/YYYY"), + ("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS"), + ("Number", T.Integer), + ("DNumber", T.Double), + ("NewNumber", T.Integer) + ] + ) + [] -- primary key + [] -- list of unique keys + + -- Test Julius + rtabNew15fo_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (FOJoin (TabL rtab) (Tab rtabNew3) $ JoinOn (\t1 t2 -> t1!"Number" == t2!"Number")) + ) + + rtabNew15fo2_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (FOJoin (TabL rtabNew3) (Tab rtab) $ JoinOn (\t1 t2 -> t1!"Number" == t2!"Number")) + ) + + + writeResult fo "_t15_fo.csv" rtmdata15 rtabNew15fo + writeResult fo "_t15_fo2.csv" rtmdata15 rtabNew15fo2 + writeResult fo "_t15_fo_J.csv" rtmdata15 rtabNew15fo_J + writeResult fo "_t15_fo2_J.csv" rtmdata15 rtabNew15fo2_J + putStrLn "Test FULL OUTER JOIN" + T.printRTable rtabNew15fo2_J + + + + +-- Test Aggregation + -- + let rtabNew16 = T.rAgg [T.raggSum "Number" "SumNumber" + , T.raggCount "Number" "CountNumber" + , T.raggAvg "Number" "AvgNumber" + , T.raggSum "Name" "SumName" + ,T.raggMax "DNumber" "maxDNumber" + ,T.raggMax "Number" "maxNumber" + ,T.raggMax "Name" "maxName" + ,T.raggMin "DNumber" "minDNumber" + ,T.raggMin "Number" "minNumber" + ,T.raggMin "Name" "minName" + ,T.raggAvg "Name" "AvgName" + ] rtabNew + rtmdata16 = T.createRTableMData ( "TestTable16", + [ --("Name", T.Varchar), + --("MyDate", T.Date "DD/MM/YYYY"), + --("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS"), + ("SumNumber", T.Integer) + ,("CountNumber", T.Integer) + ,("AvgNumber", T.Double) + ,("SumName", T.Integer) + ,("maxDNumber", T.Double) + ,("maxNumber", T.Integer) + ,("maxName", T.Varchar) + ,("minDNumber", T.Double) + ,("minNumber", T.Integer) + ,("minName", T.Varchar) + ,("AvgName", T.Double) + --,("NewNumber", T.Integer) + ] + ) + [] -- primary key + [] -- list of unique keys + + + -- Test Julius + rtabNew16_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (Agg $ + AggOn [ Sum "Number" $ As "SumNumber" + ,Count "Number" $ As "CountNumber" + ,Avg "Number" $ As "AvgNumber" + ,Sum "Name" $ As "SumName" + ,Max "DNumber" $ As "maxDNumber" + ,Max "Number" $ As "maxNumber" + ,Max "Name" $ As "maxName" + ,Min "DNumber" $ As "minDNumber" + ,Min "Number" $ As "minNumber" + ,Min "Name" $ As "minName" + ,Avg "Name" $ As "AvgName"] $ From $ Tab rtabNew) + ) + + writeResult fo "_t16.csv" rtmdata16 rtabNew16 + writeResult fo "_t16_J.csv" rtmdata16 rtabNew16_J + + T.printRTable rtabNew16_J + +-- Test GroupBy + -- + let rtabNew17 = T.rG (\t1 t2 -> t1!"Name" == t2!"Name" && t1!"MyTime" == t2!"MyTime") + [ T.raggSum "Number" "SumNumber" + , T.raggCount "Name" "CountName" + -- , T.raggAvg "Number" "AvgNumber" + , T.raggSum "Name" "SumName" + , T.raggCount "DNumber" "CountDNumber" + , T.raggMax "DNumber" "maxDNumber" + -- ,T.raggMax "Number" "maxNumber" + , T.raggMax "Name" "maxName" + -- ,T.raggMin "DNumber" "minDNumber" + -- ,T.raggMin "Number" "minNumber" + -- ,T.raggMin "Name" "minName" + -- ,T.raggAvg "Name" "AvgName" + ] + ["Name", "MyTime"] + rtabNew + + -- debugging +-- rtupList = toList rtabNew +-- listOfRTupGroupLists = Data.List.groupBy (\t1 t2 -> t1!"Name" == t2!"Name") rtupList + + rtmdata17 = T.createRTableMData ( "TestTable17", + [ ("Name", T.Varchar) + --,("MyDate", T.Date "DD/MM/YYYY"), + ,("MyTime", T.Timestamp "DD/MM/YYYY HH24:MI:SS") + ,("SumNumber", T.Integer) + ,("CountName", T.Integer) + -- ,("AvgNumber", T.Double) + ,("SumName", T.Integer) + ,("CountDNumber", T.Integer) + ,("maxDNumber", T.Double) + -- ,("maxNumber", T.Integer) + ,("maxName", T.Varchar) + -- ,("minDNumber", T.Double) + -- ,("minNumber", T.Integer) + -- ,("minName", T.Varchar) + -- ,("AvgName", T.Double) + --,("NewNumber", T.Integer) + ] + ) + [] -- primary key + [] -- list of unique keys + + -- Test Julius + rtabNew17_J = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (GroupBy ["Name", "MyTime"] + (AggOn [ Sum "Number" $ As "SumNumber" + ,Count "Name" $ As "CountName" + --,Avg "Number" $ As "AvgNumber" + ,Sum "Name" $ As "SumName" + ,Count "DNumber" $ As "CountDNumber" + ,Max "DNumber" $ As "maxDNumber" + --,Max "Number" $ As "maxNumber" + ,Max "Name" $ As "maxName"] $ From $ Tab rtabNew) + $ GroupOn (\t1 t2 -> t1!"Name" == t2!"Name" && t1!"MyTime" == t2!"MyTime")) + ) + + rtabNew17_J2 = E.etl $ evalJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (GroupBy ["Name", "MyTime"] + (AggOn [] {-[ Sum "Number" $ As "SumNumber" + ,Count "Name" $ As "CountName" + --,Avg "Number" $ As "AvgNumber" + ,Sum "Name" $ As "SumName" + ,Count "DNumber" $ As "CountDNumber" + ,Max "DNumber" $ As "maxDNumber" + --,Max "Number" $ As "maxNumber" + ,Max "Name" $ As "maxName"]-} $ From $ Tab rtabNew) + $ GroupOn (\t1 t2 -> t1!"Name" == t2!"Name" && t1!"MyTime" == t2!"MyTime")) + ) + + + -- print listOfRTupGroupLists + writeResult fo "_t17.csv" rtmdata17 rtabNew17 + writeResult fo "_t17_J.csv" rtmdata17 rtabNew17_J + + putStrLn "#### TEST GROUP BY ###" + T.printRTable rtabNew + T.printRTable rtabNew17_J + + -- test groupNoAgg function + putStrLn "GroupBy with [] AggOp list" + T.printRTable rtabNew17_J2 + putStrLn "Test groupNoAgg function" + T.printRTable $ + groupNoAgg (\t1 t2 -> t1!"Name" == t2!"Name" && t1!"MyTime" == t2!"MyTime") + ["Name", "MyTime"] + rtabNew + + -- test groupNoAggList function + putStrLn "Test groupNoAggList function" + mapM_ (T.printRTable) $ + groupNoAggList (\t1 t2 -> t1!"Name" == t2!"Name" && t1!"MyTime" == t2!"MyTime") + ["Name", "MyTime"] + rtabNew + + + putStrLn "#### TEST CUSTOM Aggregation ###" + putStrLn "Implement a custom listagg()" + + printRTable $ juliusToRTable $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (Select ["Name"] (From $ Tab rtabNew)) + ) + + rtabNew18 <- runJulius $ + EtlMapStart + :-> (EtlR $ + ROpStart + :. (GroupBy ["Name"] -- , "MyTime"] + (AggOn [ {-Sum "Number" $ As "SumNumber" + ,Count "Name" $ As "CountName" + --,Avg "Number" $ As "AvgNumber" + ,Sum "Name" $ As "SumName" + ,Count "DNumber" $ As "CountDNumber" + ,Max "DNumber" $ As "maxDNumber" + --,Max "Number" $ As "maxNumber" + ,Max "Name" $ As "maxName" + ,-} + Count "Name" $ As "CountName" + ,GenAgg "Name" (As "ListAggName") $ AggBy $ myListAgg (pack ";") + ] $ From $ Tab rtabNew) + $ GroupOn (\t1 t2 -> t1!"Name" == t2!"Name" )) -- && t1!"MyTime" == t2!"MyTime")) + ) + + -- T.printRTable rtabNew18 + T.printfRTable (genRTupleFormat [ "Name", "ListAggName", "CountName"] genDefaultColFormatMap) $ rtabNew18 + + + where + myListAgg :: Text -> AggFunction + myListAgg delimiter col rtab = + rdatatypeFoldr' ( \rtup accValue -> + if isNotNull (rtup <!> col) && (isNotNull accValue) + then + rtup <!> col `rdtappend` (RText delimiter) `rdtappend` accValue + else + --if (getRTupColValue src) rtup == Null && accValue /= Null + if isNull (rtup <!> col) && (isNotNull accValue) + then + accValue -- ignore Null value + else + --if (getRTupColValue src) rtup /= Null && accValue == Null + if isNotNull (rtup <!> col) && (isNull accValue) + then + case isText (rtup <!> col) of + True -> (rtup <!> col) + False -> Null + else + Null -- agg of Nulls is Null + ) + Null + rtab + + --print csvNew2 + --return () + + --C.writeCSVFile fo newcsv + --C.printCSVFile newcsv + +writeResult :: + String -- File name + -> Text -- new file suffix + -> T.RTableMData + -> T.RTable + -> IO() +writeResult fname sfx md rt = do + let foNameNew = (fromJust (stripSuffix ".csv" (pack fname))) `mappend` sfx + csvNew = C.fromRTable md rt + C.writeCSV (unpack foNameNew) csvNew + C.printCSV csvNew + +