module Database.Persist.Class.PersistEntity
( PersistEntity (..)
, Update (..)
, SelectOpt (..)
, BackendSpecificFilter
, Filter (..)
, Key
, Entity (..)
) where
import Database.Persist.Types.Base
import Database.Persist.Class.PersistField
import Data.Text (Text)
import qualified Data.Text as T
import Data.Aeson (ToJSON (..), FromJSON (..), object, (.:), (.=), Value (Object))
import Control.Applicative ((<$>), (<*>))
import Data.Monoid (mappend)
class PersistEntity val where
data EntityField val :: * -> *
persistFieldDef :: EntityField val typ -> FieldDef SqlType
type PersistEntityBackend val
data Unique val
entityDef :: Monad m => m val -> EntityDef SqlType
toPersistFields :: val -> [SomePersistField]
fromPersistValues :: [PersistValue] -> Either Text val
persistUniqueToFieldNames :: Unique val -> [(HaskellName, DBName)]
persistUniqueToValues :: Unique val -> [PersistValue]
persistUniqueKeys :: val -> [Unique val]
persistIdField :: EntityField val (Key val)
fieldLens :: EntityField val field
-> (forall f. Functor f => (field -> f field) -> Entity val -> f (Entity val))
data Update v = forall typ. PersistField typ => Update
{ updateField :: EntityField v typ
, updateValue :: typ
, updateUpdate :: PersistUpdate
}
data SelectOpt v = forall typ. Asc (EntityField v typ)
| forall typ. Desc (EntityField v typ)
| OffsetBy Int
| LimitTo Int
type family BackendSpecificFilter b v
data Filter v = forall typ. PersistField typ => Filter
{ filterField :: EntityField v typ
, filterValue :: Either typ [typ]
, filterFilter :: PersistFilter
}
| FilterAnd [Filter v]
| FilterOr [Filter v]
| BackendFilter (BackendSpecificFilter (PersistEntityBackend v) v)
type Key val = KeyBackend (PersistEntityBackend val) val
data Entity entity =
Entity { entityKey :: Key entity
, entityVal :: entity }
deriving (Eq, Ord, Show, Read)
instance ToJSON e => ToJSON (Entity e) where
toJSON (Entity k v) = object
[ "key" .= k
, "value" .= v
]
instance FromJSON e => FromJSON (Entity e) where
parseJSON (Object o) = Entity
<$> o .: "key"
<*> o .: "value"
parseJSON _ = fail "FromJSON Entity: not an object"
instance PersistField entity => PersistField (Entity entity) where
toPersistValue (Entity k v) = case toPersistValue v of
(PersistMap alist) -> PersistMap ((idField, toPersistValue k) : alist)
_ -> error $ T.unpack $ errMsg "expected PersistMap"
fromPersistValue (PersistMap alist) = case after of
[] -> Left $ errMsg $ "did not find " `mappend` idField `mappend` " field"
("_id", k):afterRest ->
case fromPersistValue (PersistMap (before ++ afterRest)) of
Right record -> Right $ Entity (Key k) record
Left err -> Left err
_ -> Left $ errMsg $ "impossible id field: " `mappend` T.pack (show alist)
where
(before, after) = break ((== idField) . fst) alist
fromPersistValue x = Left $
errMsg "Expected PersistMap, received: " `mappend` T.pack (show x)
errMsg :: Text -> Text
errMsg = mappend "PersistField entity fromPersistValue: "
idField :: Text
idField = "_id"