{-|
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)
            ,ExistentialQuantification
            ,StandaloneDeriving
            {--
                :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 (..) 
    ,ColumnOrder   
    ,Name
    ,ColumnName
    ,RTableName
    ,ColumnDType (..)
    ,Delimiter

    -- * Type Classes for "Tabular Data"

    ,RTabular (..)

    -- * Relational Algebra Operations

    -- ** Operations Data Types

    ,ROperation (..)
    ,UnaryRTableOperation    
    ,BinaryRTableOperation    
    ,RAggOperation (..)
    -- *** Available Aggregate Operations

    ,AggFunction (..)
    ,raggGenericAgg
    ,raggSum
    ,raggCount
    ,raggCountDist
    ,raggCountStar
    ,raggAvg
    ,raggMax
    ,raggMin
    ,raggStrAgg    

    -- ** Predicates

    ,RPredicate
    ,RGroupPredicate
    ,RJoinPredicate
    ,RUpsertPredicate (..)

    -- ** 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 = RFilterStandaloneDeriving (\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
    ,sJ
    ,runSemiJoin
    ,aJ
    ,runAntiJoin
    ,joinRTuples    
    ,runUnion
    ,runUnionAll
    ,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
    ,toUTCTime
    ,fromUTCTime    
    ,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'
    ,rtupleMap
    ,rtupleMapWithKey
    ,rdatatypeFoldr'
    ,rdatatypeFoldl'
    -- * Modify RTable (DML)

    ,insertAppendRTab    
    ,insertPrependRTab
    ,insertRTabToRTab
    ,deleteRTab    
    ,updateRTab    
    ,upsertRTab  
    ,updateRTuple
    ,upsertRTuple    
    -- * Create/Alter RTable (DDL)

    ,emptyRTable
    ,createSingletonRTable
    ,rtableFromList    
    ,addColumn    
    ,removeColumn    
    ,emptyRTuple
    ,createNullRTuple
    ,createRTuple
    ,rtupleFromList    
    ,createRDataType
    -- * Metadata Functions

    ,createRTableMData    
    ,getColumnNamesFromRTab
    ,getColumnNamesFromRTuple
    ,getColumnInfoFromRTab
    ,getColumnInfoFromRTuple
    ,getTheType
    ,listOfColInfoRDataType
    ,toListColumnName
    ,toListColumnInfo
    ,rtabsSameStructure
    ,rtuplesSameStructure
    ,getUniqueColumnNamesAfterJoin
    -- * Exceptions

    ,ColumnDoesNotExist (..)
    ,ConflictingRTableStructures (..)
    ,EmptyInputStringsInToRTimestamp (..)    
    ,UnsupportedTimeStampFormat (..)
    ,UniquenessViolationInUpsert (..)
    --,RTimestampFormatLengthMismatch (..)


    -- * 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 (find, filter, 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 Data.Time.Clock (UTCTime(..), diffTimeToPicoseconds, secondsToDiffTime)
import Data.Time.Calendar (Day, toGregorian, fromGregorian)

-- 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 :: RTable -> RTable
myRTableOperation RTable
rtab = do
       RTuple
rtup <- RTable
rtab
       let new_rtup :: RTuple
new_rtup = RTuple -> RTuple
doStuff RTuple
rtup
       RTuple -> RTable
forall (m :: * -> *) a. Monad m => a -> m a
return RTuple
new_rtup
   where
       doStuff :: RTuple -> RTuple
       doStuff :: RTuple -> RTuple
doStuff = RTuple -> RTuple
forall a. HasCallStack => a
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 :: RTable -> [RTuple]
rtableToList = RTable -> [RTuple]
forall a. Vector a -> [a]
V.toList

-- | Creates an RTable from a list of RTuples

rtableFromList :: [RTuple] -> RTable
rtableFromList :: [RTuple] -> RTable
rtableFromList = [RTuple] -> RTable
forall a. [a] -> Vector a
V.fromList

-- | Turns an RTuple to a List

rtupleToList :: RTuple -> [(ColumnName, RDataType)]
rtupleToList :: RTuple -> [(ColumnName, RDataType)]
rtupleToList = RTuple -> [(ColumnName, RDataType)]
forall k v. HashMap k v -> [(k, v)]
HM.toList

-- | Create an RTuple from a list

rtupleFromList :: [(ColumnName, RDataType)] -> RTuple 
rtupleFromList :: [(ColumnName, RDataType)] -> RTuple
rtupleFromList = [(ColumnName, RDataType)] -> RTuple
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
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 = UknownType | Integer | Varchar | Date Text | Timestamp Text | Double  deriving (Int -> ColumnDType -> ShowS
[ColumnDType] -> ShowS
ColumnDType -> String
(Int -> ColumnDType -> ShowS)
-> (ColumnDType -> String)
-> ([ColumnDType] -> ShowS)
-> Show ColumnDType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnDType] -> ShowS
$cshowList :: [ColumnDType] -> ShowS
show :: ColumnDType -> String
$cshow :: ColumnDType -> String
showsPrec :: Int -> ColumnDType -> ShowS
$cshowsPrec :: Int -> ColumnDType -> ShowS
Show, ColumnDType -> ColumnDType -> Bool
(ColumnDType -> ColumnDType -> Bool)
-> (ColumnDType -> ColumnDType -> Bool) -> Eq ColumnDType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnDType -> ColumnDType -> Bool
$c/= :: ColumnDType -> ColumnDType -> Bool
== :: ColumnDType -> ColumnDType -> Bool
$c== :: ColumnDType -> ColumnDType -> Bool
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 { RDataType -> Integer
rint :: !Integer }
      | RText { RDataType -> ColumnName
rtext :: !T.Text }
      | RUTCTime { RDataType -> UTCTime
rutct :: !UTCTime}
      | RDate { 
                RDataType -> ColumnName
rdate :: !T.Text
               ,RDataType -> ColumnName
dtformat :: !Text  -- ^ e.g., "DD\/MM\/YYYY"

            }
      | RTime { RDataType -> RTimestamp
rtime :: !RTimestamp  }
      | RDouble { RDataType -> Double
rdouble :: !Double }
    -- RFloat  { rfloat :: Float }

      | Null
      deriving (Int -> RDataType -> ShowS
[RDataType] -> ShowS
RDataType -> String
(Int -> RDataType -> ShowS)
-> (RDataType -> String)
-> ([RDataType] -> ShowS)
-> Show RDataType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RDataType] -> ShowS
$cshowList :: [RDataType] -> ShowS
show :: RDataType -> String
$cshow :: RDataType -> String
showsPrec :: Int -> RDataType -> ShowS
$cshowsPrec :: Int -> RDataType -> ShowS
Show, ReadPrec [RDataType]
ReadPrec RDataType
Int -> ReadS RDataType
ReadS [RDataType]
(Int -> ReadS RDataType)
-> ReadS [RDataType]
-> ReadPrec RDataType
-> ReadPrec [RDataType]
-> Read RDataType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RDataType]
$creadListPrec :: ReadPrec [RDataType]
readPrec :: ReadPrec RDataType
$creadPrec :: ReadPrec RDataType
readList :: ReadS [RDataType]
$creadList :: ReadS [RDataType]
readsPrec :: Int -> ReadS RDataType
$creadsPrec :: Int -> ReadS RDataType
Read, (forall x. RDataType -> Rep RDataType x)
-> (forall x. Rep RDataType x -> RDataType) -> Generic RDataType
forall x. Rep RDataType x -> RDataType
forall x. RDataType -> Rep RDataType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RDataType x -> RDataType
$cfrom :: forall x. RDataType -> Rep RDataType x
Generic, TB.Typeable)   -- http://stackoverflow.com/questions/6600380/what-is-haskells-data-typeable



-- deriving instance Generic RDataType 


-- instance Show RDataType where

--     show _ = "hello" 


-- instance Read RDataType where

--     readsPrec _ input = 

--         case input of

--             'R':'N':'u':'m':rest -> [(read rest), ""]

--             _ -> []


-- | 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 Integer
i1 == :: RDataType -> RDataType -> Bool
== RInt Integer
i2 = Integer
i1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i2
    -- RInt i == _ = False

    RText ColumnName
t1 == RText ColumnName
t2 = ColumnName
t1 ColumnName -> ColumnName -> Bool
forall a. Eq a => a -> a -> Bool
== ColumnName
t2
    -- RText t1 == _ = False

    RDate ColumnName
t1 ColumnName
s1 == RDate ColumnName
t2 ColumnName
s2 = String -> String -> RTimestamp
toRTimestamp (ColumnName -> String
unpack ColumnName
s1) (ColumnName -> String
unpack ColumnName
t1) RTimestamp -> RTimestamp -> Bool
forall a. Eq a => a -> a -> Bool
== String -> String -> RTimestamp
toRTimestamp (ColumnName -> String
unpack ColumnName
s2) (ColumnName -> String
unpack ColumnName
t2)   -- (t1 == t1) && (s1 == s2)

    -- RDate t1 s1 == _ = False

    RTime RTimestamp
t1 == RTime RTimestamp
t2 = RTimestamp
t1 RTimestamp -> RTimestamp -> Bool
forall a. Eq a => a -> a -> Bool
== RTimestamp
t2
    -- RTime t1 == _ = False

    RDouble Double
d1 == RDouble Double
d2 = Double
d1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
d2
    -- RDouble d1 == _ = False

    -- Watch out: NULL logic (anything compared to NULL returns false)

    RDataType
Null == RDataType
Null = Bool
False
    RDataType
_ == RDataType
Null = Bool
False
    RDataType
Null == RDataType
_ = Bool
False
    -- anything else is just False

    RDataType
_ == RDataType
_ = Bool
False

    RDataType
Null /= :: RDataType -> RDataType -> Bool
/= RDataType
Null = Bool
False
    RDataType
_ /= RDataType
Null = Bool
False
    RDataType
Null /= RDataType
_ = Bool
False
    RDataType
x /= RDataType
y = Bool -> Bool
not (RDataType
x RDataType -> RDataType -> Bool
forall a. Eq a => a -> a -> Bool
== RDataType
y) 

-- Need to explicitly specify due to "Null logic" (see Eq)

instance Ord RDataType where    
    compare :: RDataType -> RDataType -> Ordering
compare RDataType
Null RDataType
_ = Ordering
GT     --    Null <= _ = False

    compare RDataType
_ RDataType
Null = Ordering
GT     --  _ <= Null = False

    -- Null <= Null = False -- Comment out due to redundant warning

    compare (RInt Integer
i1) (RInt Integer
i2) = Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
i1 Integer
i2                                             --  RInt i1 <= RInt i2 = i1 <= i2

    compare (RText ColumnName
t1) (RText ColumnName
t2) = ColumnName -> ColumnName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ColumnName
t1 ColumnName
t2                                           --  RText t1 <= RText t2 = t1 <= t2

    compare (RDate ColumnName
t1 ColumnName
s1) (RDate ColumnName
t2 ColumnName
s2) = RTimestamp -> RTimestamp -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> RTimestamp
toRTimestamp (ColumnName -> String
unpack ColumnName
s1) (ColumnName -> String
unpack ColumnName
t1)) (String -> String -> RTimestamp
toRTimestamp (ColumnName -> String
unpack ColumnName
s2) (ColumnName -> String
unpack ColumnName
t2)) --  RDate t1 s1 <= RDate t2 s2 = (t1 <= t1) && (s1 == s2)

    compare (RTime RTimestamp
t1) (RTime RTimestamp
t2) = RTimestamp -> RTimestamp -> Ordering
forall a. Ord a => a -> a -> Ordering
compare RTimestamp
t1 RTimestamp
t2                                           --  RTime t1 <= RTime t2 = t1 <= t2

    -- RTime t1 <= _ = False

    compare (RDouble Double
d1) (RDouble Double
d2) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
d1 Double
d2                                       --  RDouble d1 <= RDouble d2 = d1 <= d2

    -- anything else is just False

    compare RDataType
_ RDataType
_ = Ordering
GT                                                                        --  _ <= _ = 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 :: RDataType -> Bool
isNull RDataType
x = 
    case RDataType
x of
        RDataType
Null -> Bool
True
        RDataType
_    -> Bool
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 :: RDataType -> Bool
isNotNull = Bool -> Bool
not (Bool -> Bool) -> (RDataType -> Bool) -> RDataType -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDataType -> Bool
isNull

instance Num RDataType where
    + :: RDataType -> RDataType -> RDataType
(+) (RInt Integer
i1) (RInt Integer
i2) = Integer -> RDataType
RInt (Integer
i1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i2)
    (+) (RDouble Double
d1) (RDouble Double
d2) = Double -> RDataType
RDouble (Double
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
d2)
    (+) (RDouble Double
d1) (RInt Integer
i2) = Double -> RDataType
RDouble (Double
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
    (+) (RInt Integer
i1) (RDouble Double
d2) = Double -> RDataType
RDouble (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
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 Integer
i1) (RDataType
Null) = RDataType
Null
    (+) (RDataType
Null) (RInt Integer
i2) = RDataType
Null
    (+) (RDouble Double
d1) (RDataType
Null) = RDataType
Null
    (+) (RDataType
Null) (RDouble Double
d2) = RDataType
Null
    (+) RDataType
_ RDataType
_ = RDataType
Null
    * :: RDataType -> RDataType -> RDataType
(*) (RInt Integer
i1) (RInt Integer
i2) = Integer -> RDataType
RInt (Integer
i1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i2)
    (*) (RDouble Double
d1) (RDouble Double
d2) = Double -> RDataType
RDouble (Double
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d2)
    (*) (RDouble Double
d1) (RInt Integer
i2) = Double -> RDataType
RDouble (Double
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
    (*) (RInt Integer
i1) (RDouble Double
d2) = Double -> RDataType
RDouble (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
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 Integer
i1) (RDataType
Null) = RDataType
Null
    (*) (RDataType
Null) (RInt Integer
i2) = RDataType
Null
    (*) (RDouble Double
d1) (RDataType
Null) = RDataType
Null
    (*) (RDataType
Null) (RDouble Double
d2) = RDataType
Null
    (*) RDataType
_ RDataType
_ = RDataType
Null
    abs :: RDataType -> RDataType
abs (RInt Integer
i) = Integer -> RDataType
RInt (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
    abs (RDouble Double
i) = Double -> RDataType
RDouble (Double -> Double
forall a. Num a => a -> a
abs Double
i)
    abs RDataType
_ = RDataType
Null
    signum :: RDataType -> RDataType
signum (RInt Integer
i) = Integer -> RDataType
RInt (Integer -> Integer
forall a. Num a => a -> a
signum Integer
i)
    signum (RDouble Double
i) = Double -> RDataType
RDouble (Double -> Double
forall a. Num a => a -> a
signum Double
i)
    signum RDataType
_ = RDataType
Null
    fromInteger :: Integer -> RDataType
fromInteger Integer
i = Integer -> RDataType
RInt Integer
i
    negate :: RDataType -> RDataType
negate (RInt Integer
i) = Integer -> RDataType
RInt (Integer -> Integer
forall a. Num a => a -> a
negate Integer
i)
    negate (RDouble Double
i) = Double -> RDataType
RDouble (Double -> Double
forall a. Num a => a -> a
negate Double
i)
    negate RDataType
_ = RDataType
Null

-- | In order to be able to use (/) with RDataType

instance Fractional RDataType where
    / :: RDataType -> RDataType -> RDataType
(/) (RInt Integer
i1) (RInt Integer
i2) = Double -> RDataType
RDouble (Double -> RDataType) -> Double -> RDataType
forall a b. (a -> b) -> a -> b
$ (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
    (/) (RDouble Double
d1) (RInt Integer
i2) = Double -> RDataType
RDouble (Double -> RDataType) -> Double -> RDataType
forall a b. (a -> b) -> a -> b
$ (Double
d1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i2)
    (/) (RInt Integer
i1) (RDouble Double
d2) = Double -> RDataType
RDouble (Double -> RDataType) -> Double -> RDataType
forall a b. (a -> b) -> a -> b
$ (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
d2)
    (/) (RDouble Double
d1) (RDouble Double
d2) = Double -> RDataType
RDouble (Double -> RDataType) -> Double -> RDataType
forall a b. (a -> b) -> a -> b
$ Double
d1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
d2
    (/) RDataType
_ RDataType
_ = RDataType
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 :: Rational -> RDataType
fromRational Rational
r = Double -> RDataType
RDouble (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)

-- | Standard date format

stdDateFormat :: String
stdDateFormat = String
"DD/MM/YYYY"

-- | Get the Column Names of an RTable

getColumnNamesFromRTab :: RTable -> [ColumnName]
getColumnNamesFromRTab :: RTable -> [ColumnName]
getColumnNamesFromRTab RTable
rtab = RTuple -> [ColumnName]
getColumnNamesFromRTuple (RTuple -> [ColumnName]) -> RTuple -> [ColumnName]
forall a b. (a -> b) -> a -> b
$ RTable -> RTuple
headRTup RTable
rtab

-- | Returns the Column Names of an RTuple

getColumnNamesFromRTuple :: RTuple -> [ColumnName]
getColumnNamesFromRTuple :: RTuple -> [ColumnName]
getColumnNamesFromRTuple RTuple
t = RTuple -> [ColumnName]
forall k v. HashMap k v -> [k]
HM.keys RTuple
t

-- Get the column metadata of an 'RTable'

getColumnInfoFromRTab :: RTable -> [ColumnInfo]
getColumnInfoFromRTab :: RTable -> [ColumnInfo]
getColumnInfoFromRTab RTable
rtab = RTuple -> [ColumnInfo]
getColumnInfoFromRTuple (RTuple -> [ColumnInfo]) -> RTuple -> [ColumnInfo]
forall a b. (a -> b) -> a -> b
$ RTable -> RTuple
headRTup RTable
rtab

-- Get the column metadata of an 'RTuple'

getColumnInfoFromRTuple :: RTuple -> [ColumnInfo]
getColumnInfoFromRTuple :: RTuple -> [ColumnInfo]
getColumnInfoFromRTuple  RTuple
t = 
   HashMap ColumnName ColumnInfo -> [ColumnInfo]
forall k v. HashMap k v -> [v]
HM.elems (HashMap ColumnName ColumnInfo -> [ColumnInfo])
-> HashMap ColumnName ColumnInfo -> [ColumnInfo]
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RDataType -> ColumnInfo)
-> RTuple -> HashMap ColumnName ColumnInfo
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\ColumnName
c RDataType
v -> ColumnInfo :: ColumnName -> ColumnDType -> ColumnInfo
ColumnInfo { name :: ColumnName
name = ColumnName
c, dtype :: ColumnDType
dtype = RDataType -> ColumnDType
getTheType RDataType
v}) RTuple
t 

-- | Take a column value and return its type

getTheType :: RDataType -> ColumnDType
getTheType :: RDataType -> ColumnDType
getTheType RDataType
v = 
    case RDataType
v of
        RInt Integer
_                           ->  ColumnDType
Integer
        RText ColumnName
_                          ->  ColumnDType
Varchar
        RDate {rdate :: RDataType -> ColumnName
rdate = ColumnName
d, dtformat :: RDataType -> ColumnName
dtformat = ColumnName
f}  ->  ColumnName -> ColumnDType
Date ColumnName
f 
        RTime RTimestamp
_                          ->  ColumnName -> ColumnDType
Timestamp (String -> ColumnName
pack String
stdTimestampFormat)
        RDouble Double
_                        ->  ColumnDType
Double
        RDataType
Null                             ->  ColumnDType
UknownType

-- | Get the first RTuple from an RTable

headRTup ::
        RTable
    ->  RTuple
headRTup :: RTable -> RTuple
headRTup = RTable -> RTuple
forall a. Vector a -> a
V.head    

-- | 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 :: ColumnName -> RTuple -> Maybe RDataType
rtupLookup =  ColumnName -> RTuple -> Maybe RDataType
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
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 :: RDataType -> ColumnName -> RTuple -> RDataType
rtupLookupDefault =  RDataType -> ColumnName -> RTuple -> RDataType
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
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 :: ColumnName -> RTuple -> RDataType
getRTupColValue =  RDataType -> ColumnName -> RTuple -> RDataType
rtupLookupDefault RDataType
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

<!> :: RTuple -> ColumnName -> RDataType
(<!>) RTuple
t ColumnName
c = -- flip getRTupColValue

       -- (HM.!)

       case ColumnName -> RTuple -> Maybe RDataType
rtupLookup ColumnName
c RTuple
t of
            Just RDataType
v -> RDataType
v
            Maybe RDataType
Nothing -> ColumnDoesNotExist -> RDataType
forall a e. Exception e => e -> a
throw (ColumnDoesNotExist -> RDataType)
-> ColumnDoesNotExist -> RDataType
forall a b. (a -> b) -> a -> b
$ ColumnName -> ColumnDoesNotExist
ColumnDoesNotExist ColumnName
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

<!!> :: RTuple -> ColumnName -> Maybe RDataType
(<!!>) RTuple
t ColumnName
c = ColumnName -> RTuple -> Maybe RDataType
rtupLookup ColumnName
c RTuple
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 :: RDataType -> RDataType -> RDataType
nvl RDataType
v RDataType
defaultVal = 
    if RDataType -> Bool
isNull RDataType
v
        then RDataType
defaultVal
        else RDataType
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 :: ColumnName -> RDataType -> RTuple -> RDataType
nvlColValue ColumnName
col RDataType
defaultVal RTuple
tup = 
    if RTuple -> Bool
isRTupEmpty RTuple
tup
        then RDataType
Null
        else 
            case RTuple
tup RTuple -> ColumnName -> RDataType
<!> ColumnName
col of
                RDataType
Null   -> RDataType
defaultVal
                RDataType
val    -> RDataType
val 

data IgnoreDefault = Ignore | NotIgnore deriving (IgnoreDefault -> IgnoreDefault -> Bool
(IgnoreDefault -> IgnoreDefault -> Bool)
-> (IgnoreDefault -> IgnoreDefault -> Bool) -> Eq IgnoreDefault
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IgnoreDefault -> IgnoreDefault -> Bool
$c/= :: IgnoreDefault -> IgnoreDefault -> Bool
== :: IgnoreDefault -> IgnoreDefault -> Bool
$c== :: IgnoreDefault -> IgnoreDefault -> Bool
Eq, Int -> IgnoreDefault -> ShowS
[IgnoreDefault] -> ShowS
IgnoreDefault -> String
(Int -> IgnoreDefault -> ShowS)
-> (IgnoreDefault -> String)
-> ([IgnoreDefault] -> ShowS)
-> Show IgnoreDefault
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IgnoreDefault] -> ShowS
$cshowList :: [IgnoreDefault] -> ShowS
show :: IgnoreDefault -> String
$cshow :: IgnoreDefault -> String
showsPrec :: Int -> IgnoreDefault -> ShowS
$cshowsPrec :: Int -> IgnoreDefault -> ShowS
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 :: ColumnName
-> RDataType
-> RDataType
-> RDataType
-> IgnoreDefault
-> RTuple
-> RDataType
decodeColValue ColumnName
cname RDataType
searchVal RDataType
returnVal RDataType
defaultVal IgnoreDefault
ignoreInd RTuple
tup = 
    if RTuple -> Bool
isRTupEmpty RTuple
tup
        then RDataType
Null
        else 
{-
            case tup <!> cname of
                searchVal   -> returnVal
                v           -> if ignoreInd == Ignore then v else defaultVal 
-}
            if RTuple
tup RTuple -> ColumnName -> RDataType
<!> ColumnName
cname RDataType -> RDataType -> Bool
forall a. Eq a => a -> a -> Bool
== RDataType
searchVal
                then RDataType
returnVal
                else
                    if IgnoreDefault
ignoreInd IgnoreDefault -> IgnoreDefault -> Bool
forall a. Eq a => a -> a -> Bool
== IgnoreDefault
Ignore
                        then RTuple
tup RTuple -> ColumnName -> RDataType
<!> ColumnName
cname
                        else RDataType
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 :: ColumnName -> RDataType -> RTuple -> RTuple
nvlRTuple ColumnName
c RDataType
defaultVal RTuple
tup  = 
    if RTuple -> Bool
isRTupEmpty RTuple
tup
       then RTuple
emptyRTuple
       else (RDataType -> RDataType) -> RTuple -> RTuple
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (\RDataType
v -> RDataType -> RDataType -> RDataType
nvl RDataType
v RDataType
defaultVal) RTuple
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 :: ColumnName -> RDataType -> RTable -> RTable
nvlRTable ColumnName
c RDataType
defaultVal RTable
tab  = 
    if RTable -> Bool
isRTabEmpty RTable
tab
        then RTable
emptyRTable
        else
            (RTuple -> RTuple) -> RTable -> RTable
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\RTuple
t -> ColumnName -> RDataType -> RTuple -> RTuple
upsertRTuple ColumnName
c (ColumnName -> RDataType -> RTuple -> RDataType
nvlColValue ColumnName
c RDataType
defaultVal RTuple
t) RTuple
t) RTable
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 :: ColumnName
-> RDataType
-> RDataType
-> RDataType
-> IgnoreDefault
-> RTable
-> RTable
decodeRTable ColumnName
cName RDataType
searchVal RDataType
returnVal RDataType
defaultVal IgnoreDefault
ignoreInd RTable
tab = 
    if RTable -> Bool
isRTabEmpty RTable
tab
        then RTable
emptyRTable
        else
            (RTuple -> RTuple) -> RTable -> RTable
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\RTuple
t -> ColumnName -> RDataType -> RTuple -> RTuple
upsertRTuple ColumnName
cName (ColumnName
-> RDataType
-> RDataType
-> RDataType
-> IgnoreDefault
-> RTuple
-> RDataType
decodeColValue ColumnName
cName RDataType
searchVal RDataType
returnVal RDataType
defaultVal IgnoreDefault
ignoreInd RTuple
t) RTuple
t) RTable
tab   

