OrderBy ASC/DESC

README.md

@@ -1,19 +1,19 @@
 # database-generic
 
-Database agnostic typeclass to access generically persisted data.
+Database-agnostic interface to generically persisted data.
 
 ## Introduction
 
 Explanation of the above:
-- Database agnostic typeclass: the typeclass is called `MonadDb` and you must
-  specify how it can communicate with your database (e.g. PostgreSQL server)
+- Database-agnostic interface: the interface is called `MonadDb`, and you must
+  specify how it can communicate with your database (e.g. PostgreSQL server).
 - Generically persisted data: you can derive the necessary instances for your
-  data types via `Generics` (or write your own instance). This will enable
-  `MonadDb` to read/write instances of your data types to/from your database.
+  data types via `Generics`. This will enable `MonadDb` to read/write instances
+  of your data types to/from your database.
 
 A key intended feature of this library is that the typeclass `MonadDb` can be
 used either server-side or client-side. Allowing your client application (e.g.
-web app) to use the same functions to access data as you use server-side.
+web app) to use the same functions to access your data as your server-side does.
 
 Another important intended feature is an optional `servant` server. Merely
 provide an instance of `MonadDb` so the server knows how to communicate with
@@ -32,30 +32,33 @@ To run the tutorial on your machine:
 
 ## Features
 
-| Feature                                  | Status | Tested |
-|------------------------------------------|--------|--------|
-| Create table                             | ✅     | ✅     |
-| Select all                               | ✅     | ✅     |
-| Select by ID                             | ✅     | ✅     |
-| Return subset of fields                  | ✅     | ✅     |
-| Where column equals                      |        |        |
-| Where column is null                     |        |        |
-| Where column is not null                 |        |        |
-| Order by clause                          | ✅     | ✅     |
-| Order by asc/desc                        |        |        |
-| Limit clause                             | ✅     | ✅     |
-| Offset clause                            | ✅     | ✅     |
-| Insert one                               | ✅     |        |
-| Insert many                              | ✅     |        |
-| Insert returning                         | ✅     |        |
-| Delete all                               | ✅     | ✅     |
-| Delete by ID                             | ✅     | ✅     |
-| Delete returning                         | ✅     | ✅     |
-| Joins                                    |        |        |
-| Stream statements over Conduit           |        |        |
-| Stream updates over Conduit              |        |        |
-| Server: endpoint to execute statement    | ✅     |        |
-| Server: stream statements over WebSocket |        |        |
-| Server: stream updates over WebSocket    |        |        |
-| Server: permission checks                |        |        |
-| Reflex (client-side) MonadDb instance    |        |        |
+Examples of the following features can be found in [the
+tutorial](tutorial/tutorial/Main.hs).
+
+| Feature                                  | In Tutorial | Tested |
+|------------------------------------------|-------------|--------|
+| Create table                             | ✅          | ✅     |
+| Insert one                               | ✅          |        |
+| Insert many                              | ✅          |        |
+| Insert returning                         | ✅          |        |
+| Insert returning fields                  | ✅          | ✅     |
+| Select by PK                             | ✅          | ✅     |
+| Select all                               | ✅          | ✅     |
+| Select returning fields                  | ✅          | ✅     |
+| Where column equals                      |             |        |
+| Where column is null                     |             |        |
+| Where column is not null                 |             |        |
+| Limit clause                             | ✅          | ✅     |
+| Offset clause                            | ✅          | ✅     |
+| Order by clause                          | ✅          | ✅     |
+| Delete by PK                             | ✅          | ✅     |
+| Delete all                               | ✅          | ✅     |
+| Delete returning                         | ✅          | ✅     |
+| Server: endpoint to execute statement    | ✅          |        |
+| Joins                                    |             |        |
+| Stream statements over Conduit           |             |        |
+| Stream updates over Conduit              |             |        |
+| Server: stream statements over WebSocket |             |        |
+| Server: stream updates over WebSocket    |             |        |
+| Server: permission checks                |             |        |
+| Reflex (client-side) MonadDb instance    |             |        |

database-generic/database-generic.cabal

