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