-- 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 :: RDataType -> RDataType
stripRText (RText ColumnName
t) = ColumnName -> RDataType
RText (ColumnName -> RDataType) -> ColumnName -> RDataType
forall a b. (a -> b) -> a -> b
$ ColumnName -> ColumnName
T.strip ColumnName
t
stripRText RDataType
_ = RDataType
Null

-- | Concatenates two Text 'RDataTypes', in all other cases of 'RDataType' it returns 'Null'.

rdtappend :: 
    RDataType 
    -> RDataType
    -> RDataType
rdtappend :: RDataType -> RDataType -> RDataType
rdtappend (RText ColumnName
t1) (RText ColumnName
t2) = ColumnName -> RDataType
RText (ColumnName
t1 ColumnName -> ColumnName -> ColumnName
`T.append` ColumnName
t2)
rdtappend RDataType
_ RDataType
_ = RDataType
Null


-- | Helper function to remove a character around (from both beginning and end) of an (RText t) value

removeCharAroundRText :: Char -> RDataType -> RDataType
removeCharAroundRText :: Char -> RDataType -> RDataType
removeCharAroundRText Char
ch (RText ColumnName
t) = ColumnName -> RDataType
RText (ColumnName -> RDataType) -> ColumnName -> RDataType
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ColumnName -> ColumnName
T.dropAround (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
ch) ColumnName
t
removeCharAroundRText Char
ch RDataType
_ = RDataType
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 {
            RTimestamp -> Int
year :: !Int
            ,RTimestamp -> Int
month :: !Int
            ,RTimestamp -> Int
day :: !Int
            ,RTimestamp -> Int
hours24 :: !Int
            ,RTimestamp -> Int
minutes :: !Int
            ,RTimestamp -> Int
seconds :: !Int
        } deriving (Int -> RTimestamp -> ShowS
[RTimestamp] -> ShowS
RTimestamp -> String
(Int -> RTimestamp -> ShowS)
-> (RTimestamp -> String)
-> ([RTimestamp] -> ShowS)
-> Show RTimestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RTimestamp] -> ShowS
$cshowList :: [RTimestamp] -> ShowS
show :: RTimestamp -> String
$cshow :: RTimestamp -> String
showsPrec :: Int -> RTimestamp -> ShowS
$cshowsPrec :: Int -> RTimestamp -> ShowS
Show, ReadPrec [RTimestamp]
ReadPrec RTimestamp
Int -> ReadS RTimestamp
ReadS [RTimestamp]
(Int -> ReadS RTimestamp)
-> ReadS [RTimestamp]
-> ReadPrec RTimestamp
-> ReadPrec [RTimestamp]
-> Read RTimestamp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RTimestamp]
$creadListPrec :: ReadPrec [RTimestamp]
readPrec :: ReadPrec RTimestamp
$creadPrec :: ReadPrec RTimestamp
readList :: ReadS [RTimestamp]
$creadList :: ReadS [RTimestamp]
readsPrec :: Int -> ReadS RTimestamp
$creadsPrec :: Int -> ReadS RTimestamp
Read, (forall x. RTimestamp -> Rep RTimestamp x)
-> (forall x. Rep RTimestamp x -> RTimestamp) -> Generic RTimestamp
forall x. Rep RTimestamp x -> RTimestamp
forall x. RTimestamp -> Rep RTimestamp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RTimestamp x -> RTimestamp
$cfrom :: forall x. RTimestamp -> Rep RTimestamp x
Generic)


-- | In order to be able to force full evaluation up to Normal Form (NF)

instance NFData RTimestamp


instance Eq RTimestamp where
        RTimestampVal Int
y1 Int
m1 Int
d1 Int
h1 Int
mi1 Int
s1 == :: RTimestamp -> RTimestamp -> Bool
==  RTimestampVal Int
y2 Int
m2 Int
d2 Int
h2 Int
mi2 Int
s2 = 
            Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y2 Bool -> Bool -> Bool
&& Int
m1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m2 Bool -> Bool -> Bool
&& Int
d1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
d2 Bool -> Bool -> Bool
&& Int
h1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
h2 Bool -> Bool -> Bool
&& Int
mi1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
mi2 Bool -> Bool -> Bool
&& Int
s1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s2

instance Ord RTimestamp where
    -- compare :: a -> a -> Ordering

    compare :: RTimestamp -> RTimestamp -> Ordering
compare (RTimestampVal Int
y1 Int
m1 Int
d1 Int
h1 Int
mi1 Int
s1) (RTimestampVal Int
y2 Int
m2 Int
d2 Int
h2 Int
mi2 Int
s2) = 
        if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
y1 Int
y2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ 
            then Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
y1 Int
y2
            else 
                if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
m1 Int
m2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ 
                    then Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
m1 Int
m2
                    else if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
d1 Int
d2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ
                            then Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
d1 Int
d2
                            else if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
h1 Int
h2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ
                                    then Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
h1 Int
h2
                                    else if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
mi1 Int
mi2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ
                                            then Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
mi1 Int
mi2
                                            else if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
s1 Int
s2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ
                                                    then Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
s1 Int
s2
                                                    else Ordering
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 :: String -> String -> RTimestamp
toRTimestamp String
fmt String
stime = 
    -- if (Data.List.length fmt) /= (Data.List.length stime)

    --     then throw $ RTimestampFormatLengthMismatch fmt stime

    --     else

    if String
fmt String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
|| String
stime String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== []
        then EmptyInputStringsInToRTimestamp -> RTimestamp
forall a e. Exception e => e -> a
throw (EmptyInputStringsInToRTimestamp -> RTimestamp)
-> EmptyInputStringsInToRTimestamp -> RTimestamp
forall a b. (a -> b) -> a -> b
$ String -> String -> EmptyInputStringsInToRTimestamp
EmptyInputStringsInToRTimestamp String
fmt String
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 :: HashMap String String
elemMap = String -> String -> HashMap String String -> HashMap String String
parseFormat2 String
fmt String
stime HashMap String String
forall k v. HashMap k v
HM.empty

                -- year

                y :: Int
y = case String -> HashMap String String -> Maybe String
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup String
"YYYY" HashMap String String
elemMap of
                        Maybe String
Nothing -> Int
1 :: Int 
                        Just String
yyyy  ->   (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
yyyy String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
                                        Int -> Int -> Int
forall a. Num a => a -> a -> a
+   (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
yyyy String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
1)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100) 
                                        Int -> Int -> Int
forall a. Num a => a -> a -> a
+   (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
yyyy String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
2)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10)
                                        Int -> Int -> Int
forall a. Num a => a -> a -> a
+   (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
yyyy String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
3))
                -- round to 1 - 9999

                year :: Int
year = case Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
9999 of 
                    Int
0 -> Int
9999
                    Int
yv -> Int
yv

                -- month

                mo :: Int
mo = case String -> HashMap String String -> Maybe String
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup String
"MM" HashMap String String
elemMap of
                        Maybe String
Nothing ->  Int
1 :: Int
                        Just String
mm  ->  -- Also take care the case where mm < 10 and is not given as two digits e.g., '03' but '3'

                                    if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
mm Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                                        then (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
mm String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1)
                                        else
                                            (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
mm String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10)
                                            Int -> Int -> Int
forall a. Num a => a -> a -> a
+  (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
mm String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
1)) 
                -- round to 1 - 12 values 

                month :: Int
month = case Int
mo Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
12 of
                            Int
0  -> Int
12
                            Int
mv -> Int
mv

                -- day                            

                d :: Int
d = case String -> HashMap String String -> Maybe String
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup String
"DD" HashMap String String
elemMap of
                        Maybe String
Nothing ->  Int
1 :: Int
                        Just String
dd ->  -- Also take care the case where dd < 10 and is not given as two digits e.g., '03' but '3'

                                    if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
dd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                                        then (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
dd String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1)
                                        else
                                            (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
dd String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10)
                                            Int -> Int -> Int
forall a. Num a => a -> a -> a
+  (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
dd String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
1)) 
                -- round to 1 - 31 values 

                day :: Int
day = case Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
31 of
                            Int
0  -> Int
31
                            Int
dv -> Int
dv

                -- hour

                h :: Int
h = case String -> HashMap String String -> Maybe String
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup String
"HH" HashMap String String
elemMap of
                        Maybe String
Nothing ->  Int
0 :: Int
                        Just String
hh ->  -- Also take care the case where hh < 10 and is not given as two digits e.g., '03' but '3'

                                    if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
hh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                                        then (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
hh String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1)
                                        else
                                            (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
hh String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10)
                                            Int -> Int -> Int
forall a. Num a => a -> a -> a
+  (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
hh String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
1)) 
                -- round to 0 - 23 values 

                hour :: Int
hour = Int
h Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
24 

                -- minutes

                m :: Int
m = case String -> HashMap String String -> Maybe String
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup String
"MI" HashMap String String
elemMap of
                        Maybe String
Nothing ->  Int
0 :: Int
                        Just String
mi ->  -- Also take care the case where mi < 10 and is not given as two digits e.g., '03' but '3'

                                    if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
mi Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                                        then (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
mi String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1)
                                        else
                                            (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
mi String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10)
                                            Int -> Int -> Int
forall a. Num a => a -> a -> a
+  (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
mi String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
1)) 
                -- round to 0 - 59 values 

                min :: Int
min = Int
m Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
60 


                -- seconds

                s :: Int
s = case String -> HashMap String String -> Maybe String
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup String
"SS" HashMap String String
elemMap of
                        Maybe String
Nothing ->  Int
0 :: Int
                        Just String
ss ->  -- Also take care the case where mi < 10 and is not given as two digits e.g., '03' but '3'

                                    if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                                        then (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
ss String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1)
                                        else
                                            (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
ss String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
0)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10)
                                            Int -> Int -> Int
forall a. Num a => a -> a -> a
+  (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
digitToInt (Char -> Int) -> Char -> Int
forall a b. (a -> b) -> a -> b
$ (String
ss String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
1)) 
                -- round to 0 - 59 values 

                sec :: Int
sec = Int
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
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 :: Int -> Int -> Int -> Int -> Int -> Int -> RTimestamp
RTimestampVal {
                                year :: Int
year = Int
year
                                ,month :: Int
month = Int
month
                                ,day :: Int
day = Int
day
                                ,hours24 :: Int
hours24 = Int
hour
                                ,minutes :: Int
minutes = Int
min
                                ,seconds :: Int
seconds = Int
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 :: String -> String -> HashMap String String -> HashMap String String
parseFormat2 [] String
_ HashMap String String
currMap = HashMap String String
currMap
        parseFormat2 String
fmt String
tstamp HashMap String String
currMap =
            let
                -- search for the format keywords (in each iteration)

                keywords :: [String]
keywords = [String
"YYYY",String
"MM", String
"DD", String
"HH", String
"MI", String
"SS"]
                positions :: [Maybe Int]
positions = (String -> Maybe Int) -> [String] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\String
subs -> String -> String -> Maybe Int
forall a. Eq a => [a] -> [a] -> Maybe Int
instr String
subs String
fmt) [String]
keywords

                -- get from format string the first substring  of letter characters

                (String
fmtElement, String
restFormat) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.span (\Char
c -> Char -> Bool
isAlpha Char
c) String
fmt
                -- remove prefix non-Alpha characters from rest

                restFormatFinal :: String
