-- | Converting a sorting specification to a value understandable by Beam.
module Servant.Util.Beam.Postgres.Sorting
    ( SortingSpecApp
    , fieldSort
    , sortBy_
    ) where

import Universum

import Data.Coerce (coerce)
import Database.Beam.Backend.SQL (BeamSqlBackend)
import Database.Beam.Query (SqlOrderable, asc_, desc_, orderBy_)
import Database.Beam.Query.Internal (Projectible, Q, QExpr, QNested, QOrd, ThreadRewritable,
                                     WithRewrittenThread)

import Servant.Util.Combinators.Sorting.Backend
import Servant.Util.Combinators.Sorting.Base

-- | Implements sorting for beam-postgres package.
data BeamSortingBackend be s

instance (BeamSqlBackend be) =>
         SortingBackend (BeamSortingBackend be s) where

    type SortedValue (BeamSortingBackend be s) a =
        QExpr be s a

    type BackendOrdering (BeamSortingBackend be s) =
        QOrd be s Void

    backendFieldSort :: SortedValue (BeamSortingBackend be s) a
-> SortingApp (BeamSortingBackend be s) ('TyNamedParam name a)
backendFieldSort SortedValue (BeamSortingBackend be s) a
field = (SortingItemTagged ('TyNamedParam name a)
 -> BackendOrdering (BeamSortingBackend be s))
-> SortingApp (BeamSortingBackend be s) ('TyNamedParam name a)
forall backend (param :: TyNamedParam *).
(SortingItemTagged param -> BackendOrdering backend)
-> SortingApp backend param
SortingApp ((SortingItemTagged ('TyNamedParam name a)
  -> BackendOrdering (BeamSortingBackend be s))
 -> SortingApp (BeamSortingBackend be s) ('TyNamedParam name a))
-> (SortingItemTagged ('TyNamedParam name a)
    -> BackendOrdering (BeamSortingBackend be s))
-> SortingApp (BeamSortingBackend be s) ('TyNamedParam name a)
forall a b. (a -> b) -> a -> b
$ \(SortingItemTagged (SortingItem Text
_name SortingOrder
order)) ->
        let applyOrder :: QExpr be s Void -> QOrd be s Void
applyOrder = case SortingOrder
order of
                SortingOrder
Ascendant  -> QExpr be s Void -> QOrd be s Void
forall be s a. BeamSqlBackend be => QExpr be s a -> QOrd be s a
asc_
                SortingOrder
Descendant -> QExpr be s Void -> QOrd be s Void
forall be s a. BeamSqlBackend be => QExpr be s a -> QOrd be s a
desc_

        -- TODO [DSCP-425]
        -- Ordering NULLs is not supported by SQLite :peka:
        -- nullsOrder = case siNullsOrder of
        --     Nothing         -> id
        --     Just NullsFirst -> nullsFirst_
        --     Just NullsLast  -> nullsLast_

        in QExpr be s Void -> QOrd be s Void
applyOrder (QExpr be s a -> QExpr be s Void
coerce QExpr be s a
SortedValue (BeamSortingBackend be s) a
field)

-- | Applies 'orderBy_' according to the given sorting specification.
sortBy_
    :: ( backend ~ BeamSortingBackend syntax0 s0
       , allParams ~ AllSortingParams provided base
       , ApplyToSortItem backend allParams
       , Projectible be a
       , SqlOrderable be (BackendOrdering backend)
       , ThreadRewritable (QNested s) a
       )
    => SortingSpec provided base
    -> (a -> SortingSpecApp backend allParams)
    -> Q be db (QNested s) a
    -> Q be db s (WithRewrittenThread (QNested s) s a)
sortBy_ :: SortingSpec provided base
-> (a -> SortingSpecApp backend allParams)
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
sortBy_ SortingSpec provided base
spec a -> SortingSpecApp backend allParams
app = (a -> [QOrd syntax0 s0 Void])
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
forall s a ordering be (db :: (* -> *) -> *).
(Projectible be a, SqlOrderable be ordering,
 ThreadRewritable (QNested s) a) =>
(a -> ordering)
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
orderBy_ (SortingSpec provided base
-> SortingSpecApp backend allParams -> [BackendOrdering backend]
forall (provided :: [TyNamedParam *])
       (base :: [TyNamedParam (SortingOrderType *)])
       (allParams :: [TyNamedParam *]) backend.
(allParams ~ AllSortingParams provided base,
 ApplyToSortItem backend allParams) =>
SortingSpec provided base
-> SortingSpecApp backend allParams -> [BackendOrdering backend]
backendApplySorting SortingSpec provided base
spec (SortingSpecApp backend allParams -> [QOrd syntax0 s0 Void])
-> (a -> SortingSpecApp backend allParams)
-> a
-> [QOrd syntax0 s0 Void]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SortingSpecApp backend allParams
app)