git.iko.soy/rel8
on 9b5abf2 help sign in
rel8/src/Rel8/Table/Order.hs
50 lines 1.6 kB history raw
1{-# language NamedFieldPuns #-}
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.Order ( asc, desc, nullsFirst, nullsLast )
19import Rel8.Order ( Order )
20import Rel8.Schema.Context ( unDB )
21import Rel8.Schema.Dict ( Dict( Dict ) )
22import Rel8.Schema.HTable (htabulateA, hfield, hdicts, hspecs)
23import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
24import Rel8.Schema.Spec ( SSpec(..) )
25import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
26import Rel8.Table
27import Rel8.Table.Ord
28import Rel8.Type.Ord
31ascTable :: forall a. OrdTable a => Order a
32ascTable = contramap toColumns $ getConst $
33 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
34 SSpec {nullability} -> case hfield ords field of
35 Dict -> Const $ unDB . (`hfield` field) >$< case nullability of
36 Nullable -> nullsFirst asc
37 NonNullable -> asc
38 where
39 ords = hdicts @(Columns a) @(ConstrainDBType DBOrd)
42descTable :: forall a. OrdTable a => Order a
43descTable = contramap toColumns $ getConst $
44 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
45 SSpec {nullability} -> case hfield ords field of
46 Dict -> Const $ unDB . (`hfield` field) >$< case nullability of
47 Nullable -> nullsLast desc
48 NonNullable -> desc
49 where
50 ords = hdicts @(Columns a) @(ConstrainDBType DBOrd)