restFormatFinal = (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.span (\Char
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isAlpha Char
c) String
restFormat
                -- get from tstamp string the first substring  of number characters

                (String
tmElement, String
restTstamp) =  (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.span (\Char
c -> Char -> Bool
isDigit Char
c) String
tstamp
                -- remove prefix non-Digit characters from rest

                restTstampFinal :: String
restTstampFinal = (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.span (\Char
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isDigit Char
c) String
restTstamp
                -- insert into map the pair 

                newMap :: HashMap String String
newMap = String -> String -> HashMap String String -> HashMap String String
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert String
fmtElement String
tmElement HashMap String String
currMap
            in 
                -- if no keyword found then throw an exception

                if (Maybe Int -> Bool) -> [Maybe Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Data.List.all (\Maybe Int
t -> Maybe Int
t Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
forall a. Maybe a
Nothing) ([Maybe Int] -> Bool) -> [Maybe Int] -> Bool
forall a b. (a -> b) -> a -> b
$ [Maybe Int]
positions
                    then UnsupportedTimeStampFormat -> HashMap String String
forall a e. Exception e => e -> a
throw (UnsupportedTimeStampFormat -> HashMap String String)
-> UnsupportedTimeStampFormat -> HashMap String String
forall a b. (a -> b) -> a -> b
$ String -> UnsupportedTimeStampFormat
UnsupportedTimeStampFormat String
fmt
                    else String -> String -> HashMap String String -> HashMap String String
parseFormat2 String
restFormatFinal String
restTstampFinal HashMap String String
newMap

-- | Convert an 'RTimestamp' value to a Universal Time value ('UTCTime')

toUTCTime :: RTimestamp -> UTCTime
toUTCTime :: RTimestamp -> UTCTime
toUTCTime (RTimestampVal Int
yy Int
mm Int
dd Int
hh24 Int
mins Int
ss) =
    let day :: Day
day = Integer -> Int -> Int -> Day
fromGregorian (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
yy::Integer) Int
mm Int
dd
        secs :: DiffTime
secs = Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
hh24Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mmInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ss  :: Integer)
    in Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
secs 

-- | Convert a Universal Time value ('UTCTime') to an 'RTimestamp' value

fromUTCTime :: UTCTime -> RTimestamp
fromUTCTime :: UTCTime -> RTimestamp
fromUTCTime UTCTime
utc = 
    let UTCTime Day
day DiffTime
s = UTCTime
utc
        secs :: Int
secs =  Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ ((Double
1.0e-12::Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ (Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ DiffTime -> Integer
diffTimeToPicoseconds DiffTime
s)  ::Int
        (Integer
yy, Int
mm, Int
dd) = Day -> (Integer, Int, Int)
toGregorian Day
day
        hh24 :: Int
hh24 = (Int
secs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
60) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
60
        mins :: Int
mins =  (Int
secs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
60) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
60
        ss :: Int
ss = (Int
secs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` (Int
60Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
60
    in -- RTimestampVal (fromIntegral yy) mm dd hh24 mins ss

        RTimestampVal :: Int -> Int -> Int -> Int -> Int -> Int -> RTimestamp
RTimestampVal {year :: Int
year = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
yy), month :: Int
month = Int
mm, day :: Int
day = Int
dd, hours24 :: Int
hours24 = Int
hh24, minutes :: Int
minutes = Int
mins, seconds :: Int
seconds = Int
ss}

-- | 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 :: [a] -> [a] -> Maybe Int
instr [a]
subs [a]
s = ([a] -> Bool) -> [[a]] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
Data.List.findIndex ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
Data.List.isPrefixOf [a]
subs) ([[a]] -> Maybe Int) -> [[a]] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. [a] -> [[a]]
Data.List.tails [a]
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 :: ColumnName -> ColumnName -> Maybe Int
instrText ColumnName
subs ColumnName
s = String -> String -> Maybe Int
forall a. Eq a => [a] -> [a] -> Maybe Int
instr (ColumnName -> String
T.unpack ColumnName
subs) (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ColumnName -> String
T.unpack ColumnName
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 :: RDataType -> RDataType -> Maybe Int
instrRText (RText ColumnName
subs) (RText ColumnName
s) = ColumnName -> ColumnName -> Maybe Int
instrText ColumnName
subs ColumnName
s
instrRText RDataType
_ RDataType
_ = Maybe Int
forall a. Maybe a
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 :: String -> String -> RTimestamp
createRTimestamp String
fmt String
timeVal = String -> String -> RTimestamp
toRTimestamp String
fmt String
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 :: RDataType -> Maybe ColumnName
toText (RText ColumnName
t) = ColumnName -> Maybe ColumnName
forall a. a -> Maybe a
Just ColumnName
t
toText RDataType
_ = Maybe ColumnName
forall a. Maybe a
Nothing

-- | Return an 'RDataType' from 'Text'

fromText :: T.Text -> RDataType
fromText :: ColumnName -> RDataType
fromText ColumnName
t = ColumnName -> RDataType
RText ColumnName
t

-- | Returns 'True' only if this is an 'RText'

isText :: RDataType -> Bool
isText :: RDataType -> Bool
isText (RText ColumnName
t) = Bool
True
isText RDataType
_ = Bool
False

-- | Standard timestamp format. For example: \"DD/MM/YYYY HH24:MI:SS\"

stdTimestampFormat :: String
stdTimestampFormat = String
"DD/MM/YYYY HH24:MI:SS" :: String

-- | 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 :: String -> RTimestamp -> RDataType
rTimestampToRText String
"DD/MM/YYYY HH24:MI:SS" RTimestamp
ts =  let -- timeString = show (day ts) ++ "/" ++ show (month ts) ++ "/" ++ show (year ts) ++ " " ++ show (hours24 ts) ++ ":" ++ show (minutes ts) ++ ":" ++ show (seconds ts)

                                                    timeString :: String
timeString = Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
day RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
month RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
year RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
hours24 RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
minutes RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
seconds RTimestamp
ts)
                                                    expand :: a -> String
expand a
i = if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 then String
"0"String -> ShowS
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
i) else a -> String
forall a. Show a => a -> String
show a
i
                                                in ColumnName -> RDataType
RText (ColumnName -> RDataType) -> ColumnName -> RDataType
forall a b. (a -> b) -> a -> b
$ String -> ColumnName
T.pack String
timeString
rTimestampToRText String
"YYYYMMDD-HH24.MI.SS" RTimestamp
ts =    let -- timeString = show (year ts) ++ show (month ts) ++ show (day ts) ++ "-" ++ show (hours24 ts) ++ "." ++ show (minutes ts) ++ "." ++ show (seconds ts)

                                                    timeString :: String
timeString = Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
year RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
month RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
day RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
hours24 RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
minutes RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
seconds RTimestamp
ts)
                                                    expand :: a -> String
expand a
i = if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 then String
"0"String -> ShowS
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
i) else a -> String
forall a. Show a => a -> String
show a
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 ColumnName -> RDataType
RText (ColumnName -> RDataType) -> ColumnName -> RDataType
forall a b. (a -> b) -> a -> b
$ String -> ColumnName
T.pack String
timeString
rTimestampToRText String
"YYYYMMDD" RTimestamp
ts =               let 
                                                    timeString :: String
timeString = Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
year RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
month RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
day RTimestamp
ts) 
                                                    expand :: a -> String
expand a
i = if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 then String
"0"String -> ShowS
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
i) else a -> String
forall a. Show a => a -> String
show a
i
                                                in ColumnName -> RDataType
RText (ColumnName -> RDataType) -> ColumnName -> RDataType
forall a b. (a -> b) -> a -> b
$ String -> ColumnName
T.pack String
timeString
rTimestampToRText String
"YYYYMM" RTimestamp
ts =                 let 
                                                    timeString :: String
timeString = Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
year RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
month RTimestamp
ts) 
                                                    expand :: a -> String
expand a
i = if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 then String
"0"String -> ShowS
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
i) else a -> String
forall a. Show a => a -> String
show a
i
                                                in ColumnName -> RDataType
RText (ColumnName -> RDataType) -> ColumnName -> RDataType
forall a b. (a -> b) -> a -> b
$ String -> ColumnName
T.pack String
timeString
rTimestampToRText String
"YYYY" RTimestamp
ts =                   let 
                                                    timeString :: String
timeString = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ RTimestamp -> Int
year RTimestamp
ts -- expand (year ts)

                                                    -- expand i = if i < 10 then "0"++ (show i) else show i

                                                in ColumnName -> RDataType
RText (ColumnName -> RDataType) -> ColumnName -> RDataType
forall a b. (a -> b) -> a -> b
$ String -> ColumnName
T.pack String
timeString

rTimestampToRText String
_ RTimestamp
ts =                        let -- timeString = show (day ts) ++ "/" ++ show (month ts) ++ "/" ++ show (year ts) ++ " " ++ show (hours24 ts) ++ ":" ++ show (minutes ts) ++ ":" ++ show (seconds ts)

                                                    timeString :: String
timeString = Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
day RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
month RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
year RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
hours24 RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
minutes RTimestamp
ts) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
expand (RTimestamp -> Int
seconds RTimestamp
ts)
                                                    expand :: a -> String
expand a
i = if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 then String
"0"String -> ShowS
forall a. [a] -> [a] -> [a]
++ (a -> String
forall a. Show a => a -> String
show a
i) else a -> String
forall a. Show a => a -> String
show a
i
                                                in ColumnName -> RDataType
RText (ColumnName -> RDataType) -> ColumnName -> RDataType
forall a b. (a -> b) -> a -> b
$ String -> ColumnName
T.pack String
timeString


-- | Metadata for an RTable

data RTableMData =  RTableMData {
                        RTableMData -> ColumnName
rtname :: RTableName        -- ^  Name of the 'RTable'

                        ,RTableMData -> RTupleMData
rtuplemdata :: RTupleMData  -- ^ Tuple-level metadata                    

                        -- other metadata

                        ,RTableMData -> [ColumnName]
pkColumns :: [ColumnName] -- ^ Primary Key

                        ,RTableMData -> [[ColumnName]]
uniqueKeys :: [[ColumnName]] -- ^ List of unique keys i.e., each sublist is a unique key column combination

                    } deriving (Int -> RTableMData -> ShowS
[RTableMData] -> ShowS
RTableMData -> String
(Int -> RTableMData -> ShowS)
-> (RTableMData -> String)
-> ([RTableMData] -> ShowS)
-> Show RTableMData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RTableMData] -> ShowS
$cshowList :: [RTableMData] -> ShowS
show :: RTableMData -> String
$cshow :: RTableMData -> String
showsPrec :: Int -> RTableMData -> ShowS
$cshowsPrec :: Int -> RTableMData -> ShowS
Show, RTableMData -> RTableMData -> Bool
(RTableMData -> RTableMData -> Bool)
-> (RTableMData -> RTableMData -> Bool) -> Eq RTableMData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RTableMData -> RTableMData -> Bool
$c/= :: RTableMData -> RTableMData -> Bool
== :: RTableMData -> RTableMData -> Bool
$c== :: RTableMData -> RTableMData -> Bool
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 :: (ColumnName, [(ColumnName, ColumnDType)])
-> [ColumnName] -> [[ColumnName]] -> RTableMData
createRTableMData (ColumnName
n, [(ColumnName, ColumnDType)]
cdts) [ColumnName]
pk [[ColumnName]]
uks = 
        RTableMData :: ColumnName
-> RTupleMData -> [ColumnName] -> [[ColumnName]] -> RTableMData
RTableMData { rtname :: ColumnName
rtname = ColumnName
n, rtuplemdata :: RTupleMData
rtuplemdata = [(ColumnName, ColumnDType)] -> RTupleMData
createRTupleMdata [(ColumnName, ColumnDType)]
cdts, pkColumns :: [ColumnName]
pkColumns = [ColumnName]
pk, uniqueKeys :: [[ColumnName]]
uniqueKeys = [[ColumnName]]
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 :: [(ColumnName, ColumnDType)] -> RTupleMData
createRTupleMdata [(ColumnName, ColumnDType)]
clist = 
    let colNamecolInfo :: [(ColumnName, ColumnInfo)]
colNamecolInfo = ((ColumnName, ColumnDType) -> (ColumnName, ColumnInfo))
-> [(ColumnName, ColumnDType)] -> [(ColumnName, ColumnInfo)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\(ColumnName
n,ColumnDType
t) -> (ColumnName
n, ColumnInfo :: ColumnName -> ColumnDType -> ColumnInfo
ColumnInfo{    name :: ColumnName
name = ColumnName
n 
                                                                    --,colorder = fromJust (elemIndex (n,t) clist)

                                                                    ,dtype :: ColumnDType
dtype = ColumnDType
t 
                                                                })) [(ColumnName, ColumnDType)]
clist
        colOrdercolName :: [(Int, ColumnName)]
colOrdercolName = ((ColumnName, ColumnDType) -> (Int, ColumnName))
-> [(ColumnName, ColumnDType)] -> [(Int, ColumnName)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\(ColumnName
n,ColumnDType
t) -> (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust ((ColumnName, ColumnDType)
-> [(ColumnName, ColumnDType)] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (ColumnName
n,ColumnDType
t) [(ColumnName, ColumnDType)]
clist), ColumnName
n)) [(ColumnName, ColumnDType)]
clist
    in ([(Int, ColumnName)] -> HashMap Int ColumnName
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Int, ColumnName)]
colOrdercolName, [(ColumnName, ColumnInfo)] -> HashMap ColumnName ColumnInfo
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(ColumnName, ColumnInfo)]
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 :: RTupleMData -> [ColumnName]
toListColumnName RTupleMData
rtupmd = 
    let mapColOrdColName :: HashMap Int ColumnName
mapColOrdColName = RTupleMData -> HashMap Int ColumnName
forall a b. (a, b) -> a
fst RTupleMData
rtupmd
        listColOrdColName :: [(Int, ColumnName)]
listColOrdColName = HashMap Int ColumnName -> [(Int, ColumnName)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Int ColumnName
mapColOrdColName  -- generate a list of [ColumnOrdr, ColumnName] in random order

        -- order list based on ColumnOrder

        ordlistColOrdColName :: [(Int, ColumnName)]
ordlistColOrdColName = ((Int, ColumnName) -> Int)
-> [(Int, ColumnName)] -> [(Int, ColumnName)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(Int
o,ColumnName
c) -> Int
o) [(Int, ColumnName)]
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 ((Int, ColumnName) -> ColumnName)
-> [(Int, ColumnName)] -> [ColumnName]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ((Int, ColumnName) -> ColumnName
forall a b. (a, b) -> b
snd) [(Int, ColumnName)]
ordlistColOrdColName

-- | toListColumnInfo: returns a list of RTuple columnInfo, in the fixed column order of the RTuple

toListColumnInfo :: 
    RTupleMData
    -> [ColumnInfo]
toListColumnInfo :: RTupleMData -> [ColumnInfo]
toListColumnInfo RTupleMData
rtupmd = 
    let mapColNameColInfo :: HashMap ColumnName ColumnInfo
mapColNameColInfo = RTupleMData -> HashMap ColumnName ColumnInfo
forall a b. (a, b) -> b
snd RTupleMData
rtupmd
    in (ColumnName -> ColumnInfo) -> [ColumnName] -> [ColumnInfo]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\ColumnName
cname -> HashMap ColumnName ColumnInfo
mapColNameColInfo HashMap ColumnName ColumnInfo -> ColumnName -> ColumnInfo
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! ColumnName
cname) (RTupleMData -> [ColumnName]
toListColumnName RTupleMData
rtupmd)


-- | toListRDataType: returns a list of RDataType values of an RTuple, in the fixed column order of the RTuple

toListRDataType :: 
    RTupleMData
    -> RTuple
    -> [RDataType]
toListRDataType :: RTupleMData -> RTuple -> [RDataType]
toListRDataType RTupleMData
rtupmd RTuple
rtup = (ColumnName -> RDataType) -> [ColumnName] -> [RDataType]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\ColumnName
cname -> RTuple
rtup RTuple -> ColumnName -> RDataType
<!> ColumnName
cname) (RTupleMData -> [ColumnName]
toListColumnName RTupleMData
rtupmd)


-- | Basic metadata for a column of an RTuple

data ColumnInfo =   ColumnInfo { 
                        ColumnInfo -> ColumnName
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.

                        ,ColumnInfo -> ColumnDType
dtype :: ColumnDType
                    } deriving (Int -> ColumnInfo -> ShowS
[ColumnInfo] -> ShowS
ColumnInfo -> String
(Int -> ColumnInfo -> ShowS)
-> (ColumnInfo -> String)
-> ([ColumnInfo] -> ShowS)
-> Show ColumnInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnInfo] -> ShowS
$cshowList :: [ColumnInfo] -> ShowS
show :: ColumnInfo -> String
$cshow :: ColumnInfo -> String
showsPrec :: Int -> ColumnInfo -> ShowS
$cshowsPrec :: Int -> ColumnInfo -> ShowS
Show,ColumnInfo -> ColumnInfo -> Bool
(ColumnInfo -> ColumnInfo -> Bool)
-> (ColumnInfo -> ColumnInfo -> Bool) -> Eq ColumnInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnInfo -> ColumnInfo -> Bool
$c/= :: ColumnInfo -> ColumnInfo -> Bool
== :: ColumnInfo -> ColumnInfo -> Bool
$c== :: ColumnInfo -> ColumnInfo -> Bool
Eq)

-- | Define equality for two 'ColumnInfo' structures

-- For two column two have \"equal structure\" they must have the same name

-- and the same type. If one of the two (or both) have an 'UknownType', then they are still considered of equal structure.

{-
instance Eq (ColumnInfo) where
    (==) ci1 ci2 = 
        if (name ci1) == (name ci2)
            then
                if ((dtype ci1) == (dtype ci2))
                    ||
                    (dtype ci1 == UknownType)
                    ||
                    (dtype ci2 == UknownType)
                    then True
                    else False
            else
                False
-}

-- | 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].

-- It guarantees that RDataTypes will be in the same column order as [ColumnInfo], i.e., the correct RDataType for the correct column

listOfColInfoRDataType :: [ColumnInfo] -> RTuple -> [(ColumnInfo, RDataType)]  
listOfColInfoRDataType :: [ColumnInfo] -> RTuple -> [(ColumnInfo, RDataType)]
listOfColInfoRDataType (ColumnInfo
ci:[]) RTuple
rtup = [(ColumnInfo
ci, RTuple
rtup RTuple -> ColumnName -> RDataType
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.!(ColumnInfo -> ColumnName
name ColumnInfo
ci))]  -- rt HM.!(name ci) -> this returns the RDataType by column name

listOfColInfoRDataType (ColumnInfo
ci:[ColumnInfo]
colInfos) RTuple
rtup = (ColumnInfo
ci, RTuple
rtup RTuple -> ColumnName -> RDataType
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.!(ColumnInfo -> ColumnName
name ColumnInfo
ci))(ColumnInfo, RDataType)
-> [(ColumnInfo, RDataType)] -> [(ColumnInfo, RDataType)]
forall a. a -> [a] -> [a]
:[ColumnInfo] -> RTuple -> [(ColumnInfo, RDataType)]
listOfColInfoRDataType [ColumnInfo]
colInfos RTuple
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 :: a -> RDataType
createRDataType a
val = 
        case TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
TB.typeOf a
val) of
                        --"Int"     -> RInt $ D.fromDyn (D.toDyn val) 0

                        String
"Int"     -> case (Dynamic -> Maybe Integer
forall a. Typeable a => Dynamic -> Maybe a
D.fromDynamic (a -> Dynamic
forall a. Typeable a => a -> Dynamic
D.toDyn a
val)) of   -- toDyn :: Typeable a => a -> Dynamic

                                                Just Integer
v -> Integer -> RDataType
RInt Integer
v             -- fromDynamic :: Typeable a    => Dynamic  -> Maybe a  

                                                Maybe Integer
Nothing -> RDataType
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) ""

                        String
"Text"     -> case (Dynamic -> Maybe ColumnName
forall a. Typeable a => Dynamic -> Maybe a
D.fromDynamic (a -> Dynamic
forall a. Typeable a => a -> Dynamic
D.toDyn a
val)) of 
                                                Just ColumnName
v -> ColumnName -> RDataType
RText ColumnName
v
                                                Maybe ColumnName
Nothing -> RDataType
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

                        String
"Double"     -> case (Dynamic -> Maybe Double
forall a. Typeable a => Dynamic -> Maybe a
D.fromDynamic (a -> Dynamic
forall a. Typeable a => a -> Dynamic
D.toDyn a
val)) of 
                                                Just Double
v -> Double -> RDataType
RDouble Double
v
                                                Maybe Double
Nothing -> RDataType
Null                                                
                        --"Float"   -> RFloat $ D.fromDyn (D.toDyn val) 0.0

                {--        "Float"     -> case (D.fromDynamic (D.toDyn val)) of 
                                                Just v -> RFloat v
                                                Nothing -> Null                       --}
                        String
_         -> RDataType
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    { ROperation -> [ColumnName]
colPrjList :: [ColumnName] }   -- ^ Projection

    | RFilter { ROperation -> RTuple -> Bool
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 { ROperation -> RJoinPredicate
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

    | RSemiJoin { jpred :: RJoinPredicate }     -- ^ Semi-Join

    | RAntiJoin { jpred :: RJoinPredicate }     -- ^ Anti-Join    

    | RAggregate { ROperation -> [RAggOperation]
aggList :: [RAggOperation] -- ^ list of aggregates 

                 } -- ^ Performs aggregation operations on specific columns and returns a singleton RTable

    | RGroupBy  { 
                    ROperation -> RJoinPredicate
gpred :: RGroupPredicate        -- ^ the grouping predicate

                    ,aggList :: [RAggOperation]     -- ^ the list of aggregates

                    ,ROperation -> [ColumnName]
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 { ROperation -> RTable -> RTable
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 { ROperation -> BinaryRTableOperation
rbinOp :: BinaryRTableOperation } -- ^ A generic binary 'ROperation'.

    | ROrderBy { ROperation -> [(ColumnName, OrderingSpec)]
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 (Int -> OrderingSpec -> ShowS
[OrderingSpec] -> ShowS
OrderingSpec -> String
(Int -> OrderingSpec -> ShowS)
-> (OrderingSpec -> String)
-> ([OrderingSpec] -> ShowS)
-> Show OrderingSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrderingSpec] -> ShowS
$cshowList :: [OrderingSpec] -> ShowS
show :: OrderingSpec -> String
$cshow :: OrderingSpec -> String
showsPrec :: Int -> OrderingSpec -> ShowS
$cshowsPrec :: Int -> OrderingSpec -> ShowS
Show, OrderingSpec -> OrderingSpec -> Bool
(OrderingSpec -> OrderingSpec -> Bool)
-> (OrderingSpec -> OrderingSpec -> Bool) -> Eq OrderingSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderingSpec -> OrderingSpec -> Bool
$c/= :: OrderingSpec -> OrderingSpec -> Bool
== :: OrderingSpec -> OrderingSpec -> Bool
$c== :: OrderingSpec -> OrderingSpec -> Bool
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 Upsert Predicate. It defines when two 'RTuple's should be paired in a merge operation.

-- The matching predicate must be applied on a specific set of matching columns. The source 'RTable'

-- in the Upsert operation must return a unique set of 'RTuple's, if grouped by this set of matching columns.

-- Otherwise an exception ('UniquenessViolationInUpsert') is thrown.

data RUpsertPredicate = RUpsertPredicate {
                            RUpsertPredicate -> [ColumnName]
matchCols :: [ColumnName]
                            ,RUpsertPredicate -> RJoinPredicate
matchPred :: RTuple -> RTuple -> Bool
                        }

-- type RUpsertPredicate = 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 {
                         RAggOperation -> ColumnName
sourceCol :: ColumnName        -- ^ Source column

                        ,RAggOperation -> ColumnName
targetCol :: ColumnName        -- ^ Target column

                        ,RAggOperation -> RTable -> RTuple
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 :: AggFunction -> ColumnName -> ColumnName -> RAggOperation
raggGenericAgg AggFunction
aggf ColumnName
src ColumnName
trg = RAggOperation :: ColumnName -> ColumnName -> (RTable -> RTuple) -> RAggOperation
RAggOperation {
                 sourceCol :: ColumnName
sourceCol = ColumnName
src
                ,targetCol :: ColumnName
targetCol = ColumnName
trg                                 
                ,aggFunc :: RTable -> RTuple
aggFunc = \RTable
rtab -> [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName
trg, AggFunction
aggf ColumnName
src RTable
rtab)]  
        }

type Delimiter = String

-- | The StrAgg aggregate operation

-- This is known as \"string_agg\"" in Postgresql and \"listagg\" in Oracle.

-- It aggregates the values of a text 'RDataType' column with a specified delimiter

raggStrAgg ::
        ColumnName -- ^ source column

    ->  ColumnName -- ^ target column

    ->  Delimiter  -- ^ delimiter string 

    ->  RAggOperation
raggStrAgg :: ColumnName -> ColumnName -> String -> RAggOperation
raggStrAgg ColumnName
src ColumnName
trg String
delimiter =  RAggOperation :: ColumnName -> ColumnName -> (RTable -> RTuple) -> RAggOperation
RAggOperation {
                 sourceCol :: ColumnName
sourceCol = ColumnName
src
                ,targetCol :: ColumnName
targetCol = ColumnName
trg                       
                ,aggFunc :: RTable -> RTuple
aggFunc = \RTable
rtab -> [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName
trg, String -> AggFunction
strAggFold String
delimiter ColumnName
src RTable
rtab)]  
        }

-- | A helper function that implements the basic fold for the raggStrAgg aggregation        

strAggFold :: Delimiter -> AggFunction
strAggFold :: String -> AggFunction
strAggFold String
dlmt ColumnName
col RTable
rtab = 
    (RTuple -> RDataType -> RDataType)
-> RDataType -> RTable -> RDataType
rdatatypeFoldr' ( \RTuple
rtup RDataType
accValue -> 
        if RDataType -> Bool
isNotNull (RTuple
rtup RTuple -> ColumnName -> RDataType
<!> ColumnName
col)  Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)
            then
                RTuple
rtup RTuple -> ColumnName -> RDataType
<!> ColumnName
col RDataType -> RDataType -> RDataType
`rdtappend` (ColumnName -> RDataType
RText ColumnName
delimiter) RDataType -> RDataType -> RDataType
`rdtappend` RDataType
accValue
            else
                --if (getRTupColValue src) rtup == Null && accValue /= Null 

                if RDataType -> Bool
isNull (RTuple
rtup RTuple -> ColumnName -> RDataType
<!> ColumnName
col) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)
                    then
                        RDataType
accValue  -- ignore Null value

                    else
                        --if (getRTupColValue src) rtup /= Null && accValue == Null 

                        if RDataType -> Bool
isNotNull (RTuple
rtup RTuple -> ColumnName -> RDataType
<!> ColumnName
col) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNull RDataType
accValue)
                            then
                                case RDataType -> Bool
isText (RTuple
rtup RTuple -> ColumnName -> RDataType
<!> ColumnName
col) of
                                    Bool
True ->  (RTuple
rtup RTuple -> ColumnName -> RDataType
<!> ColumnName
col) 
                                    Bool
False -> RDataType
Null
                            else
                                RDataType
Null -- agg of Nulls is Null

                    )
                    RDataType
Null
                    RTable
rtab
    where
        delimiter :: ColumnName
delimiter = String -> ColumnName
pack String
dlmt -- convert String to Text



-- | The Sum aggregate operation

raggSum :: 
        ColumnName -- ^ source column

    ->  ColumnName -- ^ target column

    ->  RAggOperation
raggSum :: ColumnName -> ColumnName -> RAggOperation
raggSum ColumnName
src ColumnName
trg = RAggOperation :: ColumnName -> ColumnName -> (RTable -> RTuple) -> RAggOperation
RAggOperation {
                 sourceCol :: ColumnName
sourceCol = ColumnName
src
                ,targetCol :: ColumnName
targetCol = ColumnName
trg                                 
                ,aggFunc :: RTable -> RTuple
aggFunc = \RTable
rtab -> [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName
trg, AggFunction
sumFold ColumnName
src RTable
rtab)]  
        }

-- | A helper function in raggSum that implements the basic fold for sum aggregation        

sumFold :: AggFunction -- ColumnName -> RTable -> RDataType

sumFold :: AggFunction
sumFold ColumnName
src RTable
rtab =         
    (RTuple -> RDataType -> RDataType)
-> RDataType -> RTable -> RDataType
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' ( \RTuple
rtup RDataType
accValue ->                                                                     
                    --if (getRTupColValue src) rtup /= Null && accValue /= Null

                    if (RDataType -> Bool
isNotNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup)  Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)
                        then
                            (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup RDataType -> RDataType -> RDataType
forall a. Num a => a -> a -> a
+ RDataType
accValue
                        else
                            --if (getRTupColValue src) rtup == Null && accValue /= Null 

                            if (RDataType -> Bool
isNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)
                                then
                                    RDataType
accValue  -- ignore Null value

                                else
                                    --if (getRTupColValue src) rtup /= Null && accValue == Null 

                                    if (RDataType -> Bool
isNotNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNull RDataType
accValue)
                                        then
                                            (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup RDataType -> RDataType -> RDataType
forall a. Num a => a -> a -> a
+ Integer -> RDataType
RInt Integer
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
                                            RDataType
Null -- agg of Nulls is Null

             ) (RDataType
Null) RTable
rtab


-- | The Count aggregate operation

-- Count aggregation (no distinct)

raggCount :: 
        ColumnName -- ^ source column

    ->  ColumnName -- ^ target column

    ->  RAggOperation
raggCount :: ColumnName -> ColumnName -> RAggOperation
raggCount ColumnName
src ColumnName
trg = RAggOperation :: ColumnName -> ColumnName -> (RTable -> RTuple) -> RAggOperation
RAggOperation {
                 sourceCol :: ColumnName
sourceCol = ColumnName
src
                ,targetCol :: ColumnName
targetCol = ColumnName
trg
                ,aggFunc :: RTable -> RTuple
aggFunc = \RTable
rtab -> [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName
trg, AggFunction
countFold ColumnName
src RTable
rtab)]  
        }


-- | A helper function in raggCount that implements the basic fold for Count aggregation        

countFold :: AggFunction -- ColumnName -> RTable -> RDataType

countFold :: AggFunction
countFold ColumnName
src RTable
rtab =         
    (RTuple -> RDataType -> RDataType)
-> RDataType -> RTable -> RDataType
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' ( \RTuple
rtup RDataType
accValue ->                                                                     
                            --if (getRTupColValue src) rtup /= Null && accValue /= Null

                            if (RDataType -> Bool
isNotNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup)  Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)  
                                then
                                    Integer -> RDataType
RInt Integer
1 RDataType -> RDataType -> RDataType
forall a. Num a => a -> a -> a
+ RDataType
accValue
                                else
                                    --if (getRTupColValue src) rtup == Null && accValue /= Null 

                                    if (RDataType -> Bool
isNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)  
                                        then
                                            RDataType
accValue  -- ignore Null value

                                        else
                                            --if (getRTupColValue src) rtup /= Null && accValue == Null 

                                            if (RDataType -> Bool
isNotNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNull RDataType
accValue)
                                                then
                                                    Integer -> RDataType
RInt Integer
1  -- ignore so far Null agg result

                                                else
                                                    RDataType
Null -- agg of Nulls is Null

             ) (RDataType
Null) RTable
rtab


-- | The CountStar aggregate operation 

--  Returns the number of 'RTuple's in the 'RTable' (i.e., @count(*)@ in SQL) 

raggCountStar ::         
        ColumnName -- ^ target column to save the result aggregated value

    ->  RAggOperation
raggCountStar :: ColumnName -> RAggOperation
raggCountStar ColumnName
trg  = RAggOperation :: ColumnName -> ColumnName -> (RTable -> RTuple) -> RAggOperation
RAggOperation {
                sourceCol :: ColumnName
sourceCol = ColumnName
""  -- no source column required

                ,targetCol :: ColumnName
targetCol = ColumnName
trg
                ,aggFunc :: RTable -> RTuple
aggFunc = \RTable
rtab -> [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName
trg, RTable -> RDataType
countStarFold RTable
rtab)]  
        }
-- | A helper function in raggCountStar that implements the basic fold for CountStar aggregation        

countStarFold :: RTable -> RDataType
countStarFold :: RTable -> RDataType
countStarFold RTable
rtab = Integer -> RDataType
RInt (Integer -> RDataType) -> Integer -> RDataType
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [RTuple] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length ([RTuple] -> Int) -> [RTuple] -> Int
forall a b. (a -> b) -> a -> b
$ RTable -> [RTuple]
rtableToList RTable
rtab


-- | The CountDist aggregate operation 

-- Count distinct aggregation (i.e., @count(distinct col)@ in SQL). Returns the distinct number of values for this column.

raggCountDist :: 
        ColumnName -- ^ source column

    ->  ColumnName -- ^ target column

    ->  RAggOperation
raggCountDist :: ColumnName -> ColumnName -> RAggOperation
raggCountDist ColumnName
src ColumnName
trg = RAggOperation :: ColumnName -> ColumnName -> (RTable -> RTuple) -> RAggOperation
RAggOperation {
                 sourceCol :: ColumnName
sourceCol = ColumnName
src
                ,targetCol :: ColumnName
targetCol = ColumnName
trg
                ,aggFunc :: RTable -> RTuple
aggFunc = \RTable
rtab -> [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName
trg, AggFunction
countDistFold ColumnName
src RTable
rtab)]  
        }

-- | A helper function in raggCountDist that implements the basic fold for CountDist aggregation        

countDistFold :: AggFunction -- ColumnName -> ColumnName -> RTable -> RDataType

countDistFold :: AggFunction
countDistFold ColumnName
src RTable
rtab = 
    let
        -- change the input rtable to fold, to be the distinct list of values

        -- implement it with a group by on the src column

        rtabDist :: RTable
rtabDist = RJoinPredicate
-> [RAggOperation] -> [ColumnName] -> RTable -> RTable
runGroupBy   (\RTuple
t1 RTuple
t2 -> RTuple
t1 RTuple -> ColumnName -> RDataType
<!> ColumnName
src RDataType -> RDataType -> Bool
forall a. Eq a => a -> a -> Bool
== RTuple
t2 RTuple -> ColumnName -> RDataType
<!> ColumnName
src)
                                [ColumnName -> ColumnName -> RAggOperation
raggCount ColumnName
src ColumnName
"dummy"]  -- this will be omitted anyway

                                [ColumnName
src]
                                RTable
rtab
    in (RTuple -> RDataType -> RDataType)
-> RDataType -> RTable -> RDataType
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' ( \RTuple
rtup RDataType
accValue ->                                                                     
                            --if (getRTupColValue src) rtup /= Null && accValue /= Null

                            if (RDataType -> Bool
isNotNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup)  Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)  
                                then
                                    Integer -> RDataType
RInt Integer
1 RDataType -> RDataType -> RDataType
forall a. Num a => a -> a -> a
+ RDataType
accValue
                                else
                                    --if (getRTupColValue src) rtup == Null && accValue /= Null 

                                    if (RDataType -> Bool
isNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)  
                                        then
                                            RDataType
accValue  -- ignore Null value

                                        else
                                            --if (getRTupColValue src) rtup /= Null && accValue == Null 

                                            if (RDataType -> Bool
isNotNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNull RDataType
accValue)
                                                then
                                                    Integer -> RDataType
RInt Integer
1  -- ignore so far Null agg result

                                                else
                                                    RDataType
Null -- agg of Nulls is Null

             ) (RDataType
Null) RTable
rtabDist


-- | The Average aggregate operation

raggAvg :: 
        ColumnName -- ^ source column

    ->  ColumnName -- ^ target column

    ->  RAggOperation
raggAvg :: ColumnName -> ColumnName -> RAggOperation
raggAvg ColumnName
src ColumnName
trg = RAggOperation :: ColumnName -> ColumnName -> (RTable -> RTuple) -> RAggOperation
RAggOperation {
                 sourceCol :: ColumnName
sourceCol = ColumnName
src
                ,targetCol :: ColumnName
targetCol = ColumnName
trg
                ,aggFunc :: RTable -> RTuple
aggFunc = \RTable
rtab -> [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName
trg, let 
                                                             sum :: RDataType
sum = AggFunction
sumFold ColumnName
src RTable
rtab
                                                             cnt :: RDataType
cnt =  AggFunction
countFold ColumnName
src RTable
rtab
                                                        in case (RDataType
sum,RDataType
cnt) of
                                                                (RInt Integer
s, RInt Integer
c) -> Double -> RDataType
RDouble (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c)
                                                                (RDouble Double
s, RInt Integer
c) -> Double -> RDataType
RDouble (Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c)
                                                                (RDataType
_, RDataType
_)           -> RDataType
Null
                                                 )]  
        }        

-- | The Max aggregate operation

raggMax :: 
        ColumnName -- ^ source column

    ->  ColumnName -- ^ target column

    ->  RAggOperation
raggMax :: ColumnName -> ColumnName -> RAggOperation
raggMax ColumnName
src ColumnName
trg = RAggOperation :: ColumnName -> ColumnName -> (RTable -> RTuple) -> RAggOperation
RAggOperation {
                 sourceCol :: ColumnName
sourceCol = ColumnName
src
                ,targetCol :: ColumnName
targetCol = ColumnName
trg
                ,aggFunc :: RTable -> RTuple
aggFunc = \RTable
rtab -> [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName
trg, AggFunction
maxFold ColumnName
src RTable
rtab)]  
        }        


-- | A helper function in raggMax that implements the basic fold for Max aggregation        

maxFold :: AggFunction -- ColumnName -> ColumnName -> RTable -> RDataType

maxFold :: AggFunction
maxFold ColumnName
src RTable
rtab =         
    (RTuple -> RDataType -> RDataType)
-> RDataType -> RTable -> RDataType
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' ( \RTuple
rtup RDataType
accValue ->         
                                --if (getRTupColValue src) rtup /= Null && accValue /= Null

                                if (RDataType -> Bool
isNotNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup)  Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)  
                                    then
                                        RDataType -> RDataType -> RDataType
forall a. Ord a => a -> a -> a
max ((ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) RDataType
accValue
                                    else
                                        --if (getRTupColValue src) rtup == Null && accValue /= Null 

                                        if (RDataType -> Bool
isNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)  
                                            then
                                                RDataType
accValue  -- ignore Null value

                                            else
                                                --if (getRTupColValue src) rtup /= Null && accValue == Null 

                                                if (RDataType -> Bool
isNotNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNull RDataType
accValue)
                                                    then
                                                        (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup  -- ignore so far Null agg result

                                                    else
                                                        RDataType
Null -- agg of Nulls is Null

             ) RDataType
Null RTable
rtab


-- | The Min aggregate operation

raggMin :: 
        ColumnName -- ^ source column

    ->  ColumnName -- ^ target column

    ->  RAggOperation
raggMin :: ColumnName -> ColumnName -> RAggOperation
raggMin ColumnName
src ColumnName
trg = RAggOperation :: ColumnName -> ColumnName -> (RTable -> RTuple) -> RAggOperation
RAggOperation {
                 sourceCol :: ColumnName
sourceCol = ColumnName
src
                ,targetCol :: ColumnName
targetCol = ColumnName
trg
                ,aggFunc :: RTable -> RTuple
aggFunc = \RTable
rtab -> [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName
trg, AggFunction
minFold ColumnName
src RTable
rtab)]  
        }        

-- | A helper function in raggMin that implements the basic fold for Min aggregation        

minFold :: AggFunction -- ColumnName -> ColumnName -> RTable -> RDataType

minFold :: AggFunction
minFold ColumnName
src RTable
rtab =         
    (RTuple -> RDataType -> RDataType)
-> RDataType -> RTable -> RDataType
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' ( \RTuple
rtup RDataType
accValue ->         
                                --if (getRTupColValue src) rtup /= Null && accValue /= Null

                                if (RDataType -> Bool
isNotNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup)  Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)
                                    then
                                        RDataType -> RDataType -> RDataType
forall a. Ord a => a -> a -> a
min ((ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) RDataType
accValue
                                    else
                                        --if (getRTupColValue src) rtup == Null && accValue /= Null 

                                        if (RDataType -> Bool
isNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNotNull RDataType
accValue)  
                                            then
                                                RDataType
accValue  -- ignore Null value

                                            else
                                                --if (getRTupColValue src) rtup /= Null && accValue == Null 

                                                if (RDataType -> Bool
isNotNull (RDataType -> Bool) -> RDataType -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup) Bool -> Bool -> Bool
&& (RDataType -> Bool
isNull RDataType
accValue)
                                                    then
                                                        (ColumnName -> RTuple -> RDataType
getRTupColValue ColumnName
src) RTuple
rtup  -- ignore so far Null agg result

                                                    else
                                                        RDataType
Null -- agg of Nulls is Null

             ) RDataType
Null RTable
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 :: ROperation -> RTable -> RTable
ropU = ROperation -> RTable -> RTable
runUnaryROperation

-- | Execute a Unary ROperation

runUnaryROperation :: 
    ROperation -- ^ input ROperation

    -> RTable  -- ^ input RTable

    -> RTable  -- ^ output RTable

runUnaryROperation :: ROperation -> RTable -> RTable
runUnaryROperation ROperation
rop RTable
irtab = 
    case ROperation
rop of
        RFilter { fpred :: ROperation -> RTuple -> Bool
fpred = RTuple -> Bool
rpredicate }                                                  ->  (RTuple -> Bool) -> RTable -> RTable
runRfilter RTuple -> Bool
rpredicate RTable
irtab
        RPrj { colPrjList :: ROperation -> [ColumnName]
colPrjList = [ColumnName]
colNames }                                                  ->  [ColumnName] -> RTable -> RTable
runProjection [ColumnName]
colNames RTable
irtab
        RAggregate { aggList :: ROperation -> [RAggOperation]
aggList = [RAggOperation]
aggFunctions }                                           ->  [RAggOperation] -> RTable -> RTable
runAggregation [RAggOperation]
aggFunctions RTable
irtab
        RGroupBy  { gpred :: ROperation -> RJoinPredicate
gpred = RJoinPredicate
groupingpred, aggList :: ROperation -> [RAggOperation]
aggList = [RAggOperation]
aggFunctions, colGrByList :: ROperation -> [ColumnName]
colGrByList = [ColumnName]
cols }  ->  RJoinPredicate
-> [RAggOperation] -> [ColumnName] -> RTable -> RTable
runGroupBy RJoinPredicate
groupingpred [RAggOperation]
aggFunctions [ColumnName]
cols RTable
irtab
        RCombinedOp { rcombOp :: ROperation -> RTable -> RTable
rcombOp = RTable -> RTable
comb }                                                  ->  (RTable -> RTable) -> RTable -> RTable
runCombinedROp RTable -> RTable
comb RTable
irtab 
        ROrderBy { colOrdList :: ROperation -> [(ColumnName, OrderingSpec)]
colOrdList = [(ColumnName, OrderingSpec)]
colist }                                                ->  [(ColumnName, OrderingSpec)] -> RTable -> RTable
runOrderBy [(ColumnName, OrderingSpec)]
colist RTable
irtab

-- | ropUres operator executes a unary ROperation. A short name for the 'runUnaryROperationRes' function

ropUres :: ROperation -> RTable -> RTabResult
ropUres = ROperation -> RTable -> RTabResult
runUnaryROperationRes

-- | Execute a Unary ROperation and return an 'RTabResult'

runUnaryROperationRes :: 
    ROperation -- ^ input ROperation

    -> RTable  -- ^ input RTable

    -> RTabResult  -- ^ output: Result of operation

runUnaryROperationRes :: ROperation -> RTable -> RTabResult
runUnaryROperationRes ROperation
rop RTable
irtab = 
    let resultRtab :: RTable
resultRtab = ROperation -> RTable -> RTable
runUnaryROperation ROperation
rop RTable
irtab
        returnedRtups :: RTuplesRet
returnedRtups = Int -> RTuplesRet
rtuplesRet (Int -> RTuplesRet) -> Int -> RTuplesRet
forall a b. (a -> b) -> a -> b
$ RTable -> Int
forall a. Vector a -> Int
V.length RTable
resultRtab
    in (RTable, RTuplesRet) -> RTabResult
rtabResult (RTable
resultRtab, RTuplesRet
returnedRtups)

-- | ropB operator executes a binary ROperation. A short name for the 'runBinaryROperation' function

ropB :: ROperation -> BinaryRTableOperation
ropB = ROperation -> BinaryRTableOperation
runBinaryROperation

-- | Execute a Binary ROperation

runBinaryROperation :: 
    ROperation -- ^ input ROperation

    -> RTable  -- ^ input RTable1

    -> RTable  -- ^ input RTable2    

    -> RTable  -- ^ output RTabl

runBinaryROperation :: ROperation -> BinaryRTableOperation
runBinaryROperation ROperation
rop RTable
irtab1 RTable
irtab2 = 
    case ROperation
rop of
        RInJoin    { jpred :: ROperation -> RJoinPredicate
jpred = RJoinPredicate
jpredicate } -> RJoinPredicate -> BinaryRTableOperation
runInnerJoinO RJoinPredicate
jpredicate RTable
irtab1 RTable
irtab2
        RLeftJoin  { jpred :: ROperation -> RJoinPredicate
jpred = RJoinPredicate
jpredicate } -> RJoinPredicate -> BinaryRTableOperation
runLeftJoin RJoinPredicate
jpredicate RTable
irtab1 RTable
irtab2
        RRightJoin { jpred :: ROperation -> RJoinPredicate
jpred = RJoinPredicate
jpredicate } -> RJoinPredicate -> BinaryRTableOperation
runRightJoin RJoinPredicate
jpredicate RTable
irtab1 RTable
irtab2
        RSemiJoin    { jpred :: ROperation -> RJoinPredicate
jpred = RJoinPredicate
jpredicate } -> RJoinPredicate -> BinaryRTableOperation
runSemiJoin RJoinPredicate
jpredicate RTable
irtab1 RTable
irtab2
        RAntiJoin    { jpred :: ROperation -> RJoinPredicate
jpred = RJoinPredicate
jpredicate } -> RJoinPredicate -> BinaryRTableOperation
runAntiJoin RJoinPredicate
jpredicate RTable
irtab1 RTable
irtab2        
        ROperation
RUnion -> BinaryRTableOperation
runUnion RTable
irtab1 RTable
irtab2
        ROperation
RInter -> BinaryRTableOperation
runIntersect RTable
irtab1 RTable
irtab2
        ROperation
RDiff  -> BinaryRTableOperation
runDiff RTable
irtab1 RTable
irtab2  
        RBinOp { rbinOp :: ROperation -> BinaryRTableOperation
rbinOp = BinaryRTableOperation
bop } -> BinaryRTableOperation
bop RTable
irtab1 RTable
irtab2      

-- | ropBres operator executes a binary ROperation. A short name for the 'runBinaryROperationRes' function

ropBres :: ROperation -> RTable -> RTable -> RTabResult
ropBres = ROperation -> RTable -> RTable -> RTabResult
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 :: ROperation -> RTable -> RTable -> RTabResult
runBinaryROperationRes ROperation
rop RTable
irtab1 RTable
irtab2 = 
    let resultRtab :: RTable
resultRtab = ROperation -> BinaryRTableOperation
runBinaryROperation ROperation
rop RTable
irtab1 RTable
irtab2
        returnedRtups :: RTuplesRet
returnedRtups = Int -> RTuplesRet
rtuplesRet (Int -> RTuplesRet) -> Int -> RTuplesRet
forall a b. (a -> b) -> a -> b
$ RTable -> Int
forall a. Vector a -> Int
V.length RTable
resultRtab
    in (RTable, RTuplesRet) -> RTabResult
rtabResult (RTable
resultRtab, RTuplesRet
returnedRtups)


-- * #########  Construction ##########


-- | Test whether an RTable is empty

isRTabEmpty :: RTable -> Bool
isRTabEmpty :: RTable -> Bool
isRTabEmpty = RTable -> Bool
forall a. Vector a -> Bool
V.null

-- | Test whether an RTuple is empty

isRTupEmpty :: RTuple -> Bool
isRTupEmpty :: RTuple -> Bool
isRTupEmpty = RTuple -> Bool
forall k v. HashMap k v -> Bool
HM.null

-- | emptyRTable: Create an empty RTable

emptyRTable :: RTable
emptyRTable :: RTable
emptyRTable = RTable
forall a. Vector a
V.empty :: RTable

-- | Creates an empty RTuple (i.e., one with no column,value mappings)

emptyRTuple :: RTuple 
emptyRTuple :: RTuple
emptyRTuple = RTuple
forall k v. HashMap k v
HM.empty


-- | Creates an RTable with a single RTuple

createSingletonRTable ::
       RTuple 
    -> RTable 
createSingletonRTable :: RTuple -> RTable
createSingletonRTable RTuple
rt = RTuple -> RTable
forall a. a -> Vector a
V.singleton RTuple
rt

-- | createRTuple: Create an Rtuple from a list of column names and values

createRTuple ::
      [(ColumnName, RDataType)]  -- ^ input list of (columnname,value) pairs

    -> RTuple 
createRTuple :: [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName, RDataType)]
l = [(ColumnName, RDataType)] -> RTuple
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(ColumnName, RDataType)]
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 :: [ColumnName] -> RTuple
createNullRTuple [ColumnName]
cnames = [(ColumnName, RDataType)] -> RTuple
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(ColumnName, RDataType)] -> RTuple)
-> [(ColumnName, RDataType)] -> RTuple
forall a b. (a -> b) -> a -> b
$ [(ColumnName, RDataType)]
zipped
    where zipped :: [(ColumnName, RDataType)]
zipped = [ColumnName] -> [RDataType] -> [(ColumnName, RDataType)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [ColumnName]
cnames (Int -> [RDataType] -> [RDataType]
forall a. Int -> [a] -> [a]
Data.List.take ([ColumnName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length [ColumnName]
cnames) (RDataType -> [RDataType]
forall a. a -> [a]
repeat RDataType
Null))

-- | Returns 'True' if the input 'RTuple' is a Null RTuple, otherwise it returns 'False'

-- Note that a Null RTuple has all its values equal with 'Null' but it still has columns. This is different from an empty 'RTuple', which

-- is an 'RTuple' withi no columns and no values whatsoever. See 'isRTupEmpty'.

isNullRTuple ::
       RTuple 
    -> Bool    
isNullRTuple :: RTuple -> Bool
isNullRTuple RTuple
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 :: RTuple
checkt = (RDataType -> Bool) -> RTuple -> RTuple
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter (\RDataType
v -> RDataType -> Bool
isNotNull  RDataType
v) RTuple
t  --v /= Null) t 

    in if RTuple -> Bool
isRTupEmpty RTuple
checkt 
            then Bool
True
            else Bool
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' :: (RTuple -> RTable -> RTable) -> BinaryRTableOperation
rtabFoldr' RTuple -> RTable -> RTable
f RTable
accum RTable
rtab = (RTuple -> RTable -> RTable) -> BinaryRTableOperation
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' RTuple -> RTable -> RTable
f RTable
accum RTable
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' :: (RTuple -> RDataType -> RDataType)
-> RDataType -> RTable -> RDataType
rdatatypeFoldr' RTuple -> RDataType -> RDataType
f RDataType
accum RTable
rtab = (RTuple -> RDataType -> RDataType)
-> RDataType -> RTable -> RDataType
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' RTuple -> RDataType -> RDataType
f RDataType
accum RTable
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' :: (RTable -> RTuple -> RTable) -> BinaryRTableOperation
rtabFoldl' RTable -> RTuple -> RTable
f RTable
accum RTable
rtab = (RTable -> RTuple -> RTable) -> BinaryRTableOperation
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' RTable -> RTuple -> RTable
f RTable
accum RTable
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' :: (RDataType -> RTuple -> RDataType)
-> RDataType -> RTable -> RDataType
rdatatypeFoldl' RDataType -> RTuple -> RDataType
f RDataType
accum RTable
rtab = (RDataType -> RTuple -> RDataType)
-> RDataType -> RTable -> RDataType
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' RDataType -> RTuple -> RDataType
f RDataType
accum RTable
rtab


-- | Map function over an 'RTable'.

rtabMap :: (RTuple -> RTuple) -> RTable -> RTable
rtabMap :: (RTuple -> RTuple) -> RTable -> RTable
rtabMap RTuple -> RTuple
f RTable
rtab = (RTuple -> RTuple) -> RTable -> RTable
forall a b. (a -> b) -> Vector a -> Vector b
V.map RTuple -> RTuple
f RTable
rtab 

-- | O(n) Transform this 'RTuple' by applying a function to every value

rtupleMap :: (RDataType -> RDataType) -> RTuple -> RTuple
rtupleMap :: (RDataType -> RDataType) -> RTuple -> RTuple
rtupleMap RDataType -> RDataType
f RTuple
t = (RDataType -> RDataType) -> RTuple -> RTuple
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map RDataType -> RDataType
f RTuple
t 

-- | O(n) Transform this 'RTuple' by applying a function to every value

rtupleMapWithKey :: (ColumnName -> RDataType -> RDataType) -> RTuple -> RTuple
rtupleMapWithKey :: (ColumnName -> RDataType -> RDataType) -> RTuple -> RTuple
rtupleMapWithKey ColumnName -> RDataType -> RDataType
f RTuple
t = (ColumnName -> RDataType -> RDataType) -> RTuple -> RTuple
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey ColumnName -> RDataType -> RDataType
f RTuple
t

-- * ########## RTable Relational Operations ##############


-- | Number of RTuples returned by an RTable operation

type RTuplesRet = Sum Int

-- | Creates an RTuplesRet type

rtuplesRet :: Int -> RTuplesRet
rtuplesRet :: Int -> RTuplesRet
rtuplesRet Int
i = (Int -> RTuplesRet
forall a. a -> Sum a
M.Sum Int
i) :: RTuplesRet

-- | Return the number embedded in the RTuplesRet data type

getRTuplesRet :: RTuplesRet -> Int 
getRTuplesRet :: RTuplesRet -> Int
getRTuplesRet = RTuplesRet -> Int
forall a. Sum a -> a
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 :: (RTable, RTuplesRet) -> RTabResult
rtabResult (RTable
rtab, RTuplesRet
rtupRet) = (RTable, RTuplesRet) -> RTabResult
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
writer (RTable
rtab, RTuplesRet
rtupRet)

-- | Returns the info "stored" in the RTabResult Writer Monad

runRTabResult ::
       RTabResult
    -> (RTable, RTuplesRet)
runRTabResult :: RTabResult -> (RTable, RTuplesRet)
runRTabResult RTabResult
rtr = RTabResult -> (RTable, RTuplesRet)
forall w a. Writer w a -> (a, w)
runWriter RTabResult
rtr

-- | Returns the "log message" in the RTabResult Writer Monad, which is the number of returned RTuples

execRTabResult ::
       RTabResult
    -> RTuplesRet
execRTabResult :: RTabResult -> RTuplesRet
execRTabResult RTabResult
rtr = RTabResult -> RTuplesRet
forall w a. Writer w a -> w
execWriter RTabResult
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 :: ColumnName -> RTable -> RTable
removeColumn ColumnName
col RTable
rtabSrc = do
      RTuple
srcRtup <- RTable
rtabSrc
      let targetRtup :: RTuple
targetRtup = ColumnName -> RTuple -> RTuple
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete ColumnName
col RTuple
srcRtup  
      RTuple -> RTable
forall (m :: * -> *) a. Monad m => a -> m a
return RTuple
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 :: ColumnName -> RDataType -> RTable -> RTable
addColumn ColumnName
name RDataType
initVal RTable
rtabSrc = do
    RTuple
srcRtup <- RTable
rtabSrc
    let targetRtup :: RTuple
targetRtup = ColumnName -> RDataType -> RTuple -> RTuple
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ColumnName
name RDataType
initVal RTuple
srcRtup
    RTuple -> RTable
forall (m :: * -> *) a. Monad m => a -> m a
return RTuple
targetRtup


-- | Filter (i.e. selection operator). A short name for the 'runRFilter' function

f :: (RTuple -> Bool) -> RTable -> RTable
f = (RTuple -> Bool) -> RTable -> RTable
runRfilter

-- | Executes an RFilter operation

runRfilter ::
    RPredicate
    -> RTable
    -> RTable
runRfilter :: (RTuple -> Bool) -> RTable -> RTable
runRfilter RTuple -> Bool
rpred RTable
rtab = 
    if RTable -> Bool
isRTabEmpty RTable
rtab
        then RTable
emptyRTable
        else 
            (RTuple -> Bool) -> RTable -> RTable
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter RTuple -> Bool
rpred RTable
rtab

-- | RTable Projection operator. A short name for the 'runProjection' function

p :: [ColumnName] -> RTable -> RTable
p = [ColumnName] -> RTable -> RTable
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 :: [ColumnName] -> RTable -> RTable
runProjection [ColumnName]
colNamList RTable
irtab = 
    if RTable -> Bool
isRTabEmpty RTable
irtab
        then
            RTable
emptyRTable
        else
            do -- RTable is a Monad

                RTuple
srcRtuple <- RTable
irtab
                let
                    -- 1. get original column value (in this case it is a list of values :: Maybe RDataType)

                    srcValueL :: [Maybe RDataType]
srcValueL = (ColumnName -> Maybe RDataType)
-> [ColumnName] -> [Maybe RDataType]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
colName -> ColumnName -> RTuple -> Maybe RDataType
rtupLookup ColumnName
colName RTuple
srcRtuple) [ColumnName]
colNamList

                -- if there is at least one Nothing value then an non-existing column name has been asked. 

                if Maybe RDataType -> [Maybe RDataType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem Maybe RDataType
forall a. Maybe a
Nothing [Maybe RDataType]
srcValueL 
                    then -- return an empty RTable

                        RTable
emptyRTable
                    else
                        let 
                            -- 2. create the new RTuple                        

                            valList :: [RDataType]
valList = (Maybe RDataType -> RDataType) -> [Maybe RDataType] -> [RDataType]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(Just RDataType
v) -> RDataType
v) [Maybe RDataType]
srcValueL -- get rid of Maybe

                            targetRtuple :: RTuple
targetRtuple = [(ColumnName, RDataType)] -> RTuple
rtupleFromList ([ColumnName] -> [RDataType] -> [(ColumnName, RDataType)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [ColumnName]
colNamList [RDataType]
valList) -- HM.fromList

                        in RTuple -> RTable
forall (m :: * -> *) a. Monad m => a -> m a
return RTuple
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 :: [ColumnName] -> RTable -> RTable
runProjectionMissedHits [ColumnName]
colNamList RTable
irtab = 
    if RTable -> Bool
isRTabEmpty RTable
irtab
        then
            RTable
emptyRTable
        else
            do -- RTable is a Monad

                RTuple
srcRtuple <- RTable
irtab
                let
                    -- 1. get original column value (in this case it is a list of values)

                    srcValueL :: [RDataType]
srcValueL = (ColumnName -> RDataType) -> [ColumnName] -> [RDataType]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
src -> RDataType -> ColumnName -> RTuple -> RDataType
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HM.lookupDefault       RDataType
Null -- return Null if value cannot be found based on column name 

                                                                    ColumnName
src   -- column name to look for (source) - i.e., the key in the HashMap

                                                                    RTuple
srcRtuple  -- source RTuple (i.e., a HashMap ColumnName RDataType)

                                    ) [ColumnName]
colNamList
                    -- 2. create the new RTuple

                    targetRtuple :: RTuple
targetRtuple = [(ColumnName, RDataType)] -> RTuple
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([ColumnName] -> [RDataType] -> [(ColumnName, RDataType)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [ColumnName]
colNamList [RDataType]
srcValueL)
                RTuple -> RTable
forall (m :: * -> *) a. Monad m => a -> m a
return RTuple
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 :: Int -> RTable -> RTable
limit Int
n RTable
r1 = Int -> RTable -> RTable
forall a. Int -> Vector a -> Vector a
V.take Int
n RTable
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' anti-join operator. A short name for the 'runAntiJoin' function

aJ :: RJoinPredicate -> BinaryRTableOperation
aJ = RJoinPredicate -> BinaryRTableOperation
runAntiJoin

-- | Implements the anti-Join operation between two RTables (any type of join predicate is allowed)

-- It returns the 'RTuple's from the left 'RTable' that DONT match with the right 'RTable'.

runAntiJoin ::
    RJoinPredicate
    -> RTable
    -> RTable
    -> RTable
runAntiJoin :: RJoinPredicate -> BinaryRTableOperation
runAntiJoin RJoinPredicate
jpred RTable
tabDriver RTable
tabProbed = 
    if RTable -> Bool
isRTabEmpty RTable
tabDriver Bool -> Bool -> Bool
|| RTable -> Bool
isRTabEmpty RTable
tabProbed
        then
            RTable
emptyRTable
        else
            BinaryRTableOperation
d RTable
tabDriver (RTable -> RTable) -> RTable -> RTable
forall a b. (a -> b) -> a -> b
$ RJoinPredicate -> BinaryRTableOperation
sJ RJoinPredicate
jpred RTable
tabDriver RTable
tabProbed 
{-            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 (not $ jpred rtupDrv t) 
                                then 
                                    -- insert joined tuple to result table (i.e. the accumulator)
                                    insertAppendRTab (rtupDrv) accum
                                else 
                                    -- keep the accumulator unchanged
                                    accum
                        ) emptyRTable tabProbed 
-}

-- | 'RTable' semi-join operator. A short name for the 'runSemiJoin' function

sJ :: RJoinPredicate -> BinaryRTableOperation
sJ = RJoinPredicate -> BinaryRTableOperation
runSemiJoin

-- | Implements the semi-Join operation between two RTables (any type of join predicate is allowed)

-- It returns the 'RTuple's from the left 'RTable' that match with the right 'RTable'.

-- Note that if an 'RTuple' from the left 'RTable' matches more than one 'RTuple's from the right 'RTable'

-- the semi join operation will return only a single 'RTuple'.    

runSemiJoin ::
    RJoinPredicate
    -> RTable
    -> RTable
    -> RTable
runSemiJoin :: RJoinPredicate -> BinaryRTableOperation
runSemiJoin RJoinPredicate
jpred RTable
tabDriver RTable
tabProbed = 
    if RTable -> Bool
isRTabEmpty RTable
tabDriver Bool -> Bool -> Bool
|| RTable -> Bool
isRTabEmpty RTable
tabProbed
        then
            RTable
emptyRTable
        else 
            do 
                RTuple
rtupDrv <- RTable
tabDriver
                -- this is the equivalent of a nested loop with tabDriver playing the role of the driving table and tabProbed the probed table

                (RTuple -> RTable -> RTable) -> BinaryRTableOperation
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' (\RTuple
t RTable
accum -> 
                            if (RJoinPredicate
jpred RTuple
rtupDrv RTuple
t) 
                                then 
                                    -- insert joined tuple to result table (i.e. the accumulator)

                                    RTuple -> RTable -> RTable
insertAppendRTab (RTuple
rtupDrv) RTable
accum
                                else 
                                    -- keep the accumulator unchanged

                                    RTable
accum
                        ) RTable
emptyRTable RTable
tabProbed 

-- | 'RTable' Inner Join Operator. A short name for the 'runInnerJoinO' function

iJ :: RJoinPredicate -> BinaryRTableOperation
iJ = RJoinPredicate -> BinaryRTableOperation
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 :: RJoinPredicate -> BinaryRTableOperation
runInnerJoin RJoinPredicate
jpred RTable
irtab1 RTable
irtab2 =  
    if (RTable -> Bool
isRTabEmpty RTable
irtab1) Bool -> Bool -> Bool
|| (RTable -> Bool
isRTabEmpty RTable
irtab2)
        then
            RTable
emptyRTable
        else 
            do 
                RTuple
rtup1 <- RTable
irtab1
                RTuple
rtup2 <- RTable
irtab2
                let targetRtuple :: RTuple
targetRtuple = 
                        if (RJoinPredicate
jpred RTuple
rtup1 RTuple
rtup2)
                        then RTuple -> RTuple -> RTuple
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union RTuple
rtup1 RTuple
rtup2                 
                        else RTuple
forall k v. HashMap k v
HM.empty
                RTable -> RTable
removeEmptyRTuples (RTuple -> RTable
forall (m :: * -> *) a. Monad m => a -> m a
return RTuple
targetRtuple)
                    where removeEmptyRTuples :: RTable -> RTable
removeEmptyRTuples = (RTuple -> Bool) -> RTable -> RTable
f (Bool -> Bool
not(Bool -> Bool) -> (RTuple -> Bool) -> RTuple -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RTuple -> Bool
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 :: RJoinPredicate -> BinaryRTableOperation
runInnerJoinO RJoinPredicate
jpred RTable
tabDriver RTable
tabProbed =  
    if RTable -> Bool
isRTabEmpty RTable
tabDriver Bool -> Bool -> Bool
|| RTable -> Bool
isRTabEmpty RTable
tabProbed
        then
            RTable
emptyRTable
        else 
            do 
                RTuple
rtupDrv <- RTable
tabDriver
                -- this is the equivalent of a nested loop with tabDriver playing the role of the driving table and tabProbed the probed table

                (RTuple -> RTable -> RTable) -> BinaryRTableOperation
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' (\RTuple
t RTable
accum -> 
                            if (RJoinPredicate
jpred RTuple
rtupDrv RTuple
t) 
                                then 
                                    -- insert joined tuple to result table (i.e. the accumulator)

                                    RTuple -> RTable -> RTable
insertAppendRTab (RTuple -> RTuple -> RTuple
joinRTuples RTuple
rtupDrv RTuple
t) RTable
accum
                                else 
                                    -- keep the accumulator unchanged

                                    RTable
accum
                        ) RTable
emptyRTable RTable
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 :: RTuple -> RTuple -> RTuple
joinRTuples RTuple
tleft RTuple
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 :: RTuple
dontNeedChange  = RTuple -> RTuple -> RTuple
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HM.difference RTuple
tright RTuple
tleft
        changedPart :: RTuple
changedPart = RTuple -> RTuple -> RTuple
changeKeys RTuple
tleft RTuple
tright
        -- create  a new version of tright, with no common keys with tleft

        new_tright :: RTuple
new_tright = RTuple -> RTuple -> RTuple
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union RTuple
dontNeedChange RTuple
changedPart
    in RTuple -> RTuple -> RTuple
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union RTuple
tleft RTuple
new_tright  
        where 
            -- rename keys of right rtuple until there no more common keys with the left rtuple            

            changeKeys :: RTuple -> RTuple -> RTuple
            changeKeys :: RTuple -> RTuple -> RTuple
changeKeys RTuple
tleft RTuple
changedPart = 
                if RTuple -> Bool
isRTupEmpty (RTuple -> RTuple -> RTuple
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HM.intersection RTuple
changedPart RTuple
tleft)
                    then -- we are done, no more common keys

                        RTuple
changedPart
                    else
                        -- there are still common keys to change

                        let
                            needChange :: RTuple
needChange = RTuple -> RTuple -> RTuple
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HM.intersection RTuple
changedPart RTuple
tleft -- (k,v) pairs that exist in changedPart and the keys also appear in tleft. Thus these keys have to be renamed

                            dontNeedChange :: RTuple
dontNeedChange  = RTuple -> RTuple -> RTuple
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HM.difference RTuple
changedPart RTuple
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 :: RTuple
new_changedPart =  [(ColumnName, RDataType)] -> RTuple
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(ColumnName, RDataType)] -> RTuple)
-> [(ColumnName, RDataType)] -> RTuple
forall a b. (a -> b) -> a -> b
$ ((ColumnName, RDataType) -> (ColumnName, RDataType))
-> [(ColumnName, RDataType)] -> [(ColumnName, RDataType)]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(ColumnName
k,RDataType
v) -> (ColumnName -> ColumnName
newKey ColumnName
k, RDataType
v)) ([(ColumnName, RDataType)] -> [(ColumnName, RDataType)])
-> [(ColumnName, RDataType)] -> [(ColumnName, RDataType)]
forall a b. (a -> b) -> a -> b
$ RTuple -> [(ColumnName, RDataType)]
forall k v. HashMap k v -> [(k, v)]
toList RTuple
needChange
                        in RTuple -> RTuple -> RTuple
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union RTuple
dontNeedChange (RTuple -> RTuple -> RTuple
changeKeys RTuple
tleft RTuple
new_changedPart)
                          
            -- generate a new key as this:

            -- "hello" -> "hello_1"

            -- "hello_1" -> "hello_2"

            -- "hello_2" -> "hello_3"

            newKey :: ColumnName -> ColumnName
            newKey :: ColumnName -> ColumnName
newKey ColumnName
nameT  = 
                let 
                    name :: String
name  = ColumnName -> String
T.unpack ColumnName
nameT
                    lastChar :: Char
lastChar = String -> Char
forall a. [a] -> a
Data.List.last String
name
                    beforeLastChar :: Char
beforeLastChar = String
name String -> Int -> Char
forall a. [a] -> Int -> a
!! (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
name Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
                in  
                    if Char
beforeLastChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'  Bool -> Bool -> Bool
&&  Char -> Bool
Data.Char.isDigit Char
lastChar
                                    then String -> ColumnName
T.pack (String -> ColumnName) -> String -> ColumnName
forall a b. (a -> b) -> a -> b
$ (Int -> ShowS
forall a. Int -> [a] -> [a]
Data.List.take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
name Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
name) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ( Char
'_' Char -> ShowS
forall a. a -> [a] -> [a]
: (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ (String -> Int
forall a. Read a => String -> a
read (Char
lastChar Char -> ShowS
forall a. a -> [a] -> [a]
: String
"") :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) )
                                    else String -> ColumnName
T.pack (String -> ColumnName) -> String -> ColumnName
forall a b. (a -> b) -> a -> b
$ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_1"


-- | RTable Left Outer Join Operator. A short name for the 'runLeftJoin' function

lJ :: RJoinPredicate -> BinaryRTableOperation
lJ = RJoinPredicate -> BinaryRTableOperation
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 :: RJoinPredicate -> BinaryRTableOperation
runLeftJoin RJoinPredicate
jpred RTable
preservingTab RTable
tab = 
    if RTable -> Bool
isRTabEmpty RTable
preservingTab
        then 
            RTable
emptyRTable
        else
            if RTable -> Bool
isRTabEmpty RTable
tab
                then
                    -- return the preserved tab 

                    RTable
preservingTab

                else 
                    -- we know that both the preservingTab and tab are non empty 

                    let 
                        unionFstPart :: RTable
unionFstPart = RJoinPredicate -> BinaryRTableOperation
iJ RJoinPredicate
jpred RTable
preservingTab RTable
tab 

                        -- debug

                        -- !dummy1 = trace ("unionFstPart:\n" ++ show unionFstPart) True


                        -- project only the preserving tab's columns

                        fstPartProj :: RTable
fstPartProj = [ColumnName] -> RTable -> RTable
p (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
preservingTab) RTable
unionFstPart

                        -- the second part are the rows from the preserving table that dont join

                        -- we will use the Difference operations for this

                        unionSndPart :: RTable
unionSndPart = 
                            let 
                                difftab :: RTable
difftab = BinaryRTableOperation
d RTable
preservingTab RTable
fstPartProj -- unionFstPart


                                -- now enhance the result with the columns of the right table

                            in RJoinPredicate -> BinaryRTableOperation
iJ (\RTuple
t1 RTuple
t2 -> Bool
True) RTable
difftab (RTuple -> RTable
createSingletonRTable (RTuple -> RTable) -> RTuple -> RTable
forall a b. (a -> b) -> a -> b
$ [ColumnName] -> RTuple
createNullRTuple ([ColumnName] -> RTuple) -> [ColumnName] -> RTuple
forall a b. (a -> b) -> a -> b
$ (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
tab))
                        -- debug

                        -- !dummy2 = trace ("unionSndPart :\n" ++ show unionSndPart) True

                        -- !dummy3 = trace ("u unionFstPart unionSndPart :\n" ++ (show $ u unionFstPart unionSndPart)) True


                            {-   -- now enhance the result with the columns of the right table
                                joinedColumnsTab = iJ (\t1 t2 -> True) difftab (createSingletonRTable $ createNullRTuple $ (getColumnNamesFromRTab tab))
                                -- get only the columns from the two rtables that dont overlap
                                finalListOfColumns = getUniqueColumnNames (getColumnNamesFromRTab preservingTab) (getColumnNamesFromRTab tab) 
                                -- project only the columns from both rtables that dont overlap
                                -- otherwise, the union will hit an "ConflictingRTableStructures "Cannot run: Union, due to conflicting RTable structures" exception.
                            in p finalListOfColumns joinedColumnsTab
                            -}
                    in BinaryRTableOperation
u RTable
unionFstPart RTable
unionSndPart


-- | Receives two lists of 'ColumnName's and returns the unique list of 'ColumnName's 

-- after concatenating the two and removing the names from the second one that are a prefix of the first one.

-- This function is intended to dedublicate common columns after a join (see 'ij'), where "ColA" for example,

-- will also appear as "ColA_1". This function DOES NOT dedublicate columns "ColA" and "ColAsomeSuffix", only

-- cases like this one "ColName_Num" (e.g., ColName_1, ColName_2, etc.)

-- Here is an example:

--

-- >>> getUniqueColumnNames ["ColA","ColB"] ["ColC","ColA", "ColA_1", "ColA_2", "ColA_A", "ColA_hello", "ColAhello"]

-- >>> ["ColA","ColB","ColC","ColA_A","ColA_hello","ColAhello"]

--

getUniqueColumnNamesAfterJoin :: [ColumnName] -> [ColumnName] -> [ColumnName]
getUniqueColumnNamesAfterJoin :: [ColumnName] -> [ColumnName] -> [ColumnName]
getUniqueColumnNamesAfterJoin [ColumnName]
cl1 [ColumnName]
cl2 = 
    -- cl1  ++ Data.List.filter (\n2 -> and $ Data.List.map (\n1 -> not $ T.isPrefixOf n1 n2) cl1) cl2

    [ColumnName]
cl1  [ColumnName] -> [ColumnName] -> [ColumnName]
forall a. [a] -> [a] -> [a]
++ (ColumnName -> Bool) -> [ColumnName] -> [ColumnName]
forall a. (a -> Bool) -> [a] -> [a]
Data.List.filter (\ColumnName
n2 -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (ColumnName -> Bool) -> [ColumnName] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
n1 -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ColumnName -> ColumnName -> Bool
isMyPrefixOf ColumnName
n1 ColumnName
n2) [ColumnName]
cl1) [ColumnName]
cl2
    where
        -- We want a prefix test that will return:

        -- isMyPrefixOf "ColA" "ColA_1" == True

        -- isMyPrefixOf "ColA" "ColA_lala" == False

        -- isMyPrefixOf "ColA" "ColAlala" == False

        isMyPrefixOf :: ColumnName -> ColumnName -> Bool
        isMyPrefixOf :: ColumnName -> ColumnName -> Bool
isMyPrefixOf ColumnName
cn1 ColumnName
cn2 = 
            let
                -- rip off suffixes of the form "_Num" e.g., "Col_1", "Col_2"  -> "Col", "Col"

                cn2_new :: ColumnName
cn2_new = (Char -> Bool) -> ColumnName -> ColumnName
T.dropWhileEnd (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') (ColumnName -> ColumnName) -> ColumnName -> ColumnName
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ColumnName -> ColumnName
T.dropWhileEnd (\Char
c -> Char -> Bool
isDigit Char
c) ColumnName
cn2
                -- and now compare for equality

            in ColumnName
cn1 ColumnName -> ColumnName -> Bool
forall a. Eq a => a -> a -> Bool
== ColumnName
cn2_new

-- | RTable Right Outer Join Operator. A short name for the 'runRightJoin' function

rJ :: RJoinPredicate -> BinaryRTableOperation
rJ = RJoinPredicate -> BinaryRTableOperation
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 :: RJoinPredicate -> BinaryRTableOperation
runRightJoin RJoinPredicate
jpred RTable
tab RTable
preservingTab =
    if RTable -> Bool
isRTabEmpty RTable
preservingTab
        then 
            RTable
emptyRTable
        else
            if RTable -> Bool
isRTabEmpty RTable
tab
                then
                    RTable
preservingTab        
                else     
                    -- we know that both the preservingTab and tab are non empty 

                    let 
                        unionFstPart :: RTable
unionFstPart =                             
                            RJoinPredicate -> BinaryRTableOperation
iJ (RJoinPredicate -> RJoinPredicate
forall a b c. (a -> b -> c) -> b -> a -> c
flip RJoinPredicate
jpred) RTable
preservingTab RTable
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 :: RTable
fstPartProj = 
                            [ColumnName] -> RTable -> RTable
p (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
preservingTab) RTable
unionFstPart

                        -- the second part are the rows from the preserving table that dont join

                        -- we will use the Difference operations for this

                        unionSndPart :: RTable
unionSndPart = 
                            let 
                                difftab :: RTable
difftab = 
                                    BinaryRTableOperation
d RTable
preservingTab   RTable
fstPartProj -- unionFstPart 

                                -- now enhance the result with the columns of the left table

                            in RJoinPredicate -> BinaryRTableOperation
iJ (\RTuple
t1 RTuple
t2 -> Bool
True) RTable
difftab (RTuple -> RTable
createSingletonRTable (RTuple -> RTable) -> RTuple -> RTable
forall a b. (a -> b) -> a -> b
$ [ColumnName] -> RTuple
createNullRTuple ([ColumnName] -> RTuple) -> [ColumnName] -> RTuple
forall a b. (a -> b) -> a -> b
$ (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
tab))
                        -- debug

                        -- !dummy2 = trace ("unionSndPart :\n" ++ show unionSndPart) True

                        -- !dummy3 = trace ("u unionFstPart unionSndPart :\n" ++ (show $ u unionFstPart unionSndPart)) True

                    in BinaryRTableOperation
u RTable
unionFstPart RTable
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 :: RJoinPredicate -> BinaryRTableOperation
foJ = RJoinPredicate -> BinaryRTableOperation
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 :: RJoinPredicate -> BinaryRTableOperation
runFullOuterJoin RJoinPredicate
jpred RTable
leftRTab RTable
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 :: RTable
unionFstPart = RJoinPredicate -> BinaryRTableOperation
lJ RJoinPredicate
jpred RTable
leftRTab RTable
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 :: RTable
unionSndPartTemp1 = BinaryRTableOperation
d (RJoinPredicate -> BinaryRTableOperation
rJ RJoinPredicate
jpred RTable
leftRTab RTable
rightRTab) (RJoinPredicate -> BinaryRTableOperation
iJ (RJoinPredicate -> RJoinPredicate
forall a b c. (a -> b -> c) -> b -> a -> c
flip RJoinPredicate
jpred) RTable
rightRTab RTable
leftRTab)        
        -- isolate the columns of the rightTab

        unionSndPartTemp2 :: RTable
unionSndPartTemp2 = [ColumnName] -> RTable -> RTable
p (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
rightRTab) RTable
unionSndPartTemp1
        -- this join is a trick in order to change names of the rightTab

        unionSndPart :: RTable
unionSndPart = RJoinPredicate -> BinaryRTableOperation
iJ (\RTuple
t1 RTuple
t2 -> Bool
True) (RTuple -> RTable
createSingletonRTable (RTuple -> RTable) -> RTuple -> RTable
forall a b. (a -> b) -> a -> b
$ [ColumnName] -> RTuple
createNullRTuple ([ColumnName] -> RTuple) -> [ColumnName] -> RTuple
forall a b. (a -> b) -> a -> b
$ (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
leftRTab)) RTable
unionSndPartTemp2
    in RTable
unionFstPart BinaryRTableOperation
`u` RTable
unionSndPart

-- | RTable Union Operator. A short name for the 'runUnion' function

u :: BinaryRTableOperation
u = BinaryRTableOperation
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.

-- Note that dublicate 'RTuple' elimination takes places.

runUnion :: 
    RTable
    -> RTable
    -> RTable
runUnion :: BinaryRTableOperation
runUnion RTable
rt1 RTable
rt2 =
    if RTable -> Bool
isRTabEmpty RTable
rt1 Bool -> Bool -> Bool
&& RTable -> Bool
isRTabEmpty RTable
rt2
        then 
            RTable
emptyRTable
        else
            if RTable -> Bool
isRTabEmpty RTable
rt1
                then RTable
rt2 
                else
                    if RTable -> Bool
isRTabEmpty RTable
rt2
                        then RTable
rt1
                        else 
                            -- check similarity of rtable structures 

                            if RTable -> RTable -> Bool
rtabsSameStructure RTable
rt1 RTable
rt2  
                                then
                                    -- run the union

                                    -- 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)

                                    RTable
rt1 BinaryRTableOperation
forall a. Vector a -> Vector a -> Vector a
V.++ ((RTuple -> RTable -> RTable) -> BinaryRTableOperation
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr (RTuple -> RTable -> RTable
un) RTable
emptyRTable RTable
rt2)
                                else 
                                   ConflictingRTableStructures -> RTable
forall a e. Exception e => e -> a
throw (ConflictingRTableStructures -> RTable)
-> ConflictingRTableStructures -> RTable
forall a b. (a -> b) -> a -> b
$ String -> ConflictingRTableStructures
ConflictingRTableStructures String
"Cannot run: Union, due to conflicting RTable structures." 
    where
        un :: RTuple -> RTable -> RTable
        un :: RTuple -> RTable -> RTable
un RTuple
tupRight RTable
acc = 
            -- Can we find tupRight in the left table?            

            if RTuple -> RTable -> Bool
didYouFindIt RTuple
tupRight RTable
rt1 
                then RTable
acc   -- then discard tuplRight ,leave result unchanged          

                else RTable -> RTuple -> RTable
forall a. Vector a -> a -> Vector a
V.snoc RTable
acc RTuple
tupRight  -- else insert tupRight into final result


-- | Implements the union-all of two RTables. I.e., a union without dublicate 'RTuple' elimination. Runs in O(m+n).

runUnionAll :: 
    RTable
    -> RTable
    -> RTable
runUnionAll :: BinaryRTableOperation
runUnionAll RTable
rt1 RTable
rt2 =
    if RTable -> Bool
isRTabEmpty RTable
rt1 Bool -> Bool -> Bool
&& RTable -> Bool
isRTabEmpty RTable
rt2
        then 
            RTable
emptyRTable
        else
            if RTable -> Bool
isRTabEmpty RTable
rt1
                then RTable
rt2 
                else
                    if RTable -> Bool
isRTabEmpty RTable
rt2
                        then RTable
rt1
                        else  
                            -- check similarity of rtable structures

                            if RTable -> RTable -> Bool
rtabsSameStructure RTable
rt1 RTable
rt2  
                                then
                                    -- run the union

                                    RTable
rt1 BinaryRTableOperation
forall a. Vector a -> Vector a -> Vector a
V.++ RTable
rt2  -- Data.Vector concatenation O(n+m)

                                else 
                                   ConflictingRTableStructures -> RTable
forall a e. Exception e => e -> a
throw (ConflictingRTableStructures -> RTable)
-> ConflictingRTableStructures -> RTable
forall a b. (a -> b) -> a -> b
$ String -> ConflictingRTableStructures
ConflictingRTableStructures String
"Cannot run: UnionAll, due to conflicting RTable structures."                             

-- | RTable Intersection Operator. A short name for the 'runIntersect' function

i :: BinaryRTableOperation
i = BinaryRTableOperation
runIntersect

-- | Implements the intersection of two RTables 

runIntersect :: 
    RTable
    -> RTable
    -> RTable
runIntersect :: BinaryRTableOperation
runIntersect RTable
rt1 RTable
rt2 =
    if RTable -> Bool
isRTabEmpty RTable
rt1 Bool -> Bool -> Bool
|| RTable -> Bool
isRTabEmpty RTable
rt2 
        then
            RTable
emptyRTable
        else 
            -- check similarity of rtable structures

            if RTable -> RTable -> Bool
rtabsSameStructure RTable
rt1 RTable
rt2  
                then
                    -- run the intersection

                    -- construct the intersect result by traversing the left table and checking if each tuple exists in the right table

                    (RTuple -> RTable -> RTable) -> BinaryRTableOperation
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr (RTuple -> RTable -> RTable
intsect) RTable
emptyRTable RTable
rt1
                else 
                   ConflictingRTableStructures -> RTable
forall a e. Exception e => e -> a
throw (ConflictingRTableStructures -> RTable)
-> ConflictingRTableStructures -> RTable
forall a b. (a -> b) -> a -> b
$ String -> ConflictingRTableStructures
ConflictingRTableStructures String
"Cannot run: Intersect, due to conflicting RTable structures." 
    where
        intsect :: RTuple -> RTable -> RTable
        intsect :: RTuple -> RTable -> RTable
intsect RTuple
tupLeft RTable
acc = 
            -- Can we find tupLeft in the right table?            

            if RTuple -> RTable -> Bool
didYouFindIt RTuple
tupLeft RTable
rt2 
                then RTable -> RTuple -> RTable
forall a. Vector a -> a -> Vector a
V.snoc RTable
acc RTuple
tupLeft  -- then insert tupLeft into final result

                else RTable
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 :: BinaryRTableOperation
d = BinaryRTableOperation
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 :: BinaryRTableOperation
runDiff RTable
rt1 RTable
rt2 =
    if RTable -> Bool
isRTabEmpty RTable
rt1
        then
            RTable
emptyRTable
        else 
            if RTable -> Bool
isRTabEmpty RTable
rt2
                then
                    RTable
rt1
                else  
                    -- check similarity of rtable structures

                    if RTable -> RTable -> Bool
rtabsSameStructure RTable
rt1 RTable
rt2  
                        then
                            -- run the minus

                            -- construct the diff result by traversing the left table and checking if each tuple exists in the right table

                            (RTuple -> RTable -> RTable) -> BinaryRTableOperation
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr (RTuple -> RTable -> RTable
diff) RTable
emptyRTable RTable
rt1
                        else 
                           ConflictingRTableStructures -> RTable
forall a e. Exception e => e -> a
throw (ConflictingRTableStructures -> RTable)
-> ConflictingRTableStructures -> RTable
forall a b. (a -> b) -> a -> b
$ String -> ConflictingRTableStructures
ConflictingRTableStructures String
"Cannot run: Minus, due to conflicting RTable structures."                             
    where
        diff :: RTuple -> RTable -> RTable
        diff :: RTuple -> RTable -> RTable
diff RTuple
tupLeft RTable
acc = 
            -- Can we find tupLeft in the right table?            

            if RTuple -> RTable -> Bool
didYouFindIt RTuple
tupLeft RTable
rt2 
                then RTable
acc  -- then discard tuplLeft ,leave result unchanged

                else RTable -> RTuple -> RTable
forall a. Vector a -> a -> Vector a
V.snoc RTable
acc RTuple
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 :: RTuple -> RTable -> Bool
didYouFindIt RTuple
searchTup RTable
tab = 
    (RTuple -> Bool -> Bool) -> Bool -> RTable -> Bool
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr (\RTuple
t Bool
acc -> (RJoinPredicate
areTheyEqual RTuple
searchTup RTuple
t) Bool -> Bool -> Bool
|| Bool
acc) Bool
False RTable
tab 
areTheyEqual :: RTuple -> RTuple -> Bool
areTheyEqual :: RJoinPredicate
areTheyEqual RTuple
t1 RTuple
t2 =  -- foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a

    (ColumnName -> RDataType -> Bool -> Bool) -> Bool -> RTuple -> Bool
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey (ColumnName -> RDataType -> Bool -> Bool
accumulator) Bool
True RTuple
t1
        where 
            accumulator :: ColumnName -> RDataType -> Bool -> Bool
            accumulator :: ColumnName -> RDataType -> Bool -> Bool
accumulator ColumnName
colName RDataType
val Bool
acc = 
                case RDataType
val of
                    RDataType
Null -> 
                            case (RTuple
t2RTuple -> ColumnName -> RDataType
<!>ColumnName
colName) of
                                RDataType
Null -> Bool
acc -- -- i.e., True && acc ,if both columns are Null then return equality

                                RDataType
_    -> Bool
False -- i.e., False && acc

                    RDataType
_    -> case (RTuple
t2RTuple -> ColumnName -> RDataType
<!>ColumnName
colName) of
                                RDataType
Null -> Bool
False -- i.e., False && acc

                                RDataType
_    -> (RDataType
val RDataType -> RDataType -> Bool
forall a. Eq a => a -> a -> Bool
== RTuple
t2RTuple -> ColumnName -> RDataType
<!>ColumnName
colName) Bool -> Bool -> Bool
&& Bool
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 :: [RAggOperation] -> RTable -> RTable
rAgg = [RAggOperation] -> RTable -> RTable
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 :: [RAggOperation] -> RTable -> RTable
runAggregation [] RTable
rtab = RTable
rtab
runAggregation [RAggOperation]
aggOps RTable
rtab =          
    if RTable -> Bool
isRTabEmpty RTable
rtab
        then RTable
emptyRTable
        else
            RTuple -> RTable
createSingletonRTable ([RAggOperation] -> RTable -> RTuple
getResultRTuple [RAggOperation]
aggOps RTable
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 :: [RAggOperation] -> RTable -> RTuple
getResultRTuple [] RTable
_ = RTuple
emptyRTuple
                getResultRTuple (RAggOperation
agg:[RAggOperation]
aggs) RTable
rt =                    
                    let RAggOperation { sourceCol :: RAggOperation -> ColumnName
sourceCol = ColumnName
src, targetCol :: RAggOperation -> ColumnName
targetCol = ColumnName
trg, aggFunc :: RAggOperation -> RTable -> RTuple
aggFunc = RTable -> RTuple
aggf } = RAggOperation
agg                        
                    in ([RAggOperation] -> RTable -> RTuple
getResultRTuple [RAggOperation]
aggs RTable
rt) RTuple -> RTuple -> RTuple
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union` (RTable -> RTuple
aggf RTable
rt)   -- (aggf rt) `HM.union` (getResultRTuple aggs rt) 


-- | Order By Operator. A short name for the 'runOrderBy' function

rO :: [(ColumnName, OrderingSpec)] -> RTable -> RTable
rO = [(ColumnName, OrderingSpec)] -> RTable -> RTable
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 :: [(ColumnName, OrderingSpec)] -> RTable -> RTable
runOrderBy [(ColumnName, OrderingSpec)]
ordSpec RTable
rtab = 
    if RTable -> Bool
isRTabEmpty RTable
rtab
        then RTable
emptyRTable
    else 
        let unsortedRTupList :: [RTuple]
unsortedRTupList = RTable -> [RTuple]
rtableToList RTable
rtab
            sortedRTupList :: [RTuple]
sortedRTupList = (RTuple -> RTuple -> Ordering) -> [RTuple] -> [RTuple]
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy (\RTuple
t1 RTuple
t2 -> [(ColumnName, OrderingSpec)] -> RTuple -> RTuple -> Ordering
compareTuples [(ColumnName, OrderingSpec)]
ordSpec RTuple
t1 RTuple
t2) [RTuple]
unsortedRTupList
        in [RTuple] -> RTable
rtableFromList [RTuple]
sortedRTupList
        where 
            compareTuples :: [(ColumnName, OrderingSpec)] -> RTuple -> RTuple -> Ordering
            compareTuples :: [(ColumnName, OrderingSpec)] -> RTuple -> RTuple -> Ordering
compareTuples [] RTuple
t1 RTuple
t2 = Ordering
EQ
            compareTuples ((ColumnName
col, OrderingSpec
colordspec) : [(ColumnName, OrderingSpec)]
rest) RTuple
t1 RTuple
t2 = 
                -- if they are equal or both Null on the column in question, then go to the next column

                if RDataType -> RDataType -> RDataType
nvl (RTuple
t1 RTuple -> ColumnName -> RDataType
<!> ColumnName
col) (ColumnName -> RDataType
RText ColumnName
"I am Null baby!") RDataType -> RDataType -> Bool
forall a. Eq a => a -> a -> Bool
== RDataType -> RDataType -> RDataType
nvl (RTuple
t2 RTuple -> ColumnName -> RDataType
<!> ColumnName
col) (ColumnName -> RDataType
RText ColumnName
"I am Null baby!")
                    then [(ColumnName, OrderingSpec)] -> RTuple -> RTuple -> Ordering
compareTuples [(ColumnName, OrderingSpec)]
rest RTuple
t1 RTuple
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 RDataType -> Bool
isNull (RTuple
t1 RTuple -> ColumnName -> RDataType
<!> ColumnName
col)
                            then 
                                case OrderingSpec
colordspec of
                                    OrderingSpec
Asc ->  Ordering
GT -- t1 is GT than t2 (Nulls go to the end)

                                    OrderingSpec
Desc -> Ordering
LT
                            else 
                                if RDataType -> Bool
isNull (RTuple
t2 RTuple -> ColumnName -> RDataType
<!> ColumnName
col)
                                    then 
                                        case OrderingSpec
colordspec of
                                            OrderingSpec
Asc ->  Ordering
LT -- t1 is LT than t2 (Nulls go to the end)

                                            OrderingSpec
Desc -> Ordering
GT
                                else
                                    -- here we cant have Nulls

                                    case RDataType -> RDataType -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RTuple
t1 RTuple -> ColumnName -> RDataType
<!> ColumnName
col) (RTuple
t2 RTuple -> ColumnName -> RDataType
<!> ColumnName
col) of
                                        Ordering
GT -> if OrderingSpec
colordspec OrderingSpec -> OrderingSpec -> Bool
forall a. Eq a => a -> a -> Bool
== OrderingSpec
Asc 
                                                then Ordering
GT else Ordering
LT
                                        Ordering
LT -> if OrderingSpec
colordspec OrderingSpec -> OrderingSpec -> Bool
forall a. Eq a => a -> a -> Bool
== OrderingSpec
Asc 
                                                then Ordering
LT else Ordering
GT

-- | Group By Operator. A short name for the 'runGroupBy' function

rG :: RJoinPredicate
-> [RAggOperation] -> [ColumnName] -> RTable -> RTable
rG = RJoinPredicate
-> [RAggOperation] -> [ColumnName] -> RTable -> RTable
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 :: RJoinPredicate -> [ColumnName] -> RTable -> [RTable]
groupNoAggList RJoinPredicate
gpred [ColumnName]
cols RTable
rtab = 
    if RTable -> Bool
isRTabEmpty RTable
rtab
        then [RTable
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 :: [RTuple]
listOfRTupSorted = RTable -> [RTuple]
rtableToList (RTable -> [RTuple]) -> RTable -> [RTuple]
forall a b. (a -> b) -> a -> b
$ [(ColumnName, OrderingSpec)] -> RTable -> RTable
runOrderBy ([ColumnName] -> [(ColumnName, OrderingSpec)]
createOrderingSpec [ColumnName]
cols) RTable
rtab

                -- debug

               -- !dummy1 = trace (show listOfRTupSorted) True

                    
                    -- b then produce the groups

                listOfRTupGroupLists :: [[RTuple]]
listOfRTupGroupLists = RJoinPredicate -> [RTuple] -> [[RTuple]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
Data.List.groupBy RJoinPredicate
gpred [RTuple]
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 :: [RTable]
listofGroupRtabs = ([RTuple] -> RTable) -> [[RTuple]] -> [RTable]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map ([RTuple] -> RTable
rtableFromList) [[RTuple]]
listOfRTupGroupLists
            in [RTable]
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 :: [RTable] -> RTable
concatRTab [RTable]
rtabsl = BinaryRTableOperation -> [RTable] -> RTable
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Data.List.foldr1 (BinaryRTableOperation
u) [RTable]
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 :: RJoinPredicate -> [ColumnName] -> RTable -> RTable
groupNoAgg RJoinPredicate
gpred [ColumnName]
cols RTable
rtab = 
    if RTable -> Bool
isRTabEmpty RTable
rtab
        then RTable
emptyRTable
        else 
            let
                listofGroupRtabs :: [RTable]
listofGroupRtabs = RJoinPredicate -> [ColumnName] -> RTable -> [RTable]
groupNoAggList RJoinPredicate
gpred [ColumnName]
cols RTable
rtab
            in [RTable] -> RTable
concatRTab [RTable]
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 :: RJoinPredicate
-> [RAggOperation] -> [ColumnName] -> RTable -> RTable
runGroupBy RJoinPredicate
gpred [RAggOperation]
aggOps [ColumnName]
cols RTable
rtab =  
    if RTable -> Bool
isRTabEmpty RTable
rtab
        then 
            RTable
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 :: [RTable]
listofGroupRtabs = RJoinPredicate -> [ColumnName] -> RTable -> [RTable]
groupNoAggList RJoinPredicate
gpred [ColumnName]
cols RTable
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 :: [RTable]
listOfGroupingColumnsRtabs = (RTable -> RTable) -> [RTable] -> [RTable]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map ( (Int -> RTable -> RTable
limit Int
1) (RTable -> RTable) -> (RTable -> RTable) -> RTable -> RTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ColumnName] -> RTable -> RTable
p [ColumnName]
cols) ) [RTable]
listofGroupRtabs

                -- debug

                -- !dummy3 = trace (show listOfGroupingColumnsRtabs) True


                -- 4. Aggregate each group according to input and produce a list of (aggregated singleton RTables)

                listOfAggregatedRtabs :: [RTable]
listOfAggregatedRtabs = (RTable -> RTable) -> [RTable] -> [RTable]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map ([RAggOperation] -> RTable -> RTable
rAgg [RAggOperation]
aggOps) [RTable]
listofGroupRtabs

                -- debug

                -- !dummy4 = trace (show listOfAggregatedRtabs ) True


                -- 5. Join the two list of singleton RTables

                listOfFinalRtabs :: [RTable]
listOfFinalRtabs = 
                    if [RAggOperation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.List.null [RAggOperation]
aggOps -- if the aggregation list is empty

                        then
                            [RTable]
listOfGroupingColumnsRtabs -- then returned just the group by columns

                        else
                            BinaryRTableOperation -> [RTable] -> [RTable] -> [RTable]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Data.List.zipWith (RJoinPredicate -> BinaryRTableOperation
iJ (\RTuple
t1 RTuple
t2 -> Bool
True)) [RTable]
listOfGroupingColumnsRtabs [RTable]
listOfAggregatedRtabs

                -- debug

                -- !dummy5 = trace (show listOfFinalRtabs) True



                -- 6. Union all individual singleton RTables into the final RTable

            in  BinaryRTableOperation -> [RTable] -> RTable
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Data.List.foldr1 (BinaryRTableOperation
u) [RTable]
listOfFinalRtabs
            

-- | Helper function to returned a fixed Ordering Specification 'OrderingSpec' from a list of 'ColumnName's

createOrderingSpec :: [ColumnName] -> [(ColumnName, OrderingSpec)]
createOrderingSpec :: [ColumnName] -> [(ColumnName, OrderingSpec)]
createOrderingSpec [ColumnName]
cols = [ColumnName] -> [OrderingSpec] -> [(ColumnName, OrderingSpec)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [ColumnName]
cols (Int -> [OrderingSpec] -> [OrderingSpec]
forall a. Int -> [a] -> [a]
Data.List.take ([ColumnName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length [ColumnName]
cols) ([OrderingSpec] -> [OrderingSpec])
-> [OrderingSpec] -> [OrderingSpec]
forall a b. (a -> b) -> a -> b
$ OrderingSpec -> [OrderingSpec]
forall a. a -> [a]
Data.List.repeat OrderingSpec
Asc)

-- | A short name for the 'runCombinedROp' function

rComb :: (RTable -> RTable) -> RTable -> RTable
rComb = (RTable -> RTable) -> RTable -> RTable
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 :: (RTable -> RTable) -> RTable -> RTable
runCombinedROp RTable -> RTable
f RTable
rtab = RTable -> RTable
f RTable
rtab


-- * ########## RTable DML Operations ##############


-- | O(n) append an RTuple to an RTable

-- Please note that this is an __immutable__ implementation of an 'RTable' insert.

-- This simply means that the insert operation returns a new 'RTable' and does not

-- affect the original 'RTable'.

insertAppendRTab :: RTuple -> RTable -> RTable
insertAppendRTab :: RTuple -> RTable -> RTable
insertAppendRTab RTuple
rtup RTable
rtab = -- V.snoc rtab rtup

    if RTable -> Bool
isRTabEmpty RTable
rtab Bool -> Bool -> Bool
&& RTuple -> Bool
isRTupEmpty RTuple
rtup 
        then RTable
emptyRTable
        else
            if RTable -> Bool
isRTabEmpty RTable
rtab Bool -> Bool -> Bool
&& Bool -> Bool
not(RTuple -> Bool
isRTupEmpty RTuple
rtup)
                then
                    RTuple -> RTable
createSingletonRTable RTuple
rtup 
                else
                    if Bool -> Bool
not(RTable -> Bool
isRTabEmpty RTable
rtab) Bool -> Bool -> Bool
&& RTuple -> Bool
isRTupEmpty RTuple
rtup 
                        then RTable
rtab 
                        else  -- non of the two is empty

                            -- check similarity of structure vefore the insert

                            if RTable -> RTable -> Bool
rtabsSameStructure (RTuple -> RTable
createSingletonRTable RTuple
rtup) RTable
rtab
                                then 
                                    RTable -> RTuple -> RTable
forall a. Vector a -> a -> Vector a
V.snoc RTable
rtab RTuple
rtup
                                else 
                                    ConflictingRTableStructures -> RTable
forall a e. Exception e => e -> a
throw (ConflictingRTableStructures -> RTable)
-> ConflictingRTableStructures -> RTable
forall a b. (a -> b) -> a -> b
$ String -> ConflictingRTableStructures
ConflictingRTableStructures String
"Cannot run: Insert Into Values (insertAppendRTab), due to conflicting RTable structures." 

-- | O(n) prepend an RTuple to an RTable

-- Please note that this is an __immutable__ implementation of an 'RTable' insert.

-- This simply means that the insert operation returns a new 'RTable' and does not

-- affect the original 'RTable'.

insertPrependRTab :: RTuple -> RTable -> RTable
insertPrependRTab :: RTuple -> RTable -> RTable
insertPrependRTab RTuple
rtup RTable
rtab = 
    if RTable -> Bool
isRTabEmpty RTable
rtab Bool -> Bool -> Bool
&& RTuple -> Bool
isRTupEmpty RTuple
rtup 
        then RTable
emptyRTable
        else
            if RTable -> Bool
isRTabEmpty RTable
rtab Bool -> Bool -> Bool
&& Bool -> Bool
not(RTuple -> Bool
isRTupEmpty RTuple
rtup)
                then
                    RTuple -> RTable
createSingletonRTable RTuple
rtup 
                else
                    if Bool -> Bool
not(RTable -> Bool
isRTabEmpty RTable
rtab) Bool -> Bool -> Bool
&& RTuple -> Bool
isRTupEmpty RTuple
rtup 
                        then RTable
rtab 
                        else  -- non of the two is empty    

                            -- check similarity of structure vefore the insert

                            if RTable -> RTable -> Bool
rtabsSameStructure (RTuple -> RTable
createSingletonRTable RTuple
rtup) RTable
rtab
                                then 
                                    RTuple -> RTable -> RTable
forall a. a -> Vector a -> Vector a
V.cons RTuple
rtup RTable
rtab 
                                else 
                                    ConflictingRTableStructures -> RTable
forall a e. Exception e => e -> a
throw (ConflictingRTableStructures -> RTable)
-> ConflictingRTableStructures -> RTable
forall a b. (a -> b) -> a -> b
$ String -> ConflictingRTableStructures
ConflictingRTableStructures String
"Cannot run: insertPrependRTab, due to conflicting RTable structures." 


-- | Insert an 'RTable' to an existing 'RTable'. This is equivalent to an @INSERT INTO SELECT@ caluse in SQL.

-- We want to insert into an 'RTable' the results of a \"subquery\", which in our case is materialized via the

-- input 'RTable'.

-- Please note that this is an __immutable__ implementation of an 'RTable' insert.

-- This simply means that the insert operation returns a new 'RTable' and does not

-- affect the original 'RTable'.

-- Also note that the source and target 'RTable's should have the same structure.

-- By \"structure\", we mean that the 'ColumnName's and the corresponding data types must match. Essentially what we record in the 'ColumnInfo'

-- must be the same for the two 'RTable's. Otherwise a 'ConflictingRTableStructures' exception will be thrown.

insertRTabToRTab ::
                RTable -- ^ Source 'RTable' to be inserted

                -> RTable -- ^ Target 'RTable'

                -> RTable -- ^ Final Result

insertRTabToRTab :: BinaryRTableOperation
insertRTabToRTab RTable
src RTable
trg = 
    if RTable -> Bool
isRTabEmpty RTable
src
        then RTable
trg
        else
            if RTable -> Bool
isRTabEmpty RTable
trg
                then RTable
src 
                else -- both src and trg are not empty

                    
                    -- check that both rtables have the same structure: 

                    --      num of columns, column data types and column names.

                    if RTable -> RTable -> Bool
rtabsSameStructure RTable
src RTable
trg 
                        then
                            -- run the insert (as a union all)

                            BinaryRTableOperation
runUnionAll RTable
src RTable
trg
                        else 
                           ConflictingRTableStructures -> RTable
forall a e. Exception e => e -> a
throw (ConflictingRTableStructures -> RTable)
-> ConflictingRTableStructures -> RTable
forall a b. (a -> b) -> a -> b
$ String -> ConflictingRTableStructures
ConflictingRTableStructures String
"Cannot run: Insert Into <TAB> RTuples, due to conflicting RTable structures." 

-- | Upsert (Update+Insert, aka Merge) Operation. We provide a source 'RTable' and a matching condition ('RUpsertPredicate') to the 'RTuple's 

-- of the target 'RTable'. An 'RTuple' from the target 'RTable' might match to a single only 'RTuple' in the source 'RTable', or not match at all. 

-- If it is matched to more than one 'RTuple's then an exception ('UniquenessViolationInUpsert') is thrown. 

-- When an 'RTuple' from the target 'RTable' is matched to a source 'RTuple', then the corresponding columns of the target 'RTuple' are updated

-- with the new values provided in the source 'RTuple'. This takes place for the target 'RTuple's that match but also that satisfy the input 

-- 'RPredicate'. Thus we can restrict further with a filter the 'RTuple's of the target 'RTable' where the update will take place.

-- Finally, the source 'RTuple's that did not match to the target 'RTable', are inserted (appended) to the target 'RTable'

--

-- Please note that this is an __immutable__ implementation of an 'RTable' upsert.

-- This simply means that the upsert operation returns a new 'RTable' and does not

-- affect the original 'RTable'.

-- Moreover, if we have multiple threads updating an 'RTable', due to immutability, each thread \"sees\" its own copy of

-- the 'RTable' and thus there is no need for locking the updated 'RTuple's, as happens in a common RDBMS.

--

-- Also note that the source and target 'RTable's should have the same structure.

-- By \"structure\", we mean that the 'ColumnName's and the corresponding data types must match. Essentially what we record in the 'ColumnInfo'

-- must be the same for the two 'RTable's. Otherwise a 'ConflictingRTableStructures' exception will be thrown.

--

-- @

--  An Example:

--  Source RTable: src = 

--      Id  |   Msg         | Other

--      ----|---------------|-------

--      1   |   "hello2"    |"a"    

--      2   |   "world2"    |"a"    

--      3   |   "new"       |"a"    

--

--  Target RTable: trg = 

--      Id  |   Msg         | Other

--      ----|---------------|-------

--      1   |   "hello1"    |"b"    

--      2   |   "world1"    |"b"    

--      4   |   "old"       |"b"    

--      5   |   "hello"     |"b"    

--

--  >>> upsertRTab  src

--                  RUpsertPredicate {matchCols = [\"Id\"], matchPred = \\t1 t2 -> t1 \<!\> \"Id\" == t2 \<!\> \"Id\" }

--                  [\"Msg\"]

--                  (\\t ->   let 

--                              msg = case toText (t \<!\> \"Msg\") of

--                                          Just t -> t

--                                          Nothing -> pack ""

--                          in (take 5 msg) == (pack "hello")

--                  )  -- Msg like "hello%"

--                  trg

--

--  Result RTable: rslt = 

--      Id  |   Msg         | Other

--      ----|---------------|-------

--      1   |   "hello2"    |"b"   (Note that only column \"Msg\" has been overwritten, as per the 3rd argument) 

--      2   |   "world1"    |"b"    

--      3   |   "new"       |"a"    

--      4   |   "old"       |"b"    

--      5   |   "hello"     |"b"    

-- @

--

upsertRTab ::
    RTable -- ^ Source 'RTable', i.e., the equivalent to an SQL @USING@ subclause 

    -> RUpsertPredicate -- ^ The 'RTuple' matching predicate for the merge operation


    -> [ColumnName] -- ^ List of column names to be updated with the corresponding new values coming from the source 'RTuple's 

                    -- that match with the target 'RTuple's based on the 'RUpsertPredicate' 

    -> RPredicate  -- ^ A filter that specifies the target 'RTuple's to be updated

    -> RTable -- ^ The target 'RTable'

    -> RTable -- ^ Final Result

upsertRTab :: RTable
-> RUpsertPredicate
-> [ColumnName]
-> (RTuple -> Bool)
-> RTable
-> RTable
upsertRTab RTable
srcTab RUpsertPredicate
upsPred [ColumnName]
cols RTuple -> Bool
fpred RTable
trgTab = 
    {-
        README PLEASE: Upsert Algorithm

        upsertRTab srcTab upsPred cols fpred trgTab = 

            insertRTabToRTab (Table S1) $ UNION (Table T1) (Table T2) (Table T3) 

            where
                Table T1 =  let 
                                tab  = p (cols ++ (matchCols upsPred)) $ srcTab <semi-join> (f fpred trgTab) <on> (matchPred upsPred) 
                            
                                -- this projection will ensure that the right columns will be overwritten
                                -- dont forget that srcTab and trgTab have the same structure, thus also the same column names 
                            in  p (getColumnNamesFromRTab trgTab) $ tab <inner-join> (f fpred trgTab) <on> (matchPred upsPred) 
 
                        --      1   |   "hello2"    |"a" 

                Table T2 = (f fpred trgTab) <anti-join> srcTab <on> (matchPred upsPred)
                        --      5   |   "hello"     |"b"    

                Table T3 = f (not . fpred) trgTab
                        --      2   |   "world1"    |"b"    
                        --      4   |   "old"       |"b"    

                Table S1 = srcTab <anti-join> trgTab <on> (matchPred upsPred)
                        --      3   |   "new"       |"a"    
        
        Also, Table T1 must be unique if we group by the columns participating in upsPred (i.e., matchCols upsPred)

    -}
    if RTable -> Bool
isRTabEmpty RTable
srcTab
        then RTable
trgTab
        else
            if RTable -> Bool
isRTabEmpty RTable
trgTab
                then RTable
srcTab 
                else -- both src and trg are not empty

                    
                    -- check that both rtables have the same structure: 

                    --      num of columns, column data types and column names.

                    if RTable -> RTable -> Bool
rtabsSameStructure RTable
srcTab RTable
trgTab 
                        then
                            -- check uniqueness condition at srcTab: group by the matching columns and make sure there are no dublicates

                            if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ RTable -> Bool
isRTabEmpty (RTable -> Bool) -> RTable -> Bool
forall a b. (a -> b) -> a -> b
$
                                            (RTuple -> Bool) -> RTable -> RTable
f (\RTuple
t -> RTuple
t RTuple -> ColumnName -> RDataType
<!> ColumnName
"numOfRows" RDataType -> RDataType -> Bool
forall a. Ord a => a -> a -> Bool
> RDataType
1) (RTable -> RTable) -> RTable -> RTable
forall a b. (a -> b) -> a -> b
$
                                            RJoinPredicate
-> [RAggOperation] -> [ColumnName] -> RTable -> RTable
rG  (\RTuple
t1 RTuple
t2 -> (ColumnName -> Bool -> Bool) -> Bool -> [ColumnName] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr (\ColumnName
col Bool
acc -> (RTuple
t1 RTuple -> ColumnName -> RDataType
<!> ColumnName
col RDataType -> RDataType -> Bool
forall a. Eq a => a -> a -> Bool
== RTuple
t2 RTuple -> ColumnName -> RDataType
<!> ColumnName
col) Bool -> Bool -> Bool
&& Bool
acc) Bool
True (RUpsertPredicate -> [ColumnName]
matchCols RUpsertPredicate
upsPred))
                                                [ColumnName -> RAggOperation
raggCountStar ColumnName
"numOfRows"]
                                                (RUpsertPredicate -> [ColumnName]
matchCols RUpsertPredicate
upsPred)
                                                RTable
srcTab
                                then
                                    UniquenessViolationInUpsert -> RTable
forall a e. Exception e => e -> a
throw (UniquenessViolationInUpsert -> RTable)
-> UniquenessViolationInUpsert -> RTable
forall a b. (a -> b) -> a -> b
$ String -> UniquenessViolationInUpsert
UniquenessViolationInUpsert String
"Cannot run: Upsert because the source RTable is not unique in the matching columns." 
                                else
                                    -- run the upsert

                                    let
                                        t1 :: RTable
t1 =    let
                                                    tab :: RTable
tab  = [ColumnName] -> RTable -> RTable
p ([ColumnName]
cols [ColumnName] -> [ColumnName] -> [ColumnName]
forall a. [a] -> [a] -> [a]
++ (RUpsertPredicate -> [ColumnName]
matchCols RUpsertPredicate
upsPred)) (RTable -> RTable) -> RTable -> RTable
forall a b. (a -> b) -> a -> b
$ RJoinPredicate -> BinaryRTableOperation
sJ (RUpsertPredicate -> RJoinPredicate
matchPred RUpsertPredicate
upsPred) RTable
srcTab ((RTuple -> Bool) -> RTable -> RTable
f RTuple -> Bool
fpred RTable
trgTab)
                                                    -- debug

                                                    -- !dummy1 = trace ("tab:\n" ++ show tab) True


                                                    -- this projection will ensure that the right columns will be overwritten

                                                    -- dont forget that srcTab and trgTab have the same structure, thus also the same column names 

                                                in  [ColumnName] -> RTable -> RTable
p (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
trgTab) (RTable -> RTable) -> RTable -> RTable
forall a b. (a -> b) -> a -> b
$ RJoinPredicate -> BinaryRTableOperation
iJ (RUpsertPredicate -> RJoinPredicate
matchPred RUpsertPredicate
upsPred) RTable
tab ((RTuple -> Bool) -> RTable -> RTable
f RTuple -> Bool
fpred RTable
trgTab)  
                                        
                                        -- debug

                                        -- !dummy2 = trace ("t1:\n" ++ show t1) True


                                        t2 :: RTable
t2 =  RJoinPredicate -> BinaryRTableOperation
aJ (RUpsertPredicate -> RJoinPredicate
matchPred RUpsertPredicate
upsPred) ((RTuple -> Bool) -> RTable -> RTable
f RTuple -> Bool
fpred RTable
trgTab) RTable
srcTab

                                        -- debug

                                        -- !dummy3 = trace ("t2:\n" ++ show t2) True                                        


                                        t3 :: RTable
t3 = (RTuple -> Bool) -> RTable -> RTable
f (Bool -> Bool
not (Bool -> Bool) -> (RTuple -> Bool) -> RTuple -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTuple -> Bool
fpred) RTable
trgTab

                                        s1 :: RTable
s1 = RJoinPredicate -> BinaryRTableOperation
aJ (RUpsertPredicate -> RJoinPredicate
matchPred RUpsertPredicate
upsPred) RTable
srcTab RTable
trgTab 

                                    in BinaryRTableOperation
insertRTabToRTab RTable
s1 (RTable -> RTable) -> RTable -> RTable
forall a b. (a -> b) -> a -> b
$ BinaryRTableOperation
u RTable
t1 (RTable -> RTable) -> RTable -> RTable
forall a b. (a -> b) -> a -> b
$ BinaryRTableOperation
u RTable
t2 RTable
t3  
                        else 
                           ConflictingRTableStructures -> RTable
forall a e. Exception e => e -> a
throw (ConflictingRTableStructures -> RTable)
-> ConflictingRTableStructures -> RTable
forall a b. (a -> b) -> a -> b
$ String -> ConflictingRTableStructures
ConflictingRTableStructures String
"Cannot run: Upsert due to conflicting RTable structures." 

    

-- | Compares the structure of the input 'RTable's and returns 'True' if these are the same.

-- By \"structure\", we mean that the 'ColumnName's and the corresponding data types must match. Essentially what we record in the 'ColumnInfo'

-- must be the same for the two 'RTable's.

-- Note that in the case of two columns having the same name but one of the two (or both) have a 'dtype' equal to 'UknownType', then

-- this function assumes that they are the same (i.e., equal 'ColumnInfo's).

rtabsSameStructure :: RTable -> RTable -> Bool
rtabsSameStructure :: RTable -> RTable -> Bool
rtabsSameStructure RTable
rtab1 RTable
rtab2 =
    let 
        cinfo_list1 :: [ColumnInfo]
cinfo_list1 = RTable -> [ColumnInfo]
getColumnInfoFromRTab RTable
rtab1
        cinfo_list2 :: [ColumnInfo]
cinfo_list2 = RTable -> [ColumnInfo]
getColumnInfoFromRTab RTable
rtab2
        -- in the case of two columns with the same name but with one of the two having a Null value,

        -- then the comparison of the column data types will fail, since the column with the Null values

        -- will have an "UknownType" in ColumnDType.

        -- So, we have to normalize the list for this case, so that they pass the equality test

        --

        -- Traverse the list, and if you find a column of UknownType, then make it the same type with 

        -- that of the column with the same name from the other list (if there is such a column)

        cinfo_list1_new :: [ColumnInfo]
cinfo_list1_new = (ColumnInfo -> ColumnInfo) -> [ColumnInfo] -> [ColumnInfo]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map ([ColumnInfo] -> ColumnInfo -> ColumnInfo
normalizeColInfoList [ColumnInfo]
cinfo_list2) [ColumnInfo]
cinfo_list1
        cinfo_list2_new :: [ColumnInfo]
cinfo_list2_new = (ColumnInfo -> ColumnInfo) -> [ColumnInfo] -> [ColumnInfo]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map ([ColumnInfo] -> ColumnInfo -> ColumnInfo
normalizeColInfoList [ColumnInfo]
cinfo_list1) [ColumnInfo]
cinfo_list2
    in  
        -- In order for the two lists to have the same elements (regardless of their order),

        -- then the double minus must result to an empty list.

        ( ([ColumnInfo]
cinfo_list1_new [ColumnInfo] -> [ColumnInfo] -> [ColumnInfo]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ColumnInfo]
cinfo_list2_new) [ColumnInfo] -> [ColumnInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [] )
                    Bool -> Bool -> Bool
&&
        ( ([ColumnInfo]
cinfo_list2_new [ColumnInfo] -> [ColumnInfo] -> [ColumnInfo]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ColumnInfo]
cinfo_list1_new) [ColumnInfo] -> [ColumnInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [] )
    where
        -- Traverse the list, and if you find a column of UknownType, then make it the same type with 

        -- that of the column with the same name from the other list (if there is such a column)        

        normalizeColInfoList :: [ColumnInfo] -> ColumnInfo -> ColumnInfo
        normalizeColInfoList :: [ColumnInfo] -> ColumnInfo -> ColumnInfo
normalizeColInfoList [ColumnInfo]
cinfo_list2 ColumnInfo
ci1 =  --  (\ci1 -> 

            -- check if there is a column in the other list with the same name

            case (ColumnInfo -> Bool) -> [ColumnInfo] -> Maybe ColumnInfo
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (\ColumnInfo
ci2 -> (ColumnInfo -> ColumnName
name ColumnInfo
ci1) ColumnName -> ColumnName -> Bool
forall a. Eq a => a -> a -> Bool
== (ColumnInfo -> ColumnName
name ColumnInfo
ci2)) [ColumnInfo]
cinfo_list2 of
                Maybe ColumnInfo
Nothing -> ColumnInfo
ci1  -- do nothing

                Just ColumnInfo
ci ->  -- if the type of the 1st one is Uknown

                            if (ColumnInfo -> ColumnDType
dtype ColumnInfo
ci1) ColumnDType -> ColumnDType -> Bool
forall a. Eq a => a -> a -> Bool
== ColumnDType
UknownType
                                then
                                    -- change the type to that of ci2

                                    ColumnInfo :: ColumnName -> ColumnDType -> ColumnInfo
ColumnInfo {name :: ColumnName
name = (ColumnInfo -> ColumnName
name ColumnInfo
ci1), dtype :: ColumnDType
dtype = (ColumnInfo -> ColumnDType
dtype ColumnInfo
ci)}
                                else -- do nothing

                                    ColumnInfo
ci1 
        -- )


-- | Compares the structure of the input 'RTuple's and returns 'True' if these are the same.

-- By \"structure\", we mean that the 'ColumnName's and the corresponding data types must match. Essentially what we record in the 'ColumnInfo'

-- must be the same for the two 'RTuple's

rtuplesSameStructure :: RTuple -> RTuple -> Bool
rtuplesSameStructure :: RJoinPredicate
rtuplesSameStructure RTuple
t1 RTuple
t2 =
    let 
        cinfo_list1 :: [ColumnInfo]
cinfo_list1 = RTuple -> [ColumnInfo]
getColumnInfoFromRTuple RTuple
t1
        cinfo_list2 :: [ColumnInfo]
cinfo_list2 = RTuple -> [ColumnInfo]
getColumnInfoFromRTuple RTuple
t2
    in  
        -- In order for the two lists to have the same elements (regardless of their order),

        -- then the double minus must result to an empty list.

        ( ([ColumnInfo]
cinfo_list1 [ColumnInfo] -> [ColumnInfo] -> [ColumnInfo]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ColumnInfo]
cinfo_list2) [ColumnInfo] -> [ColumnInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [] )
                    Bool -> Bool -> Bool
&&
        ( ([ColumnInfo]
cinfo_list2 [ColumnInfo] -> [ColumnInfo] -> [ColumnInfo]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ColumnInfo]
cinfo_list1) [ColumnInfo] -> [ColumnInfo] -> Bool
forall a. Eq a => a -> a -> Bool
== [] )



-- | Delete 'RTuple's from an 'RTable' based on an 'RPredicate'.

-- Please note that this is an __immutable__ implementation of an 'RTable' update. This simply means that

-- the delete operation returns a new 'RTable'. So, the original 'RTable' remains unchanged and no deletion in-place

-- takes place whatsoever.

-- Moreover, if we have multiple threads deleting an 'RTable', due to immutability, each thread \"sees\" its own copy of

-- the 'RTable' and thus there is no need for locking the deleted 'RTuple's, as happens in a common RDBMS.

deleteRTab ::
        RPredicate  -- ^ Predicate specifying the 'Rtuple's that must be deleted

    ->  RTable      -- ^ 'RTable' that the deletion will be applied

    ->  RTable      -- ^ Result 'RTable'

deleteRTab :: (RTuple -> Bool) -> RTable -> RTable
deleteRTab RTuple -> Bool
rpred RTable
rtab = (RTuple -> Bool) -> RTable -> RTable
f (Bool -> Bool
not (Bool -> Bool) -> (RTuple -> Bool) -> RTuple -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTuple -> Bool
rpred) RTable
rtab -- simply omit the rtuples satisfying the predicates    


-- | Update an RTable. The input includes a list of (ColumnName, new Value) pairs.

-- Also a filter predicate is specified, in order to restrict the update only to those

-- 'RTuple's that fulfill the predicate.

-- Please note that this is an __immutable__ implementation of an 'RTable' update. This simply means that

-- the update operation returns a new 'RTable' that includes all the 'RTuple's of the original 'RTable', both the ones

-- that have been updated and the others that have not. So, the original 'RTable' remains unchanged and no update in-place

-- takes place whatsoever.

-- Moreover, if we have multiple threads updating an 'RTable', due to immutability, each thread \"sees\" its own copy of

-- the 'RTable' and thus there is no need for locking the updated 'RTuple's, as happens in a common RDBMS.

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 :: [(ColumnName, RDataType)] -> (RTuple -> Bool) -> RTable -> RTable
updateRTab [] RTuple -> Bool
_ RTable
inputRtab = RTable
inputRtab 
updateRTab ((ColumnName
colName, RDataType
newVal) : [(ColumnName, RDataType)]
rest) RTuple -> Bool
rpred RTable
inputRtab = 
    {-  -- READ ME PLEASE --
        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 RTable -> Bool
isRTabEmpty RTable
inputRtab 
        then RTable
emptyRTable
        else
            let 
                tabA :: RTable
tabA = (RTuple -> RTuple) -> RTable -> RTable
rtabMap (ColumnName -> RDataType -> RTuple -> RTuple
updateRTuple ColumnName
colName RDataType
newVal) ((RTuple -> Bool) -> RTable -> RTable
f RTuple -> Bool
rpred RTable
inputRtab)
                tabB :: RTable
tabB = (RTuple -> Bool) -> RTable -> RTable
f (Bool -> Bool
not (Bool -> Bool) -> (RTuple -> Bool) -> RTuple -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTuple -> Bool
rpred) RTable
inputRtab 
            in [(ColumnName, RDataType)] -> (RTuple -> Bool) -> RTable -> RTable
updateRTab [(ColumnName, RDataType)]
rest RTuple -> Bool
rpred (BinaryRTableOperation
u RTable
tabA RTable
tabB)

-- | Update an RTuple at a specific column specified by name with a value. If the 'ColumnName'

-- exists, then the value is updated with the input value. If the 'ColumnName' does not exist,

-- then a 'ColumnDoesNotExist' exception is thrown.

updateRTuple ::
           ColumnName  -- ^ key where the update will take place

        -> RDataType   -- ^ new value

        -> RTuple      -- ^ input RTuple

        -> RTuple      -- ^ output RTuple

updateRTuple :: ColumnName -> RDataType -> RTuple -> RTuple
updateRTuple ColumnName
cname RDataType
newVal RTuple
tupsrc = 
    case ColumnName -> RTuple -> Maybe RDataType
rtupLookup ColumnName
cname RTuple
tupsrc of
        Maybe RDataType
Nothing   ->  ColumnDoesNotExist -> RTuple
forall a e. Exception e => e -> a
throw (ColumnDoesNotExist -> RTuple) -> ColumnDoesNotExist -> RTuple
forall a b. (a -> b) -> a -> b
$ ColumnName -> ColumnDoesNotExist
ColumnDoesNotExist ColumnName
cname 
        Maybe RDataType
_         ->  ColumnName -> RDataType -> RTuple -> RTuple
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ColumnName
cname RDataType
newVal RTuple
tupsrc
        

-- | 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 upsert will take place

        -> RDataType   -- ^ new value

        -> RTuple      -- ^ input RTuple

        -> RTuple      -- ^ output RTuple

upsertRTuple :: ColumnName -> RDataType -> RTuple -> RTuple
upsertRTuple ColumnName
cname RDataType
newVal RTuple
tupsrc = ColumnName -> RDataType -> RTuple -> RTuple
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ColumnName
cname RDataType
newVal RTuple
tupsrc

-- * ########## RTable IO Operations ##############


-- | Basic data type for defining the desired formatting of an 'RTuple' when printing an RTable (see 'printfRTable').

data RTupleFormat = RTupleFormat {
    
    RTupleFormat -> [ColumnName]
colSelectList :: [ColumnName] -- ^ For defining the column ordering (i.e., the SELECT clause in SQL)    

    ,RTupleFormat -> ColFormatMap
colFormatMap :: ColFormatMap -- ^ For defining the formating per Column in \"'printf' style\"


} deriving (RTupleFormat -> RTupleFormat -> Bool
(RTupleFormat -> RTupleFormat -> Bool)
-> (RTupleFormat -> RTupleFormat -> Bool) -> Eq RTupleFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RTupleFormat -> RTupleFormat -> Bool
$c/= :: RTupleFormat -> RTupleFormat -> Bool
== :: RTupleFormat -> RTupleFormat -> Bool
$c== :: RTupleFormat -> RTupleFormat -> Bool
Eq, Int -> RTupleFormat -> ShowS
[RTupleFormat] -> ShowS
RTupleFormat -> String
(Int -> RTupleFormat -> ShowS)
-> (RTupleFormat -> String)
-> ([RTupleFormat] -> ShowS)
-> Show RTupleFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RTupleFormat] -> ShowS
$cshowList :: [RTupleFormat] -> ShowS
show :: RTupleFormat -> String
$cshow :: RTupleFormat -> String
showsPrec :: Int -> RTupleFormat -> ShowS
$cshowsPrec :: Int -> RTupleFormat -> ShowS
Show)

-- | A map of ColumnName to Format Specification

type ColFormatMap = HM.HashMap ColumnName FormatSpecifier

-- | Generates a default Column Format Specification

genDefaultColFormatMap :: ColFormatMap
genDefaultColFormatMap :: ColFormatMap
genDefaultColFormatMap = ColFormatMap
forall k v. HashMap k v
HM.empty

-- | Generates a Column Format Specification

genColFormatMap :: 
    [(ColumnName, FormatSpecifier)]
    -> ColFormatMap
genColFormatMap :: [(ColumnName, FormatSpecifier)] -> ColFormatMap
genColFormatMap [(ColumnName, FormatSpecifier)]
fs = [(ColumnName, FormatSpecifier)] -> ColFormatMap
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(ColumnName, FormatSpecifier)]
fs


-- | Format specifier of 'Text.Printf.printf' style

data FormatSpecifier = DefaultFormat | Format String deriving (FormatSpecifier -> FormatSpecifier -> Bool
(FormatSpecifier -> FormatSpecifier -> Bool)
-> (FormatSpecifier -> FormatSpecifier -> Bool)
-> Eq FormatSpecifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatSpecifier -> FormatSpecifier -> Bool
$c/= :: FormatSpecifier -> FormatSpecifier -> Bool
== :: FormatSpecifier -> FormatSpecifier -> Bool
$c== :: FormatSpecifier -> FormatSpecifier -> Bool
Eq, Int -> FormatSpecifier -> ShowS
[FormatSpecifier] -> ShowS
FormatSpecifier -> String
(Int -> FormatSpecifier -> ShowS)
-> (FormatSpecifier -> String)
-> ([FormatSpecifier] -> ShowS)
-> Show FormatSpecifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatSpecifier] -> ShowS
$cshowList :: [FormatSpecifier] -> ShowS
show :: FormatSpecifier -> String
$cshow :: FormatSpecifier -> String
showsPrec :: Int -> FormatSpecifier -> ShowS
$cshowsPrec :: Int -> FormatSpecifier -> ShowS
Show)

-- | Generate an RTupleFormat data type instance

genRTupleFormat :: 
    [ColumnName]    -- ^ Column Select list 

    -> ColFormatMap -- ^ Column Format Map

    -> RTupleFormat  -- ^ Output

genRTupleFormat :: [ColumnName] -> ColFormatMap -> RTupleFormat
genRTupleFormat [ColumnName]
colNames ColFormatMap
colfMap = RTupleFormat :: [ColumnName] -> ColFormatMap -> RTupleFormat
RTupleFormat { colSelectList :: [ColumnName]
colSelectList = [ColumnName]
colNames, colFormatMap :: ColFormatMap
colFormatMap = 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
genRTupleFormatDefault = RTupleFormat :: [ColumnName] -> ColFormatMap -> RTupleFormat
RTupleFormat { colSelectList :: [ColumnName]
colSelectList = [], colFormatMap :: ColFormatMap
colFormatMap = 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 :: (RTupleFormat -> RTable -> IO ())
-> RTupleFormat -> RTable -> IO (Either e ())
eitherPrintfRTable RTupleFormat -> RTable -> IO ()
printFunc RTupleFormat
fmt RTable
rtab = IO () -> IO (Either e ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either e ())) -> IO () -> IO (Either e ())
forall a b. (a -> b) -> a -> b
$ RTupleFormat -> RTable -> IO ()
printFunc RTupleFormat
fmt RTable
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 :: RTupleFormat -> RTable -> IO ()
printfRTable RTupleFormat
rtupFmt RTable
rtab = -- undefined

    if RTable -> Bool
isRTabEmpty RTable
rtab
        then
            do 
                String -> IO ()
putStrLn String
"-------------------------------------------"
                String -> IO ()
putStrLn String
" 0 rows returned"
                String -> IO ()
putStrLn String
"-------------------------------------------"

        else
            do
                -- find the max value-length for each column, this will be the width of the box for this column

                let listOfLengths :: [Int]
listOfLengths = RTupleFormat -> RTable -> [Int]
getMaxLengthPerColumnFmt RTupleFormat
rtupFmt RTable
rtab

                --debug

                --putStrLn $ "List of Lengths: " ++ show listOfLengths


                RTupleFormat -> [Int] -> Char -> RTable -> IO ()
printContLineFmt RTupleFormat
rtupFmt [Int]
listOfLengths Char
'-' RTable
rtab
                -- print the Header

                RTupleFormat -> [Int] -> RTable -> IO ()
printRTableHeaderFmt RTupleFormat
rtupFmt [Int]
listOfLengths RTable
rtab 

                -- print the body

                RTupleFormat -> [Int] -> [RTuple] -> IO ()
printRTabBodyFmt RTupleFormat
rtupFmt [Int]
listOfLengths ([RTuple] -> IO ()) -> [RTuple] -> IO ()
forall a b. (a -> b) -> a -> b
$ RTable -> [RTuple]
forall a. Vector a -> [a]
V.toList RTable
rtab

                -- print number of rows returned

                let numrows :: Int
numrows = RTable -> Int
forall a. Vector a -> Int
V.length RTable
rtab
                if Int
numrows Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                    then 
                        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
numrows) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" row returned"        
                    else
                        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
numrows) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" rows returned"        

                RTupleFormat -> [Int] -> Char -> RTable -> IO ()
printContLineFmt RTupleFormat
rtupFmt [Int]
listOfLengths Char
'-' RTable
rtab
                where
                    -- [Int] a List of width per column to be used in the box definition        

                    printRTabBodyFmt :: RTupleFormat -> [Int] -> [RTuple] -> IO()
                    printRTabBodyFmt :: RTupleFormat -> [Int] -> [RTuple] -> IO ()
printRTabBodyFmt RTupleFormat
_ [Int]
_ [] = String -> IO ()
putStrLn String
""            
                    printRTabBodyFmt RTupleFormat
rtupf [Int]
ws (RTuple
rtup : [RTuple]
rest) = do
                            RTupleFormat -> [Int] -> RTuple -> IO ()
printRTupleFmt RTupleFormat
rtupf [Int]
ws RTuple
rtup
                            RTupleFormat -> [Int] -> [RTuple] -> IO ()
printRTabBodyFmt RTupleFormat
rtupf [Int]
ws [RTuple]
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 :: (RTable -> IO ()) -> RTable -> IO (Either e ())
eitherPrintRTable RTable -> IO ()
printFunc RTable
rtab = IO () -> IO (Either e ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either e ())) -> IO () -> IO (Either e ())
forall a b. (a -> b) -> a -> b
$ RTable -> IO ()
printFunc RTable
rtab 

-- | printRTable : Print the input RTable on screen

printRTable ::
       RTable
    -> IO ()
printRTable :: RTable -> IO ()
printRTable RTable
rtab = 
    if RTable -> Bool
isRTabEmpty RTable
rtab
        then
            do 
                String -> IO ()
putStrLn String
"-------------------------------------------"
                String -> IO ()
putStrLn String
" 0 rows returned"
                String -> IO ()
putStrLn String
"-------------------------------------------"

        else
            do
                -- find the max value-length for each column, this will be the width of the box for this column

                let listOfLengths :: [Int]
listOfLengths = RTable -> [Int]
getMaxLengthPerColumn RTable
rtab

                --debug

                --putStrLn $ "List of Lengths: " ++ show listOfLengths


                [Int] -> Char -> RTable -> IO ()
printContLine [Int]
listOfLengths Char
'-' RTable
rtab
                -- print the Header

                [Int] -> RTable -> IO ()
printRTableHeader [Int]
listOfLengths RTable
rtab 

                -- print the body

                [Int] -> [RTuple] -> IO ()
printRTabBody [Int]
listOfLengths ([RTuple] -> IO ()) -> [RTuple] -> IO ()
forall a b. (a -> b) -> a -> b
$ RTable -> [RTuple]
forall a. Vector a -> [a]
V.toList RTable
rtab

                -- print number of rows returned

                let numrows :: Int
numrows = RTable -> Int
forall a. Vector a -> Int
V.length RTable
rtab
                if Int
numrows Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                    then 
                        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
numrows) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" row returned"        
                    else
                        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
numrows) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" rows returned"        

                [Int] -> Char -> RTable -> IO ()
printContLine [Int]
listOfLengths Char
'-' RTable
rtab
                where
                    -- [Int] a List of width per column to be used in the box definition        

                    printRTabBody :: [Int] -> [RTuple] -> IO()
                    printRTabBody :: [Int] -> [RTuple] -> IO ()
printRTabBody [Int]
_ [] = String -> IO ()
putStrLn String
""            
                    printRTabBody [Int]
ws (RTuple
rtup : [RTuple]
rest) = do
                            [Int] -> RTuple -> IO ()
printRTuple [Int]
ws RTuple
rtup
                            [Int] -> [RTuple] -> IO ()
printRTabBody [Int]
ws [RTuple]
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 :: RTupleFormat -> RTable -> [Int]
getMaxLengthPerColumnFmt RTupleFormat
rtupFmt RTable
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 :: RTable
lengthRTab = do
            RTuple
rtup <- RTable
rtab
            let ls :: [(ColumnName, RDataType)]
ls = ((ColumnName, RDataType) -> (ColumnName, RDataType))
-> [(ColumnName, RDataType)] -> [(ColumnName, RDataType)]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(ColumnName
c, RDataType
v) -> (ColumnName
c, Integer -> RDataType
RInt (Integer -> RDataType) -> Integer -> RDataType
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (String -> Int) -> (RDataType -> String) -> RDataType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDataType -> String
rdataTypeToString (RDataType -> Int) -> RDataType -> Int
forall a b. (a -> b) -> a -> b
$ RDataType
v) ) (RTuple -> [(ColumnName, RDataType)]
rtupleToList RTuple
rtup)
                -- create an RTuple with the column names lengths

                headerLengths :: [(ColumnName, RDataType)]
headerLengths = [ColumnName] -> [RDataType] -> [(ColumnName, RDataType)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
rtab) ((ColumnName -> RDataType) -> [ColumnName] -> [RDataType]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
c -> Integer -> RDataType
RInt (Integer -> RDataType) -> Integer -> RDataType
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (ColumnName -> String
T.unpack ColumnName
c)) (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
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

            (RTuple -> RTable
forall (m :: * -> *) a. Monad m => a -> m a
return (RTuple -> RTable) -> RTuple -> RTable
forall a b. (a -> b) -> a -> b
$ [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName, RDataType)]
ls) BinaryRTableOperation
forall a. Vector a -> Vector a -> Vector a
V.++ (RTuple -> RTable
forall (m :: * -> *) a. Monad m => a -> m a
return (RTuple -> RTable) -> RTuple -> RTable
forall a b. (a -> b) -> a -> b
$ [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName, RDataType)]
headerLengths)

        -- Get the max length for each column

        resultRTab :: RTable
resultRTab = RTable -> RTable
findMaxLengthperColumn RTable
lengthRTab
                where
                    findMaxLengthperColumn :: RTable -> RTable
                    findMaxLengthperColumn :: RTable -> RTable
findMaxLengthperColumn RTable
rt = 
                        let colNames :: [ColumnName]
colNames = (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
rt) -- [ColumnName]

                            aggOpsList :: [RAggOperation]
aggOpsList = (ColumnName -> RAggOperation) -> [ColumnName] -> [RAggOperation]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
c -> ColumnName -> ColumnName -> RAggOperation
raggMax ColumnName
c ColumnName
c) [ColumnName]
colNames  -- [AggOp]

                        in [RAggOperation] -> RTable -> RTable
runAggregation [RAggOperation]
aggOpsList RTable
rt
         -- get the RTuple with the results

        resultRTuple :: RTuple
resultRTuple = RTable -> RTuple
headRTup RTable
resultRTab
    in 
        -- transform it to [Int]

        if RTupleFormat
rtupFmt RTupleFormat -> RTupleFormat -> Bool
forall a. Eq a => a -> a -> Bool
/= RTupleFormat
genRTupleFormatDefault
            then
                -- generate [Int] in the column order specified by the format parameter        

                (RDataType -> Int) -> [RDataType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(RInt Integer
i) -> Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) ([RDataType] -> [Int]) -> [RDataType] -> [Int]
forall a b. (a -> b) -> a -> b
$ 
                    (ColumnName -> RDataType) -> [ColumnName] -> [RDataType]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
colname -> RTuple
resultRTuple RTuple -> ColumnName -> RDataType
<!> ColumnName
colname) ([ColumnName] -> [RDataType]) -> [ColumnName] -> [RDataType]
forall a b. (a -> b) -> a -> b
$ RTupleFormat -> [ColumnName]
colSelectList RTupleFormat
rtupFmt  -- [RInt i]

            else
                -- else just choose the default column order (i.e., unspecified)

                ((ColumnName, RDataType) -> Int)
-> [(ColumnName, RDataType)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(ColumnName
colname, RInt Integer
i) -> Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) (RTuple -> [(ColumnName, RDataType)]
rtupleToList RTuple
resultRTuple)                

-- | Returns the max length of the String representation of each value, for each column of the input RTable. 

getMaxLengthPerColumn :: RTable -> [Int]
getMaxLengthPerColumn :: RTable -> [Int]
getMaxLengthPerColumn RTable
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 :: RTable
lengthRTab = do
            RTuple
rtup <- RTable
rtab
            let ls :: [(ColumnName, RDataType)]
ls = ((ColumnName, RDataType) -> (ColumnName, RDataType))
-> [(ColumnName, RDataType)] -> [(ColumnName, RDataType)]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(ColumnName
c, RDataType
v) -> (ColumnName
c, Integer -> RDataType
RInt (Integer -> RDataType) -> Integer -> RDataType
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (String -> Int) -> (RDataType -> String) -> RDataType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDataType -> String
rdataTypeToString (RDataType -> Int) -> RDataType -> Int
forall a b. (a -> b) -> a -> b
$ RDataType
v) ) (RTuple -> [(ColumnName, RDataType)]
rtupleToList RTuple
rtup)
                -- create an RTuple with the column names lengths

                headerLengths :: [(ColumnName, RDataType)]
headerLengths = [ColumnName] -> [RDataType] -> [(ColumnName, RDataType)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
rtab) ((ColumnName -> RDataType) -> [ColumnName] -> [RDataType]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
c -> Integer -> RDataType
RInt (Integer -> RDataType) -> Integer -> RDataType
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (ColumnName -> String
T.unpack ColumnName
c)) (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
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

            (RTuple -> RTable
forall (m :: * -> *) a. Monad m => a -> m a
return (RTuple -> RTable) -> RTuple -> RTable
forall a b. (a -> b) -> a -> b
$ [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName, RDataType)]
ls) BinaryRTableOperation
forall a. Vector a -> Vector a -> Vector a
V.++ (RTuple -> RTable
forall (m :: * -> *) a. Monad m => a -> m a
return (RTuple -> RTable) -> RTuple -> RTable
forall a b. (a -> b) -> a -> b
$ [(ColumnName, RDataType)] -> RTuple
createRTuple [(ColumnName, RDataType)]
headerLengths)

        -- Get the max length for each column

        resultRTab :: RTable
resultRTab = RTable -> RTable
findMaxLengthperColumn RTable
lengthRTab
                where
                    findMaxLengthperColumn :: RTable -> RTable
                    findMaxLengthperColumn :: RTable -> RTable
findMaxLengthperColumn RTable
rt = 
                        let colNames :: [ColumnName]
colNames = (RTable -> [ColumnName]
getColumnNamesFromRTab RTable
rt) -- [ColumnName]

                            aggOpsList :: [RAggOperation]
aggOpsList = (ColumnName -> RAggOperation) -> [ColumnName] -> [RAggOperation]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
c -> ColumnName -> ColumnName -> RAggOperation
raggMax ColumnName
c ColumnName
c) [ColumnName]
colNames  -- [AggOp]

                        in [RAggOperation] -> RTable -> RTable
