src/Rel8/Table/Order.hs · rel8

on 5a47018 help sign in

rel8/src/Rel8/Table/Order.hs

51 lines 1.8 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 ( unE )

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.Null ( Nullity( Null, NotNull ) )

25import Rel8.Schema.Spec ( SSpec( SSpec, nullity ) )

26import Rel8.Table ( Columns, toColumns )

27import Rel8.Table.Ord ( OrdTable, ordTable )

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 {nullity} -> case hfield (ordTable @a) field of

36 Dict -> Const $ unE . (`hfield` field) >$<

37 case nullity of

38 Null -> nullsFirst asc

39 NotNull -> asc

42-- | Construct an 'Order' for a 'Table' by sorting all columns into descending

43-- orders (any nullable columns will be sorted with @NULLS LAST@).

44descTable :: forall a. OrdTable a => Order a

45descTable = contramap toColumns $ getConst $

46 htabulateA @(Columns a) $ \field -> case hfield hspecs field of

47 SSpec {nullity} -> case hfield (ordTable @a) field of

48 Dict -> Const $ unE . (`hfield` field) >$<

49 case nullity of

50 Null -> nullsLast desc

51 NotNull -> desc