git.iko.soy/rel8
on 11bcbbb help sign in
rel8/src/Rel8/Table/Order.hs
80 lines 2.6 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, hdicts, hspecs)
24import Rel8.Schema.Nullability
25 ( Unnullify, Nullability( Nullable, NonNullable )
26 , Sql, nullabilization
27 )
28import Rel8.Schema.Spec ( Spec( Spec ), SSpec( SSpec ) )
29import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
30import Rel8.Table
31import Rel8.Table.Ord
32import Rel8.Type.Ord
35-- | Construct an 'Order' for a 'Table' by sorting all columns into ascending
36-- orders (any nullable columns will be sorted with @NULLS FIRST@).
37ascTable :: forall a. OrdTable a => Order a
38ascTable = contramap toColumns $ getConst $
39 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
40 SSpec {} -> case hfield ords field of
41 dict@Dict -> case ord dict of
42 Dict -> Const $ unDB . (`hfield` field) >$< case nullability dict of
43 Nullable -> nullsFirst asc
44 NonNullable -> asc
45 where
46 ords = hdicts @(Columns a) @(ConstrainDBType DBOrd)
49-- | Construct an 'Order' for a 'Table' by sorting all columns into descending
50-- orders (any nullable columns will be sorted with @NULLS LAST@).
51descTable :: forall a. OrdTable a => Order a
52descTable = contramap toColumns $ getConst $
53 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
54 SSpec {} -> case hfield ords field of
55 dict@Dict -> case ord dict of
56 Dict -> Const $ unDB . (`hfield` field) >$< case nullability dict of
57 Nullable -> nullsLast desc
58 NonNullable -> desc
59 where
60 ords = hdicts @(Columns a) @(ConstrainDBType DBOrd)
63nullability :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Nullability a
64nullability = step2 . step1
65 where
66 step1 :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Dict (Sql DBOrd) a
67 step1 Dict = Dict
69 step2 :: Dict (Sql DBOrd) a -> Nullability a
70 step2 Dict = nullabilization
73ord :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Dict DBOrd (Unnullify a)
74ord = step2 . step1
75 where
76 step1 :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Dict (Sql DBOrd) a
77 step1 Dict = Dict
79 step2 :: Dict (Sql DBOrd) a -> Dict DBOrd (Unnullify a)
80 step2 Dict = Dict