Calendar.hs

{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
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)

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

instance DeserializeDb [(Entity DbMeal, Maybe (Entity DbRecipe), Maybe (Entity DbFood))] [Meal] where
  deserializeDb items = map deserializeDb $ listCrap $ groupBy equalMeal items
    where
      listCrap :: [[ (Entity DbMeal,   Maybe (Entity DbRecipe), Maybe (Entity DbFood))  ]]
               -> [  (Entity DbMeal, [(Maybe (Entity DbRecipe), Maybe (Entity DbFood))]) ]
      listCrap = map (\list -> ( fst3 (head list)
                                , map (\(_, r, f) -> (r,f)) list))

      equalMeal :: (Entity DbMeal, b, c)
                -> (Entity DbMeal, b, c)
                -> Bool
      equalMeal m1 m2 = entityKey (fst3 m1) == entityKey (fst3 m2)

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)

instance DeserializeDb (Entity DbMeal, [(Maybe (Entity DbRecipe), Maybe (Entity DbFood))]) Meal where
  deserializeDb  (m, items) = deserializeDb $ (m, cleanedItems items)
    where
      cleanedItems :: [ (Maybe (Entity DbRecipe), Maybe (Entity DbFood)) ]
                   -> [ (Entity DbRecipe, Maybe (Entity DbFood)) ]
      cleanedItems []     = []
      cleanedItems (x:xs) = case (fst x) of
                              Just y  -> (y, snd x) : cleanedItems xs
                              Nothing -> cleanedItems xs

instance DeserializeDb (Entity DbMeal, [ (Entity DbRecipe, Maybe (Entity DbFood) ) ]) Meal where
  deserializeDb (m, items) = deserializeDb $ (m, joinedItems items)
    where
      grouped :: [ (Entity DbRecipe, Maybe (Entity DbFood) ) ]
              -> [[ (Entity DbRecipe, Maybe (Entity DbFood) ) ]]
      grouped = groupBy (\a b -> fst a == fst b)

      joinedItems i  = map (\list -> ( (fst . head) list
                                     , mapMaybe snd list)) (grouped i)

instance DeserializeDb (Entity DbMeal, [(Entity DbRecipe, [ (Entity DbFood) ])]) Meal where
  deserializeDb ((Entity _ val), rs) =
    let d = dbMealDay val
        n = dbMealName val
        r = map deserializeDb rs
    in  Meal Nothing (utctDay d) n r

instance DeserializeDb (Entity DbMeal, [Entity DbRecipe]) Meal where
  deserializeDb ((Entity _ val), recipes) =
    let d = dbMealDay val
        n = dbMealName val
        r = map deserializeDb recipes
    in  Meal Nothing (utctDay d) n r

-------------------------------------------------------------------------------
-- DbRecipe Deserialization
-------------------------------------------------------------------------------

instance DeserializeDb (Entity DbRecipe) Recipe where
  deserializeDb r = deserializeDb (r, ([] :: [Entity DbFood]))

instance DeserializeDb (Entity DbRecipe, [ Maybe (Entity DbFood) ]) Recipe where
  deserializeDb (r, f) = deserializeDb (r, catMaybes f)

instance DeserializeDb [(Entity DbRecipe, Maybe (Entity DbFood))] [Recipe] 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)

instance DeserializeDb (Entity DbRecipe, [Entity DbFood]) Recipe where
  deserializeDb ((Entity _ val), foods) =
      let n = dbRecipeName val
          f = map deserializeDb foods
      in  Recipe Nothing n f

-------------------------------------------------------------------------------
-- DbFood Deserialization
-------------------------------------------------------------------------------

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