runAggregation [RAggOperation]
aggOpsList RTable
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 :: RTuple
resultRTuple = RTable -> RTuple
headRTup RTable
resultRTab
    in 
        -- transform it to a [Int]

        ((ColumnName, RDataType) -> Int)
-> [(ColumnName, RDataType)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(ColumnName
colname, RInt Integer
i) -> Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) (RTuple -> [(ColumnName, RDataType)]
rtupleToList RTuple
resultRTuple)

spaceSeparatorWidth :: Int
spaceSeparatorWidth :: Int
spaceSeparatorWidth = Int
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 :: Int -> ShowS
addSpace Int
i String
s = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
Data.List.take Int
i (Char -> String
forall a. a -> [a]
repeat Char
' ')    


-- | 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 :: Int -> Char -> ShowS
addCharacter Int
i Char
c String
s = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
Data.List.take Int
i (Char -> String
forall a. a -> [a]
repeat Char
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 :: RTupleFormat -> [Int] -> Char -> RTable -> IO ()
printContLineFmt RTupleFormat
rtupFmt [Int]
widths Char
ch RTable
rtab = do
    let listOfColNames :: [ColumnName]
listOfColNames =    if RTupleFormat
rtupFmt RTupleFormat -> RTupleFormat -> Bool
forall a. Eq a => a -> a -> Bool
/= RTupleFormat
genRTupleFormatDefault
                                then
                                    RTupleFormat -> [ColumnName]
colSelectList RTupleFormat
rtupFmt
                                else
                                    RTable -> [ColumnName]
getColumnNamesFromRTab RTable
rtab -- [ColumnName] 

        listOfLinesCont :: [String]
listOfLinesCont = (ColumnName -> String) -> [ColumnName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
c -> Int -> ShowS
forall a. Int -> [a] -> [a]
Data.List.take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (ColumnName -> String
T.unpack ColumnName
c)) (Char -> String
forall a. a -> [a]
repeat Char
ch)) [ColumnName]
listOfColNames
        --listOfLinesCont = Data.List.map (\c ->  T.replicate (T.length c) (T.singleton ch)) listOfColNames

        formattedLinesCont :: [String]
