<commit_before>{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MonadComprehensions   #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RebindableSyntax      #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}
    
-- TPC-H Q21

module Queries.TPCH.Q21
    ( q21
    , q21'
    ) where

import qualified Data.Text as T

import qualified Prelude as P
import Database.DSH
import Database.DSH.Compiler

import Database.HDBC.PostgreSQL

import Queries.TPCH.Records

q21 :: Text -> Q [(Text, Integer)]
q21 nation =
  sortWith (\(view -> (name, nw)) -> pair (-1 * nw) name) $
  map (\kg -> pair (fst kg) (length $ snd kg)) $
  groupWithKey id $
  [ s_nameQ s
  | s <- suppliers
  , l1 <- lineitems
  , o <- orders
  , n <- nations
  , s_suppkeyQ s == l_suppkeyQ l1
  , o_orderkeyQ o == l_orderkeyQ l1
  , o_orderstatusQ o == toQ "F"
  , l_receiptdateQ l1 > l_commitdateQ l1
  , not $ null [ 1 :: Q Integer
               | l2 <- lineitems
	       , l_orderkeyQ l2 == l_orderkeyQ l1
	       , l_suppkeyQ l2 /= l_suppkeyQ l1
	       ]
  , null [ 1 :: Q Integer
         | l3 <- lineitems
	 , l_orderkeyQ l3 == l_orderkeyQ l1
	 , l_suppkeyQ l3 == l_suppkeyQ l1
	 , l_receiptdateQ l3 > l_commitdateQ l3
	 ]
  ]

-- Variant of TPC-H Q21 with explicit universal and existential quantifiers.
q21' :: Text -> Q [(Text, Integer)]
q21' nation =
  sortWith (\(view -> (name, nw)) -> pair (-1 * nw) name) $
  map (\kg -> pair (fst kg) (length $ snd kg)) $
  groupWithKey id $
  [ s_nameQ s
  | s <- suppliers
  , l1 <- lineitems
  , o <- orders
  , n <- nations
  , s_suppkeyQ s == l_suppkeyQ l1
  , o_orderkeyQ o == l_orderkeyQ l1
  , o_orderstatusQ o == toQ "F"
  , l_receiptdateQ l1 > l_commitdateQ l1
  , not $ null [ 1 :: Q Integer
               | l2 <- lineitems
	       , l_orderkeyQ l2 == l_orderkeyQ l1
	       , l_suppkeyQ l2 /= l_suppkeyQ l1
	       ]
  , null [ 1 :: Q Integer
         | l3 <- lineitems
	 , l_orderkeyQ l3 == l_orderkeyQ l1
	 , l_suppkeyQ l3 == l_suppkeyQ l1
	 , l_receiptdateQ l3 > l_commitdateQ l3
	 ]
  ]
<commit_msg>TPC-H Q21 with all and any.<commit_after>{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MonadComprehensions   #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RebindableSyntax      #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}
    
-- TPC-H Q21

module Queries.TPCH.Q21
    ( q21
    , q21'
    ) where

import qualified Data.Text as T

import qualified Prelude as P
import Database.DSH
import Database.DSH.Compiler

import Database.HDBC.PostgreSQL

import Queries.TPCH.Records

q21 :: Text -> Q [(Text, Integer)]
q21 nation =
  sortWith (\(view -> (name, nw)) -> pair (-1 * nw) name) $
  map (\kg -> pair (fst kg) (length $ snd kg)) $
  groupWithKey id $
  [ s_nameQ s
  | s <- suppliers
  , l1 <- lineitems
  , o <- orders
  , n <- nations
  , s_suppkeyQ s == l_suppkeyQ l1
  , o_orderkeyQ o == l_orderkeyQ l1
  , o_orderstatusQ o == toQ "F"
  , l_receiptdateQ l1 > l_commitdateQ l1
  , not $ null [ 1 :: Q Integer
               | l2 <- lineitems
	       , l_orderkeyQ l2 == l_orderkeyQ l1
	       , l_suppkeyQ l2 /= l_suppkeyQ l1
	       ]
  , null [ 1 :: Q Integer
         | l3 <- lineitems
	 , l_orderkeyQ l3 == l_orderkeyQ l1
	 , l_suppkeyQ l3 == l_suppkeyQ l1
	 , l_receiptdateQ l3 > l_commitdateQ l3
	 ]
  ]

-- Variant of TPC-H Q21 with explicit universal and existential quantifiers.
q21' :: Text -> Q [(Text, Integer)]
q21' nation =
  sortWith (\(view -> (name, nw)) -> pair (-1 * nw) name) $
  map (\kg -> pair (fst kg) (length $ snd kg)) $
  groupWithKey id $
  [ s_nameQ s
  | s <- suppliers
  , l1 <- lineitems
  , o <- orders
  , n <- nations
  , s_suppkeyQ s == l_suppkeyQ l1
  , o_orderkeyQ o == l_orderkeyQ l1
  , o_orderstatusQ o == toQ "F"
  , l_receiptdateQ l1 > l_commitdateQ l1
  , any (\l2 -> l_orderkeyQ l2 == l_orderkeyQ l1 && l_suppkeyQ l2 /= l_suppkeyQ l1) 
        lineitems
  , all (\l3 -> not $ l_orderkey l3 == l_orderkeyQ l1
                      && l_suppkeyQ l3 == l_suppkeyQ l1
                      && l_receiptdateQ l3 > l_commitdateQ l3)
        lineitems
  ]

{'fraction_non_alphanumeric': 0.12609970674486803, 'fraction_numerical': 0.026167381006090683, 'mean_word_length': 2.3163799551234106, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 29, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7526193', 'n_tokens_mistral': 1834, 'n_tokens_neox': 1734, 'n_words': 447}