Test and further document ToBaseId (#190)

* Test and further document ToBaseId

My coworker Lev was adding this typeclass to our codebase and we hadn't used it before. I added a little more documentation that I think would help clarify things, particularly what the point of the witness function was. More importantly I added a test for this typeclass.

* 3.3.3.2

changelog.md

@@ -1,3 +1,8 @@
+3.3.3.2
+========
+- @maxgabriel
+  - [#190](https://github.com/bitemyapp/esqueleto/pull/190) Further document and test `ToBaseId`
+
 3.3.3.1
 ========
 - @belevy

esqueleto.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           esqueleto
-version:        3.3.3.1
+version:        3.3.3.2
 synopsis:       Type-safe EDSL for SQL queries on persistent backends.
 description:    @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends.  Its language closely resembles SQL, so you don't have to learn new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime.
                 .

src/Database/Esqueleto/Internal/Internal.hs

@@ -996,7 +996,7 @@ case_ = unsafeSqlCase
 -- | Convert an entity's key into another entity's.
 --
 -- This function is to be used when you change an entity's @Id@ to be
--- that of another entity.  For example:
+-- that of another entity. For example:
 --
 -- @
 -- Bar
@@ -1007,12 +1007,13 @@ case_ = unsafeSqlCase
 --   Primary bar
 -- @
 --
--- For this example, declare:
+-- In this example, Bar is said to be the BaseEnt(ity), and Foo the child.
+-- To model this in Esqueleto, declare:
 --
 -- @
 -- instance ToBaseId Foo where
 --   type BaseEnt Foo = Bar
---   toBaseIdWitness = FooKey
+--   toBaseIdWitness barId = FooKey barId
 -- @
 --
 -- Now you're able to write queries such as:
@@ -1371,7 +1372,10 @@ instance SqlString a => SqlString (Maybe a) where
 -- | Class that enables one to use 'toBaseId' to convert an entity's
 -- key on a query into another (cf. 'toBaseId').
 class ToBaseId ent where
+  -- | e.g. @type BaseEnt MyBase = MyChild@
   type BaseEnt ent :: *
+  -- | Convert from the key of the BaseEnt(ity) to the key of the child entity.
+  -- This function is not actually called, but that it typechecks proves this operation is safe.
   toBaseIdWitness :: Key (BaseEnt ent) -> Key ent
 
 

test/Common/Test.hs

@@ -248,6 +248,11 @@ share [mkPersist sqlSettings, mkMigrate "migrateUnique"] [persistUpperCase|
     deriving Eq Show
 |]
 
+
+instance ToBaseId ArticleMetadata where
+  type BaseEnt ArticleMetadata = Article
+  toBaseIdWitness articleId = ArticleMetadataKey articleId
+
 -- | this could be achieved with S.fromList, but not all lists
 --   have Ord instances
 sameElementsAs :: Eq a => [a] -> [a] -> Bool
@@ -777,6 +782,19 @@ testSelectJoin run = do
           where_ $ (articleMetadata ^. ArticleMetadataId) ==. (val ((ArticleMetadataKey articleId)))
           pure articleMetadata
         liftIO $ [articleMetaE] `shouldBe` result
+    it "allows joining between a primary key that is itself a key of another table, using ToBaseId" $ do
+      run $ do
+        let number = 101
+        insert_ $ Frontcover number ""
+        articleE@(Entity articleId _) <- insert' $ Article "title" number
+        articleMetaE <- insert' (ArticleMetadata articleId)
+
+        articlesAndMetadata <- select $
+          from $ \(article `InnerJoin` articleMetadata) -> do
+          on (toBaseId (articleMetadata ^. ArticleMetadataId) ==. article ^. ArticleId)
+          return (article, articleMetadata)
+        liftIO $ [(articleE, articleMetaE)] `shouldBe` articlesAndMetadata
+
     it "works with a ForeignKey to a non-id primary key returning both entities" $
       run $ do
         let fc = Frontcover number ""