Commit 03b69a84 authored by Michael Hanus 's avatar Michael Hanus
Browse files

currypp updated

parent ce728f29
......@@ -13,6 +13,7 @@ browser/.cpm/packages/showflatcurry-0.0.1
currycheck/.cpm/packages/rewriting-0.0.1
currypp/.cpm/packages/cass-0.0.1
currypp/.cpm/packages/cass-analysis-0.0.4
currypp/.cpm/packages/cdbi-1.0.0
currypp/.cpm/packages/currycheck-1.0.1
currypp/.cpm/packages/rewriting-0.0.1
currypp/.cpm/packages/abstract-curry-1.0.0
......
Copyright (c) 2017, Michael Hanus
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the names of the copyright holders nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
cdbi: Type-safe database programming
====================================
This package contains libraries to support type-safe database programming.
[This paper](http://www.informatik.uni-kiel.de/~mh/papers/JFLP04_dyn.html)
contains a description of the basic ideas behind these libraries.
Usually, it is not necessary to use these libraries directly.
Instead, one can use the Curry preprocessor to formulate
type-safe SQL queries which are translated into calls to these libraries.
--------------------------------------------------------------------------
{
"name": "cdbi",
"version": "1.0.0",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "Libraries for type-safe database programming",
"category": [ "Database" ],
"dependencies": { },
"exportedModules": [ "Database.ERD",
"Database.CDBI.Connection",
"Database.CDBI.Criteria",
"Database.CDBI.Description",
"Database.CDBI.ER",
"Database.CDBI.QueryTypes" ],
"compilerCompatibility": {
"pakcs": ">= 1.14.0, < 2.0.0",
"kics2": ">= 0.5.0, < 2.0.0"
},
"license": "BSD-3-Clause",
"licenseFile": "LICENSE",
"source": {
"git": "https://git.ps.informatik.uni-kiel.de/curry-packages/cdbi.git",
"tag": "$version"
}
}
This diff is collapsed.
--- ----------------------------------------------------------------------------
--- This module provides datatypes, constructor functions and translation
--- functions to specify SQL criteria including options(group-by, having, order-by)
---
--- @author Mike Tallarek, Julia Krone
--- @version 0.2
--- @category database
--- ----------------------------------------------------------------------------
module Database.CDBI.Criteria (
Criteria(..), Constraint(..), ColVal(..), GroupBy,
Option, Value(..), CValue, CColumn, Condition(..), Specifier(..),
emptyCriteria, int, float, char, string, bool, date,
col, idVal, colNum, colVal, colValAlt, isNull, isNotNull, equal,
(.=.), notEqual, (./=.), greaterThan, (.>.), lessThan, (.<.),
greaterThanEqual, (.<=.), lessThanEqual, (.>=.),
like, (.~.), between, isIn, (.<->.), toCValue, toCColumn,
ascOrder, descOrder, groupBy, having, groupByCol, trCriteria,
trConstraint, trCondition, trValue, trColumn,trSpecifier,
trOption, sumIntCol, sumFloatCol, countCol, avgIntCol,
avgFloatCol, minCol, maxCol, condition, noHave) where
import List (intercalate)
import Time (ClockTime)
import Database.CDBI.Connection (SQLValue (..), SQLType(..), valueToString)
import Database.CDBI.Description (Column (..), Table)
-- -----------------------------------------------------------------------------
-- Datatypes for constructing SQL criteria
-- -----------------------------------------------------------------------------
--- Criterias for queries that can have a constraint and a group-by clause
data Criteria = Criteria Constraint (Maybe GroupBy)
--- specifier for queries
data Specifier = Distinct | All
--- datatype to represent order-by statement
data Option = AscOrder CValue
| DescOrder CValue
--- datatype to represent group-by statement
data GroupBy = GroupBy CValue GroupByTail
--- subtype for additional columns or having-Clause in group-by statement
data GroupByTail = Having Condition | GBT CValue GroupByTail | NoHave
--- datatype for conditions inside a having-clause
data Condition = Con Constraint
| Fun String Specifier Constraint
| HAnd [Condition]
| HOr [Condition]
| Neg Condition
--- A datatype to compare values.
--- Can be either a SQLValue or a Column with an additional
--- Integer (rename-number). The Integer is for dealing with renamed
--- tables in queries (i.e. Students as 1Students). If the Integer n is 0
--- the column will be named as usual ("Table"."Column"), otherwise it will
--- be named "nTable"."Column" in the query This is for being able to do
--- complex "where exists" constraints
data Value a = Val SQLValue | Col (Column a) Int
--- A datatype thats a combination between a Column and a Value
--- (Needed for update queries)
data ColVal = ColVal CColumn CValue
--- Type for columns used inside a constraint.
type CColumn = Column ()
--- Type for values used inside a constraint.
type CValue = Value ()
--- Constraints for queries
--- Every constructor with at least one value has a function as a constructor
--- and only that function will be exported to assure type-safety
--- Most of these are just like the Sql-where-commands Exists needs the
--- table-name, an integer and maybe a constraint
--- (where exists (select * from table where constraint))
--- The integer n will rename the table if it has a different value than 0
--- (where exists (select * from table as ntable where...))
data Constraint
= IsNull CValue
| IsNotNull CValue
| BinaryRel RelOp CValue CValue
| Between CValue CValue CValue
| IsIn CValue [CValue]
| Not Constraint
| And [Constraint]
| Or [Constraint]
| Exists Table Int Constraint
| None
data RelOp = Eq | Neq | Lt | Lte | Gt | Gte | Like
-- -----------------------------------------------------------------------------
-- Constructor functions
-- -----------------------------------------------------------------------------
--- An empty criteria
emptyCriteria :: Criteria
emptyCriteria = Criteria None Nothing
--- Constructor for a Value Val of type Int
--- @param i - The value
int :: Int -> Value Int
int = Val . SQLInt
--- Constructor for a Value Val of type Float
--- @param i - The value
float :: Float -> Value Float
float = Val . SQLFloat
--- Constructor for a Value Val of type Char
--- @param i - The value
char :: Char -> Value Char
char = Val . SQLChar
--- Constructor for a Value Val of type String
--- @param i - The value
string :: String -> Value String
string = Val . SQLString
--- Constructor for a Value Val of type Bool
--- @param i - The value
bool :: Bool -> Value Bool
bool = Val . SQLBool
--- Constructor for a Value Val of type ClockTime
--- @param i - The value
date :: ClockTime -> Value ClockTime
date = Val . SQLDate
--- Constructor for Values of ID-types
--- Should just be used internally!
idVal :: Int -> Value _
idVal i = Val (SQLInt i)
val :: SQLValue -> Value _
val v = (Val v)
--- Constructor for a Value Col without a rename-number
--- @param c - The column
col :: Column a -> Value a
col c = Col c 0
--- Constructor for a Value Col with a rename-number
--- @param c - The column
--- @param n - The rename-number
colNum :: Column a -> Int -> Value a
colNum c n = Col c n
--- A constructor for ColVal needed for typesafety
--- @param c - The Column
--- @param v - The Value
colVal :: Column a -> Value a -> ColVal
colVal c v = ColVal (toCColumn c) (toCValue v)
--- Alternative ColVal constructor without typesafety
--- @param table - The Tablename of the column
--- @param cl - The column name
--- @param s - The SQLValue
colValAlt :: String -> String -> SQLValue -> ColVal
colValAlt table cl s =
ColVal (toCColumn
(Column ("\"" ++ cl ++ "\"")
("\"" ++ table ++ "\".\"" ++ "\"" ++ cl ++ "\"")))
(Val s)
--- IsNull construnctor
--- @param v1 - First Value
isNull :: Value a -> Constraint
isNull v1 = IsNull (toCValue v1)
--- IsNotNull construnctor
--- @param v1 - First Value
isNotNull :: Value a -> Constraint
isNotNull v1 = IsNotNull (toCValue v1)
--- Equal construnctor
--- @param v1 - First Value
--- @param v2 - Second Value
equal :: Value a -> Value a -> Constraint
equal v1 v2 = BinaryRel Eq (toCValue v1) (toCValue v2)
--- Infix Equal
(.=.) :: Value a -> Value a -> Constraint
(.=.) = equal
--- NotEqual construnctor
--- @param v1 - First Value
--- @param v2 - Second Value
notEqual :: Value a -> Value a -> Constraint
notEqual v1 v2 = BinaryRel Neq (toCValue v1) (toCValue v2)
--- Infix NotEqual
(./=.) :: Value a -> Value a -> Constraint
(./=.) = notEqual
--- GreatherThan construnctor
--- @param v1 - First Value
--- @param v2 - Second Value
greaterThan :: Value a -> Value a -> Constraint
greaterThan v1 v2 = BinaryRel Gt (toCValue v1) (toCValue v2)
--- Infix GreaterThan
(.>.) :: Value a -> Value a -> Constraint
(.>.) = greaterThan
--- LessThan construnctor
--- @param v1 - First Value
--- @param v2 - Second Value
lessThan :: Value a -> Value a -> Constraint
lessThan v1 v2 = BinaryRel Lt (toCValue v1) (toCValue v2)
--- Infix LessThan
(.<.) :: Value a -> Value a -> Constraint
(.<.) = lessThan
--- GreaterThanEqual construnctor
--- @param v1 - First Value
--- @param v2 - Second Value
greaterThanEqual :: Value a -> Value a -> Constraint
greaterThanEqual v1 v2 = BinaryRel Gte (toCValue v1) (toCValue v2)
--- Infix GreaterThanEqual
(.>=.) :: Value a -> Value a -> Constraint
(.>=.) = greaterThanEqual
--- LessThanEqual construnctor
--- @param v1 - First Value
--- @param v2 - Second Value
lessThanEqual :: Value a -> Value a -> Constraint
lessThanEqual v1 v2 = BinaryRel Lte (toCValue v1) (toCValue v2)
--- Infix LessThanEqual
(.<=.) :: Value a -> Value a -> Constraint
(.<=.) = lessThanEqual
--- Like construnctor
--- @param v1 - First Value
--- @param v2 - Second Value
like :: Value a -> Value a -> Constraint
like v1 v2 = BinaryRel Like (toCValue v1) (toCValue v2)
--- Infix Like
(.~.) :: Value a -> Value a -> Constraint
(.~.) = like
--- Between construnctor
--- @param v1 - First Value
--- @param v2 - Second Value
--- @param v3 - Third Value
between :: Value a -> Value a -> Value a -> Constraint
between v1 v2 v3 = Between (toCValue v1) (toCValue v2) (toCValue v3)
--- IsIn construnctor
--- @param v1 - First Value
--- @param xs - List of Values
isIn :: Value a -> [Value a] -> Constraint
isIn v1 xs = IsIn (toCValue v1) (map toCValue xs)
--- Infix IsIn
(.<->.) :: Value a -> [Value a] -> Constraint
(.<->.) = isIn
--- Constructor for the option: Ascending Order by Column
--- @param c - The Column that should be ordered by
ascOrder :: Value a -> Option
ascOrder v = AscOrder (toCValue v)
--- Constructor for the option: Descending Order by Column
--- @param c - The Column that should be ordered by
descOrder :: Value a -> Option
descOrder v = DescOrder (toCValue v)
---Constructor for group-by-clause
---@param c - The Column that should be grouped by
---@param gbTail - GroupByTail, i.e. more columns or a having-clause
groupBy :: Value a -> GroupByTail -> GroupBy
groupBy c gbTail = GroupBy (toCValue c) gbTail
--- Constructor to specifiy more than one column for group-by
--- @param c - the additional column
--- @param gbTail - subsequent part of group-by statement
groupByCol :: Value a -> GroupByTail -> GroupByTail
groupByCol c gbTail = GBT (toCValue c) gbTail
---Constructor for having condition
---@param con - The condition
having :: Condition -> GroupByTail
having con = Having con
--- Constructor for empty having-Clause
noHave :: GroupByTail
noHave = NoHave
---Constructor for Condition with just a simple Constraint
condition :: Constraint -> Condition
condition con = Con con
---Constructor for aggregation function sum for columns of type Int
--- having-clauses.
---@param spec - specifier Distinct or All
---@param c - Column that is to be summed up
---@param v - value the result is compared to (has to be of type Int)
---@param op - relating operator
sumIntCol :: Specifier -> Value Int -> Value Int
-> (Value () -> Value () -> Constraint) -> Condition
sumIntCol spec c v op = (Fun "Sum " spec (op (toCValue c) (toCValue v)))
--- Constructor for aggregation function sum for columns of type float
--- in having-clauses.
---@param spec - specifier Distinct or All
---@param c - Column that is to be summed up
---@param v - value the result is compared to (has to be of type float)
---@param op - relating operator
sumFloatCol :: Specifier -> Value Float -> Value Float
-> (Value () -> Value () -> Constraint) -> Condition
sumFloatCol spec c v op = (Fun "Sum " spec (op (toCValue c) (toCValue v)))
--- Constructor for aggregation function avg for columns of type Int
--- in having-clauses.
---@param spec - specifier Distinct or All
---@param c - Column that is to be averaged
---@param v - value the result is compared to (has to be of type float)
---@param op - relating operator
avgIntCol :: Specifier -> Value Int -> Value Float
-> (Value () -> Value () -> Constraint) -> Condition
avgIntCol spec c v op = (Fun "Avg " spec (op (toCValue c) (toCValue v)))
--- Constructor for aggregation function avg for columns of type float
--- in having-clauses.
---@param spec - specifier Distinct or All
---@param c - Column that is to be avaraged
---@param v - value the result is compared to (has to be of type float)
---@param op - relating operator
avgFloatCol :: Specifier -> Value Float -> Value Float
-> (Value () -> Value () -> Constraint) -> Condition
avgFloatCol spec c v op = (Fun "Avg " spec (op (toCValue c) (toCValue v)))
---Constructor for aggregation function count in having-clauses.
---@param spec - specifier Distinct or All
---@param c - Column which elements are to be counted
---@param v - value the result is compared to (has to be of type Int).
---@param op - relating operator
countCol :: Specifier -> Value _ -> Value Int
-> (Value () -> Value () -> Constraint) -> Condition
countCol spec c v op = (Fun "Count " spec (op (toCValue c) (toCValue v)))
--- Constructor for aggregation function min in having-clauses.
--- @param spec - specifier Distinct or All
---@param c - column the minimal element has to be extracted from
---@param v - value to compare to the minimal value, same type as column
---@param op - operator
minCol :: Specifier -> Value a -> Value a
-> (Value () -> Value () -> Constraint) -> Condition
minCol spec c v op = (Fun "Min " spec (op (toCValue c) (toCValue v)))
--- Constructor for aggregation function max in having-clauses.
--- @param spec - specifier Distinct or All
---@param c - column the maximal element has to be extracted from
---@param v - value to compare to the maximal value, same type as column
---@param op - operator
maxCol :: Specifier -> Value a -> Value a
-> (Value () -> Value () -> Constraint) -> Condition
maxCol spec c v op = (Fun "Max " spec (op (toCValue c) (toCValue v)))
--Convert to UnitType
toCColumn :: Column a -> Column ()
toCColumn (Column s1 s2) = (Column s1 s2)
toCValue :: Value a -> CValue
toCValue (Col (Column s1 s2) n) = Col (Column s1 s2) n
toCValue (Val v1) = Val v1
-- -----------------------------------------------------------------------------
-- Translation of a constraint into a SQL string.
-- -----------------------------------------------------------------------------
-- Translate Criteria to a string in a sql-query
trCriteria :: Criteria -> String
trCriteria crit = case crit of
(Criteria None group) -> trGroup group
(Criteria c group) -> " where " ++ trConstraint c ++ " "
++ trGroup group
-- Translate an Order-by to a string in a sql-query
trOption :: [Option] -> String
trOption [] = ""
trOption (ls@((AscOrder _):_)) = " order by " ++
intercalate ", " (map trOption' ls)
trOption (ls@((DescOrder _):_)) = " order by " ++
intercalate ", " (map trOption' ls)
trOption' :: Option -> String
trOption' (AscOrder v) = trValue v ++ " asc"
trOption' (DescOrder v) = trValue v ++ " desc"
-- translate a group-by to a string in a sql-query
trGroup :: (Maybe GroupBy) -> String
trGroup Nothing = ""
trGroup (Just (GroupBy cs gbTail)) = " group by " ++ trValue cs ++
trTail gbTail
trTail :: GroupByTail -> String
trTail (GBT cs gbTail) = ", "++ trValue cs ++ trTail gbTail
trTail NoHave = ""
trTail (Having cond) = " Having " ++ trCondition cond
trCondition :: Condition -> String
trCondition (HAnd conds) = intercalate " and " (map trCondition conds)
trCondition (HOr conds) = intercalate " or " (map trCondition conds)
trCondition (Con cons) = trConstraint cons
trCondition (Neg cond) = "(not "++ (trCondition cond)++")"
trCondition (Fun fun spec cons) = "("++fun ++ "("++trSpecifier spec ++constr
where ('(':'(':constr) = trConstraint cons
-- Translate a Constraint to a string in a sql-query
trConstraint :: Constraint -> String
trConstraint (IsNull v) = paren $ (paren $ trValue v) ++ " is NULL"
trConstraint (IsNotNull v) = paren $ (paren $ trValue v) ++ " is not NULL"
trConstraint (BinaryRel rel v1 v2)
= paren $ (paren $ trValue v1) ++ trRelOp rel ++ trValue v2
trConstraint (Between v1 v2 v3)
= paren $ (paren $ trValue v1) ++ " between " ++ trValue v2 ++ " and " ++ trValue v3
trConstraint (IsIn v vs)
= paren $ trValue v ++ " in " ++ paren (intercalate ", " $ map trValue vs)
trConstraint (Not c) = paren $ "not " ++ trConstraint c
trConstraint (And [] ) = ""
trConstraint (And cs@(_:_)) = paren $ intercalate " and " (map trConstraint cs)
trConstraint (Or [] ) = ""
trConstraint (Or cs@(_:_)) = paren $ intercalate " or " (map trConstraint cs)
trConstraint (Exists table n cs) =
"(exists (select * from '" ++ table ++ "' " ++
(asTable table n) ++ " " ++ (trCriteria (Criteria cs Nothing)) ++ "))"
trRelOp :: RelOp -> String
trRelOp Eq = " == "
trRelOp Neq = " <> "
trRelOp Lt = " < "
trRelOp Lte = " <= "
trRelOp Gt = " > "
trRelOp Gte = " >= "
trRelOp Like = " like "
-- Translate a Value to a String
trValue :: Value a -> String
trValue (Val v) = valueToString v
trValue (Col (Column _ c) n) = trColumn c n
-- Translate "Table.Column" to "nTable.Colum" where n is the Integer-Parameter
trColumn :: String -> Int -> String
trColumn ('"':table_column) n =
if n==0 then '"' : table_column
else '"' : show n ++ table_column
{-
trColumn ("\"" ++ table ++ "\"." ++ column) n =
case n of
0 -> "\"" ++ table ++ "\"." ++ column
m -> "\"" ++ (show m) ++ table ++ "\"." ++ column
-}
paren :: String -> String
paren s = '(' : s ++ ")"
-- Create the "as tablename" string
asTable :: Table -> Int -> Table
asTable table n = case n of
0 -> ""
m -> " as '" ++ (show m) ++ table ++ "'"
--Translate specifier
trSpecifier :: Specifier -> String
trSpecifier All = ""
trSpecifier Distinct = "Distinct "
\ No newline at end of file
--- This module contains basic datatypes and operations to represent
--- a relational data model in a type-safe manner. This representation is
--- used by the library `Database.CDBI.ER` to provide type safety
--- when working with relational databases.
--- The tool `erd2cdbi` generates from an entity-relationship model
--- a Curry program that represents all entities and relationships
--- by the use of this module.
---
--- @author Mike Tallarek, changes by Julia Krone
--- @version 0.2
--- @category database
--- ----------------------------------------------------------------------------
module Database.CDBI.Description where
import Time
import Database.CDBI.Connection (SQLType, SQLValue(..))
-- -----------------------------------------------------------------------------
-- Datatypes for describing entities
-- -----------------------------------------------------------------------------
--- The datatype EntityDescription is a description of a database entity
--- type including the name, the types the entity consists of, a function
--- transforming an instance of this entity to a list of SQLValues, a
--- second function doing the same but converting the key value always to
--- SQLNull to ensure that keys are auto incrementing and a
--- function transforming a list of SQLValues to an instance of this entity
data EntityDescription a = ED String
[SQLType]
(a -> [SQLValue])
(a -> [SQLValue]) --for insertion
([SQLValue] -> a)
--- Entity-types can be combined (For Example Student and Lecture could be
--- combined to Data StuLec = StuLec Student Lecture). If a description for
--- this new type is written CDBI can look up that type in the database
--- The description is a list of Tuples consisting of a String (The name of
--- the entity type that will be combined), a "rename-number" n which will
--- rename the table to "table as ntable" and a list of SQLTypes (The types
--- that make up that entity type). Furthermore there has to be a function
--- that transform a list of SQLValues into this combined type, and two
--- functions that transform the combined type into a list of SQLValues, the
--- first one for updates, the second one for insertion.
--- The list of sqlvalues needs to match what is returned by the database.
data CombinedDescription a = CD [(Table, Int, [SQLType])]
([SQLValue] -> a)
(a -> [[SQLValue]])
(a -> [[SQLValue]]) -- for insertion
--- A type representing tablenames
type Table = String
--- A datatype representing column names.
--- The first string is the simple name of the column (for example the
--- column Name of the row Student). The second string is the name of the
--- column combined with the name of the row (for example Student.Name).
--- These names should always be in quotes (for example "Student"."Name")
--- so no errors emerge (the name "Group" for
--- example would result in errors if not in quotes).
--- Has a phantom-type for the value the column represents.
data Column _ = Column String String