Welcome to Databass, Part 2, even more bass. In part 1, we defined a query GADT and runQuery function. Here, we'll figure out how to materialize relations and tuples in memory. As before, full source is on github. First, though, I had a question about implementing Group and Ungroup, which we skipped in part 1. For the sake of completeness, we'll add them here.

Group and Ungroup

Recall the relations from Part 1.

╔═════════════════════════════════════════════════════════════════╗
║     S (suppliers)                          SP (suppliers-parts) ║
║    ┌────┬───────┬────────┬────────┐           ┌────┬────┬─────┐ ║
║    │ S# │ SNAME │ STATUS │ CITY   │           │ S# │ P# │ QTY │ ║
║    ├════┼───────┼────────┼────────┤           ├════┼════┼─────┤ ║
║    │ S1 │ Smith │     20 │ London │           │ S1 │ P1 │ 300 │ ║
║    │ S2 │ Jones │     10 │ Paris  │           │ S1 │ P2 │ 200 │ ║
║    │ S3 │ Blake │     30 │ Paris  │           │ S1 │ P3 │ 400 │ ║
║    │ S4 │ Clark │     20 │ London │           │ S1 │ P4 │ 200 │ ║
║    │ S5 │ Adams │     30 │ Athens │           │ S1 │ P5 │ 100 │ ║
║    └────┴───────┴────────┴────────┘           │ S1 │ P6 │ 100 │ ║
║     P (parts)                                 │ S2 │ P1 │ 300 │ ║
║    ┌────┬───────┬───────┬────────┬────────┐   │ S2 │ P2 │ 400 │ ║
║    │ P# │ PNAME │ COLOR │ WEIGHT │ CITY   │   │ S3 │ P2 │ 200 │ ║
║    ├════┼───────┼───────┼────────┼────────┤   │ S4 │ P2 │ 200 │ ║
║    │ P1 │ Nut   │ Red   │   12.0 │ London │   │ S4 │ P4 │ 300 │ ║
║    │ P2 │ Bolt  │ Green │   17.0 │ Paris  │   │ S4 │ P5 │ 400 │ ║
║    │ P3 │ Screw │ Blue  │   17.0 │ Oslo   │   └────┴────┴─────┘ ║
║    │ P4 │ Screw │ Red   │   14.0 │ London │                     ║
║    │ P5 │ Cam   │ Blue  │   12.0 │ Paris  │                     ║
║    │ P6 │ Cog   │ Red   │   19.0 │ London │                     ║
║    └────┴───────┴───────┴────────┴────────┘                     ║
╚═════════════════════════════════════════════════════════════════╝

