DSH 0.8.2.0 → 0.8.2.1
raw patch · 6 files changed
+152/−5 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- DSH.cabal +4/−2
- LICENSE +1/−1
- examples/Example01.hs +3/−1
- examples/Example02.hs +41/−0
- examples/Example03.hs +101/−0
- examples/Makefile +2/−1
DSH.cabal view
@@ -1,5 +1,5 @@ Name: DSH-Version: 0.8.2.0+Version: 0.8.2.1 Synopsis: Database Supported Haskell Description: This is a Haskell library for database-supported program execution. Using@@ -39,13 +39,15 @@ License: BSD3 License-file: LICENSE-Author: George Giorgidze, Tom Schreiber, Nils Schweinsberg and Jeroen Weijers+Author: George Giorgidze, Alexander Ulrich, Tom Schreiber, Nils Schweinsberg and Jeroen Weijers Maintainer: giorgidze@gmail.com, jeroen.weijers@uni-tuebingen.de Stability: Experimental Category: Database Build-type: Simple Extra-source-files: examples/Example01.hs+ examples/Example02.hs+ examples/Example03.hs examples/Makefile tests/Main.hs tests/Makefile
LICENSE view
@@ -1,4 +1,4 @@-Copyright George Giorgidze, Tom Schreiber, Nils Schweinsberg and Jeroen Weijers 2010+Copyright George Giorgidze, Alexander Ulrich, Tom Schreiber, Nils Schweinsberg and Jeroen Weijers 2010 - 2012 All rights reserved.
examples/Example01.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE MonadComprehensions, RebindableSyntax, ViewPatterns #-}+{-# LANGUAGE MonadComprehensions #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE ViewPatterns #-} module Main where
+ examples/Example02.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE MonadComprehensions #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE ViewPatterns #-}++module Main where++import qualified Prelude as P+import Database.DSH+import Database.DSH.Compiler++import Database.HDBC.PostgreSQL++employees :: Q [(Text, Text, Integer)]+employees = toQ [ ("Simon", "MS", 80)+ , ("Erik", "MS", 90)+ , ("Phil", "Ed", 40)+ , ("Gordon", "Ed", 45)+ , ("Paul", "Yale", 60)+ ]++departments :: Q [Text]+departments = nub [ dept | (view -> (_name,dept,_salary)) <- employees]++deptSalary :: Q Text -> Q Integer+deptSalary dept = sum [ salary+ | (view -> (_name,dept',salary)) <- employees+ , dept == dept']++mainQuery :: Q [(Text,Integer)]+mainQuery = [ pair dept (deptSalary dept)+ | dept <- departments]++getConn :: IO Connection+getConn = connectPostgreSQL "user = 'giorgidz' password = '' host = 'localhost' dbname = 'giorgidz'"++runQ :: (Show a,QA a) => Q a -> IO ()+runQ q = getConn P.>>= \conn -> (fromQ conn q P.>>= P.print) P.>> disconnect conn++main :: IO ()+main = runQ mainQuery
+ examples/Example03.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MonadComprehensions #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++module Main where++import qualified Prelude as P+import Database.DSH+import Database.DSH.Compiler++import Database.HDBC.PostgreSQL++data Employee = Prof { name :: Text+ , chair :: Text+ , advisedStudents :: [Text]+ }+ | Stud { name :: Text+ , topic :: Text+ , advisor :: Text+ }+ deriving (Eq,Ord,Show)++deriveDSH ''Employee++students :: Q [(Integer,Text,Text,Text)]+students = toQ [ (1,"J","P","T")+ , (2,"A","Q","T")+ ]++professors :: Q [(Integer,Text,Text)]+professors = toQ [ (0,"T","DB")]++employment :: Q [(Integer,Text,Text,Integer)]+employment = toQ [ (0,"DB","professor",2008)+ , (1,"DB","student",2010)+ , (2,"DB","student",2011)+ , (3,"PL","student",2012)+ ]++salaries :: Q [(Integer,Integer)]+salaries = toQ [ (0,4096)+ , (1,2048)+ , (2,2048)+ ]++employeesBySeniority :: Q [Employee]+employeesBySeniority = concat+ [ if eStatus == "student"+ then [ stud sName sTopic sAdvisor+ | (view -> (sID, sName, sTopic, sAdvisor)) <- students+ , eID == sID+ ]+ else [ prof pName pChair sAdvised+ | (view -> (pID, pName, pChair)) <- professors+ , eID == pID+ , let sAdvised = [ sName+ | (view -> (_, sName, _, sAdvisor)) <- students+ , sAdvisor == pName+ ]+ ]+ | (view -> (eID, _, eStatus, _)) <- sortWith (\(view -> (_, _, _, d)) -> d) employment+ ]++safeMinimum :: (Ord a, QA a) => Q [a] -> Q (Maybe a)+safeMinimum as = if null as then nothing else just (minimum as) ++salPerDept :: Q [(Text, [Integer])]+salPerDept =+ [ pair dept [ salary+ | (view -> (sID,salary)) <- salaries+ , (view -> (dID,_,_,_)) <- deptMembers+ , sID == dID+ ]+ | (view -> (dept, deptMembers)) <- groupWithKey (\(view -> (_,d,_,_)) -> d) employment+ ]++minSalPerDept :: Q [(Text, Integer)]+minSalPerDept = [ pair dept (elim (safeMinimum sals)+ 0+ (\minSal -> minSal))+ | (view -> (dept, sals)) <- salPerDept+ ]++getConn :: IO Connection+getConn = connectPostgreSQL "user = 'giorgidz' password = '' host = 'localhost' dbname = 'giorgidz'"++runQ :: (Show a,QA a) => Q a -> IO ()+runQ q = getConn P.>>= \conn -> (fromQ conn q P.>>= P.print) P.>> disconnect conn++main :: IO ()+main = sequence_ [ runQ employeesBySeniority+ , runQ salPerDept+ , runQ minSalPerDept+ ]
examples/Makefile view
@@ -1,7 +1,8 @@ all: clean ghc -Wall -O3 --make Example01.hs ghc -Wall -O3 --make Example02.hs+ ghc -Wall -O3 --make Example03.hs rm -rf *.hi *.o clean:- rm -rf *.hi *.o Example01 Example02+ rm -rf *.hi *.o Example01 Example02 Example03