@@ -37,6 +37,7 @@ library
                       Database.Generic.Statement.Insert,
                       Database.Generic.Statement.Limit,
                       Database.Generic.Statement.NoType,
+                      Database.Generic.Statement.Order,
                       Database.Generic.Statement.OrderBy,
                       Database.Generic.Statement.Output,
                       Database.Generic.Statement.Returning,

database-generic/src/Database/Generic.hs

@@ -6,9 +6,10 @@ import Database.Generic.Class as X (MonadDb(..), MonadDbNewConn(..))
 import Database.Generic.Operations as X (execute, executeTx, tx, tx_)
 import Database.Generic.Statement.CreateTable as X (createTable)
 import Database.Generic.Statement.Delete as X (deleteAll, deleteById)
-import Database.Generic.Statement.Fields as X (field, field2, field3)
+import Database.Generic.Statement.Fields as X ((/\), field, order)
 import Database.Generic.Statement.Insert as X (insertMany, insertOne)
 import Database.Generic.Statement.Limit as X (limit, limitOffset)
+import Database.Generic.Statement.Order as X (Order(..))
 import Database.Generic.Statement.OrderBy as X (orderBy)
 import Database.Generic.Statement.Returning as X ((==>), returning, returningFields)
 import Database.Generic.Statement.Select as X (selectAll, selectById)

database-generic/src/Database/Generic/Class.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE UndecidableInstances #-}
-
 module Database.Generic.Class where
 
 import Database.Generic.Database (Database, DbV)
@@ -8,6 +6,7 @@ import Database.Generic.Statement (Statement)
 import Database.Generic.Statement.NoType qualified as NT
 import Database.Generic.Statement.Output (HasOutputType, Output, OutputError, OutputType, outputType)
 
+-- | Type synonym to simplify the type of values returned by executing statements.
 type ExecuteReturns m db a = Either (ExecuteError (Error m db) (DbV db)) a
 
 -- | Monads that can execute database statements.
@@ -21,15 +20,21 @@ class
   )
   => MonadDb m db | m -> db where
 
+  -- | Connection type, over which statements are executed.
   type C m db :: Type
 
+  -- | Wrapper type over input and output  to 'executeStatement'.
   type T m db :: Type -> Type
   type T m db = Identity -- Default for convenience.
 
   type Error m db :: Type
   type Error m db = SomeException -- Default for convenience.
 
-  -- | Execute a statement and parse the output based on expected 'OutputType'.
+  -- | Execute a statement and parse the 'Output' based on expected 'OutputType'.
+  --
+  -- If you want to modify the type of value returned by 'executeStatement' (to
+  -- be parsed into fields of your data type), then implement 'Database' with a
+  -- custom 'DbV' type. Probably you don't want to do this though.
   executeStatement
     :: C m db
     -> (T m db) (NT.Statement, OutputType)

database-generic/src/Database/Generic/Database.hs

@@ -4,6 +4,9 @@ import Database.Generic.Prelude
 import Database.Generic.Entity.DbTypes (DbValue)
 
 class Database db where
+  -- | Type representing one cell in a row, as returned from statement execution.
+  --
+  -- Needs to be parsable via 'FromDbValues', into the fields of your data types.
   type DbV db :: Type
 
 data PostgreSQL

database-generic/src/Database/Generic/Operations.hs

@@ -8,7 +8,7 @@ import Database.Generic.Prelude
 import Database.Generic.Statement (Statement(..), ToStatement(..))
 import Database.Generic.Statement qualified as Statement
 import Database.Generic.Statement.Output (HasOutputType, OutputT, ParseOutput(..))
-import Database.Generic.Statement.Type (StatementType(..), Cons)
+import Database.Generic.Statement.Type (List(..), StatementType(..))
 import Database.Generic.Statement.Tx qualified as Tx
 import Database.Generic.Transaction (Tx, runTx)
 