SP GROUP ( { P#, QTY } AS PQ ) looks like

╔════════════════════════════╗
║    ┌────┬────────────────┐ ║
║    │ S# │ PQ             │ ║
║    ├════┼────────────────┤ ║
║    │    │ ┌────┬──────┐  │ ║
║    │ S1 │ │ P# │ QTY  │  │ ║
║    │    │ ├────┼──────┤  │ ║
║    │    │ │ P1 │ 300  │  │ ║
║    │    │ │ P2 │ 200  │  │ ║
║    │    │ │ P3 │ 400  │  │ ║
║    │    │ │ P4 │ 200  │  │ ║
║    │    │ │ P5 │ 100  │  │ ║
║    │    │ │ P6 │ 100  │  │ ║
║    │    │ └────┴──────┘  │ ║
║    │    │                │ ║
║    │    │ ┌────┬──────┐  │ ║
║    │ S2 │ │ P# │ QTY  │  │ ║
║    │    │ ├────┼──────┤  │ ║
║    │    │ │ P1 │ 300  │  │ ║
║    │    │ │ P2 │ 400  │  │ ║
║    │    │ └────┴──────┘  │ ║
║    │    │ ┌────┬──────┐  │ ║
║    │ S3 │ │ P# │ QTY  │  │ ║
║    │    │ ├────┼──────┤  │ ║
║    │    │ │ P2 │ 200  │  │ ║
║    │    │ └────┴──────┘  │ ║
║    │    │                │ ║
║    │    │ ┌────┬──────┐  │ ║
║    │ S4 │ │ P# │ QTY  │  │ ║
║    │    │ ├────┼──────┤  │ ║
║    │    │ │ P2 │ 200  │  │ ║
║    │    │ │ P4 │ 300  │  │ ║
║    │    │ │ P5 │ 400  │  │ ║
║    │    │ └────┴──────┘  │ ║
║    └────┴────────────────┘ ║
╚════════════════════════════╝

The group operation "smooshes" (the technical term) the given attributes into a relation and then assigns that relation to a new attribute. The body of the returned relation (the outer one) has one entry for every distinct value of the attributes not named in the group operation.

SPQ UNGROUP PQ, where SPQ is the above relation, performs the inverse operation, returning the original value of the SP relation.

We've been using [Tuple t] as our return value for queries to mean "relation," so that's what we'll use as the attribute value.

  Group ::
    ( Split grouped rest t
    , Sortable (l ::: [Tuple grouped] ': rest)
    , Ord (Tuple rest)
    ) =>
    Var l ->
    Proxy grouped ->
    Proxy rest ->
    Query t relations ->
    Query (Sort (l ::: [Tuple grouped] ': rest)) relations
  Ungroup ::
    (Split '[l ::: [Tuple grouped]] rest t, Sortable (grouped :++ rest)) =>
    Var l ->
    Proxy grouped ->
    Proxy rest ->
    Query t relations ->
    Query (Sort (grouped :++ rest)) relations

Note that Ord is a little stronger than Eq which would be semantically sufficient. However, having Ord lets us implement Group in \(O(n\log(n))\), as opposed to \(O(n^2)\) with just Eq.

  Group var (_ :: Proxy grouped) (_ :: Proxy rest) q ->
    let splits = sortBy (comparing snd) $ map (split @grouped @rest) $ runQuery q db
        groups = groupBy ((==) `on` snd) splits
     in map
          ( \((grouped, rest) :| gs) ->
              quicksort (Ext var (grouped : fmap fst gs) rest)
          )
          groups
  Ungroup (_ :: Var l) (_ :: Proxy grouped) (_ :: Proxy rest) q ->
    concatMap
      ( \tuple ->
          let (Ext _ grouped Empty, rest) =
                split @'[l ::: [Tuple grouped]] @rest tuple
           in map (\group -> quicksort (append group rest)) grouped
      )
      (runQuery q db)

Populating the database

We're going to assume that on every run of our hypothetical app, we'll want to use exactly one schema that doesn't change throughout the lifetime of the program.

To create an empty database in memory to store relations, we want something like

emptyDB :: Proxy relations -> Tuple (RelationsToDB relations)
emptyDB _ = case ???

However, in this form, we can't scrutinize the relations type variable to determine if it's empty or a cons like we would a normal list. Instead, we need a typeclass.

class EmptyDB (relations :: [Mapping Symbol Type]) where
  emptyDB :: Proxy relations -> Tuple (RelationsToDB relations)

The empty case is easy.

instance EmptyDB '[] where
  emptyDB _ = Empty

For cons, we insert the induction into the context of the instance, before the =>.

instance
  (EmptyDB relations, Ord (Tuple key)) =>
  EmptyDB (name ::: (Relation heading key val) ': relations)
  where
  emptyDB (_ :: Proxy (name ::: relation ': relations)) =
    Ext (Var @name) mempty (emptyDB (Proxy @relations))

To insert tuples into the database, we split the tuple into (key, val) and add them to the correct Map. We should also fail in the case that the key is already in the database. Again, when implementing something with this many constraints, it's useful to start with () => and fill it in until the compiler is happy.

insert ::
  forall relation relations name heading key val .
  ( relations :! name ~ relation
  , Relation heading key val ~ relation
  , Split key val heading
  , Ord (Tuple key)
  , IsMember name (RelationToMap relation) (RelationsToDB relations)
  , Updatable name (RelationToMap relation) (RelationsToDB relations) (RelationsToDB relations)
  ) =>
  Var name ->
  Proxy relations ->
  Tuple heading ->
  Tuple (RelationsToDB relations) ->
  Maybe (Tuple (RelationsToDB relations))
insert var _ tuple db =
  let old_rel = lookp var db
      (key, val) = split @key @val tuple
      new_rel = M.insert key val old_rel
   in if M.member key old_rel then Nothing else Just (update db var new_rel)

We'll also want to be able to update database entries. Let's first write a version that updates the relation at a given key and is only allowed to modify the portion of the heading outside of the key attributes. For keys not in the relation, we'll just do nothing.

updateByKey ::
  ( relations :! name ~ relation
  , Relation heading key val ~ relation
  , Ord (Tuple key)
  , IsMember name (RelationToMap relation) (RelationsToDB relations)
  , Updatable name (RelationToMap relation) (RelationsToDB relations) (RelationsToDB relations)
  ) =>
  Var name ->
  Proxy relations ->
  Tuple key ->
  (Tuple val -> Tuple val) ->
  Tuple (RelationsToDB relations) ->
  Tuple (RelationsToDB relations)
updateByKey var _ key fn db =
  let old_rel = lookp var db
      new_rel = M.adjust fn key old_rel
   in update db var new_rel

We could also write an update function that takes an arbitrary WHERE clause that filters on all attributes in the tuple, but that would be slower, and in practice, most UPDATE calls I've seen in SQL are of the form UPDATE table WHERE id=some_id.

Writing to disk

To save state between program runs, we can write the entire database to a file periodically and read it at program start. Map already has a Binary instance, so all we need to do is write one for Tuple.

The empty case is trivial.

instance Binary (Tuple '[]) where
  put Empty = pure ()
  get = pure Empty

For the non-empty case, the easiest thing to do is length-prefix every attribute of the tuple when serializing.

instance (Binary x, Binary (Tuple ts)) => Binary (Tuple (l ::: x ': ts)) where
  put (Ext _ x xs) = do
    let bytes = runPut $ put x
    put (BL.length bytes)
    put x
    put xs
  get = do
    size :: Int64 <- get
    x <- isolate (fromIntegral size) get
    Ext Var x <$> get

I'm not completely satisfied with this. It requires that we serialize twice, once to find the length and once to actually write the thing. There's also a note in the source of the Binary instance for regular lists about not blowing the stack for large lists with a naive implementation, which would certainly happen to us. To get around this, they write get tail recursively and reverse at the end. I haven't tried doing that for a heterogeneous list, but it seems like it would be a nightmare to implement. I'd be happy to be wrong about that, though, if anyone is keen to try.

That concludes part 2. In the next installment, we'll see how to use what we've built to serve an API.