DSH 0.10.0.1 → 0.10.0.2
raw patch · 2 files changed
+1/−371 lines, 2 filesdep ~DSHdep ~HDBC-postgresqldep ~base
Dependency ranges changed: DSH, HDBC-postgresql, base, text
Files
- DSH.cabal +1/−7
- tests/Manual.hs +0/−364
DSH.cabal view
@@ -1,5 +1,5 @@ Name: DSH-Version: 0.10.0.1+Version: 0.10.0.2 Synopsis: Database Supported Haskell Description: This is a Haskell library for database-supported program execution. Using@@ -222,12 +222,6 @@ algebra-dag >= 0.1, algebra-sql >= 0.1 GHC-Options: -Wall -fno-warn-orphans--executable manual- hs-source-dirs: tests- main-is: Manual.hs- build-depends: base, DSH, HDBC-postgresql, text- ghc-options: -Wall -fno-warn-orphans Test-Suite Flattening_TA type: exitcode-stdio-1.0
− tests/Manual.hs
@@ -1,364 +0,0 @@-{-# 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--import qualified Data.Text as T--import TPCH--data Foo = Foo { foo1 :: Integer, foo2 :: Text, foo3 :: Integer }--deriveDSH ''Foo-deriveTA ''Foo-generateTableSelectors ''Foo--getConn :: IO Connection-getConn = connectPostgreSQL "user = 'au' password = 'foobar' host = 'localhost' port = '5432' dbname = 'tpch'"--xs :: Q [(Integer, Integer)]-xs = toQ [(3,5),(4,6),(5,7),(6,9)]--ys :: Q [Integer]-ys = toQ [1,2,3,4]--bar :: Q [(Integer, Integer, Integer)]-bar = [ triple a c 42 | (view -> (a, b, c)) <- toQ ([(1,2,3), (4,5,6), (7,8,9)] :: [(Integer, Integer, Integer)]) ]--{--li :: Q [(Integer, Text, Double)]-li = [ tup3 (l_linenumberQ l) (l_returnflagQ l) (l_discountQ l)- | l <- lineitems- , l_taxQ l > 5.0- ]--}--data Range = Range { start :: Integer, end :: Integer }--deriveDSH ''Range--avgBalance :: Q [Customer] -> Q Double-avgBalance cs =- avg [ c_acctbalQ c | c <- cs, c_acctbalQ c > 0.0 ]--ordersOf :: Q Customer -> Q [Order]-ordersOf c =- [ o | o <- orders, o_custkeyQ o == c_custkeyQ c ]--potentialCustomers :: Q [Customer] -> Q [Customer]-potentialCustomers cs =- [ c | c <- cs,- c_acctbalQ c > avgBalance cs, length (ordersOf c) == 0 ]--countryCodeOf :: Q Customer -> Q Text-countryCodeOf c = subString 1 2 (c_phoneQ c)--livesIn :: Q Customer -> [Text] -> Q Bool-livesIn c countries = countryCodeOf c `elem` toQ countries--q22 :: [Text] -> Q [(Text, Integer, Double)]-q22 countries =- sortWith (\(view -> (country, _, _)) -> country)- [ tup3 country (length custs) (sum (map c_acctbalQ custs)) |- (view -> (country, custs)) <- groupWithKey countryCodeOf pots ]- where- pots = potentialCustomers [ c | c <- customers,- c `livesIn` countries ]--minSupplyCost :: Q Integer -> Q Double-minSupplyCost partkey = - minimum $ - [ ps_supplycostQ ps- | ps <- partsupps- , s <- suppliers- , n <- nations- , r <- regions- , partkey == ps_partkeyQ ps- , s_suppkeyQ s == ps_suppkeyQ ps- , s_nationkeyQ s == n_nationkeyQ n- , n_regionkeyQ n == r_regionkeyQ r- , r_nameQ r == (toQ "EUROPE")- ]--sortingCriteria- :: Q (Double, Text, Text, Integer, Text, Text, Text, Text)- -> Q (Double, Text, Text, Integer)-sortingCriteria (view -> (b, sn, nn, pk, _, _, _, _)) =- tup4 (b * (toQ $ -1.0)) nn sn pk--q2 :: Q [(Double, Text, Text, Integer, Text, Text, Text, Text)]-q2 = - sortWith sortingCriteria $- [ tup8 (s_acctbalQ s)- (s_nameQ s)- (n_nameQ n)- (p_partkeyQ p)- (p_mfgrQ p)- (s_addressQ s)- (s_phoneQ s)- (s_commentQ s)- | p <- parts- , ps <- partsupps- , s <- suppliers- , n <- nations- , r <- regions- , p_partkeyQ p == ps_partkeyQ ps- , s_suppkeyQ s == ps_suppkeyQ ps- , p_sizeQ p == (toQ 15)- , p_typeQ p `like` (toQ "%BRASS")- , s_nationkeyQ s == n_nationkeyQ n- , n_regionkeyQ n == r_regionkeyQ r- , r_nameQ r == (toQ "EUROPE")- , ps_supplycostQ ps == minSupplyCost (p_partkeyQ p)- ]--orderQuantity :: Q [LineItem] -> Q Double-orderQuantity lis = sum $ map l_quantityQ lis--jan_q7a :: Q [LineItem]-jan_q7a = snd $ head $ sortWith (orderQuantity . snd) $ groupWithKey l_orderkeyQ lineitems------------------------------------------------------------------------------------- Query written from a database viewpoint---- List the lineitems of the order with the most parts.-sumPerOrder :: Q [(Integer, Double)]-sumPerOrder = map (\(view -> (ok, lis)) -> pair ok (sum $ map l_quantityQ lis)) - $ groupWithKey l_orderkeyQ lineitems--jan_q7b :: Q [LineItem]-jan_q7b = - [ l- | l <- lineitems- , (view -> (ok, nrItems)) <- sumPerOrder- , l_orderkeyQ l == ok- , nrItems == maximum(map snd sumPerOrder)- ]--q :: Q [[Integer]]-q = map init (toQ ([] :: [[Integer]]))--data Trade = Trade- { t_price :: Double- , t_tid :: Integer- , t_timestamp :: Integer- , t_tradeDate :: Integer- }--deriveDSH ''Trade-deriveTA ''Trade-generateTableSelectors ''Trade--data Portfolio = Portfolio- { po_pid :: Integer- , po_tid :: Integer- , po_tradedSince :: Integer- }--deriveDSH ''Portfolio-deriveTA ''Portfolio-generateTableSelectors ''Portfolio--trades :: Q [Trade]-trades = table "trades" $ TableHints [ Key ["t_tid", "t_timestamp"] ] NonEmpty--portfolios :: Q [Portfolio]-portfolios = table "portfolio" $ TableHints [Key ["po_pid"] ] NonEmpty------------------------------------------------------------------------------------- For a given date and stock, compute the best profit obtained by--- buying the stock and selling it later.---- | For each list element, compute the minimum of all elements up to--- the current one.-mins :: (Ord a, QA a, TA a) => Q [a] -> Q [a]-mins as = [ minimum [ a' | (view -> (a', i')) <- nas, i' <= i ]- | let nas = number as- , (view -> (a, i)) <- nas- ] --{---Being able to write the query using a parallel comprehension would be-nice:--maximum [ t_priceQ t - minPrice- | t <- trades'- | minPrice <- mins $ map t_priceQ trades'- ]----}----bestProfit :: Integer -> Integer -> Q Double-bestProfit stock date = - maximum [ t_priceQ t - minPrice- | (view -> (t, minPrice)) <- zip trades' (mins $ map t_priceQ trades')- ]- where- trades' = filter (\t -> t_tidQ t == toQ stock && t_tradeDateQ t == toQ date)- $ sortWith t_timestampQ trades--hasNationality :: Q Customer -> Text -> Q Bool-hasNationality c nn = - or [ n_nameQ n == toQ nn && n_nationkeyQ n == c_nationkeyQ c- | n <- nations- ]--ordersWithStatus :: Text -> Q Customer -> Q [Order]-ordersWithStatus status c =- [ o | o <- ordersOf c, o_orderstatusQ o == toQ status ]--revenue :: Q Order -> Q Double-revenue o = sum [ l_extendedpriceQ l * (1 - l_discountQ l)- | l <- lineitems- , l_orderkeyQ l == o_orderkeyQ o- ]--expectedRevenueFor :: Text -> Q [(Text, [(Integer, Double)])]-expectedRevenueFor nation =- [ pair (c_nameQ c) [ pair (o_orderdateQ o) (revenue o)- | o <- ordersWithStatus "P" c ]- | c <- customers- , c `hasNationality` nation- ]--foobar = take 10 $ sortWith id $ map revenue orders--njg3 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> Q [(Integer, Integer)]-njg3 njgxs njgys njgzs =- [ pair x y- | x <- toQ njgxs- , y <- toQ njgys- , length [ toQ () | z <- toQ njgzs, fst z == x ] > 2- ]--njgxs1 :: [Integer]-njgxs1 = [1,2]--njgys1 :: [Integer]-njgys1 = [2,3]--njgzs1 :: [(Integer, Integer)]-njgzs1 = [(2, 20), (5, 60), (3, 30)]--backdep5 :: Q [[Integer]]-backdep5 = [ [ x + length xs | x <- take (length xs - 3) xs ] | xs <- toQ ([[1,2,3], [], [4,5,6]] :: [[Integer]]) ]--foo42 :: Q [Integer]-foo42 = filter (const $ toQ True) (toQ ([1,2,3,45] :: [Integer]))--revenue2 :: Integer -> Q [(Integer, Double)]-revenue2 intervalFrom =- [ pair supplier_no (sum [ ep * (1 - discount)- | (view -> (_, ep, discount)) <- g- ])- | (view -> (supplier_no, g)) <- groupWithKey (\(view -> (a, b, c)) -> a) intervalItems- ]-- where- intervalItems = [ tup3 (l_suppkeyQ l)- (l_extendedpriceQ l)- (l_discountQ l)- | l <- lineitems- , l_shipdateQ l >= toQ intervalFrom- , l_shipdateQ l <= (toQ intervalFrom) + 23- ]--q15 :: Integer -> Q [(Integer, (Text, Text, Text, Double))]-q15 intervalFrom = - sortWith fst- [ pair (s_suppkeyQ s)- (tup4 (s_nameQ s)- (s_addressQ s)- (s_phoneQ s)- total_rev)- | s <- suppliers- , (view -> (supplier_no, total_rev)) <- revenue2 intervalFrom- , s_suppkeyQ s == supplier_no- , total_rev == (maximum $ map snd $ revenue2 intervalFrom)- ]--cartprod :: Q ([Integer], [Integer]) -> Q [(Integer, Integer)]-cartprod (view -> (xs, ys)) =- [ tup2 x y- | x <- xs- , y <- ys- , x == y- ]--tup :: Q [(Integer, Integer, Integer, Integer)]-tup = map (\(view -> (a, b, c, d)) -> tup4 (a + c) (b - d) b d) (toQ ([(0,0,0,0)] :: [(Integer, Integer, Integer, Integer)]))--frontguard :: Q [[Integer]]-frontguard =- [ [ y | x > 13, y <- toQ ([1,2,3,4] :: [Integer]), y < 3 ]- | x <- toQ ([10, 20, 30] :: [Integer])- ]--njxs1 :: [Integer]-njxs1 = [1,2,3,4,5,6]--njys1 :: [Integer]-njys1 = [3,4,5,6,3,6,4,1,1,1]--nj6 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]-nj6 njxs njys = - [ pair x [ y | y <- toQ njys, x + y > 10, y < 7 ]- | x <- toQ njxs- ]--nj9 :: [Integer] -> [Integer] -> Q [[Integer]]-nj9 njxs njys = [ [ x + y | y <- toQ njys, x + 1 == y, y > 2, x < 6 ] | x <- toQ njxs ]--backdep3 :: Q [[Integer]] -> Q [[Integer]]-backdep3 xss = [ [ x + length xs | x <- xs ] | xs <- xss ]--backdep4 :: Q [[[Integer]]] -> Q [[[Integer]]]-backdep4 xsss = [ [ [ x + length xs + length xss- | x <- xs- ]- | xs <- xss- ]- | xss <- xsss- ]--q23 :: [[[Integer]]] -> Q [[(Integer, [[Integer]])]]-q23 xsss = map (groupWithKey length) (toQ xsss)---- Test data for testcase hnj12-njxs2, njys2, njzs2 :: [Integer]-njxs2 = [1,2,3,4,5,5,2]-njys2 = [2,1,0,5,4,4,4]-njzs2 = [6,1,1,3,2,5]--nj12 :: [Integer] -> [Integer] -> [Integer] -> Q [[[(Integer, Integer, Integer)]]]-nj12 njxs njys njzs =- [ [ [ tup3 x y z | z <- toQ njzs, y == z ]- | y <- toQ njys- , x == y- ]- | x <- toQ njxs- ]--main :: IO ()-main = getConn P.>>= \c -> debugQ "q" c (nj12 njxs2 njys2 njzs2) P.>>= \r -> putStrLn (show r)--- main = runQX100 x100Conn q P.>>= \r -> putStrLn $ show r---main = debugQX100 "q" x100Conn q