@@ -30,30 +30,30 @@ execute =
 -- | Like 'execute' but each 'Statement' is appended with a commit statement.
 executeTx :: forall m r s db.
   ( Database db
-  , HasOutputType (Cons CommitTx s)
+  , HasOutputType (L CommitTx s)
   , MonadDb m db
   , MonadDbWithConn m (C m db)
-  , ParseOutput (DbV db) (Cons CommitTx s)
+  , ParseOutput (DbV db) (L CommitTx s)
   , ToStatement r
   , s ~ S r
   )
   => r
-  -> m (ExecuteReturns m db (OutputT (Cons CommitTx s)))
+  -> m (ExecuteReturns m db (OutputT (L CommitTx s)))
 executeTx =
   fmap extract . withDbConn . flip executeAndParse . pure . Statement.commitTx . statement
 
 -- | Like 'executeTx' but shape of input and output is of type 't'.
 executeTxs :: forall m r s db.
   ( Database db
-  , HasOutputType (Cons CommitTx s)
+  , HasOutputType (L CommitTx s)
   , MonadDb m db
   , MonadDbNewConn m (C m db)
-  , ParseOutput (DbV db) (Cons CommitTx s)
+  , ParseOutput (DbV db) (L CommitTx s)
   , ToStatement r
   , s ~ S r
   )
   => (T m db) r
-  -> m ((T m db) (ExecuteReturns m db (OutputT (Cons CommitTx s))))
+  -> m ((T m db) (ExecuteReturns m db (OutputT (L CommitTx s))))
 executeTxs =
   (newDbConn >>=) . flip executeAndParse . fmap (Statement.commitTx . statement)
 

database-generic/src/Database/Generic/Statement.hs

@@ -7,47 +7,47 @@ import Database.Generic.Statement.Insert qualified as I
 import Database.Generic.Statement.Output (HasOutputType(..))
 import Database.Generic.Statement.Select qualified as S
 import Database.Generic.Statement.Tx qualified as Tx
-import Database.Generic.Statement.Type (Cons, StatementType(..))
+import Database.Generic.Statement.Type (List(..), StatementType(..))
 
 -- | One or more statements. We track a type-level list 's' of the statements,
 -- because the order of the statements can affect what is returned.