formattedLinesCont = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(Int
w,String
l) -> Int -> Char -> ShowS
addCharacter (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
l) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaceSeparatorWidth) Char
ch String
l) ([Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [Int]
widths [String]
listOfLinesCont)
        formattedRowOfLinesCont :: String
formattedRowOfLinesCont = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr (\String
line String
accum -> String
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
accum) String
"" [String]
formattedLinesCont
    String -> IO ()
putStrLn String
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 :: [Int] -> Char -> RTable -> IO ()
printContLine [Int]
widths Char
ch RTable
rtab = do
    let listOfColNames :: [ColumnName]
listOfColNames =  RTable -> [ColumnName]
getColumnNamesFromRTab RTable
rtab -- [ColumnName] 

        listOfLinesCont :: [String]
listOfLinesCont = (ColumnName -> String) -> [ColumnName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
c -> Int -> ShowS
forall a. Int -> [a] -> [a]
Data.List.take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (ColumnName -> String
T.unpack ColumnName
c)) (Char -> String
forall a. a -> [a]
repeat Char
ch)) [ColumnName]
listOfColNames
        formattedLinesCont :: [String]
formattedLinesCont = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(Int
w,String
l) -> Int -> Char -> ShowS
addCharacter (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
l) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaceSeparatorWidth) Char
ch String
l) ([Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [Int]
widths [String]
listOfLinesCont)
        formattedRowOfLinesCont :: String
formattedRowOfLinesCont = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr (\String
line String
accum -> String
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
accum) String
"" [String]
formattedLinesCont
    String -> IO ()
putStrLn String
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 :: RTupleFormat -> [Int] -> RTable -> IO ()
printRTableHeaderFmt RTupleFormat
rtupFmt [Int]
widths RTable
rtab = do -- undefined    

        let listOfColNames :: [ColumnName]
listOfColNames = if RTupleFormat
rtupFmt RTupleFormat -> RTupleFormat -> Bool
forall a. Eq a => a -> a -> Bool
/= RTupleFormat
genRTupleFormatDefault then RTupleFormat -> [ColumnName]
colSelectList RTupleFormat
rtupFmt else  RTable -> [ColumnName]
getColumnNamesFromRTab RTable
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 :: [String]
formattedList = ((Int, ColumnName) -> String) -> [(Int, ColumnName)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(Int
w,ColumnName
c) -> Int -> ShowS
addSpace (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (ColumnName -> String
T.unpack ColumnName
c)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaceSeparatorWidth) (ColumnName -> String
T.unpack ColumnName
c)) ([Int] -> [ColumnName] -> [(Int, ColumnName)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [Int]
widths [ColumnName]
listOfColNames) 
            -- Paste all boxes together horizontally

            -- formattedRow = BX.render $ Data.List.foldr (\colname_box accum -> accum BX.<+> colname_box) BX.nullBox formattedList

            formattedRow :: String
formattedRow = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr (\String
colname String
accum -> String
colname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
accum) String
"" [String]
formattedList
            
            listOfLines :: [String]
listOfLines = (ColumnName -> String) -> [ColumnName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
c -> Int -> ShowS
forall a. Int -> [a] -> [a]
Data.List.take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (ColumnName -> String
T.unpack ColumnName
c)) (Char -> String
forall a. a -> [a]
repeat Char
'~')) [ColumnName]
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 :: [String]
formattedLines = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(Int
w,String
l) -> Int -> ShowS
addSpace (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
l) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaceSeparatorWidth) String
l) ([Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [Int]
widths [String]
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 :: String
formattedRowOfLines = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr (\String
line String
accum -> String
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
accum) String
"" [String]
formattedLines
          ---  formattedRowOfLinesCont = Data.List.foldr (\line accum -> line ++ accum) "" formattedLinesCont


      --  printUnderlines formattedRowOfLinesCont

        String -> IO ()
printHeader String
formattedRow
        String -> IO ()
printUnderlines String
formattedRowOfLines
        where
            printHeader :: String -> IO()
            printHeader :: String -> IO ()
printHeader String
h = String -> IO ()
putStrLn String
h

            printUnderlines :: String -> IO()
            printUnderlines :: String -> IO ()
printUnderlines String
l = String -> IO ()
putStrLn String
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 :: [Int] -> RTable -> IO ()
printRTableHeader [Int]
widths RTable
rtab = do -- undefined    

        let listOfColNames :: [ColumnName]
listOfColNames =  RTable -> [ColumnName]
getColumnNamesFromRTab RTable
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 :: [String]
formattedList = ((Int, ColumnName) -> String) -> [(Int, ColumnName)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(Int
w,ColumnName
c) -> Int -> ShowS
addSpace (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (ColumnName -> String
T.unpack ColumnName
c)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaceSeparatorWidth) (ColumnName -> String
T.unpack ColumnName
c)) ([Int] -> [ColumnName] -> [(Int, ColumnName)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [Int]
widths [ColumnName]
listOfColNames) 
            -- Paste all boxes together horizontally

            -- formattedRow = BX.render $ Data.List.foldr (\colname_box accum -> accum BX.<+> colname_box) BX.nullBox formattedList

            formattedRow :: String
formattedRow = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr (\String
colname String
accum -> String
colname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
accum) String
"" [String]
formattedList
            
            listOfLines :: [String]
listOfLines = (ColumnName -> String) -> [ColumnName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
c -> Int -> ShowS
forall a. Int -> [a] -> [a]
Data.List.take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length (ColumnName -> String
T.unpack ColumnName
c)) (Char -> String
forall a. a -> [a]
repeat Char
'~')) [ColumnName]
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 :: [String]
formattedLines = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(Int
w,String
l) -> Int -> ShowS
addSpace (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
l) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaceSeparatorWidth) String
l) ([Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [Int]
widths [String]
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 :: String
formattedRowOfLines = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr (\String
line String
accum -> String
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
accum) String
"" [String]
formattedLines
          ---  formattedRowOfLinesCont = Data.List.foldr (\line accum -> line ++ accum) "" formattedLinesCont


      --  printUnderlines formattedRowOfLinesCont

        String -> IO ()
printHeader String
formattedRow
        String -> IO ()
printUnderlines String
formattedRowOfLines
        where
            printHeader :: String -> IO()
            printHeader :: String -> IO ()
printHeader String
h = String -> IO ()
putStrLn String
h

            printUnderlines :: String -> IO()
            printUnderlines :: String -> IO ()
printUnderlines String
l = String -> IO ()
putStrLn String
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 :: RTupleFormat -> [Int] -> RTuple -> IO ()
printRTupleFmt RTupleFormat
rtupFmt [Int]
widths RTuple
rtup = do
    -- take list of values of each column and convert to String

    let rtupList :: [String]
rtupList =  if RTupleFormat
rtupFmt RTupleFormat -> RTupleFormat -> Bool
forall a. Eq a => a -> a -> Bool
== RTupleFormat
genRTupleFormatDefault
                        then -- then no column ordering is specified nore column formatting

                            ((ColumnName, RDataType) -> String)
-> [(ColumnName, RDataType)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (RDataType -> String
rdataTypeToString (RDataType -> String)
-> ((ColumnName, RDataType) -> RDataType)
-> (ColumnName, RDataType)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnName, RDataType) -> RDataType
forall a b. (a, b) -> b
snd) (RTuple -> [(ColumnName, RDataType)]
rtupleToList RTuple
rtup)  -- [RDataType] --> [String]

                        else 
                            if (RTupleFormat -> ColFormatMap
colFormatMap RTupleFormat
rtupFmt) ColFormatMap -> ColFormatMap -> Bool
forall a. Eq a => a -> a -> Bool
== ColFormatMap
genDefaultColFormatMap
                                then -- col ordering is specified but no formatting per column

                                    (ColumnName -> String) -> [ColumnName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
colname -> FormatSpecifier -> RDataType -> String
rdataTypeToStringFmt FormatSpecifier
DefaultFormat (RDataType -> String) -> RDataType -> String
forall a b. (a -> b) -> a -> b
$ RTuple
rtup RTuple -> ColumnName -> RDataType
<!> ColumnName
colname ) ([ColumnName] -> [String]) -> [ColumnName] -> [String]
forall a b. (a -> b) -> a -> b
$ RTupleFormat -> [ColumnName]
colSelectList RTupleFormat
rtupFmt
                                else  -- both column ordering, as well as formatting per column is specified

                                    (ColumnName -> String) -> [ColumnName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\ColumnName
colname -> FormatSpecifier -> RDataType -> String
rdataTypeToStringFmt ((RTupleFormat -> ColFormatMap
colFormatMap RTupleFormat
rtupFmt) ColFormatMap -> ColumnName -> FormatSpecifier
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
! ColumnName
colname) (RDataType -> String) -> RDataType -> String
forall a b. (a -> b) -> a -> b
$ RTuple
rtup RTuple -> ColumnName -> RDataType
<!> ColumnName
colname ) ([ColumnName] -> [String]) -> [ColumnName] -> [String]
forall a b. (a -> b) -> a -> b
$ RTupleFormat -> [ColumnName]
colSelectList RTupleFormat
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 :: [String]
formattedValueList = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(Int
w,String
v) -> Int -> ShowS
addSpace (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaceSeparatorWidth) String
v) ([Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [Int]
widths [String]
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 :: String
formattedRow = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr (\String
value_box String
accum -> String
value_box String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
accum) String
"" [String]
formattedValueList
    String -> IO ()
putStrLn String
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 :: [Int] -> RTuple -> IO ()
printRTuple [Int]
widths RTuple
rtup = do
    -- take list of values of each column and convert to String

    let rtupList :: [String]
rtupList = ((ColumnName, RDataType) -> String)
-> [(ColumnName, RDataType)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (RDataType -> String
rdataTypeToString (RDataType -> String)
-> ((ColumnName, RDataType) -> RDataType)
-> (ColumnName, RDataType)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnName, RDataType) -> RDataType
forall a b. (a, b) -> b
snd) (RTuple -> [(ColumnName, RDataType)]
rtupleToList RTuple
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 :: [String]
formattedValueList = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (\(Int
w,String
v) -> Int -> ShowS
addSpace (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length String
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaceSeparatorWidth) String
v) ([Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
Data.List.zip [Int]
widths [String]
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 :: String
formattedRow = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr (\String
value_box String
accum -> String
value_box String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
accum) String
"" [String]
formattedValueList
    String -> IO ()
putStrLn String
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 :: FormatSpecifier -> RDataType -> String
rdataTypeToStringFmt FormatSpecifier
fmt RDataType
rdt =
    case FormatSpecifier
fmt of 
        FormatSpecifier
DefaultFormat -> RDataType -> String
rdataTypeToString RDataType
rdt
        Format String
fspec -> 
            case RDataType
rdt of
                RInt Integer
i -> String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
fspec Integer
i
                RText ColumnName
t -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
fspec (ColumnName -> String
unpack ColumnName
t)
                RDate {rdate :: RDataType -> ColumnName
rdate = ColumnName
d, dtformat :: RDataType -> ColumnName
dtformat = ColumnName
f} -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
fspec (ColumnName -> String
unpack ColumnName
d)
                RTime RTimestamp
t -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
fspec ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ColumnName -> String
unpack (ColumnName -> String) -> ColumnName -> String
forall a b. (a -> b) -> a -> b
$ RDataType -> ColumnName
rtext (String -> RTimestamp -> RDataType
rTimestampToRText String
"DD/MM/YYYY HH24:MI:SS" RTimestamp
t)
                -- Round to only two decimal digits after the decimal point

                RDouble Double
db -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
fspec Double
db -- show db

                RDataType
Null -> String
"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 :: RDataType -> String
rdataTypeToString RDataType
rdt =
    case RDataType
rdt of
        RInt Integer
i -> Integer -> String
forall a. Show a => a -> String
show Integer
i
        RText ColumnName
t -> ColumnName -> String
unpack ColumnName
t
        RDate {rdate :: RDataType -> ColumnName
rdate = ColumnName
d, dtformat :: RDataType -> ColumnName
dtformat = ColumnName
f} -> ColumnName -> String
unpack ColumnName
d
        RTime RTimestamp
t -> ColumnName -> String
unpack (ColumnName -> String) -> ColumnName -> String
forall a b. (a -> b) -> a -> b
$ RDataType -> ColumnName
rtext (String -> RTimestamp -> RDataType
rTimestampToRText String
"DD/MM/YYYY HH24:MI:SS" RTimestamp
t)
        -- Round to only two decimal digits after the decimal point

        RDouble Double
db -> String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f" Double
db -- show db

        RDataType
Null -> String
"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(ColumnDoesNotExist -> ColumnDoesNotExist -> Bool
(ColumnDoesNotExist -> ColumnDoesNotExist -> Bool)
-> (ColumnDoesNotExist -> ColumnDoesNotExist -> Bool)
-> Eq ColumnDoesNotExist
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnDoesNotExist -> ColumnDoesNotExist -> Bool
$c/= :: ColumnDoesNotExist -> ColumnDoesNotExist -> Bool
== :: ColumnDoesNotExist -> ColumnDoesNotExist -> Bool
$c== :: ColumnDoesNotExist -> ColumnDoesNotExist -> Bool
Eq,Int -> ColumnDoesNotExist -> ShowS
[ColumnDoesNotExist] -> ShowS
ColumnDoesNotExist -> String
(Int -> ColumnDoesNotExist -> ShowS)
-> (ColumnDoesNotExist -> String)
-> ([ColumnDoesNotExist] -> ShowS)
-> Show ColumnDoesNotExist
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnDoesNotExist] -> ShowS
$cshowList :: [ColumnDoesNotExist] -> ShowS
show :: ColumnDoesNotExist -> String
$cshow :: ColumnDoesNotExist -> String
showsPrec :: Int -> ColumnDoesNotExist -> ShowS
$cshowsPrec :: Int -> ColumnDoesNotExist -> ShowS
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(UnsupportedTimeStampFormat -> UnsupportedTimeStampFormat -> Bool
(UnsupportedTimeStampFormat -> UnsupportedTimeStampFormat -> Bool)
-> (UnsupportedTimeStampFormat
    -> UnsupportedTimeStampFormat -> Bool)
-> Eq UnsupportedTimeStampFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnsupportedTimeStampFormat -> UnsupportedTimeStampFormat -> Bool
$c/= :: UnsupportedTimeStampFormat -> UnsupportedTimeStampFormat -> Bool
== :: UnsupportedTimeStampFormat -> UnsupportedTimeStampFormat -> Bool
$c== :: UnsupportedTimeStampFormat -> UnsupportedTimeStampFormat -> Bool
Eq,Int -> UnsupportedTimeStampFormat -> ShowS
[UnsupportedTimeStampFormat] -> ShowS
UnsupportedTimeStampFormat -> String
(Int -> UnsupportedTimeStampFormat -> ShowS)
-> (UnsupportedTimeStampFormat -> String)
-> ([UnsupportedTimeStampFormat] -> ShowS)
-> Show UnsupportedTimeStampFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnsupportedTimeStampFormat] -> ShowS
$cshowList :: [UnsupportedTimeStampFormat] -> ShowS
show :: UnsupportedTimeStampFormat -> String
$cshow :: UnsupportedTimeStampFormat -> String
showsPrec :: Int -> UnsupportedTimeStampFormat -> ShowS
$cshowsPrec :: Int -> UnsupportedTimeStampFormat -> ShowS
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(EmptyInputStringsInToRTimestamp
-> EmptyInputStringsInToRTimestamp -> Bool
(EmptyInputStringsInToRTimestamp
 -> EmptyInputStringsInToRTimestamp -> Bool)
-> (EmptyInputStringsInToRTimestamp
    -> EmptyInputStringsInToRTimestamp -> Bool)
-> Eq EmptyInputStringsInToRTimestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyInputStringsInToRTimestamp
-> EmptyInputStringsInToRTimestamp -> Bool
$c/= :: EmptyInputStringsInToRTimestamp
-> EmptyInputStringsInToRTimestamp -> Bool
== :: EmptyInputStringsInToRTimestamp
-> EmptyInputStringsInToRTimestamp -> Bool
$c== :: EmptyInputStringsInToRTimestamp
-> EmptyInputStringsInToRTimestamp -> Bool
Eq, Int -> EmptyInputStringsInToRTimestamp -> ShowS
[EmptyInputStringsInToRTimestamp] -> ShowS
EmptyInputStringsInToRTimestamp -> String
(Int -> EmptyInputStringsInToRTimestamp -> ShowS)
-> (EmptyInputStringsInToRTimestamp -> String)
-> ([EmptyInputStringsInToRTimestamp] -> ShowS)
-> Show EmptyInputStringsInToRTimestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyInputStringsInToRTimestamp] -> ShowS
$cshowList :: [EmptyInputStringsInToRTimestamp] -> ShowS
show :: EmptyInputStringsInToRTimestamp -> String
$cshow :: EmptyInputStringsInToRTimestamp -> String
showsPrec :: Int -> EmptyInputStringsInToRTimestamp -> ShowS
$cshowsPrec :: Int -> EmptyInputStringsInToRTimestamp -> ShowS
Show)
instance Exception EmptyInputStringsInToRTimestamp

-- | This exception means that we have tried to do some operation between two 'RTables', which requires that

-- the structure of the two is the same. e.g., an @Insert Into <TAB> RTuples@, or a @UNION@ or toher set operations. 

-- By \"structure\", we mean that the 'ColumnName's and the corresponding data types must match. Essentially what we record in the 'ColumnInfo'

-- must be the same for the two 'RTable's

data ConflictingRTableStructures = 
        ConflictingRTableStructures String  -- ^ Error message indicating the operation that failed.

        deriving(ConflictingRTableStructures -> ConflictingRTableStructures -> Bool
(ConflictingRTableStructures
 -> ConflictingRTableStructures -> Bool)
-> (ConflictingRTableStructures
    -> ConflictingRTableStructures -> Bool)
-> Eq ConflictingRTableStructures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConflictingRTableStructures -> ConflictingRTableStructures -> Bool
$c/= :: ConflictingRTableStructures -> ConflictingRTableStructures -> Bool
== :: ConflictingRTableStructures -> ConflictingRTableStructures -> Bool
$c== :: ConflictingRTableStructures -> ConflictingRTableStructures -> Bool
Eq, Int -> ConflictingRTableStructures -> ShowS
[ConflictingRTableStructures] -> ShowS
ConflictingRTableStructures -> String
(Int -> ConflictingRTableStructures -> ShowS)
-> (ConflictingRTableStructures -> String)
-> ([ConflictingRTableStructures] -> ShowS)
-> Show ConflictingRTableStructures
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConflictingRTableStructures] -> ShowS
$cshowList :: [ConflictingRTableStructures] -> ShowS
show :: ConflictingRTableStructures -> String
$cshow :: ConflictingRTableStructures -> String
showsPrec :: Int -> ConflictingRTableStructures -> ShowS
$cshowsPrec :: Int -> ConflictingRTableStructures -> ShowS
Show)
instance Exception ConflictingRTableStructures

-- | This exception means that we have tried an Upsert operation where the source 'RTable' does not have

-- a unique set of 'Rtuple's if grouped by the columns used in the matching condition.

-- This simply means that we cannot determine which of the dublicate 'RTuple's in the source 'RTable'

-- will overwrite the target 'RTable', when the matching condition is satisfied.

data UniquenessViolationInUpsert =
        UniquenessViolationInUpsert String -- ^ Error message

        deriving(UniquenessViolationInUpsert -> UniquenessViolationInUpsert -> Bool
(UniquenessViolationInUpsert
 -> UniquenessViolationInUpsert -> Bool)
-> (UniquenessViolationInUpsert
    -> UniquenessViolationInUpsert -> Bool)
-> Eq UniquenessViolationInUpsert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UniquenessViolationInUpsert -> UniquenessViolationInUpsert -> Bool
$c/= :: UniquenessViolationInUpsert -> UniquenessViolationInUpsert -> Bool
== :: UniquenessViolationInUpsert -> UniquenessViolationInUpsert -> Bool
$c== :: UniquenessViolationInUpsert -> UniquenessViolationInUpsert -> Bool
Eq, Int -> UniquenessViolationInUpsert -> ShowS
[UniquenessViolationInUpsert] -> ShowS
UniquenessViolationInUpsert -> String
(Int -> UniquenessViolationInUpsert -> ShowS)
-> (UniquenessViolationInUpsert -> String)
-> ([UniquenessViolationInUpsert] -> ShowS)
-> Show UniquenessViolationInUpsert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UniquenessViolationInUpsert] -> ShowS
$cshowList :: [UniquenessViolationInUpsert] -> ShowS
show :: UniquenessViolationInUpsert -> String
$cshow :: UniquenessViolationInUpsert -> String
showsPrec :: Int -> UniquenessViolationInUpsert -> ShowS
$cshowsPrec :: Int -> UniquenessViolationInUpsert -> ShowS
Show)
instance Exception UniquenessViolationInUpsert