{-# LANGUAGE ExistentialQuantification #-}

-- | Welcome to @persistent@!
--
-- This library intends to provide an easy, flexible, and convenient interface
-- to various data storage backends. Backends include SQL databases, like
-- @mysql@, @postgresql@, and @sqlite@, as well as NoSQL databases, like
-- @mongodb@ and @redis@.
--
-- If you intend on using a SQL database, then check out "Database.Persist.Sql".
module Database.Persist
    ( -- * Defining Database Models

    --

      -- | @persistent@ lets you define your database models using a special syntax.
      -- This syntax allows you to customize the resulting Haskell datatypes and
      -- database schema. See "Database.Persist.Quasi" for details on that definition
      -- language.

      -- ** Reference Schema & Dataset

    --

      -- | For a quick example of the syntax, we'll introduce this database schema, and
      -- we'll use it to explain the update and filter combinators.
      --
      -- @
      -- 'share' ['mkPersist' 'sqlSettings', 'mkMigrate' "migrateAll"] ['persistLowerCase'|
      -- User
      --     name String
      --     age Int
      --     deriving Show
      -- |]
      -- @
      --
      -- This creates a Haskell datatype that looks like this:
      --
      -- @
      -- data User = User
      --     { userName :: String
      --     , userAge :: Int
      --     }
      --     deriving Show
      -- @
      --
      -- In a SQL database, we'd get a migration like this:
      --
      -- @
      -- CREATE TABLE "user" (
      --      id    SERIAL PRIMARY KEY,
      --      name  TEXT NOT NULL,
      --      age   INT NOT NULL
      -- );
      -- @
      --
      -- The examples below will refer to this as dataset-1.
      --
      -- #dataset#
      --
      -- > +-----+-----+-----+
      -- > |id   |name |age  |
      -- > +-----+-----+-----+
      -- > |1    |SPJ  |40   |
      -- > +-----+-----+-----+
      -- > |2    |Simon|41   |
      -- > +-----+-----+-----+

      -- * Database Operations

      -- | The module "Database.Persist.Class" defines how to operate with
      -- @persistent@ database models. Check that module out for basic
      -- operations, like 'get', 'insert', and 'selectList'.
      module Database.Persist.Class

      -- * Types

      -- | This module re-export contains a lot of the important types for
      -- working with @persistent@ datatypes and underlying values.
    , module Database.Persist.Types

      -- * Query Operators

      -- | A convention that @persistent@ tries to follow is that operators on
      -- Database types correspond to a Haskell (or database) operator with a @.@
      -- character at the end. So to do @a || b@ , you'd write @a '||.' b@. To

      -- ** Query update combinators

      -- | These operations are used when performing updates against the database.
      --  Functions like 'upsert' use them to provide new or modified values.
    , (=.)
    , (+=.)
    , (-=.)
    , (*=.)
    , (/=.)

      -- ** Query filter combinators

      -- | These functions are useful in the 'PersistQuery' class, like
      -- 'selectList', 'updateWhere', etc.
    , (==.)
    , (!=.)
    , (<.)
    , (>.)
    , (<=.)
    , (>=.)
    , (<-.)
    , (/<-.)
    , (||.)

      -- * JSON Utilities
    , listToJSON
    , mapToJSON
    , toJsonText
    , getPersistMap

      -- * Other utilities
    , limitOffsetOrder
    ) where

import Data.Aeson (ToJSON, toJSON)
import Data.Aeson.Text (encodeToTextBuilder)
import qualified Data.Text as T
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)

import Database.Persist.Class
import Database.Persist.Class.PersistField (getPersistMap)
import Database.Persist.Types

infixr 3 =., +=., -=., *=., /=.
(=.)
    , (+=.)
    , (-=.)
    , (*=.)
    , (/=.)
        :: forall v typ. (PersistField typ) => EntityField v typ -> typ -> Update v

