git.iko.soy/rel8
on 28aaa76 help sign in
rel8/src/Rel8/Table/Order.hs
54 lines 1.9 kB history raw
1{-# language DataKinds #-}
2{-# language NamedFieldPuns #-}
3{-# language ScopedTypeVariables #-}
4{-# language TypeApplications #-}
5{-# language TypeFamilies #-}
7module Rel8.Table.Order
8 ( ascTable
9 , descTable
10 )
11where
13-- base
14import Data.Functor.Const ( Const( Const ), getConst )
15import Data.Functor.Contravariant ( (>$<), contramap )
16import Prelude
18-- rel8
19import Rel8.Expr ( unDB )
20import Rel8.Expr.Order ( asc, desc, nullsFirst, nullsLast )
21import Rel8.Order ( Order )
22import Rel8.Schema.Dict ( Dict( Dict ) )
23import Rel8.Schema.HTable (htabulateA, hfield, hspecs)
24import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
25import Rel8.Schema.Spec ( SSpec( SSpec ) )
26import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )
27import Rel8.Table
28import Rel8.Table.Ord
31-- | Construct an 'Order' for a 'Table' by sorting all columns into ascending
32-- orders (any nullable columns will be sorted with @NULLS FIRST@).
33ascTable :: forall a. OrdTable a => Order a
34ascTable = contramap toColumns $ getConst $
35 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
36 SSpec {} -> case hfield (ordTable @a) field of
37 dict@Dict -> case dbTypeDict dict of
38 Dict -> Const $ unDB . (`hfield` field) >$<
39 case dbTypeNullability dict of
40 Nullable -> nullsFirst asc
41 NonNullable -> asc
44-- | Construct an 'Order' for a 'Table' by sorting all columns into descending
45-- orders (any nullable columns will be sorted with @NULLS LAST@).
46descTable :: forall a. OrdTable a => Order a
47descTable = contramap toColumns $ getConst $
48 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
49 SSpec {} -> case hfield (ordTable @a) field of
50 dict@Dict -> case dbTypeDict dict of
51 Dict -> Const $ unDB . (`hfield` field) >$<
52 case dbTypeNullability dict of
53 Nullable -> nullsLast desc
54 NonNullable -> desc