{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances, GeneralizedNewtypeDeriving #-}

module Database.Persist.Class.Instances
  (
  ) where

import ClassyPrelude

import Database.Persist.Class
import Database.Persist.Types.Instances ()
import Database.Persist.Sql

import Data.Binary (Binary)
import qualified Data.Binary as Binary

import qualified Data.Map as Map

import Data.Aeson (ToJSONKey, FromJSONKey)

import Control.Monad.Fail


instance PersistEntity record => Hashable (Key record) where
  hashWithSalt s = hashWithSalt s . toPersistValue

instance PersistEntity record => Binary (Key record) where
  put = Binary.put . toPersistValue
  putList = Binary.putList . map toPersistValue
  get = either (fail . unpack) return . fromPersistValue =<< Binary.get

instance PersistEntity record => NFData (Key record) where
  rnf = rnf . keyToValues


uniqueToMap :: PersistEntity record => Unique record -> Map (HaskellName, DBName) PersistValue
uniqueToMap = fmap Map.fromList $ zip <$> persistUniqueToFieldNames <*> persistUniqueToValues

instance PersistEntity record => Eq (Unique record) where
  (==) = (==) `on` uniqueToMap


deriving newtype instance ToJSONKey (BackendKey SqlBackend)
deriving newtype instance FromJSONKey (BackendKey SqlBackend)