module Database.Persist
( module Database.Persist.Class
, module Database.Persist.Types
, insertBy
, getJust
, belongsTo
, belongsToJust
, getByValue
, selectList
, selectKeysList
, deleteCascadeWhere
, (=.), (+=.), (-=.), (*=.), (/=.)
, (==.), (!=.), (<.), (>.), (<=.), (>=.)
, (<-.), (/<-.)
, (||.)
, listToJSON
, mapToJSON
, getPersistMap
, limitOffsetOrder
) where
import Database.Persist.Types
import Database.Persist.Class
import Database.Persist.Class.PersistField (getPersistMap)
import qualified Data.Text as T
import qualified Control.Exception as E
import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Aeson (toJSON)
import Data.Aeson.Encode (fromValue)
insertBy :: (PersistEntity v, PersistStore m, PersistUnique m, PersistMonadBackend m ~ PersistEntityBackend v)
=> v -> m (Either (Entity v) (Key v))
insertBy val =
go $ persistUniqueKeys val
where
go [] = Right `liftM` insert val
go (x:xs) = do
y <- getBy x
case y of
Nothing -> go xs
Just z -> return $ Left z
getByValue :: (PersistEntity v, PersistUnique m, PersistEntityBackend v ~ PersistMonadBackend m)
=> v -> m (Maybe (Entity v))
getByValue val =
go $ persistUniqueKeys val
where
go [] = return Nothing
go (x:xs) = do
y <- getBy x
case y of
Nothing -> go xs
Just z -> return $ Just z
belongsTo ::
(PersistStore m
, PersistEntity ent1
, PersistEntity ent2
, PersistMonadBackend m ~ PersistEntityBackend ent2
) => (ent1 -> Maybe (Key ent2)) -> ent1 -> m (Maybe ent2)
belongsTo foreignKeyField model = case foreignKeyField model of
Nothing -> return Nothing
Just f -> get f
belongsToJust ::
(PersistStore m
, PersistEntity ent1
, PersistEntity ent2
, PersistMonadBackend m ~ PersistEntityBackend ent2)
=> (ent1 -> Key ent2) -> ent1 -> m ent2
belongsToJust getForeignKey model = getJust $ getForeignKey model
getJust :: (PersistStore m, PersistEntity val, Show (Key val), PersistMonadBackend m ~ PersistEntityBackend val) => Key val -> m val
getJust key = get key >>= maybe
(liftIO $ E.throwIO $ PersistForeignConstraintUnmet $ T.pack $ show key)
return
infixr 3 =., +=., -=., *=., /=.
(=.), (+=.), (-=.), (*=.), (/=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update v
f =. a = Update f a Assign
f +=. a = Update f a Add
f -=. a = Update f a Subtract
f *=. a = Update f a Multiply
f /=. a = Update f a Divide
infix 4 ==., <., <=., >., >=., !=.
(==.), (!=.), (<.), (<=.), (>.), (>=.) ::
forall v typ. PersistField typ => EntityField v typ -> typ -> Filter v
f ==. a = Filter f (Left a) Eq
f !=. a = Filter f (Left a) Ne
f <. a = Filter f (Left a) Lt
f <=. a = Filter f (Left a) Le
f >. a = Filter f (Left a) Gt
f >=. a = Filter f (Left a) Ge
infix 4 <-., /<-.
(<-.), (/<-.) :: forall v typ. PersistField typ => EntityField v typ -> [typ] -> Filter v
f <-. a = Filter f (Right a) In
f /<-. a = Filter f (Right a) NotIn
infixl 3 ||.
(||.) :: forall v. [Filter v] -> [Filter v] -> [Filter v]
a ||. b = [FilterOr [FilterAnd a, FilterAnd b]]
selectList :: (PersistEntity val, PersistQuery m, PersistEntityBackend val ~ PersistMonadBackend m)
=> [Filter val]
-> [SelectOpt val]
-> m [Entity val]
selectList a b = selectSource a b C.$$ CL.consume
selectKeysList :: (PersistEntity val, PersistQuery m, PersistEntityBackend val ~ PersistMonadBackend m)
=> [Filter val]
-> [SelectOpt val]
-> m [Key val]
selectKeysList a b = selectKeys a b C.$$ CL.consume
deleteCascadeWhere :: (DeleteCascade a m, PersistQuery m)
=> [Filter a] -> m ()
deleteCascadeWhere filts = selectKeys filts [] C.$$ CL.mapM_ deleteCascade
listToJSON :: [PersistValue] -> T.Text
listToJSON = toStrict . toLazyText . fromValue . toJSON
mapToJSON :: [(T.Text, PersistValue)] -> T.Text
mapToJSON = toStrict . toLazyText . fromValue . toJSON
limitOffsetOrder :: PersistEntity val => [SelectOpt val] -> (Int, Int, [SelectOpt val])
limitOffsetOrder opts =
foldr go (0, 0, []) opts
where
go (LimitTo l) (_, b, c) = (l, b ,c)
go (OffsetBy o) (a, _, c) = (a, o, c)
go x (a, b, c) = (a, b, x : c)