-- | Assign a field a value.
--
-- === Examples
--
-- @
-- updateAge :: MonadIO m => ReaderT SqlBackend m ()
-- updateAge = updateWhere [UserName ==. \"SPJ\" ] [UserAge =. 45]
-- @
--
-- Similar to `updateWhere` which is shown in the above example you can use other functions present in the module "Database.Persist.Class". Note that the first parameter of `updateWhere` is [`Filter` val] and second parameter is [`Update` val]. By comparing this with the type of `==.` and `=.`, you can see that they match up in the above usage.
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+--------+
-- > |id   |name |age     |
-- > +-----+-----+--------+
-- > |1    |SPJ  |40 -> 45|
-- > +-----+-----+--------+
-- > |2    |Simon|41      |
-- > +-----+-----+--------+
EntityField v typ
f =. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. typ
a = EntityField v typ -> typ -> PersistUpdate -> Update v
forall record typ.
PersistField typ =>
EntityField record typ -> typ -> PersistUpdate -> Update record
Update EntityField v typ
f typ
a PersistUpdate
Assign

-- | Assign a field by addition (@+=@).
--
-- === Examples
--
-- @
-- addAge :: MonadIO m => ReaderT SqlBackend m ()
-- addAge = updateWhere [UserName ==. \"SPJ\" ] [UserAge +=. 1]
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+---------+
-- > |id   |name |age      |
-- > +-----+-----+---------+
-- > |1    |SPJ  |40 -> 41 |
-- > +-----+-----+---------+
-- > |2    |Simon|41       |
-- > +-----+-----+---------+
EntityField v typ
f +=. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
+=. typ
a = EntityField v typ -> typ -> PersistUpdate -> Update v
forall record typ.
PersistField typ =>
EntityField record typ -> typ -> PersistUpdate -> Update record
Update EntityField v typ
f typ
a PersistUpdate
Add

-- | Assign a field by subtraction (@-=@).
--
-- === Examples
--
-- @
-- subtractAge :: MonadIO m => ReaderT SqlBackend m ()
-- subtractAge = updateWhere [UserName ==. \"SPJ\" ] [UserAge -=. 1]
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+---------+
-- > |id   |name |age      |
-- > +-----+-----+---------+
-- > |1    |SPJ  |40 -> 39 |
-- > +-----+-----+---------+
-- > |2    |Simon|41       |
-- > +-----+-----+---------+
EntityField v typ
f -=. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
-=. typ
a = EntityField v typ -> typ -> PersistUpdate -> Update v
forall record typ.
PersistField typ =>
EntityField record typ -> typ -> PersistUpdate -> Update record
Update EntityField v typ
f typ
a PersistUpdate
Subtract

-- | Assign a field by multiplication (@*=@).
--
-- === Examples
--
-- @
-- multiplyAge :: MonadIO m => ReaderT SqlBackend m ()
-- multiplyAge = updateWhere [UserName ==. \"SPJ\" ] [UserAge *=. 2]
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+--------+
-- > |id   |name |age     |
-- > +-----+-----+--------+
-- > |1    |SPJ  |40 -> 80|
-- > +-----+-----+--------+
-- > |2    |Simon|41      |
-- > +-----+-----+--------+
EntityField v typ
f *=. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
*=. typ
a = EntityField v typ -> typ -> PersistUpdate -> Update v
forall record typ.
PersistField typ =>
EntityField record typ -> typ -> PersistUpdate -> Update record
Update EntityField v typ
f typ
a PersistUpdate
Multiply

-- | Assign a field by division (@/=@).
--
-- === Examples
--
-- @
-- divideAge :: MonadIO m => ReaderT SqlBackend m ()
-- divideAge = updateWhere [UserName ==. \"SPJ\" ] [UserAge /=. 2]
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+---------+
-- > |id   |name |age      |
-- > +-----+-----+---------+
-- > |1    |SPJ  |40 -> 20 |
-- > +-----+-----+---------+
-- > |2    |Simon|41       |
-- > +-----+-----+---------+
EntityField v typ
f /=. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
/=. typ
a = EntityField v typ -> typ -> PersistUpdate -> Update v
forall record typ.
PersistField typ =>
EntityField record typ -> typ -> PersistUpdate -> Update record
Update EntityField v typ
f typ
a PersistUpdate
Divide

infix 4 ==., <., <=., >., >=., !=.
(==.)
    , (!=.)
    , (<.)
    , (<=.)
    , (>.)
    , (>=.)
        :: forall v typ. (PersistField typ) => EntityField v typ -> typ -> Filter v

-- | Check for equality.
--
-- === Examples
--
-- @
-- selectSPJ :: MonadIO m => ReaderT SqlBackend m [Entity User]
-- selectSPJ = selectList [UserName ==. \"SPJ\" ] []
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+-----+
-- > |id   |name |age  |
-- > +-----+-----+-----+
-- > |1    |SPJ  |40   |
-- > +-----+-----+-----+
EntityField v typ
f ==. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. typ
a = EntityField v typ -> FilterValue typ -> PersistFilter -> Filter v
forall record typ.
PersistField typ =>
EntityField record typ
-> FilterValue typ -> PersistFilter -> Filter record
Filter EntityField v typ
f (typ -> FilterValue typ
forall typ. typ -> FilterValue typ
FilterValue typ
a) PersistFilter
Eq

-- | Non-equality check.
--
-- === Examples
--
-- @
-- selectSimon :: MonadIO m => ReaderT SqlBackend m [Entity User]
-- selectSimon = selectList [UserName !=. \"SPJ\" ] []
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+-----+
-- > |id   |name |age  |
-- > +-----+-----+-----+
-- > |2    |Simon|41   |
-- > +-----+-----+-----+
EntityField v typ
f !=. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. typ
a = EntityField v typ -> FilterValue typ -> PersistFilter -> Filter v
forall record typ.
PersistField typ =>
EntityField record typ
-> FilterValue typ -> PersistFilter -> Filter record
Filter EntityField v typ
f (typ -> FilterValue typ
forall typ. typ -> FilterValue typ
FilterValue typ
a) PersistFilter
Ne

-- | Less-than check.
--
-- === Examples
--
-- @
-- selectLessAge :: MonadIO m => ReaderT SqlBackend m [Entity User]
-- selectLessAge = selectList [UserAge <. 41 ] []
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+-----+
-- > |id   |name |age  |
-- > +-----+-----+-----+
-- > |1    |SPJ  |40   |
-- > +-----+-----+-----+
EntityField v typ
f <. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
<. typ
a = EntityField v typ -> FilterValue typ -> PersistFilter -> Filter v
forall record typ.
PersistField typ =>
EntityField record typ
-> FilterValue typ -> PersistFilter -> Filter record
Filter EntityField v typ
f (typ -> FilterValue typ
forall typ. typ -> FilterValue typ
FilterValue typ
a) PersistFilter
Lt

-- | Less-than or equal check.
--
-- === Examples
--
-- @
-- selectLessEqualAge :: MonadIO m => ReaderT SqlBackend m [Entity User]
-- selectLessEqualAge = selectList [UserAge <=. 40 ] []
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+-----+
-- > |id   |name |age  |
-- > +-----+-----+-----+
-- > |1    |SPJ  |40   |
-- > +-----+-----+-----+
EntityField v typ
f <=. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
<=. typ
a = EntityField v typ -> FilterValue typ -> PersistFilter -> Filter v
forall record typ.
PersistField typ =>
EntityField record typ
-> FilterValue typ -> PersistFilter -> Filter record
Filter EntityField v typ
f (typ -> FilterValue typ
forall typ. typ -> FilterValue typ
FilterValue typ
a) PersistFilter
Le

-- | Greater-than check.
--
-- === Examples
--
-- @
-- selectGreaterAge :: MonadIO m => ReaderT SqlBackend m [Entity User]
-- selectGreaterAge = selectList [UserAge >. 40 ] []
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+-----+
-- > |id   |name |age  |
-- > +-----+-----+-----+
-- > |2    |Simon|41   |
-- > +-----+-----+-----+
EntityField v typ
f >. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>. typ
a = EntityField v typ -> FilterValue typ -> PersistFilter -> Filter v
forall record typ.
PersistField typ =>
EntityField record typ
-> FilterValue typ -> PersistFilter -> Filter record
Filter EntityField v typ
f (typ -> FilterValue typ
forall typ. typ -> FilterValue typ
FilterValue typ
a) PersistFilter
Gt

-- | Greater-than or equal check.
--
-- === Examples
--
-- @
-- selectGreaterEqualAge :: MonadIO m => ReaderT SqlBackend m [Entity User]
-- selectGreaterEqualAge = selectList [UserAge >=. 41 ] []
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+-----+
-- > |id   |name |age  |
-- > +-----+-----+-----+
-- > |2    |Simon|41   |
-- > +-----+-----+-----+
EntityField v typ
f >=. :: forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. typ
a = EntityField v typ -> FilterValue typ -> PersistFilter -> Filter v
forall record typ.
PersistField typ =>
EntityField record typ
-> FilterValue typ -> PersistFilter -> Filter record
Filter EntityField v typ
f (typ -> FilterValue typ
forall typ. typ -> FilterValue typ
FilterValue typ
a) PersistFilter
Ge

infix 4 <-., /<-.
(<-.)
    , (/<-.)
        :: forall v typ. (PersistField typ) => EntityField v typ -> [typ] -> Filter v

-- | Check if value is in given list.
--
-- === Examples
--
-- @
-- selectUsers :: MonadIO m => ReaderT SqlBackend m [Entity User]
-- selectUsers = selectList [UserAge <-. [40, 41]] []
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+-----+
-- > |id   |name |age  |
-- > +-----+-----+-----+
-- > |1    |SPJ  |40   |
-- > +-----+-----+-----+
-- > |2    |Simon|41   |
-- > +-----+-----+-----+
--
--
-- @
-- selectSPJ :: MonadIO m => ReaderT SqlBackend m [Entity User]
-- selectSPJ = selectList [UserAge <-. [40]] []
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+-----+
-- > |id   |name |age  |
-- > +-----+-----+-----+
-- > |1    |SPJ  |40   |
-- > +-----+-----+-----+
EntityField v typ
f <-. :: forall v typ.
PersistField typ =>
EntityField v typ -> [typ] -> Filter v
<-. [typ]
a = EntityField v typ -> FilterValue typ -> PersistFilter -> Filter v
forall record typ.
PersistField typ =>
EntityField record typ
-> FilterValue typ -> PersistFilter -> Filter record
Filter EntityField v typ
f ([typ] -> FilterValue typ
forall typ. [typ] -> FilterValue typ
FilterValues [typ]
a) PersistFilter
In

-- | Check if value is not in given list.
--
-- === Examples
--
-- @
-- selectSimon :: MonadIO m => ReaderT SqlBackend m [Entity User]
-- selectSimon = selectList [UserAge /<-. [40]] []
-- @
--
-- The above query when applied on <#dataset dataset-1>, will produce this:
--
-- > +-----+-----+-----+
-- > |id   |name |age  |
-- > +-----+-----+-----+
-- > |2    |Simon|41   |
-- > +-----+-----+-----+
EntityField v typ
f /<-. :: forall v typ.
PersistField typ =>
EntityField v typ -> [typ] -> Filter v
/<-. [typ]
a = EntityField v typ -> FilterValue typ -> PersistFilter -> Filter v
forall record typ.
PersistField typ =>
EntityField record typ
-> FilterValue typ -> PersistFilter -> Filter record
Filter EntityField v typ
f ([typ] -> FilterValue typ
forall typ. [typ] -> FilterValue typ
FilterValues [typ]
a) PersistFilter
NotIn

infixl 3 ||.
(||.) :: forall v. [Filter v] -> [Filter v] -> [Filter v]

-- | The OR of two lists of filters. For example:
--
-- > selectList
-- >     ([ PersonAge >. 25
-- >      , PersonAge <. 30 ] ||.
-- >      [ PersonIncome >. 15000
-- >      , PersonIncome <. 25000 ])
-- >     []
--
-- will filter records where a person's age is between 25 and 30 /or/ a
-- person's income is between (15000 and 25000).
--
-- If you are looking for an @(&&.)@ operator to do @(A AND B AND (C OR D))@
-- you can use the @(++)@ operator instead as there is no @(&&.)@. For
-- example:
--
-- > selectList
-- >     ([ PersonAge >. 25
-- >      , PersonAge <. 30 ] ++
-- >     ([PersonCategory ==. 1] ||.
-- >      [PersonCategory ==. 5]))
-- >     []
--
-- will filter records where a person's age is between 25 and 30 /and/
-- (person's category is either 1 or 5).
[Filter v]
a ||. :: forall v. [Filter v] -> [Filter v] -> [Filter v]
||. [Filter v]
b = [[Filter v] -> Filter v
forall record. [Filter record] -> Filter record
FilterOr [[Filter v] -> Filter v
forall record. [Filter record] -> Filter record
FilterAnd [Filter v]
a, [Filter v] -> Filter v
forall record. [Filter record] -> Filter record
FilterAnd [Filter v]
b]]

-- | Convert list of 'PersistValue's into textual representation of JSON
-- object. This is a type-constrained synonym for 'toJsonText'.
listToJSON :: [PersistValue] -> T.Text
listToJSON :: [PersistValue] -> Text
listToJSON = [PersistValue] -> Text
forall j. ToJSON j => j -> Text
toJsonText

-- | Convert map (list of tuples) into textual representation of JSON
-- object. This is a type-constrained synonym for 'toJsonText'.
mapToJSON :: [(T.Text, PersistValue)] -> T.Text
mapToJSON :: [(Text, PersistValue)] -> Text
mapToJSON = [(Text, PersistValue)] -> Text
forall j. ToJSON j => j -> Text
toJsonText

-- | A more general way to convert instances of `ToJSON` type class to
-- strict text 'T.Text'.
toJsonText :: (ToJSON j) => j -> T.Text
toJsonText :: forall j. ToJSON j => j -> Text
toJsonText = LazyText -> Text
toStrict (LazyText -> Text) -> (j -> LazyText) -> j -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
toLazyText (Builder -> LazyText) -> (j -> Builder) -> j -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Builder
forall a. ToJSON a => a -> Builder
encodeToTextBuilder (Value -> Builder) -> (j -> Value) -> j -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. j -> Value
forall a. ToJSON a => a -> Value
toJSON

-- | FIXME What's this exactly?
limitOffsetOrder
    :: (PersistEntity val)
    => [SelectOpt val]
    -> (Int, Int, [SelectOpt val])
limitOffsetOrder :: forall val.
PersistEntity val =>
[SelectOpt val] -> (Int, Int, [SelectOpt val])
limitOffsetOrder [SelectOpt val]
opts =
    (SelectOpt val
 -> (Int, Int, [SelectOpt val]) -> (Int, Int, [SelectOpt val]))
-> (Int, Int, [SelectOpt val])
-> [SelectOpt val]
-> (Int, Int, [SelectOpt val])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SelectOpt val
-> (Int, Int, [SelectOpt val]) -> (Int, Int, [SelectOpt val])
forall {record}.
SelectOpt record
-> (Int, Int, [SelectOpt record]) -> (Int, Int, [SelectOpt record])
go (Int
0, Int
0, []) [SelectOpt val]
opts
  where
    go :: SelectOpt record
-> (Int, Int, [SelectOpt record]) -> (Int, Int, [SelectOpt record])
go (LimitTo Int
l) (Int
_, Int
b, [SelectOpt record]
c) = (Int
l, Int
b, [SelectOpt record]
c)
    go (OffsetBy Int
o) (Int
a, Int
_, [SelectOpt record]
c) = (Int
a, Int
o, [SelectOpt record]
c)
    go SelectOpt record
x (Int
a, Int
b, [SelectOpt record]
c) = (Int
a, Int
b, SelectOpt record
x SelectOpt record -> [SelectOpt record] -> [SelectOpt record]
forall a. a -> [a] -> [a]
: [SelectOpt record]
c)