-data Statement (s :: [StatementType]) where
-  StatementBeginTx     :: !Tx.BeginTx          -> Statement '[BeginTx]
-  StatementCommitTx    :: !Tx.CommitTx         -> Statement '[CommitTx]
-  StatementCreateTable :: !(C.CreateTable a)   -> Statement '[CreateTable a]
-  StatementDelete      :: !(D.Delete o r a)    -> Statement '[Delete o r a]
-  StatementInsert      :: !(I.Insert o r a)    -> Statement '[Insert o r a]
-  StatementSelect      :: !(S.Select o r a ob) -> Statement '[Select o r a ob]
-  Cons                 :: !(Statement '[s1])   -> (Statement s2) -> Statement (Cons s1 s2)
+data Statement (s :: List StatementType) where
+  StatementBeginTx     :: !Tx.BeginTx          -> Statement (One BeginTx)
+  StatementCommitTx    :: !Tx.CommitTx         -> Statement (One CommitTx)
+  StatementCreateTable :: !(C.CreateTable a)   -> Statement (One (CreateTable a))
+  StatementDelete      :: !(D.Delete o r a)    -> Statement (One (Delete o r a))
+  StatementInsert      :: !(I.Insert o r a)    -> Statement (One (Insert o r a))
+  StatementSelect      :: !(S.Select o r a ob) -> Statement (One (Select o r a ob))
+  Cons                 :: !(Statement (One s1))  -> !(Statement s2) -> Statement (L s1 s2)
 
 instance HasOutputType r => HasOutputType (Statement r) where
   outputType = outputType @r
 
 -- | Typeclass to lift individual statements into 'Statement'.
 class ToStatement s where
-  type S s :: [StatementType]
+  type S s :: List StatementType
   statement :: s -> Statement (S s)
 
 instance ToStatement Tx.CommitTx where
-  type S Tx.CommitTx = '[CommitTx]
+  type S Tx.CommitTx = One CommitTx
   statement = StatementCommitTx
 
 instance ToStatement (C.CreateTable (a :: Type)) where
-  type S (C.CreateTable a) = '[CreateTable a]
+  type S (C.CreateTable a) = One (CreateTable a)
   statement = StatementCreateTable
 
 instance ToStatement (D.Delete o (r :: Maybe fs) (a :: Type)) where
-  type S (D.Delete o r a) = '[Delete o r a]
+  type S (D.Delete o r a) = One (Delete o r a)
   statement = StatementDelete
 
 instance ToStatement (I.Insert o (r :: Maybe fs) (a :: Type)) where
-  type S (I.Insert o r a) = '[Insert o r a]
+  type S (I.Insert o r a) = One (Insert o r a)
   statement = StatementInsert
 
 instance ToStatement (S.Select o (r :: Type) (a :: Type) (ob :: Bool)) where
-  type S (S.Select o r a ob) = '[Select o r a ob]
+  type S (S.Select o r a ob) = One (Select o r a ob)
   statement = StatementSelect
 
 -- | Append a commit statement to a 'Statement'.
-commitTx :: Statement s -> Statement (Cons CommitTx s)
+commitTx :: Statement s -> Statement (L CommitTx s)
 commitTx = Cons $ StatementCommitTx Tx.CommitTx

database-generic/src/Database/Generic/Statement/Fields.hs

@@ -3,6 +3,8 @@ module Database.Generic.Statement.Fields where
 import Data.Aeson qualified as Aeson
 import Database.Generic.Entity.FieldName (FieldName, HasFieldName, fieldName)
 import Database.Generic.Prelude
+import Database.Generic.Statement.Order (Order(..))
+import Database.Generic.Statement.Type (List(..))
 import Database.Generic.Serialize (Serialize(..))
 import Witch qualified as W
 
@@ -16,41 +18,80 @@ instance Serialize Fields db where
   serialize All       = "*"
   serialize (Some cs) = intercalate ", " $ W.from <$> cs
 
+-- | Named fields to order by in a statement.
+newtype OrderedFields = OrderedFields [(FieldName, Order)]
+  deriving (Aeson.FromJSON, Eq, Generic, Semigroup, Show)
+
+instance Serialize Order db => Serialize OrderedFields db where
+  serialize (OrderedFields fs) = intercalate ", " $ fs <&> \(fn, o) ->
+    from fn <> " " <> serialize @_ @db o
+
 -- | Fields 'fs' of 'a' that can be parsed into a 'b'.
 class FieldsOf fs a b | fs -> a, fs -> b where
   -- | The names of the fields to be selected.
   fieldNames :: fs -> [FieldName]
 
+-- | Ordered fields 'fs' of 'a'.
+class OrderedFieldsOf fs a | fs -> a where
+  -- | The names of the fields to be selected.
+  orderedFieldNames :: fs -> OrderedFields
+
 -- * field - field3
 
--- | Value-level representation of a field of type 'b' belonging to 'a'.
-newtype Field a b = Field { name :: FieldName } deriving Generic
+-- | A named field of type 'b' belonging to 'a'.
+field :: forall f a b. (HasField f a b, HasFieldName f) => Field' a (One b)
+field = Field $ fieldName @f
 
-instance FieldsOf (Field a b) a b where
-  fieldNames fb = [fb.name]
+-- | A named fields of type 'b' belonging to 'a', with ordering 'o'.
+order
+  :: forall f (o :: Order) a b
+  . (HasField f a b, HasFieldName f)
+  => FieldOrder a (One o)
+order = Field (fieldName @f)
 
-field :: forall f a b. (HasField f a b, HasFieldName f) => Field a b
-field = Field $ fieldName @f
+-- | Cons fields together.
+(/\) :: Field' a (One b) -> Field' a bs -> Field' a (L b bs)
+(/\) = FieldCons
+
+-- | One or more named fields belonging to 'a'.
+--
+-- Can be used to filter results to only a subset of 'a's fields.
+type Field a (bs :: List Type) = Field' a bs
+
+-- | One or more named fields belonging to 'a', with ordering 'o'.
+--
+-- This can be used to order a query of a collection of 'a's.
+type FieldOrder a (os :: List Order) = Field' a os
+
+data Field' a x where
+  Field     :: !FieldName           -> Field' a (One b)
+  FieldCons :: !(Field' a (One b)) -> !(Field' a bs) -> Field' a (L b bs)
+
+-- TODO the following code should avoid an instance per list length
+
+instance FieldsOf (Field' a (One b)) a b where
+  fieldNames (Field fn) = [fn]
+
+instance FieldsOf (Field' a (L b1 (One b2))) a (b1, b2) where
+  fieldNames (FieldCons f fs) = fieldNames f <> fieldNames fs
+
+instance FieldsOf (Field' a (L b1 (L b2 (One b3)))) a (b1, b2, b3) where
+  fieldNames (FieldCons f fs) = fieldNames f <> fieldNames fs
 
-newtype F2 a b c = F2 (Field a b, Field a c)
+instance FieldsOf (Field' a (L b1 (L b2 (L b3 (One b4))))) a (b1, b2, b3, b4) where
+  fieldNames (FieldCons f fs) = fieldNames f <> fieldNames fs
 
-instance FieldsOf (F2 a b c) a (b, c) where
-  fieldNames (F2 (fb, fc)) = [fb.name, fc.name]
+class    SingOrder o    where singOrder :: Order
+instance SingOrder Asc  where singOrder =  Asc
+instance SingOrder Desc where singOrder =  Desc
 
-field2 :: forall fb fc a b c.
-  ( HasField fb a b, HasFieldName fb
-  , HasField fc a c, HasFieldName fc
-  ) => F2 a b c
-field2 = F2 (field @fb @a @b, field @fc @a @c)
+-- TODO the following code should avoid an instance per list length
 
-newtype F3 a b c d = F3 (Field a b, Field a c, Field a d)
+instance SingOrder o => OrderedFieldsOf (Field' a (One o)) a where
+  orderedFieldNames (Field fn) = OrderedFields [(fn, singOrder @o)]
 
-instance FieldsOf (F3 a b c d) a (b, c, d) where
-  fieldNames (F3 (fb, fc, fd)) = [fb.name, fc.name, fd.name]
+instance (SingOrder o1, SingOrder o2) => OrderedFieldsOf (Field' a (L o1 (One o2)) ) a where
+  orderedFieldNames (FieldCons (Field f1) (Field f2)) = OrderedFields [(f1, singOrder @o1), (f2, singOrder @o2)]
 
-field3 :: forall fb fc fd a b c d.
-  ( HasField fb a b, HasFieldName fb
-  , HasField fc a c, HasFieldName fc
-  , HasField fd a d, HasFieldName fd
-  ) => F3 a b c d
-field3 = F3 (field @fb @a @b, field @fc @a @c, field @fd @a @d)
+instance (SingOrder o1, SingOrder o2, SingOrder o3) => OrderedFieldsOf (Field' a (L o1 (L o2 (One o3))) ) a where
+  orderedFieldNames (FieldCons (Field f1) (FieldCons (Field f2) (Field f3))) = OrderedFields [(f1, singOrder @o1), (f2, singOrder @o2), (f3, singOrder @o3)]

database-generic/src/Database/Generic/Statement/NoType.hs

@@ -8,6 +8,7 @@ import Database.Generic.Prelude
 import Database.Generic.Statement qualified as S
 import Database.Generic.Statement.CreateTable qualified as C
 import Database.Generic.Statement.Delete qualified as C
+import Database.Generic.Statement.Fields (OrderedFields)
 import Database.Generic.Statement.Insert qualified as C
 import Database.Generic.Statement.Select qualified as C
 import Database.Generic.Statement.Tx qualified as Tx
@@ -42,6 +43,7 @@ instance From (S.Statement s) Statement where
 instance
   ( Serialize DbType db
   , Serialize DbValue db
+  , Serialize OrderedFields db
   ) => Serialize Statement db where
   serialize (StatementBeginTx     s) = serialize @_ @db s
   serialize (StatementCommitTx    s) = serialize @_ @db s