Simplifying Persistent & Esqueleto code

Question

I have a fairly simple query that does two outer joins. (A meal has many recipes which in turn have many foods).

getMeals :: (MonadIO m) => Key DbUser -> SqlPersistT m [Meal]
getMeals user =
  fmap deserializeDb $ E.select $
        E.from $ \(m `E.InnerJoin` u `E.LeftOuterJoin` r `E.LeftOuterJoin` f) -> do
          E.on     (r ?. DbRecipeId E.==. f ?. DbFoodRecipeId)
          E.on     (E.just (m ^. DbMealId) E.==. r ?. DbRecipeMealId)
          E.on     (m ^. DbMealUserId      E.==. u ^. DbUserId)
          E.where_ (m ^. DbMealUserId      E.==. E.val user )
          return (m, r, f)

This query is great, it says what it needs, without anything more. But, because of how SQL works, it gives me back a table with lots of repeated meals, for each outer join that matched.

For instance, a meal with two recipes, each with two foods turns into 4 tuples.

(m1, r1, f1)
(m1, r1, f2)
(m1, r2, f3)
(m1, r2, f4)

I want to roll these back up into a single Meal data type. (simplified here to show structure, other fields of course are stored in the DB).

data Meal   = Meal   { recipes :: [Recipe] }
data Recipe = Recipe { foods :: [Food]   }
data Food   = Food   { name :: String }

I seem to have to do this merging entirely manually, and it ended up being 2 or so pages of code for this single query.

Ignoring the fact that typeclasses aren't supposed to be used like this, it looks like a lot of instances of a (silly) typeclass DeserializeDb:

class DeserializeDb a r | a -> r where
  deserializeDb :: a -> r

instance DeserializeDb [(Entity DbMeal, Maybe (Entity DbRecipe))] [Meal] where
  deserializeDb items = let grouped = groupBy (\a b -> entityKey (fst a) == entityKey (fst b)) items
                            joined  = map (\list -> ( (fst . head) list
                                                    ,  mapMaybe snd list
                                                    )) grouped
                        in (map deserializeDb joined)

SNIPPED LOTS OF INSTANCES OF VARIOUS COMPLEXITY (code: https://gist.github.com/cschneid/2989057ec4bb9875e2ae)

instance DeserializeDb (Entity DbFood) Food where
  deserializeDb (Entity _ val) = Food (dbFoodName val)

Question:

The only thing I want to expose is the query signature. The rest of this is implementation junk. Is there a trick to using Persistent that I've not noticed? Do I have to manually merge joins back into haskell types?

Answer 1

Thanks to @JPMoresmau's hinting, I ended up with a much shorter, and I think simpler approach. It may be slower on large datasets due to nub, but on small datasets it returns far faster than I need it to.

I still hate that I have so much manual plumbing to build a tree structure out of the data coming back from the database. I wonder if there's a good way to do this generically?

module Grocery.Database.Calendar where

import Grocery.DatabaseSchema
import Grocery.Types.Meal
import Grocery.Types.Recipe
import Grocery.Types.Food
import Database.Persist
import Database.Persist.Sqlite
import qualified Database.Esqueleto      as E
import           Database.Esqueleto      ((^.), (?.))
import Data.Time
import Control.Monad.Trans -- for MonadIO
import Data.List
import Data.Maybe
import Data.Tuple3

getMeals :: (MonadIO m) => Key DbUser -> SqlPersistT m [Meal]
getMeals user =
  fmap deserializeDb $ E.select $
        E.from $ \(m `E.InnerJoin` u `E.LeftOuterJoin` r `E.LeftOuterJoin` f) -> do
          E.on     (r ?. DbRecipeId E.==. f ?. DbFoodRecipeId)
          E.on     (E.just (m ^. DbMealId) E.==. r ?. DbRecipeMealId)
          E.on     (m ^. DbMealUserId      E.==. u ^. DbUserId)
          E.where_ (m ^. DbMealUserId      E.==. E.val user )
          return (m, r, f)

deserializeDb :: [(Entity DbMeal, Maybe (Entity DbRecipe), Maybe (Entity DbFood))] -> [Meal]
deserializeDb results = makeMeals results
  where
    makeMeals :: [(Entity DbMeal, Maybe (Entity DbRecipe), Maybe (Entity DbFood))] -> [Meal]
    makeMeals dupedMeals = map makeMeal (nub $ map fst3 dupedMeals)

    makeMeal :: Entity DbMeal -> Meal
    makeMeal (Entity k m) = let d = dbMealDay m
                                n = dbMealName m
                                r = makeRecipesForMeal k
                            in  Meal Nothing (utctDay d) n r

    makeRecipesForMeal :: Key DbMeal -> [Recipe]
    makeRecipesForMeal mealKey = map makeRecipe $ appropriateRecipes mealKey

    appropriateRecipes :: Key DbMeal -> [Entity DbRecipe]
    appropriateRecipes mealKey = nub $ filter (\(Entity _ v) -> dbRecipeMealId v == mealKey) $ mapMaybe snd3 results

    makeRecipe :: Entity DbRecipe -> Recipe
    makeRecipe (Entity k r) = let n = dbRecipeName r
                                  f = makeFoodForRecipe k
                              in  Recipe Nothing n f

    makeFoodForRecipe :: Key DbRecipe -> [Food]
    makeFoodForRecipe rKey = map makeFood $ appropriateFoods rKey

    appropriateFoods :: Key DbRecipe -> [Entity DbFood]
    appropriateFoods rKey = nub $ filter (\(Entity _ v) -> dbFoodRecipeId v == rKey) $ mapMaybe thd3 results

    makeFood :: Entity DbFood -> Food
    makeFood (Entity _ f) = Food (dbFoodName f)