{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-} -- usage of Error typeclass
module Database.Persist.Types.Base where

import Control.Arrow (second)
import Control.Exception (Exception)
import Control.Monad.Trans.Error (Error (..))
import qualified Data.Aeson as A
import Data.Bits (shiftL, shiftR)
import Data.ByteString (ByteString, foldl')
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BS8
import Data.Char (isSpace)
import qualified Data.HashMap.Strict as HM
import Data.Int (Int64)
import Data.Map (Map)
import Data.Maybe
import qualified Data.Scientific
import Data.Text (Text, pack)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Text.Encoding.Error (lenientDecode)
import Data.Time (Day, TimeOfDay, UTCTime)
import qualified Data.Vector as V
import Data.Word (Word32)
import Numeric (showHex, readHex)
import Web.PathPieces (PathPiece(..))
import Web.HttpApiData (ToHttpApiData (..), FromHttpApiData (..), parseUrlPieceMaybe, showTextData, readTextData, parseBoundedTextData)


-- | A 'Checkmark' should be used as a field type whenever a
-- uniqueness constraint should guarantee that a certain kind of
-- record may appear at most once, but other kinds of records may
-- appear any number of times.
--
-- /NOTE:/ You need to mark any @Checkmark@ fields as @nullable@
-- (see the following example).
--
-- For example, suppose there's a @Location@ entity that
-- represents where a user has lived:
--
-- @
-- Location
--     user    UserId
--     name    Text
--     current Checkmark nullable
--
--     UniqueLocation user current
-- @
--
-- The @UniqueLocation@ constraint allows any number of
-- 'Inactive' @Location@s to be @current@.  However, there may be
-- at most one @current@ @Location@ per user (i.e., either zero
-- or one per user).
--
-- This data type works because of the way that SQL treats
-- @NULL@able fields within uniqueness constraints.  The SQL
-- standard says that @NULL@ values should be considered
-- different, so we represent 'Inactive' as SQL @NULL@, thus
-- allowing any number of 'Inactive' records.  On the other hand,
-- we represent 'Active' as @TRUE@, so the uniqueness constraint
-- will disallow more than one 'Active' record.
--
-- /Note:/ There may be DBMSs that do not respect the SQL
-- standard's treatment of @NULL@ values on uniqueness
-- constraints, please check if this data type works before
-- relying on it.
--
-- The SQL @BOOLEAN@ type is used because it's the smallest data
-- type available.  Note that we never use @FALSE@, just @TRUE@
-- and @NULL@.  Provides the same behavior @Maybe ()@ would if
-- @()@ was a valid 'PersistField'.
data Checkmark = Active
                 -- ^ When used on a uniqueness constraint, there
                 -- may be at most one 'Active' record.
               | Inactive
                 -- ^ When used on a uniqueness constraint, there
                 -- may be any number of 'Inactive' records.
    deriving (Checkmark -> Checkmark -> Bool
(Checkmark -> Checkmark -> Bool)
-> (Checkmark -> Checkmark -> Bool) -> Eq Checkmark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Checkmark -> Checkmark -> Bool
$c/= :: Checkmark -> Checkmark -> Bool
== :: Checkmark -> Checkmark -> Bool
$c== :: Checkmark -> Checkmark -> Bool
Eq, Eq Checkmark
Eq Checkmark
-> (Checkmark -> Checkmark -> Ordering)
-> (Checkmark -> Checkmark -> Bool)
-> (Checkmark -> Checkmark -> Bool)
-> (Checkmark -> Checkmark -> Bool)
-> (Checkmark -> Checkmark -> Bool)
-> (Checkmark -> Checkmark -> Checkmark)
-> (Checkmark -> Checkmark -> Checkmark)
-> Ord Checkmark
Checkmark -> Checkmark -> Bool
Checkmark -> Checkmark -> Ordering
Checkmark -> Checkmark -> Checkmark
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Checkmark -> Checkmark -> Checkmark
$cmin :: Checkmark -> Checkmark -> Checkmark
max :: Checkmark -> Checkmark -> Checkmark
$cmax :: Checkmark -> Checkmark -> Checkmark
>= :: Checkmark -> Checkmark -> Bool
$c>= :: Checkmark -> Checkmark -> Bool
> :: Checkmark -> Checkmark -> Bool
$c> :: Checkmark -> Checkmark -> Bool
<= :: Checkmark -> Checkmark -> Bool
$c<= :: Checkmark -> Checkmark -> Bool
< :: Checkmark -> Checkmark -> Bool
$c< :: Checkmark -> Checkmark -> Bool
compare :: Checkmark -> Checkmark -> Ordering
$ccompare :: Checkmark -> Checkmark -> Ordering
$cp1Ord :: Eq Checkmark
Ord, ReadPrec [Checkmark]
ReadPrec Checkmark
Int -> ReadS Checkmark
ReadS [Checkmark]
(Int -> ReadS Checkmark)
-> ReadS [Checkmark]
-> ReadPrec Checkmark
-> ReadPrec [Checkmark]
-> Read Checkmark
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Checkmark]
$creadListPrec :: ReadPrec [Checkmark]
readPrec :: ReadPrec Checkmark
$creadPrec :: ReadPrec Checkmark
readList :: ReadS [Checkmark]
$creadList :: ReadS [Checkmark]
readsPrec :: Int -> ReadS Checkmark
$creadsPrec :: Int -> ReadS Checkmark
Read, Int -> Checkmark -> ShowS
[Checkmark] -> ShowS
Checkmark -> String
(Int -> Checkmark -> ShowS)
-> (Checkmark -> String)
-> ([Checkmark] -> ShowS)
-> Show Checkmark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Checkmark] -> ShowS
$cshowList :: [Checkmark] -> ShowS
show :: Checkmark -> String
$cshow :: Checkmark -> String
showsPrec :: Int -> Checkmark -> ShowS
$cshowsPrec :: Int -> Checkmark -> ShowS
Show, Int -> Checkmark
Checkmark -> Int
Checkmark -> [Checkmark]
Checkmark -> Checkmark
Checkmark -> Checkmark -> [Checkmark]
Checkmark -> Checkmark -> Checkmark -> [Checkmark]
(Checkmark -> Checkmark)
-> (Checkmark -> Checkmark)
-> (Int -> Checkmark)
-> (Checkmark -> Int)
-> (Checkmark -> [Checkmark])
-> (Checkmark -> Checkmark -> [Checkmark])
-> (Checkmark -> Checkmark -> [Checkmark])
-> (Checkmark -> Checkmark -> Checkmark -> [Checkmark])
-> Enum Checkmark
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Checkmark -> Checkmark -> Checkmark -> [Checkmark]
$cenumFromThenTo :: Checkmark -> Checkmark -> Checkmark -> [Checkmark]
enumFromTo :: Checkmark -> Checkmark -> [Checkmark]
$cenumFromTo :: Checkmark -> Checkmark -> [Checkmark]
enumFromThen :: Checkmark -> Checkmark -> [Checkmark]
$cenumFromThen :: Checkmark -> Checkmark -> [Checkmark]
enumFrom :: Checkmark -> [Checkmark]
$cenumFrom :: Checkmark -> [Checkmark]
fromEnum :: Checkmark -> Int
$cfromEnum :: Checkmark -> Int
toEnum :: Int -> Checkmark
$ctoEnum :: Int -> Checkmark
pred :: Checkmark -> Checkmark
$cpred :: Checkmark -> Checkmark
succ :: Checkmark -> Checkmark
$csucc :: Checkmark -> Checkmark
Enum, Checkmark
Checkmark -> Checkmark -> Bounded Checkmark
forall a. a -> a -> Bounded a
maxBound :: Checkmark
$cmaxBound :: Checkmark
minBound :: Checkmark
$cminBound :: Checkmark
Bounded)

instance ToHttpApiData Checkmark where
    toUrlPiece :: Checkmark -> Text
toUrlPiece = Checkmark -> Text
forall a. Show a => a -> Text
showTextData

instance FromHttpApiData Checkmark where
    parseUrlPiece :: Text -> Either Text Checkmark
parseUrlPiece = Text -> Either Text Checkmark
forall a. (Show a, Bounded a, Enum a) => Text -> Either Text a
parseBoundedTextData

instance PathPiece Checkmark where
  toPathPiece :: Checkmark -> Text
toPathPiece Checkmark
Active = Text
"active"
  toPathPiece Checkmark
Inactive = Text
"inactive"

  fromPathPiece :: Text -> Maybe Checkmark
fromPathPiece Text
"active" = Checkmark -> Maybe Checkmark
forall a. a -> Maybe a
Just Checkmark
Active
  fromPathPiece Text
"inactive" = Checkmark -> Maybe Checkmark
forall a. a -> Maybe a
Just Checkmark
Inactive
  fromPathPiece Text
_ = Maybe Checkmark
forall a. Maybe a
Nothing

data IsNullable = Nullable !WhyNullable
                | NotNullable
                  deriving (IsNullable -> IsNullable -> Bool
(IsNullable -> IsNullable -> Bool)
-> (IsNullable -> IsNullable -> Bool) -> Eq IsNullable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsNullable -> IsNullable -> Bool
$c/= :: IsNullable -> IsNullable -> Bool
== :: IsNullable -> IsNullable -> Bool
$c== :: IsNullable -> IsNullable -> Bool
Eq, Int -> IsNullable -> ShowS
[IsNullable] -> ShowS
IsNullable -> String
(Int -> IsNullable -> ShowS)
-> (IsNullable -> String)
-> ([IsNullable] -> ShowS)
-> Show IsNullable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsNullable] -> ShowS
$cshowList :: [IsNullable] -> ShowS
show :: IsNullable -> String
$cshow :: IsNullable -> String
showsPrec :: Int -> IsNullable -> ShowS
$cshowsPrec :: Int -> IsNullable -> ShowS
Show)


-- | The reason why a field is 'nullable' is very important.  A
-- field that is nullable because of a @Maybe@ tag will have its
-- type changed from @A@ to @Maybe A@.  OTOH, a field that is
-- nullable because of a @nullable@ tag will remain with the same
-- type.
data WhyNullable = ByMaybeAttr
                 | ByNullableAttr
                  deriving (WhyNullable -> WhyNullable -> Bool
(WhyNullable -> WhyNullable -> Bool)
-> (WhyNullable -> WhyNullable -> Bool) -> Eq WhyNullable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WhyNullable -> WhyNullable -> Bool
$c/= :: WhyNullable -> WhyNullable -> Bool
== :: WhyNullable -> WhyNullable -> Bool
$c== :: WhyNullable -> WhyNullable -> Bool
Eq, Int -> WhyNullable -> ShowS
[WhyNullable] -> ShowS
WhyNullable -> String
(Int -> WhyNullable -> ShowS)
-> (WhyNullable -> String)
-> ([WhyNullable] -> ShowS)
-> Show WhyNullable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WhyNullable] -> ShowS
$cshowList :: [WhyNullable] -> ShowS
show :: WhyNullable -> String
$cshow :: WhyNullable -> String
showsPrec :: Int -> WhyNullable -> ShowS
$cshowsPrec :: Int -> WhyNullable -> ShowS
Show)

-- | An 'EntityDef' represents the information that @persistent@ knows
-- about an Entity. It uses this information to generate the Haskell
-- datatype, the SQL migrations, and other relevant conversions.
data EntityDef = EntityDef
    { EntityDef -> HaskellName
entityHaskell :: !HaskellName
    -- ^ The name of the entity as Haskell understands it.
    , EntityDef -> DBName
entityDB      :: !DBName
    -- ^ The name of the database table corresponding to the entity.
    , EntityDef -> FieldDef
entityId      :: !FieldDef
    -- ^ The entity's primary key or identifier.
    , EntityDef -> [Text]
entityAttrs   :: ![Attr]
    -- ^ The @persistent@ entity syntax allows you to add arbitrary 'Attr's
    -- to an entity using the @!@ operator. Those attributes are stored in
    -- this list.
    , EntityDef -> [FieldDef]
entityFields  :: ![FieldDef]
    -- ^ The fields for this entity. Note that the ID field will not be
    -- present in this list. To get all of the fields for an entity, use
    -- 'keyAndEntityFields'.
    , EntityDef -> [UniqueDef]
entityUniques :: ![UniqueDef]
    -- ^ The Uniqueness constraints for this entity.
    , EntityDef -> [ForeignDef]
entityForeigns:: ![ForeignDef]
    -- ^ The foreign key relationships that this entity has to other
    -- entities.
    , EntityDef -> [Text]
entityDerives :: ![Text]
    -- ^ A list of type classes that have been derived for this entity.
    , EntityDef -> Map Text [[Text]]
entityExtra   :: !(Map Text [ExtraLine])
    , EntityDef -> Bool
entitySum     :: !Bool
    -- ^ Whether or not this entity represents a sum type in the database.
    , EntityDef -> Maybe Text
entityComments :: !(Maybe Text)
    -- ^ Optional comments on the entity.
    --
    -- @since 2.10.0
    }
    deriving (Int -> EntityDef -> ShowS
[EntityDef] -> ShowS
EntityDef -> String
(Int -> EntityDef -> ShowS)
-> (EntityDef -> String)
-> ([EntityDef] -> ShowS)
-> Show EntityDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityDef] -> ShowS
$cshowList :: [EntityDef] -> ShowS
show :: EntityDef -> String
$cshow :: EntityDef -> String
showsPrec :: Int -> EntityDef -> ShowS
$cshowsPrec :: Int -> EntityDef -> ShowS
Show, EntityDef -> EntityDef -> Bool
(EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool) -> Eq EntityDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityDef -> EntityDef -> Bool
$c/= :: EntityDef -> EntityDef -> Bool
== :: EntityDef -> EntityDef -> Bool
$c== :: EntityDef -> EntityDef -> Bool
Eq, ReadPrec [EntityDef]
ReadPrec EntityDef
Int -> ReadS EntityDef
ReadS [EntityDef]
(Int -> ReadS EntityDef)
-> ReadS [EntityDef]
-> ReadPrec EntityDef
-> ReadPrec [EntityDef]
-> Read EntityDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EntityDef]
$creadListPrec :: ReadPrec [EntityDef]
readPrec :: ReadPrec EntityDef
$creadPrec :: ReadPrec EntityDef
readList :: ReadS [EntityDef]
$creadList :: ReadS [EntityDef]
readsPrec :: Int -> ReadS EntityDef
$creadsPrec :: Int -> ReadS EntityDef
Read, Eq EntityDef
Eq EntityDef
-> (EntityDef -> EntityDef -> Ordering)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> EntityDef)
-> (EntityDef -> EntityDef -> EntityDef)
-> Ord EntityDef
EntityDef -> EntityDef -> Bool
EntityDef -> EntityDef -> Ordering
EntityDef -> EntityDef -> EntityDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EntityDef -> EntityDef -> EntityDef
$cmin :: EntityDef -> EntityDef -> EntityDef
max :: EntityDef -> EntityDef -> EntityDef
$cmax :: EntityDef -> EntityDef -> EntityDef
>= :: EntityDef -> EntityDef -> Bool
$c>= :: EntityDef -> EntityDef -> Bool
> :: EntityDef -> EntityDef -> Bool
$c> :: EntityDef -> EntityDef -> Bool
<= :: EntityDef -> EntityDef -> Bool
$c<= :: EntityDef -> EntityDef -> Bool
< :: EntityDef -> EntityDef -> Bool
$c< :: EntityDef -> EntityDef -> Bool
compare :: EntityDef -> EntityDef -> Ordering
$ccompare :: EntityDef -> EntityDef -> Ordering
$cp1Ord :: Eq EntityDef
Ord)

entitiesPrimary :: EntityDef -> Maybe [FieldDef]
entitiesPrimary :: EntityDef -> Maybe [FieldDef]
entitiesPrimary EntityDef
t = case FieldDef -> ReferenceDef
fieldReference FieldDef
primaryField of
    CompositeRef CompositeDef
c -> [FieldDef] -> Maybe [FieldDef]
forall a. a -> Maybe a
Just ([FieldDef] -> Maybe [FieldDef]) -> [FieldDef] -> Maybe [FieldDef]
forall a b. (a -> b) -> a -> b
$ (CompositeDef -> [FieldDef]
compositeFields CompositeDef
c)
    ForeignRef HaskellName
_ FieldType
_ -> [FieldDef] -> Maybe [FieldDef]
forall a. a -> Maybe a
Just [FieldDef
primaryField]
    ReferenceDef
_ -> Maybe [FieldDef]
forall a. Maybe a
Nothing
  where
    primaryField :: FieldDef
primaryField = EntityDef -> FieldDef
entityId EntityDef
t

entityPrimary :: EntityDef -> Maybe CompositeDef
entityPrimary :: EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
t = case FieldDef -> ReferenceDef
fieldReference (EntityDef -> FieldDef
entityId EntityDef
t) of
    CompositeRef CompositeDef
c -> CompositeDef -> Maybe CompositeDef
forall a. a -> Maybe a
Just CompositeDef
c
    ReferenceDef
_ -> Maybe CompositeDef
forall a. Maybe a
Nothing

entityKeyFields :: EntityDef -> [FieldDef]
entityKeyFields :: EntityDef -> [FieldDef]
entityKeyFields EntityDef
ent = case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
ent of
    Maybe CompositeDef
Nothing   -> [EntityDef -> FieldDef
entityId EntityDef
ent]
    Just CompositeDef
pdef -> CompositeDef -> [FieldDef]
compositeFields CompositeDef
pdef

keyAndEntityFields :: EntityDef -> [FieldDef]
keyAndEntityFields :: EntityDef -> [FieldDef]
keyAndEntityFields EntityDef
ent =
  case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
ent of
    Maybe CompositeDef
Nothing -> EntityDef -> FieldDef
entityId EntityDef
ent FieldDef -> [FieldDef] -> [FieldDef]
forall a. a -> [a] -> [a]
: EntityDef -> [FieldDef]
entityFields EntityDef
ent
    Just CompositeDef
_  -> EntityDef -> [FieldDef]
entityFields EntityDef
ent


type ExtraLine = [Text]

newtype HaskellName = HaskellName { HaskellName -> Text
unHaskellName :: Text }
    deriving (Int -> HaskellName -> ShowS
[HaskellName] -> ShowS
HaskellName -> String
(Int -> HaskellName -> ShowS)
-> (HaskellName -> String)
-> ([HaskellName] -> ShowS)
-> Show HaskellName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HaskellName] -> ShowS
$cshowList :: [HaskellName] -> ShowS
show :: HaskellName -> String
$cshow :: HaskellName -> String
showsPrec :: Int -> HaskellName -> ShowS
$cshowsPrec :: Int -> HaskellName -> ShowS
Show, HaskellName -> HaskellName -> Bool
(HaskellName -> HaskellName -> Bool)
-> (HaskellName -> HaskellName -> Bool) -> Eq HaskellName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HaskellName -> HaskellName -> Bool
$c/= :: HaskellName -> HaskellName -> Bool
== :: HaskellName -> HaskellName -> Bool
$c== :: HaskellName -> HaskellName -> Bool
Eq, ReadPrec [HaskellName]
ReadPrec HaskellName
Int -> ReadS HaskellName
ReadS [HaskellName]
(Int -> ReadS HaskellName)
-> ReadS [HaskellName]
-> ReadPrec HaskellName
-> ReadPrec [HaskellName]
-> Read HaskellName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HaskellName]
$creadListPrec :: ReadPrec [HaskellName]
readPrec :: ReadPrec HaskellName
$creadPrec :: ReadPrec HaskellName
readList :: ReadS [HaskellName]
$creadList :: ReadS [HaskellName]
readsPrec :: Int -> ReadS HaskellName
$creadsPrec :: Int -> ReadS HaskellName
Read, Eq HaskellName
Eq HaskellName
-> (HaskellName -> HaskellName -> Ordering)
-> (HaskellName -> HaskellName -> Bool)
-> (HaskellName -> HaskellName -> Bool)
-> (HaskellName -> HaskellName -> Bool)
-> (HaskellName -> HaskellName -> Bool)
-> (HaskellName -> HaskellName -> HaskellName)
-> (HaskellName -> HaskellName -> HaskellName)
-> Ord HaskellName
HaskellName -> HaskellName -> Bool
HaskellName -> HaskellName -> Ordering
HaskellName -> HaskellName -> HaskellName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HaskellName -> HaskellName -> HaskellName
$cmin :: HaskellName -> HaskellName -> HaskellName
max :: HaskellName -> HaskellName -> HaskellName
$cmax :: HaskellName -> HaskellName -> HaskellName
>= :: HaskellName -> HaskellName -> Bool
$c>= :: HaskellName -> HaskellName -> Bool
> :: HaskellName -> HaskellName -> Bool
$c> :: HaskellName -> HaskellName -> Bool
<= :: HaskellName -> HaskellName -> Bool
$c<= :: HaskellName -> HaskellName -> Bool
< :: HaskellName -> HaskellName -> Bool
$c< :: HaskellName -> HaskellName -> Bool
compare :: HaskellName -> HaskellName -> Ordering
$ccompare :: HaskellName -> HaskellName -> Ordering
$cp1Ord :: Eq HaskellName
Ord)
newtype DBName = DBName { DBName -> Text
unDBName :: Text }
    deriving (Int -> DBName -> ShowS
[DBName] -> ShowS
DBName -> String
(Int -> DBName -> ShowS)
-> (DBName -> String) -> ([DBName] -> ShowS) -> Show DBName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DBName] -> ShowS
$cshowList :: [DBName] -> ShowS
show :: DBName -> String
$cshow :: DBName -> String
showsPrec :: Int -> DBName -> ShowS
$cshowsPrec :: Int -> DBName -> ShowS
Show, DBName -> DBName -> Bool
(DBName -> DBName -> Bool)
-> (DBName -> DBName -> Bool) -> Eq DBName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DBName -> DBName -> Bool
$c/= :: DBName -> DBName -> Bool
== :: DBName -> DBName -> Bool
$c== :: DBName -> DBName -> Bool
Eq, ReadPrec [DBName]
ReadPrec DBName
Int -> ReadS DBName
ReadS [DBName]
(Int -> ReadS DBName)
-> ReadS [DBName]
-> ReadPrec DBName
-> ReadPrec [DBName]
-> Read DBName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DBName]
$creadListPrec :: ReadPrec [DBName]
readPrec :: ReadPrec DBName
$creadPrec :: ReadPrec DBName
readList :: ReadS [DBName]
$creadList :: ReadS [DBName]
readsPrec :: Int -> ReadS DBName
$creadsPrec :: Int -> ReadS DBName
Read, Eq DBName
Eq DBName
-> (DBName -> DBName -> Ordering)
-> (DBName -> DBName -> Bool)
-> (DBName -> DBName -> Bool)
-> (DBName -> DBName -> Bool)
-> (DBName -> DBName -> Bool)
-> (DBName -> DBName -> DBName)
-> (DBName -> DBName -> DBName)
-> Ord DBName
DBName -> DBName -> Bool
DBName -> DBName -> Ordering
DBName -> DBName -> DBName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DBName -> DBName -> DBName
$cmin :: DBName -> DBName -> DBName
max :: DBName -> DBName -> DBName
$cmax :: DBName -> DBName -> DBName
>= :: DBName -> DBName -> Bool
$c>= :: DBName -> DBName -> Bool
> :: DBName -> DBName -> Bool
$c> :: DBName -> DBName -> Bool
<= :: DBName -> DBName -> Bool
$c<= :: DBName -> DBName -> Bool
< :: DBName -> DBName -> Bool
$c< :: DBName -> DBName -> Bool
compare :: DBName -> DBName -> Ordering
$ccompare :: DBName -> DBName -> Ordering
$cp1Ord :: Eq DBName
Ord)

type Attr = Text

-- | Attributes that may be attached to fields that can affect migrations
-- and serialization in backend-specific ways.
--
-- While we endeavor to, we can't forsee all use cases for all backends,
-- and so 'FieldAttr' is extensible through its constructor 'FieldAttrOther'.
--
-- @since 2.11.0.0
data FieldAttr
    = FieldAttrMaybe
    | FieldAttrNullable
    | FieldAttrMigrationOnly
    | FieldAttrSafeToRemove
    | FieldAttrNoreference
    | FieldAttrReference Text
    | FieldAttrConstraint Text
    | FieldAttrDefault Text
    | FieldAttrSqltype Text
    | FieldAttrMaxlen Integer
    | FieldAttrOther Text
    deriving (Int -> FieldAttr -> ShowS
[FieldAttr] -> ShowS
FieldAttr -> String
(Int -> FieldAttr -> ShowS)
-> (FieldAttr -> String)
-> ([FieldAttr] -> ShowS)
-> Show FieldAttr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldAttr] -> ShowS
$cshowList :: [FieldAttr] -> ShowS
show :: FieldAttr -> String
$cshow :: FieldAttr -> String
showsPrec :: Int -> FieldAttr -> ShowS
$cshowsPrec :: Int -> FieldAttr -> ShowS
Show, FieldAttr -> FieldAttr -> Bool
(FieldAttr -> FieldAttr -> Bool)
-> (FieldAttr -> FieldAttr -> Bool) -> Eq FieldAttr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldAttr -> FieldAttr -> Bool
$c/= :: FieldAttr -> FieldAttr -> Bool
== :: FieldAttr -> FieldAttr -> Bool
$c== :: FieldAttr -> FieldAttr -> Bool
Eq, ReadPrec [FieldAttr]
ReadPrec FieldAttr
Int -> ReadS FieldAttr
ReadS [FieldAttr]
(Int -> ReadS FieldAttr)
-> ReadS [FieldAttr]
-> ReadPrec FieldAttr
-> ReadPrec [FieldAttr]
-> Read FieldAttr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldAttr]
$creadListPrec :: ReadPrec [FieldAttr]
readPrec :: ReadPrec FieldAttr
$creadPrec :: ReadPrec FieldAttr
readList :: ReadS [FieldAttr]
$creadList :: ReadS [FieldAttr]
readsPrec :: Int -> ReadS FieldAttr
$creadsPrec :: Int -> ReadS FieldAttr
Read, Eq FieldAttr
Eq FieldAttr
-> (FieldAttr -> FieldAttr -> Ordering)
-> (FieldAttr -> FieldAttr -> Bool)
-> (FieldAttr -> FieldAttr -> Bool)
-> (FieldAttr -> FieldAttr -> Bool)
-> (FieldAttr -> FieldAttr -> Bool)
-> (FieldAttr -> FieldAttr -> FieldAttr)
-> (FieldAttr -> FieldAttr -> FieldAttr)
-> Ord FieldAttr
FieldAttr -> FieldAttr -> Bool
FieldAttr -> FieldAttr -> Ordering
FieldAttr -> FieldAttr -> FieldAttr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldAttr -> FieldAttr -> FieldAttr
$cmin :: FieldAttr -> FieldAttr -> FieldAttr
max :: FieldAttr -> FieldAttr -> FieldAttr
$cmax :: FieldAttr -> FieldAttr -> FieldAttr
>= :: FieldAttr -> FieldAttr -> Bool
$c>= :: FieldAttr -> FieldAttr -> Bool
> :: FieldAttr -> FieldAttr -> Bool
$c> :: FieldAttr -> FieldAttr -> Bool
<= :: FieldAttr -> FieldAttr -> Bool
$c<= :: FieldAttr -> FieldAttr -> Bool
< :: FieldAttr -> FieldAttr -> Bool
$c< :: FieldAttr -> FieldAttr -> Bool
compare :: FieldAttr -> FieldAttr -> Ordering
$ccompare :: FieldAttr -> FieldAttr -> Ordering
$cp1Ord :: Eq FieldAttr
Ord)

-- | Parse raw field attributes into structured form. Any unrecognized
-- attributes will be preserved, identically as they are encountered,
-- as 'FieldAttrOther' values.
--
-- @since 2.11.0.0
parseFieldAttrs :: [Text] -> [FieldAttr]
parseFieldAttrs :: [Text] -> [FieldAttr]
parseFieldAttrs = (Text -> FieldAttr) -> [Text] -> [FieldAttr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> FieldAttr) -> [Text] -> [FieldAttr])
-> (Text -> FieldAttr) -> [Text] -> [FieldAttr]
forall a b. (a -> b) -> a -> b
$ \case
    Text
"Maybe" -> FieldAttr
FieldAttrMaybe
    Text
"nullable" -> FieldAttr
FieldAttrNullable
    Text
"MigrationOnly" -> FieldAttr
FieldAttrMigrationOnly
    Text
"SafeToRemove" -> FieldAttr
FieldAttrSafeToRemove
    Text
"noreference" -> FieldAttr
FieldAttrNoreference
    Text
raw
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"reference=" Text
raw -> Text -> FieldAttr
FieldAttrReference Text
x
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"constraint=" Text
raw -> Text -> FieldAttr
FieldAttrConstraint Text
x
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"default=" Text
raw -> Text -> FieldAttr
FieldAttrDefault Text
x
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"sqltype=" Text
raw -> Text -> FieldAttr
FieldAttrSqltype Text
x
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"maxlen=" Text
raw -> case ReadS Integer
forall a. Read a => ReadS a
reads (Text -> String
T.unpack Text
x) of
            [(Integer
n, String
s)] | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s -> Integer -> FieldAttr
FieldAttrMaxlen Integer
n
            [(Integer, String)]
_ -> String -> FieldAttr
forall a. HasCallStack => String -> a
error (String -> FieldAttr) -> String -> FieldAttr
forall a b. (a -> b) -> a -> b
$ String
"Could not parse maxlen field with value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
raw
        | Bool
otherwise -> Text -> FieldAttr
FieldAttrOther Text
raw

-- | A 'FieldType' describes a field parsed from the QuasiQuoter and is
-- used to determine the Haskell type in the generated code.
--
-- @name Text@ parses into @FTTypeCon Nothing "Text"@
--
-- @name T.Text@ parses into @FTTypeCon (Just "T" "Text")@
--
-- @name (Jsonb User)@ parses into:
--
-- @
-- FTApp (FTTypeCon Nothing "Jsonb") (FTTypeCon Nothing "User")
-- @
data FieldType
    = FTTypeCon (Maybe Text) Text
    -- ^ Optional module and name.
    | FTApp FieldType FieldType
    | FTList FieldType
  deriving (Int -> FieldType -> ShowS
[FieldType] -> ShowS
FieldType -> String
(Int -> FieldType -> ShowS)
-> (FieldType -> String)
-> ([FieldType] -> ShowS)
-> Show FieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldType] -> ShowS
$cshowList :: [FieldType] -> ShowS
show :: FieldType -> String
$cshow :: FieldType -> String
showsPrec :: Int -> FieldType -> ShowS
$cshowsPrec :: Int -> FieldType -> ShowS
Show, FieldType -> FieldType -> Bool
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldType -> FieldType -> Bool
$c/= :: FieldType -> FieldType -> Bool
== :: FieldType -> FieldType -> Bool
$c== :: FieldType -> FieldType -> Bool
Eq, ReadPrec [FieldType]
ReadPrec FieldType
Int -> ReadS FieldType
ReadS [FieldType]
(Int -> ReadS FieldType)
-> ReadS [FieldType]
-> ReadPrec FieldType
-> ReadPrec [FieldType]
-> Read FieldType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldType]
$creadListPrec :: ReadPrec [FieldType]
readPrec :: ReadPrec FieldType
$creadPrec :: ReadPrec FieldType
readList :: ReadS [FieldType]
$creadList :: ReadS [FieldType]
readsPrec :: Int -> ReadS FieldType
$creadsPrec :: Int -> ReadS FieldType
Read, Eq FieldType
Eq FieldType
-> (FieldType -> FieldType -> Ordering)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> FieldType)
-> (FieldType -> FieldType -> FieldType)
-> Ord FieldType
FieldType -> FieldType -> Bool
FieldType -> FieldType -> Ordering
FieldType -> FieldType -> FieldType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldType -> FieldType -> FieldType
$cmin :: FieldType -> FieldType -> FieldType
max :: FieldType -> FieldType -> FieldType
$cmax :: FieldType -> FieldType -> FieldType
>= :: FieldType -> FieldType -> Bool
$c>= :: FieldType -> FieldType -> Bool
> :: FieldType -> FieldType -> Bool
$c> :: FieldType -> FieldType -> Bool
<= :: FieldType -> FieldType -> Bool
$c<= :: FieldType -> FieldType -> Bool
< :: FieldType -> FieldType -> Bool
$c< :: FieldType -> FieldType -> Bool
compare :: FieldType -> FieldType -> Ordering
$ccompare :: FieldType -> FieldType -> Ordering
$cp1Ord :: Eq FieldType
Ord)

-- | A 'FieldDef' represents the information that @persistent@ knows about
-- a field of a datatype. This includes information used to parse the field
-- out of the database and what the field corresponds to.
data FieldDef = FieldDef
    { FieldDef -> HaskellName
fieldHaskell   :: !HaskellName
    -- ^ The name of the field. Note that this does not corresponds to the
    -- record labels generated for the particular entity - record labels
    -- are generated with the type name prefixed to the field, so
    -- a 'FieldDef' that contains a @'HaskellName' "name"@ for a type
    -- @User@ will have a record field @userName@.
    , FieldDef -> DBName
fieldDB        :: !DBName
    -- ^ The name of the field in the database. For SQL databases, this
    -- corresponds to the column name.
    , FieldDef -> FieldType
fieldType      :: !FieldType
    -- ^ The type of the field in Haskell.
    , FieldDef -> SqlType
fieldSqlType   :: !SqlType
    -- ^ The type of the field in a SQL database.
    , FieldDef -> [FieldAttr]
fieldAttrs     :: ![FieldAttr]
    -- ^ User annotations for a field. These are provided with the @!@
    -- operator.
    , FieldDef -> Bool
fieldStrict    :: !Bool
    -- ^ If this is 'True', then the Haskell datatype will have a strict
    -- record field. The default value for this is 'True'.
    , FieldDef -> ReferenceDef
fieldReference :: !ReferenceDef
    , FieldDef -> FieldCascade
fieldCascade :: !FieldCascade
    -- ^ Defines how operations on the field cascade on to the referenced
    -- tables. This doesn't have any meaning if the 'fieldReference' is set
    -- to 'NoReference' or 'SelfReference'. The cascade option here should
    -- be the same as the one obtained in the 'fieldReference'.
    --
    -- @since 2.11.0
    , FieldDef -> Maybe Text
fieldComments  :: !(Maybe Text)
    -- ^ Optional comments for a 'Field'. There is not currently a way to
    -- attach comments to a field in the quasiquoter.
    --
    -- @since 2.10.0
    , FieldDef -> Maybe Text
fieldGenerated :: !(Maybe Text)
    -- ^ Whether or not the field is a @GENERATED@ column, and additionally
    -- the expression to use for generation.
    --
    -- @since 2.11.0.0
    }
    deriving (Int -> FieldDef -> ShowS
[FieldDef] -> ShowS
FieldDef -> String
(Int -> FieldDef -> ShowS)
-> (FieldDef -> String) -> ([FieldDef] -> ShowS) -> Show FieldDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldDef] -> ShowS
$cshowList :: [FieldDef] -> ShowS
show :: FieldDef -> String
$cshow :: FieldDef -> String
showsPrec :: Int -> FieldDef -> ShowS
$cshowsPrec :: Int -> FieldDef -> ShowS
Show, FieldDef -> FieldDef -> Bool
(FieldDef -> FieldDef -> Bool)
-> (FieldDef -> FieldDef -> Bool) -> Eq FieldDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldDef -> FieldDef -> Bool
$c/= :: FieldDef -> FieldDef -> Bool
== :: FieldDef -> FieldDef -> Bool
$c== :: FieldDef -> FieldDef -> Bool
Eq, ReadPrec [FieldDef]
ReadPrec FieldDef
Int -> ReadS FieldDef
ReadS [FieldDef]
(Int -> ReadS FieldDef)
-> ReadS [FieldDef]
-> ReadPrec FieldDef
-> ReadPrec [FieldDef]
-> Read FieldDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldDef]
$creadListPrec :: ReadPrec [FieldDef]
readPrec :: ReadPrec FieldDef
$creadPrec :: ReadPrec FieldDef
readList :: ReadS [FieldDef]
$creadList :: ReadS [FieldDef]
readsPrec :: Int -> ReadS FieldDef
$creadsPrec :: Int -> ReadS FieldDef
Read, Eq FieldDef
Eq FieldDef
-> (FieldDef -> FieldDef -> Ordering)
-> (FieldDef -> FieldDef -> Bool)
-> (FieldDef -> FieldDef -> Bool)
-> (FieldDef -> FieldDef -> Bool)
-> (FieldDef -> FieldDef -> Bool)
-> (FieldDef -> FieldDef -> FieldDef)
-> (FieldDef -> FieldDef -> FieldDef)
-> Ord FieldDef
FieldDef -> FieldDef -> Bool
FieldDef -> FieldDef -> Ordering
FieldDef -> FieldDef -> FieldDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldDef -> FieldDef -> FieldDef
$cmin :: FieldDef -> FieldDef -> FieldDef
max :: FieldDef -> FieldDef -> FieldDef
$cmax :: FieldDef -> FieldDef -> FieldDef
>= :: FieldDef -> FieldDef -> Bool
$c>= :: FieldDef -> FieldDef -> Bool
> :: FieldDef -> FieldDef -> Bool
$c> :: FieldDef -> FieldDef -> Bool
<= :: FieldDef -> FieldDef -> Bool
$c<= :: FieldDef -> FieldDef -> Bool
< :: FieldDef -> FieldDef -> Bool
$c< :: FieldDef -> FieldDef -> Bool
compare :: FieldDef -> FieldDef -> Ordering
$ccompare :: FieldDef -> FieldDef -> Ordering
$cp1Ord :: Eq FieldDef
Ord)

isFieldNotGenerated :: FieldDef -> Bool
isFieldNotGenerated :: FieldDef -> Bool
isFieldNotGenerated = Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool)
-> (FieldDef -> Maybe Text) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> Maybe Text
fieldGenerated

-- | There are 3 kinds of references
-- 1) composite (to fields that exist in the record)
-- 2) single field
-- 3) embedded
data ReferenceDef = NoReference
                  | ForeignRef !HaskellName !FieldType
                    -- ^ A ForeignRef has a late binding to the EntityDef it references via HaskellName and has the Haskell type of the foreign key in the form of FieldType
                  | EmbedRef EmbedEntityDef
                  | CompositeRef CompositeDef
                  | SelfReference
                    -- ^ A SelfReference stops an immediate cycle which causes non-termination at compile-time (issue #311).
                  deriving (Int -> ReferenceDef -> ShowS
[ReferenceDef] -> ShowS
ReferenceDef -> String
(Int -> ReferenceDef -> ShowS)
-> (ReferenceDef -> String)
-> ([ReferenceDef] -> ShowS)
-> Show ReferenceDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferenceDef] -> ShowS
$cshowList :: [ReferenceDef] -> ShowS
show :: ReferenceDef -> String
$cshow :: ReferenceDef -> String
showsPrec :: Int -> ReferenceDef -> ShowS
$cshowsPrec :: Int -> ReferenceDef -> ShowS
Show, ReferenceDef -> ReferenceDef -> Bool
(ReferenceDef -> ReferenceDef -> Bool)
-> (ReferenceDef -> ReferenceDef -> Bool) -> Eq ReferenceDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceDef -> ReferenceDef -> Bool
$c/= :: ReferenceDef -> ReferenceDef -> Bool
== :: ReferenceDef -> ReferenceDef -> Bool
$c== :: ReferenceDef -> ReferenceDef -> Bool
Eq, ReadPrec [ReferenceDef]
ReadPrec ReferenceDef
Int -> ReadS ReferenceDef
ReadS [ReferenceDef]
(Int -> ReadS ReferenceDef)
-> ReadS [ReferenceDef]
-> ReadPrec ReferenceDef
-> ReadPrec [ReferenceDef]
-> Read ReferenceDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReferenceDef]
$creadListPrec :: ReadPrec [ReferenceDef]
readPrec :: ReadPrec ReferenceDef
$creadPrec :: ReadPrec ReferenceDef
readList :: ReadS [ReferenceDef]
$creadList :: ReadS [ReferenceDef]
readsPrec :: Int -> ReadS ReferenceDef
$creadsPrec :: Int -> ReadS ReferenceDef
Read, Eq ReferenceDef
Eq ReferenceDef
-> (ReferenceDef -> ReferenceDef -> Ordering)
-> (ReferenceDef -> ReferenceDef -> Bool)
-> (ReferenceDef -> ReferenceDef -> Bool)
-> (ReferenceDef -> ReferenceDef -> Bool)
-> (ReferenceDef -> ReferenceDef -> Bool)
-> (ReferenceDef -> ReferenceDef -> ReferenceDef)
-> (ReferenceDef -> ReferenceDef -> ReferenceDef)
-> Ord ReferenceDef
ReferenceDef -> ReferenceDef -> Bool
ReferenceDef -> ReferenceDef -> Ordering
ReferenceDef -> ReferenceDef -> ReferenceDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReferenceDef -> ReferenceDef -> ReferenceDef
$cmin :: ReferenceDef -> ReferenceDef -> ReferenceDef
max :: ReferenceDef -> ReferenceDef -> ReferenceDef
$cmax :: ReferenceDef -> ReferenceDef -> ReferenceDef
>= :: ReferenceDef -> ReferenceDef -> Bool
$c>= :: ReferenceDef -> ReferenceDef -> Bool
> :: ReferenceDef -> ReferenceDef -> Bool
$c> :: ReferenceDef -> ReferenceDef -> Bool
<= :: ReferenceDef -> ReferenceDef -> Bool
$c<= :: ReferenceDef -> ReferenceDef -> Bool
< :: ReferenceDef -> ReferenceDef -> Bool
$c< :: ReferenceDef -> ReferenceDef -> Bool
compare :: ReferenceDef -> ReferenceDef -> Ordering
$ccompare :: ReferenceDef -> ReferenceDef -> Ordering
$cp1Ord :: Eq ReferenceDef
Ord)

-- | An EmbedEntityDef is the same as an EntityDef
-- But it is only used for fieldReference
-- so it only has data needed for embedding
data EmbedEntityDef = EmbedEntityDef
    { EmbedEntityDef -> HaskellName
embeddedHaskell :: !HaskellName
    , EmbedEntityDef -> [EmbedFieldDef]
embeddedFields  :: ![EmbedFieldDef]
    } deriving (Int -> EmbedEntityDef -> ShowS
[EmbedEntityDef] -> ShowS
EmbedEntityDef -> String
(Int -> EmbedEntityDef -> ShowS)
-> (EmbedEntityDef -> String)
-> ([EmbedEntityDef] -> ShowS)
-> Show EmbedEntityDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmbedEntityDef] -> ShowS
$cshowList :: [EmbedEntityDef] -> ShowS
show :: EmbedEntityDef -> String
$cshow :: EmbedEntityDef -> String
showsPrec :: Int -> EmbedEntityDef -> ShowS
$cshowsPrec :: Int -> EmbedEntityDef -> ShowS
Show, EmbedEntityDef -> EmbedEntityDef -> Bool
(EmbedEntityDef -> EmbedEntityDef -> Bool)
-> (EmbedEntityDef -> EmbedEntityDef -> Bool) -> Eq EmbedEntityDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c/= :: EmbedEntityDef -> EmbedEntityDef -> Bool
== :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c== :: EmbedEntityDef -> EmbedEntityDef -> Bool
Eq, ReadPrec [EmbedEntityDef]
ReadPrec EmbedEntityDef
Int -> ReadS EmbedEntityDef
ReadS [EmbedEntityDef]
(Int -> ReadS EmbedEntityDef)
-> ReadS [EmbedEntityDef]
-> ReadPrec EmbedEntityDef
-> ReadPrec [EmbedEntityDef]
-> Read EmbedEntityDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EmbedEntityDef]
$creadListPrec :: ReadPrec [EmbedEntityDef]
readPrec :: ReadPrec EmbedEntityDef
$creadPrec :: ReadPrec EmbedEntityDef
readList :: ReadS [EmbedEntityDef]
$creadList :: ReadS [EmbedEntityDef]
readsPrec :: Int -> ReadS EmbedEntityDef
$creadsPrec :: Int -> ReadS EmbedEntityDef
Read, Eq EmbedEntityDef
Eq EmbedEntityDef
-> (EmbedEntityDef -> EmbedEntityDef -> Ordering)
-> (EmbedEntityDef -> EmbedEntityDef -> Bool)
-> (EmbedEntityDef -> EmbedEntityDef -> Bool)
-> (EmbedEntityDef -> EmbedEntityDef -> Bool)
-> (EmbedEntityDef -> EmbedEntityDef -> Bool)
-> (EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef)
-> (EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef)
-> Ord EmbedEntityDef
EmbedEntityDef -> EmbedEntityDef -> Bool
EmbedEntityDef -> EmbedEntityDef -> Ordering
EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef
$cmin :: EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef
max :: EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef
$cmax :: EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef
>= :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c>= :: EmbedEntityDef -> EmbedEntityDef -> Bool
> :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c> :: EmbedEntityDef -> EmbedEntityDef -> Bool
<= :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c<= :: EmbedEntityDef -> EmbedEntityDef -> Bool
< :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c< :: EmbedEntityDef -> EmbedEntityDef -> Bool
compare :: EmbedEntityDef -> EmbedEntityDef -> Ordering
$ccompare :: EmbedEntityDef -> EmbedEntityDef -> Ordering
$cp1Ord :: Eq EmbedEntityDef
Ord)

-- | An EmbedFieldDef is the same as a FieldDef
-- But it is only used for embeddedFields
-- so it only has data needed for embedding
data EmbedFieldDef = EmbedFieldDef
    { EmbedFieldDef -> DBName
emFieldDB       :: !DBName
    , EmbedFieldDef -> Maybe EmbedEntityDef
emFieldEmbed :: Maybe EmbedEntityDef
    , EmbedFieldDef -> Maybe HaskellName
emFieldCycle :: Maybe HaskellName
    -- ^ 'emFieldEmbed' can create a cycle (issue #311)
    -- when a cycle is detected, 'emFieldEmbed' will be Nothing
    -- and 'emFieldCycle' will be Just
    }
    deriving (Int -> EmbedFieldDef -> ShowS
[EmbedFieldDef] -> ShowS
EmbedFieldDef -> String
(Int -> EmbedFieldDef -> ShowS)
-> (EmbedFieldDef -> String)
-> ([EmbedFieldDef] -> ShowS)
-> Show EmbedFieldDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmbedFieldDef] -> ShowS
$cshowList :: [EmbedFieldDef] -> ShowS
show :: EmbedFieldDef -> String
$cshow :: EmbedFieldDef -> String
showsPrec :: Int -> EmbedFieldDef -> ShowS
$cshowsPrec :: Int -> EmbedFieldDef -> ShowS
Show, EmbedFieldDef -> EmbedFieldDef -> Bool
(EmbedFieldDef -> EmbedFieldDef -> Bool)
-> (EmbedFieldDef -> EmbedFieldDef -> Bool) -> Eq EmbedFieldDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c/= :: EmbedFieldDef -> EmbedFieldDef -> Bool
== :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c== :: EmbedFieldDef -> EmbedFieldDef -> Bool
Eq, ReadPrec [EmbedFieldDef]
ReadPrec EmbedFieldDef
Int -> ReadS EmbedFieldDef
ReadS [EmbedFieldDef]
(Int -> ReadS EmbedFieldDef)
-> ReadS [EmbedFieldDef]
-> ReadPrec EmbedFieldDef
-> ReadPrec [EmbedFieldDef]
-> Read EmbedFieldDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EmbedFieldDef]
$creadListPrec :: ReadPrec [EmbedFieldDef]
readPrec :: ReadPrec EmbedFieldDef
$creadPrec :: ReadPrec EmbedFieldDef
readList :: ReadS [EmbedFieldDef]
$creadList :: ReadS [EmbedFieldDef]
readsPrec :: Int -> ReadS EmbedFieldDef
$creadsPrec :: Int -> ReadS EmbedFieldDef
Read, Eq EmbedFieldDef
Eq EmbedFieldDef
-> (EmbedFieldDef -> EmbedFieldDef -> Ordering)
-> (EmbedFieldDef -> EmbedFieldDef -> Bool)
-> (EmbedFieldDef -> EmbedFieldDef -> Bool)
-> (EmbedFieldDef -> EmbedFieldDef -> Bool)
-> (EmbedFieldDef -> EmbedFieldDef -> Bool)
-> (EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef)
-> (EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef)
-> Ord EmbedFieldDef
EmbedFieldDef -> EmbedFieldDef -> Bool
EmbedFieldDef -> EmbedFieldDef -> Ordering
EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef
$cmin :: EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef
max :: EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef
$cmax :: EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef
>= :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c>= :: EmbedFieldDef -> EmbedFieldDef -> Bool
> :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c> :: EmbedFieldDef -> EmbedFieldDef -> Bool
<= :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c<= :: EmbedFieldDef -> EmbedFieldDef -> Bool
< :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c< :: EmbedFieldDef -> EmbedFieldDef -> Bool
compare :: EmbedFieldDef -> EmbedFieldDef -> Ordering
$ccompare :: EmbedFieldDef -> EmbedFieldDef -> Ordering
$cp1Ord :: Eq EmbedFieldDef
Ord)

toEmbedEntityDef :: EntityDef -> EmbedEntityDef
toEmbedEntityDef :: EntityDef -> EmbedEntityDef
toEmbedEntityDef EntityDef
ent = EmbedEntityDef
embDef
  where
    embDef :: EmbedEntityDef
embDef = EmbedEntityDef :: HaskellName -> [EmbedFieldDef] -> EmbedEntityDef
EmbedEntityDef
      { embeddedHaskell :: HaskellName
embeddedHaskell = EntityDef -> HaskellName
entityHaskell EntityDef
ent
      , embeddedFields :: [EmbedFieldDef]
embeddedFields = (FieldDef -> EmbedFieldDef) -> [FieldDef] -> [EmbedFieldDef]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> EmbedFieldDef
toEmbedFieldDef ([FieldDef] -> [EmbedFieldDef]) -> [FieldDef] -> [EmbedFieldDef]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityFields EntityDef
ent
      }
    toEmbedFieldDef :: FieldDef -> EmbedFieldDef
    toEmbedFieldDef :: FieldDef -> EmbedFieldDef
toEmbedFieldDef FieldDef
field =
      EmbedFieldDef :: DBName
-> Maybe EmbedEntityDef -> Maybe HaskellName -> EmbedFieldDef
EmbedFieldDef { emFieldDB :: DBName
emFieldDB       = FieldDef -> DBName
fieldDB FieldDef
field
                    , emFieldEmbed :: Maybe EmbedEntityDef
emFieldEmbed = case FieldDef -> ReferenceDef
fieldReference FieldDef
field of
                        EmbedRef EmbedEntityDef
em -> EmbedEntityDef -> Maybe EmbedEntityDef
forall a. a -> Maybe a
Just EmbedEntityDef
em
                        ReferenceDef
SelfReference -> EmbedEntityDef -> Maybe EmbedEntityDef
forall a. a -> Maybe a
Just EmbedEntityDef
embDef
                        ReferenceDef
_ -> Maybe EmbedEntityDef
forall a. Maybe a
Nothing
                    , emFieldCycle :: Maybe HaskellName
emFieldCycle = case FieldDef -> ReferenceDef
fieldReference FieldDef
field of
                        ReferenceDef
SelfReference -> HaskellName -> Maybe HaskellName
forall a. a -> Maybe a
Just (HaskellName -> Maybe HaskellName)
-> HaskellName -> Maybe HaskellName
forall a b. (a -> b) -> a -> b
$ EntityDef -> HaskellName
entityHaskell EntityDef
ent
                        ReferenceDef
_ -> Maybe HaskellName
forall a. Maybe a
Nothing
                    }

-- Type for storing the Uniqueness constraint in the Schema.
-- Assume you have the following schema with a uniqueness
-- constraint:
-- Person
--   name String
--   age Int
--   UniqueAge age
--
-- This will be represented as:
-- UniqueDef (HaskellName (packPTH "UniqueAge"))
-- (DBName (packPTH "unique_age")) [(HaskellName (packPTH "age"), DBName (packPTH "age"))] []
--
data UniqueDef = UniqueDef
    { UniqueDef -> HaskellName
uniqueHaskell :: !HaskellName
    , UniqueDef -> DBName
uniqueDBName  :: !DBName
    , UniqueDef -> [(HaskellName, DBName)]
uniqueFields  :: ![(HaskellName, DBName)]
    , UniqueDef -> [Text]
uniqueAttrs   :: ![Attr]
    }
    deriving (Int -> UniqueDef -> ShowS
[UniqueDef] -> ShowS
UniqueDef -> String
(Int -> UniqueDef -> ShowS)
-> (UniqueDef -> String)
-> ([UniqueDef] -> ShowS)
-> Show UniqueDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UniqueDef] -> ShowS
$cshowList :: [UniqueDef] -> ShowS
show :: UniqueDef -> String
$cshow :: UniqueDef -> String
showsPrec :: Int -> UniqueDef -> ShowS
$cshowsPrec :: Int -> UniqueDef -> ShowS
Show, UniqueDef -> UniqueDef -> Bool
(UniqueDef -> UniqueDef -> Bool)
-> (UniqueDef -> UniqueDef -> Bool) -> Eq UniqueDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UniqueDef -> UniqueDef -> Bool
$c/= :: UniqueDef -> UniqueDef -> Bool
== :: UniqueDef -> UniqueDef -> Bool
$c== :: UniqueDef -> UniqueDef -> Bool
Eq, ReadPrec [UniqueDef]
ReadPrec UniqueDef
Int -> ReadS UniqueDef
ReadS [UniqueDef]
(Int -> ReadS UniqueDef)
-> ReadS [UniqueDef]
-> ReadPrec UniqueDef
-> ReadPrec [UniqueDef]
-> Read UniqueDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UniqueDef]
$creadListPrec :: ReadPrec [UniqueDef]
readPrec :: ReadPrec UniqueDef
$creadPrec :: ReadPrec UniqueDef
readList :: ReadS [UniqueDef]
$creadList :: ReadS [UniqueDef]
readsPrec :: Int -> ReadS UniqueDef
$creadsPrec :: Int -> ReadS UniqueDef
Read, Eq UniqueDef
Eq UniqueDef
-> (UniqueDef -> UniqueDef -> Ordering)
-> (UniqueDef -> UniqueDef -> Bool)
-> (UniqueDef -> UniqueDef -> Bool)
-> (UniqueDef -> UniqueDef -> Bool)
-> (UniqueDef -> UniqueDef -> Bool)
-> (UniqueDef -> UniqueDef -> UniqueDef)
-> (UniqueDef -> UniqueDef -> UniqueDef)
-> Ord UniqueDef
UniqueDef -> UniqueDef -> Bool
UniqueDef -> UniqueDef -> Ordering
UniqueDef -> UniqueDef -> UniqueDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UniqueDef -> UniqueDef -> UniqueDef
$cmin :: UniqueDef -> UniqueDef -> UniqueDef
max :: UniqueDef -> UniqueDef -> UniqueDef
$cmax :: UniqueDef -> UniqueDef -> UniqueDef
>= :: UniqueDef -> UniqueDef -> Bool
$c>= :: UniqueDef -> UniqueDef -> Bool
> :: UniqueDef -> UniqueDef -> Bool
$c> :: UniqueDef -> UniqueDef -> Bool
<= :: UniqueDef -> UniqueDef -> Bool
$c<= :: UniqueDef -> UniqueDef -> Bool
< :: UniqueDef -> UniqueDef -> Bool
$c< :: UniqueDef -> UniqueDef -> Bool
compare :: UniqueDef -> UniqueDef -> Ordering
$ccompare :: UniqueDef -> UniqueDef -> Ordering
$cp1Ord :: Eq UniqueDef
Ord)

data CompositeDef = CompositeDef
    { CompositeDef -> [FieldDef]
compositeFields  :: ![FieldDef]
    , CompositeDef -> [Text]
compositeAttrs   :: ![Attr]
    }
    deriving (Int -> CompositeDef -> ShowS
[CompositeDef] -> ShowS
CompositeDef -> String
(Int -> CompositeDef -> ShowS)
-> (CompositeDef -> String)
-> ([CompositeDef] -> ShowS)
-> Show CompositeDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompositeDef] -> ShowS
$cshowList :: [CompositeDef] -> ShowS
show :: CompositeDef -> String
$cshow :: CompositeDef -> String
showsPrec :: Int -> CompositeDef -> ShowS
$cshowsPrec :: Int -> CompositeDef -> ShowS
Show, CompositeDef -> CompositeDef -> Bool
(CompositeDef -> CompositeDef -> Bool)
-> (CompositeDef -> CompositeDef -> Bool) -> Eq CompositeDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompositeDef -> CompositeDef -> Bool
$c/= :: CompositeDef -> CompositeDef -> Bool
== :: CompositeDef -> CompositeDef -> Bool
$c== :: CompositeDef -> CompositeDef -> Bool
Eq, ReadPrec [CompositeDef]
ReadPrec CompositeDef
Int -> ReadS CompositeDef
ReadS [CompositeDef]
(Int -> ReadS CompositeDef)
-> ReadS [CompositeDef]
-> ReadPrec CompositeDef
-> ReadPrec [CompositeDef]
-> Read CompositeDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompositeDef]
$creadListPrec :: ReadPrec [CompositeDef]
readPrec :: ReadPrec CompositeDef
$creadPrec :: ReadPrec CompositeDef
readList :: ReadS [CompositeDef]
$creadList :: ReadS [CompositeDef]
readsPrec :: Int -> ReadS CompositeDef
$creadsPrec :: Int -> ReadS CompositeDef
Read, Eq CompositeDef
Eq CompositeDef
-> (CompositeDef -> CompositeDef -> Ordering)
-> (CompositeDef -> CompositeDef -> Bool)
-> (CompositeDef -> CompositeDef -> Bool)
-> (CompositeDef -> CompositeDef -> Bool)
-> (CompositeDef -> CompositeDef -> Bool)
-> (CompositeDef -> CompositeDef -> CompositeDef)
-> (CompositeDef -> CompositeDef -> CompositeDef)
-> Ord CompositeDef
CompositeDef -> CompositeDef -> Bool
CompositeDef -> CompositeDef -> Ordering
CompositeDef -> CompositeDef -> CompositeDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompositeDef -> CompositeDef -> CompositeDef
$cmin :: CompositeDef -> CompositeDef -> CompositeDef
max :: CompositeDef -> CompositeDef -> CompositeDef
$cmax :: CompositeDef -> CompositeDef -> CompositeDef
>= :: CompositeDef -> CompositeDef -> Bool
$c>= :: CompositeDef -> CompositeDef -> Bool
> :: CompositeDef -> CompositeDef -> Bool
$c> :: CompositeDef -> CompositeDef -> Bool
<= :: CompositeDef -> CompositeDef -> Bool
$c<= :: CompositeDef -> CompositeDef -> Bool
< :: CompositeDef -> CompositeDef -> Bool
$c< :: CompositeDef -> CompositeDef -> Bool
compare :: CompositeDef -> CompositeDef -> Ordering
$ccompare :: CompositeDef -> CompositeDef -> Ordering
$cp1Ord :: Eq CompositeDef
Ord)

-- | Used instead of FieldDef
-- to generate a smaller amount of code
type ForeignFieldDef = (HaskellName, DBName)

data ForeignDef = ForeignDef
    { ForeignDef -> HaskellName
foreignRefTableHaskell       :: !HaskellName
    , ForeignDef -> DBName
foreignRefTableDBName        :: !DBName
    , ForeignDef -> HaskellName
foreignConstraintNameHaskell :: !HaskellName
    , ForeignDef -> DBName
foreignConstraintNameDBName  :: !DBName
    , ForeignDef -> FieldCascade
foreignFieldCascade          :: !FieldCascade
    -- ^ Determine how the field will cascade on updates and deletions.
    --
    -- @since 2.11.0
    , ForeignDef -> [((HaskellName, DBName), (HaskellName, DBName))]
foreignFields                :: ![(ForeignFieldDef, ForeignFieldDef)] -- this entity plus the primary entity
    , ForeignDef -> [Text]
foreignAttrs                 :: ![Attr]
    , ForeignDef -> Bool
foreignNullable              :: Bool
    , ForeignDef -> Bool
foreignToPrimary             :: Bool
    -- ^ Determines if the reference is towards a Primary Key or not.
    --
    -- @since 2.11.0
    }
    deriving (Int -> ForeignDef -> ShowS
[ForeignDef] -> ShowS
ForeignDef -> String
(Int -> ForeignDef -> ShowS)
-> (ForeignDef -> String)
-> ([ForeignDef] -> ShowS)
-> Show ForeignDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForeignDef] -> ShowS
$cshowList :: [ForeignDef] -> ShowS
show :: ForeignDef -> String
$cshow :: ForeignDef -> String
showsPrec :: Int -> ForeignDef -> ShowS
$cshowsPrec :: Int -> ForeignDef -> ShowS
Show, ForeignDef -> ForeignDef -> Bool
(ForeignDef -> ForeignDef -> Bool)
-> (ForeignDef -> ForeignDef -> Bool) -> Eq ForeignDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForeignDef -> ForeignDef -> Bool
$c/= :: ForeignDef -> ForeignDef -> Bool
== :: ForeignDef -> ForeignDef -> Bool
$c== :: ForeignDef -> ForeignDef -> Bool
Eq, ReadPrec [ForeignDef]
ReadPrec ForeignDef
Int -> ReadS ForeignDef
ReadS [ForeignDef]
(Int -> ReadS ForeignDef)
-> ReadS [ForeignDef]
-> ReadPrec ForeignDef
-> ReadPrec [ForeignDef]
-> Read ForeignDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ForeignDef]
$creadListPrec :: ReadPrec [ForeignDef]
readPrec :: ReadPrec ForeignDef
$creadPrec :: ReadPrec ForeignDef
readList :: ReadS [ForeignDef]
$creadList :: ReadS [ForeignDef]
readsPrec :: Int -> ReadS ForeignDef
$creadsPrec :: Int -> ReadS ForeignDef
Read, Eq ForeignDef
Eq ForeignDef
-> (ForeignDef -> ForeignDef -> Ordering)
-> (ForeignDef -> ForeignDef -> Bool)
-> (ForeignDef -> ForeignDef -> Bool)
-> (ForeignDef -> ForeignDef -> Bool)
-> (ForeignDef -> ForeignDef -> Bool)
-> (ForeignDef -> ForeignDef -> ForeignDef)
-> (ForeignDef -> ForeignDef -> ForeignDef)
-> Ord ForeignDef
ForeignDef -> ForeignDef -> Bool
ForeignDef -> ForeignDef -> Ordering
ForeignDef -> ForeignDef -> ForeignDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ForeignDef -> ForeignDef -> ForeignDef
$cmin :: ForeignDef -> ForeignDef -> ForeignDef
max :: ForeignDef -> ForeignDef -> ForeignDef
$cmax :: ForeignDef -> ForeignDef -> ForeignDef
>= :: ForeignDef -> ForeignDef -> Bool
$c>= :: ForeignDef -> ForeignDef -> Bool
> :: ForeignDef -> ForeignDef -> Bool
$c> :: ForeignDef -> ForeignDef -> Bool
<= :: ForeignDef -> ForeignDef -> Bool
$c<= :: ForeignDef -> ForeignDef -> Bool
< :: ForeignDef -> ForeignDef -> Bool
$c< :: ForeignDef -> ForeignDef -> Bool
compare :: ForeignDef -> ForeignDef -> Ordering
$ccompare :: ForeignDef -> ForeignDef -> Ordering
$cp1Ord :: Eq ForeignDef
Ord)

-- | This datatype describes how a foreign reference field cascades deletes
-- or updates.
--
-- This type is used in both parsing the model definitions and performing
-- migrations. A 'Nothing' in either of the field values means that the
-- user has not specified a 'CascadeAction'. An unspecified 'CascadeAction'
-- is defaulted to 'Restrict' when doing migrations.
--
-- @since 2.11.0
data FieldCascade = FieldCascade
    { FieldCascade -> Maybe CascadeAction
fcOnUpdate :: !(Maybe CascadeAction)
    , FieldCascade -> Maybe CascadeAction
fcOnDelete :: !(Maybe CascadeAction)
    }
    deriving (Int -> FieldCascade -> ShowS
[FieldCascade] -> ShowS
FieldCascade -> String
(Int -> FieldCascade -> ShowS)
-> (FieldCascade -> String)
-> ([FieldCascade] -> ShowS)
-> Show FieldCascade
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldCascade] -> ShowS
$cshowList :: [FieldCascade] -> ShowS
show :: FieldCascade -> String
$cshow :: FieldCascade -> String
showsPrec :: Int -> FieldCascade -> ShowS
$cshowsPrec :: Int -> FieldCascade -> ShowS
Show, FieldCascade -> FieldCascade -> Bool
(FieldCascade -> FieldCascade -> Bool)
-> (FieldCascade -> FieldCascade -> Bool) -> Eq FieldCascade
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldCascade -> FieldCascade -> Bool
$c/= :: FieldCascade -> FieldCascade -> Bool
== :: FieldCascade -> FieldCascade -> Bool
$c== :: FieldCascade -> FieldCascade -> Bool
Eq, ReadPrec [FieldCascade]
ReadPrec FieldCascade
Int -> ReadS FieldCascade
ReadS [FieldCascade]
(Int -> ReadS FieldCascade)
-> ReadS [FieldCascade]
-> ReadPrec FieldCascade
-> ReadPrec [FieldCascade]
-> Read FieldCascade
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldCascade]
$creadListPrec :: ReadPrec [FieldCascade]
readPrec :: ReadPrec FieldCascade
$creadPrec :: ReadPrec FieldCascade
readList :: ReadS [FieldCascade]
$creadList :: ReadS [FieldCascade]
readsPrec :: Int -> ReadS FieldCascade
$creadsPrec :: Int -> ReadS FieldCascade
Read, Eq FieldCascade
Eq FieldCascade
-> (FieldCascade -> FieldCascade -> Ordering)
-> (FieldCascade -> FieldCascade -> Bool)
-> (FieldCascade -> FieldCascade -> Bool)
-> (FieldCascade -> FieldCascade -> Bool)
-> (FieldCascade -> FieldCascade -> Bool)
-> (FieldCascade -> FieldCascade -> FieldCascade)
-> (FieldCascade -> FieldCascade -> FieldCascade)
-> Ord FieldCascade
FieldCascade -> FieldCascade -> Bool
FieldCascade -> FieldCascade -> Ordering
FieldCascade -> FieldCascade -> FieldCascade
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldCascade -> FieldCascade -> FieldCascade
$cmin :: FieldCascade -> FieldCascade -> FieldCascade
max :: FieldCascade -> FieldCascade -> FieldCascade
$cmax :: FieldCascade -> FieldCascade -> FieldCascade
>= :: FieldCascade -> FieldCascade -> Bool
$c>= :: FieldCascade -> FieldCascade -> Bool
> :: FieldCascade -> FieldCascade -> Bool
$c> :: FieldCascade -> FieldCascade -> Bool
<= :: FieldCascade -> FieldCascade -> Bool
$c<= :: FieldCascade -> FieldCascade -> Bool
< :: FieldCascade -> FieldCascade -> Bool
$c< :: FieldCascade -> FieldCascade -> Bool
compare :: FieldCascade -> FieldCascade -> Ordering
$ccompare :: FieldCascade -> FieldCascade -> Ordering
$cp1Ord :: Eq FieldCascade
Ord)

-- | A 'FieldCascade' that does nothing.
--
-- @since 2.11.0
noCascade :: FieldCascade
noCascade :: FieldCascade
noCascade = Maybe CascadeAction -> Maybe CascadeAction -> FieldCascade
FieldCascade Maybe CascadeAction
forall a. Maybe a
Nothing Maybe CascadeAction
forall a. Maybe a
Nothing

-- | Renders a 'FieldCascade' value such that it can be used in SQL
-- migrations.
--
-- @since 2.11.0
renderFieldCascade :: FieldCascade -> Text
renderFieldCascade :: FieldCascade -> Text
renderFieldCascade (FieldCascade Maybe CascadeAction
onUpdate Maybe CascadeAction
onDelete) =
    [Text] -> Text
T.unwords
        [ (CascadeAction -> Text) -> Maybe CascadeAction -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
" ON DELETE " (Text -> Text) -> (CascadeAction -> Text) -> CascadeAction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CascadeAction -> Text
renderCascadeAction) Maybe CascadeAction
onDelete
        , (CascadeAction -> Text) -> Maybe CascadeAction -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
" ON UPDATE " (Text -> Text) -> (CascadeAction -> Text) -> CascadeAction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CascadeAction -> Text
renderCascadeAction) Maybe CascadeAction
onUpdate
        ]

-- | An action that might happen on a deletion or update on a foreign key
-- change.
--
-- @since 2.11.0
data CascadeAction = Cascade | Restrict | SetNull | SetDefault
    deriving (Int -> CascadeAction -> ShowS
[CascadeAction] -> ShowS
CascadeAction -> String
(Int -> CascadeAction -> ShowS)
-> (CascadeAction -> String)
-> ([CascadeAction] -> ShowS)
-> Show CascadeAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CascadeAction] -> ShowS
$cshowList :: [CascadeAction] -> ShowS
show :: CascadeAction -> String
$cshow :: CascadeAction -> String
showsPrec :: Int -> CascadeAction -> ShowS
$cshowsPrec :: Int -> CascadeAction -> ShowS
Show, CascadeAction -> CascadeAction -> Bool
(CascadeAction -> CascadeAction -> Bool)
-> (CascadeAction -> CascadeAction -> Bool) -> Eq CascadeAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CascadeAction -> CascadeAction -> Bool
$c/= :: CascadeAction -> CascadeAction -> Bool
== :: CascadeAction -> CascadeAction -> Bool
$c== :: CascadeAction -> CascadeAction -> Bool
Eq, ReadPrec [CascadeAction]
ReadPrec CascadeAction
Int -> ReadS CascadeAction
ReadS [CascadeAction]
(Int -> ReadS CascadeAction)
-> ReadS [CascadeAction]
-> ReadPrec CascadeAction
-> ReadPrec [CascadeAction]
-> Read CascadeAction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CascadeAction]
$creadListPrec :: ReadPrec [CascadeAction]
readPrec :: ReadPrec CascadeAction
$creadPrec :: ReadPrec CascadeAction
readList :: ReadS [CascadeAction]
$creadList :: ReadS [CascadeAction]
readsPrec :: Int -> ReadS CascadeAction
$creadsPrec :: Int -> ReadS CascadeAction
Read, Eq CascadeAction
Eq CascadeAction
-> (CascadeAction -> CascadeAction -> Ordering)
-> (CascadeAction -> CascadeAction -> Bool)
-> (CascadeAction -> CascadeAction -> Bool)
-> (CascadeAction -> CascadeAction -> Bool)
-> (CascadeAction -> CascadeAction -> Bool)
-> (CascadeAction -> CascadeAction -> CascadeAction)
-> (CascadeAction -> CascadeAction -> CascadeAction)
-> Ord CascadeAction
CascadeAction -> CascadeAction -> Bool
CascadeAction -> CascadeAction -> Ordering
CascadeAction -> CascadeAction -> CascadeAction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CascadeAction -> CascadeAction -> CascadeAction
$cmin :: CascadeAction -> CascadeAction -> CascadeAction
max :: CascadeAction -> CascadeAction -> CascadeAction
$cmax :: CascadeAction -> CascadeAction -> CascadeAction
>= :: CascadeAction -> CascadeAction -> Bool
$c>= :: CascadeAction -> CascadeAction -> Bool
> :: CascadeAction -> CascadeAction -> Bool
$c> :: CascadeAction -> CascadeAction -> Bool
<= :: CascadeAction -> CascadeAction -> Bool
$c<= :: CascadeAction -> CascadeAction -> Bool
< :: CascadeAction -> CascadeAction -> Bool
$c< :: CascadeAction -> CascadeAction -> Bool
compare :: CascadeAction -> CascadeAction -> Ordering
$ccompare :: CascadeAction -> CascadeAction -> Ordering
$cp1Ord :: Eq CascadeAction
Ord)

-- | Render a 'CascadeAction' to 'Text' such that it can be used in a SQL
-- command.
--
-- @since 2.11.0
renderCascadeAction :: CascadeAction -> Text
renderCascadeAction :: CascadeAction -> Text
renderCascadeAction CascadeAction
action = case CascadeAction
action of
  CascadeAction
Cascade    -> Text
"CASCADE"
  CascadeAction
Restrict   -> Text
"RESTRICT"
  CascadeAction
SetNull    -> Text
"SET NULL"
  CascadeAction
SetDefault -> Text
"SET DEFAULT"

data PersistException
  = PersistError Text -- ^ Generic Exception
  | PersistMarshalError Text
  | PersistInvalidField Text
  | PersistForeignConstraintUnmet Text
  | PersistMongoDBError Text
  | PersistMongoDBUnsupported Text
    deriving Int -> PersistException -> ShowS
[PersistException] -> ShowS
PersistException -> String
(Int -> PersistException -> ShowS)
-> (PersistException -> String)
-> ([PersistException] -> ShowS)
-> Show PersistException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistException] -> ShowS
$cshowList :: [PersistException] -> ShowS
show :: PersistException -> String
$cshow :: PersistException -> String
showsPrec :: Int -> PersistException -> ShowS
$cshowsPrec :: Int -> PersistException -> ShowS
Show

instance Exception PersistException
instance Error PersistException where
    strMsg :: String -> PersistException
strMsg = Text -> PersistException
PersistError (Text -> PersistException)
-> (String -> Text) -> String -> PersistException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

-- | A raw value which can be stored in any backend and can be marshalled to
-- and from a 'PersistField'.
data PersistValue
    = PersistText Text
    | PersistByteString ByteString
    | PersistInt64 Int64
    | PersistDouble Double
    | PersistRational Rational
    | PersistBool Bool
    | PersistDay Day
    | PersistTimeOfDay TimeOfDay
    | PersistUTCTime UTCTime
    | PersistNull
    | PersistList [PersistValue]
    | PersistMap [(Text, PersistValue)]
    | PersistObjectId ByteString -- ^ Intended especially for MongoDB backend
    | PersistArray [PersistValue] -- ^ Intended especially for PostgreSQL backend for text arrays
    | PersistLiteral ByteString -- ^ Using 'PersistLiteral' allows you to use types or keywords specific to a particular backend.
    | PersistLiteralEscaped ByteString -- ^ Similar to 'PersistLiteral', but escapes the @ByteString@.
    | PersistDbSpecific ByteString -- ^ Using 'PersistDbSpecific' allows you to use types specific to a particular backend.
-- For example, below is a simple example of the PostGIS geography type:
--
-- @
-- data Geo = Geo ByteString
--
-- instance PersistField Geo where
--   toPersistValue (Geo t) = PersistDbSpecific t
--
--   fromPersistValue (PersistDbSpecific t) = Right $ Geo $ Data.ByteString.concat ["'", t, "'"]
--   fromPersistValue _ = Left "Geo values must be converted from PersistDbSpecific"
--
-- instance PersistFieldSql Geo where
--   sqlType _ = SqlOther "GEOGRAPHY(POINT,4326)"
--
-- toPoint :: Double -> Double -> Geo
-- toPoint lat lon = Geo $ Data.ByteString.concat ["'POINT(", ps $ lon, " ", ps $ lat, ")'"]
--   where ps = Data.Text.pack . show
-- @
--
-- If Foo has a geography field, we can then perform insertions like the following:
--
-- @
-- insert $ Foo (toPoint 44 44)
-- @
--
    deriving (Int -> PersistValue -> ShowS
[PersistValue] -> ShowS
PersistValue -> String
(Int -> PersistValue -> ShowS)
-> (PersistValue -> String)
-> ([PersistValue] -> ShowS)
-> Show PersistValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistValue] -> ShowS
$cshowList :: [PersistValue] -> ShowS
show :: PersistValue -> String
$cshow :: PersistValue -> String
showsPrec :: Int -> PersistValue -> ShowS
$cshowsPrec :: Int -> PersistValue -> ShowS
Show, ReadPrec [PersistValue]
ReadPrec PersistValue
Int -> ReadS PersistValue
ReadS [PersistValue]
(Int -> ReadS PersistValue)
-> ReadS [PersistValue]
-> ReadPrec PersistValue
-> ReadPrec [PersistValue]
-> Read PersistValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PersistValue]
$creadListPrec :: ReadPrec [PersistValue]
readPrec :: ReadPrec PersistValue
$creadPrec :: ReadPrec PersistValue
readList :: ReadS [PersistValue]
$creadList :: ReadS [PersistValue]
readsPrec :: Int -> ReadS PersistValue
$creadsPrec :: Int -> ReadS PersistValue
Read, PersistValue -> PersistValue -> Bool
(PersistValue -> PersistValue -> Bool)
-> (PersistValue -> PersistValue -> Bool) -> Eq PersistValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersistValue -> PersistValue -> Bool
$c/= :: PersistValue -> PersistValue -> Bool
== :: PersistValue -> PersistValue -> Bool
$c== :: PersistValue -> PersistValue -> Bool
Eq, Eq PersistValue
Eq PersistValue
-> (PersistValue -> PersistValue -> Ordering)
-> (PersistValue -> PersistValue -> Bool)
-> (PersistValue -> PersistValue -> Bool)
-> (PersistValue -> PersistValue -> Bool)
-> (PersistValue -> PersistValue -> Bool)
-> (PersistValue -> PersistValue -> PersistValue)
-> (PersistValue -> PersistValue -> PersistValue)
-> Ord PersistValue
PersistValue -> PersistValue -> Bool
PersistValue -> PersistValue -> Ordering
PersistValue -> PersistValue -> PersistValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PersistValue -> PersistValue -> PersistValue
$cmin :: PersistValue -> PersistValue -> PersistValue
max :: PersistValue -> PersistValue -> PersistValue
$cmax :: PersistValue -> PersistValue -> PersistValue
>= :: PersistValue -> PersistValue -> Bool
$c>= :: PersistValue -> PersistValue -> Bool
> :: PersistValue -> PersistValue -> Bool
$c> :: PersistValue -> PersistValue -> Bool
<= :: PersistValue -> PersistValue -> Bool
$c<= :: PersistValue -> PersistValue -> Bool
< :: PersistValue -> PersistValue -> Bool
$c< :: PersistValue -> PersistValue -> Bool
compare :: PersistValue -> PersistValue -> Ordering
$ccompare :: PersistValue -> PersistValue -> Ordering
$cp1Ord :: Eq PersistValue
Ord)

{-# DEPRECATED PersistDbSpecific "Deprecated since 2.11 because of inconsistent escaping behavior across backends. The Postgres backend escapes these values, while the MySQL backend does not. If you are using this, please switch to 'PersistLiteral' or 'PersistLiteralEscaped' based on your needs." #-}

instance ToHttpApiData PersistValue where
    toUrlPiece :: PersistValue -> Text
toUrlPiece PersistValue
val =
        case PersistValue -> Either Text Text
fromPersistValueText PersistValue
val of
            Left  Text
e -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
e
            Right Text
y -> Text
y

instance FromHttpApiData PersistValue where
    parseUrlPiece :: Text -> Either Text PersistValue
parseUrlPiece Text
input =
          Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue)
-> Either Text Int64 -> Either Text PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Int64
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece Text
input
      Either Text PersistValue
-> Either Text PersistValue -> Either Text PersistValue
forall a b. Either a b -> Either a b -> Either a b
<!> [PersistValue] -> PersistValue
PersistList  ([PersistValue] -> PersistValue)
-> Either Text [PersistValue] -> Either Text PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text [PersistValue]
forall a. Read a => Text -> Either Text a
readTextData Text
input
      Either Text PersistValue
-> Either Text PersistValue -> Either Text PersistValue
forall a b. Either a b -> Either a b -> Either a b
<!> Text -> PersistValue
PersistText  (Text -> PersistValue)
-> Either Text Text -> Either Text PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
input
      where
        infixl 3 <!>
        Left a
_ <!> :: Either a b -> Either a b -> Either a b
<!> Either a b
y = Either a b
y
        Either a b
x      <!> Either a b
_ = Either a b
x

instance PathPiece PersistValue where
  toPathPiece :: PersistValue -> Text
toPathPiece   = PersistValue -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece
  fromPathPiece :: Text -> Maybe PersistValue
fromPathPiece = Text -> Maybe PersistValue
forall a. FromHttpApiData a => Text -> Maybe a
parseUrlPieceMaybe

fromPersistValueText :: PersistValue -> Either Text Text
fromPersistValueText :: PersistValue -> Either Text Text
fromPersistValueText (PersistText Text
s) = Text -> Either Text Text
forall a b. b -> Either a b
Right Text
s
fromPersistValueText (PersistByteString ByteString
bs) =
    Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
lenientDecode ByteString
bs
fromPersistValueText (PersistInt64 Int64
i) = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> String
forall a. Show a => a -> String
show Int64
i
fromPersistValueText (PersistDouble Double
d) = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
d
fromPersistValueText (PersistRational Rational
r) = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Rational -> String
forall a. Show a => a -> String
show Rational
r
fromPersistValueText (PersistDay Day
d) = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Day -> String
forall a. Show a => a -> String
show Day
d
fromPersistValueText (PersistTimeOfDay TimeOfDay
d) = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
d
fromPersistValueText (PersistUTCTime UTCTime
d) = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
forall a. Show a => a -> String
show UTCTime
d
fromPersistValueText PersistValue
PersistNull = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"Unexpected null"
fromPersistValueText (PersistBool Bool
b) = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
b
fromPersistValueText (PersistList [PersistValue]
_) = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"Cannot convert PersistList to Text"
fromPersistValueText (PersistMap [(Text, PersistValue)]
_) = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"Cannot convert PersistMap to Text"
fromPersistValueText (PersistObjectId ByteString
_) = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"Cannot convert PersistObjectId to Text"
fromPersistValueText (PersistArray [PersistValue]
_) = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"Cannot convert PersistArray to Text"
fromPersistValueText (PersistDbSpecific ByteString
_) = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"Cannot convert PersistDbSpecific to Text"
fromPersistValueText (PersistLiteral ByteString
_) = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"Cannot convert PersistLiteral to Text"
fromPersistValueText (PersistLiteralEscaped ByteString
_) = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"Cannot convert PersistLiteralEscaped to Text"

instance A.ToJSON PersistValue where
    toJSON :: PersistValue -> Value
toJSON (PersistText Text
t) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
's' Text
t
    toJSON (PersistByteString ByteString
b) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
'b' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
b
    toJSON (PersistInt64 Int64
i) = Scientific -> Value
A.Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Int64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
    toJSON (PersistDouble Double
d) = Scientific -> Value
A.Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
Data.Scientific.fromFloatDigits Double
d
    toJSON (PersistRational Rational
r) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
'r' Char -> ShowS
forall a. a -> [a] -> [a]
: Rational -> String
forall a. Show a => a -> String
show Rational
r
    toJSON (PersistBool Bool
b) = Bool -> Value
A.Bool Bool
b
    toJSON (PersistTimeOfDay TimeOfDay
t) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
't' Char -> ShowS
forall a. a -> [a] -> [a]
: TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
t
    toJSON (PersistUTCTime UTCTime
u) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
'u' Char -> ShowS
forall a. a -> [a] -> [a]
: UTCTime -> String
forall a. Show a => a -> String
show UTCTime
u
    toJSON (PersistDay Day
d) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
'd' Char -> ShowS
forall a. a -> [a] -> [a]
: Day -> String
forall a. Show a => a -> String
show Day
d
    toJSON PersistValue
PersistNull = Value
A.Null
    toJSON (PersistList [PersistValue]
l) = Array -> Value
A.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ (PersistValue -> Value) -> [PersistValue] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> Value
forall a. ToJSON a => a -> Value
A.toJSON [PersistValue]
l
    toJSON (PersistMap [(Text, PersistValue)]
m) = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ((Text, PersistValue) -> Pair) -> [(Text, PersistValue)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ((PersistValue -> Value) -> (Text, PersistValue) -> Pair
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second PersistValue -> Value
forall a. ToJSON a => a -> Value
A.toJSON) [(Text, PersistValue)]
m
    toJSON (PersistDbSpecific ByteString
b) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
'p' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
b
    toJSON (PersistLiteral ByteString
b) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
'l' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
b
    toJSON (PersistLiteralEscaped ByteString
b) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
'e' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
b
    toJSON (PersistArray [PersistValue]
a) = Array -> Value
A.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ (PersistValue -> Value) -> [PersistValue] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> Value
forall a. ToJSON a => a -> Value
A.toJSON [PersistValue]
a
    toJSON (PersistObjectId ByteString
o) =
      String -> Value
forall a. ToJSON a => a -> Value
A.toJSON (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Char -> ShowS
showChar Char
'o' ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> ShowS
forall n. (Show n, Integral n) => Int -> n -> ShowS
showHexLen Int
8 (ByteString -> Integer
bs2i ByteString
four) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> ShowS
forall n. (Show n, Integral n) => Int -> n -> ShowS
showHexLen Int
16 (ByteString -> Integer
bs2i ByteString
eight) String
""
        where
         (ByteString
four, ByteString
eight) = Int -> ByteString -> (ByteString, ByteString)
BS8.splitAt Int
4 ByteString
o

         -- taken from crypto-api
         bs2i :: ByteString -> Integer
         bs2i :: ByteString -> Integer
bs2i ByteString
bs = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' (\Integer
i Word8
b -> (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Integer
0 ByteString
bs
         {-# INLINE bs2i #-}

         -- showHex of n padded with leading zeros if necessary to fill d digits
         -- taken from Data.BSON
         showHexLen :: (Show n, Integral n) => Int -> n -> ShowS
         showHexLen :: Int -> n -> ShowS
showHexLen Int
d n
n = String -> ShowS
showString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- n -> Int
forall a p. (Integral p, Integral a) => a -> p
sigDigits n
n) Char
'0') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex n
n  where
             sigDigits :: a -> p
sigDigits a
0 = p
1
             sigDigits a
n' = Double -> p
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Double
16 :: Double) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n') p -> p -> p
forall a. Num a => a -> a -> a
+ p
1

instance A.FromJSON PersistValue where
    parseJSON :: Value -> Parser PersistValue
parseJSON (A.String Text
t0) =
        case Text -> Maybe (Char, Text)
T.uncons Text
t0 of
            Maybe (Char, Text)
Nothing -> String -> Parser PersistValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Null string"
            Just (Char
'p', Text
t) -> (String -> Parser PersistValue)
-> (ByteString -> Parser PersistValue)
-> Either String ByteString
-> Parser PersistValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
_ -> String -> Parser PersistValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid base64") (PersistValue -> Parser PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> Parser PersistValue)
-> (ByteString -> PersistValue)
-> ByteString
-> Parser PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PersistValue
PersistDbSpecific)
                           (Either String ByteString -> Parser PersistValue)
-> Either String ByteString -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t
            Just (Char
'l', Text
t) -> (String -> Parser PersistValue)
-> (ByteString -> Parser PersistValue)
-> Either String ByteString
-> Parser PersistValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
_ -> String -> Parser PersistValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid base64") (PersistValue -> Parser PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> Parser PersistValue)
-> (ByteString -> PersistValue)
-> ByteString
-> Parser PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PersistValue
PersistLiteral)
                           (Either String ByteString -> Parser PersistValue)
-> Either String ByteString -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t
            Just (Char
'e', Text
t) -> (String -> Parser PersistValue)
-> (ByteString -> Parser PersistValue)
-> Either String ByteString
-> Parser PersistValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
_ -> String -> Parser PersistValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid base64") (PersistValue -> Parser PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> Parser PersistValue)
-> (ByteString -> PersistValue)
-> ByteString
-> Parser PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PersistValue
PersistLiteralEscaped)
                           (Either String ByteString -> Parser PersistValue)
-> Either String ByteString -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t
            Just (Char
's', Text
t) -> PersistValue -> Parser PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> Parser PersistValue)
-> PersistValue -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> PersistValue
PersistText Text
t
            Just (Char
'b', Text
t) -> (String -> Parser PersistValue)
-> (ByteString -> Parser PersistValue)
-> Either String ByteString
-> Parser PersistValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
_ -> String -> Parser PersistValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid base64") (PersistValue -> Parser PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> Parser PersistValue)
-> (ByteString -> PersistValue)
-> ByteString
-> Parser PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PersistValue
PersistByteString)
                           (Either String ByteString -> Parser PersistValue)
-> Either String ByteString -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
t
            Just (Char
't', Text
t) -> (TimeOfDay -> PersistValue)
-> Parser TimeOfDay -> Parser PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TimeOfDay -> PersistValue
PersistTimeOfDay (Parser TimeOfDay -> Parser PersistValue)
-> Parser TimeOfDay -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> Parser TimeOfDay
forall a (m :: * -> *). (Read a, MonadFail m) => Text -> m a
readMay Text
t
            Just (Char
'u', Text
t) -> (UTCTime -> PersistValue) -> Parser UTCTime -> Parser PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> PersistValue
PersistUTCTime (Parser UTCTime -> Parser PersistValue)
-> Parser UTCTime -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> Parser UTCTime
forall a (m :: * -> *). (Read a, MonadFail m) => Text -> m a
readMay Text
t
            Just (Char
'd', Text
t) -> (Day -> PersistValue) -> Parser Day -> Parser PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Day -> PersistValue
PersistDay (Parser Day -> Parser PersistValue)
-> Parser Day -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> Parser Day
forall a (m :: * -> *). (Read a, MonadFail m) => Text -> m a
readMay Text
t
            Just (Char
'r', Text
t) -> (Rational -> PersistValue)
-> Parser Rational -> Parser PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> PersistValue
PersistRational (Parser Rational -> Parser PersistValue)
-> Parser Rational -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> Parser Rational
forall a (m :: * -> *). (Read a, MonadFail m) => Text -> m a
readMay Text
t
            Just (Char
'o', Text
t) -> Parser PersistValue
-> (ByteString -> Parser PersistValue)
-> Maybe ByteString
-> Parser PersistValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser PersistValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid base64") (PersistValue -> Parser PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> Parser PersistValue)
-> (ByteString -> PersistValue)
-> ByteString
-> Parser PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PersistValue
PersistObjectId) (Maybe ByteString -> Parser PersistValue)
-> Maybe ByteString -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$
                              ((Integer, String) -> ByteString)
-> Maybe (Integer, String) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Integer -> ByteString
i2bs (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12) (Integer -> ByteString)
-> ((Integer, String) -> Integer)
-> (Integer, String)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, String) -> Integer
forall a b. (a, b) -> a
fst) (Maybe (Integer, String) -> Maybe ByteString)
-> Maybe (Integer, String) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ [(Integer, String)] -> Maybe (Integer, String)
forall a. [a] -> Maybe a
headMay ([(Integer, String)] -> Maybe (Integer, String))
-> [(Integer, String)] -> Maybe (Integer, String)
forall a b. (a -> b) -> a -> b
$ ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex ReadS Integer -> ReadS Integer
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
            Just (Char
c, Text
_) -> String -> Parser PersistValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser PersistValue) -> String -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ String
"Unknown prefix: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c]
      where
        headMay :: [a] -> Maybe a
headMay []    = Maybe a
forall a. Maybe a
Nothing
        headMay (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
        readMay :: Text -> m a
readMay Text
t =
            case ReadS a
forall a. Read a => ReadS a
reads ReadS a -> ReadS a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t of
                (a
x, String
_):[(a, String)]
_ -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
                [] -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not read"

        -- taken from crypto-api
        -- |@i2bs bitLen i@ converts @i@ to a 'ByteString' of @bitLen@ bits (must be a multiple of 8).
        i2bs :: Int -> Integer -> BS.ByteString
        i2bs :: Int -> Integer -> ByteString
i2bs Int
l Integer
i = (Int -> Maybe (Word8, Int)) -> Int -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
BS.unfoldr (\Int
l' -> if Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Maybe (Word8, Int)
forall a. Maybe a
Nothing else (Word8, Int) -> Maybe (Word8, Int)
forall a. a -> Maybe a
Just (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
l'), Int
l' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8)
        {-# INLINE i2bs #-}


    parseJSON (A.Number Scientific
n) = PersistValue -> Parser PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> Parser PersistValue)
-> PersistValue -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$
        if Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Scientific -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
n) Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
n
            then Int64 -> PersistValue
PersistInt64 (Int64 -> PersistValue) -> Int64 -> PersistValue
forall a b. (a -> b) -> a -> b
$ Scientific -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
n
            else Double -> PersistValue
PersistDouble (Double -> PersistValue) -> Double -> PersistValue
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Scientific -> Rational
forall a. Real a => a -> Rational
toRational Scientific
n
    parseJSON (A.Bool Bool
b) = PersistValue -> Parser PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> Parser PersistValue)
-> PersistValue -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ Bool -> PersistValue
PersistBool Bool
b
    parseJSON Value
A.Null = PersistValue -> Parser PersistValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistValue -> Parser PersistValue)
-> PersistValue -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ PersistValue
PersistNull
    parseJSON (A.Array Array
a) = ([PersistValue] -> PersistValue)
-> Parser [PersistValue] -> Parser PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PersistValue] -> PersistValue
PersistList ((Value -> Parser PersistValue) -> [Value] -> Parser [PersistValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser PersistValue
forall a. FromJSON a => Value -> Parser a
A.parseJSON ([Value] -> Parser [PersistValue])
-> [Value] -> Parser [PersistValue]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a)
    parseJSON (A.Object Object
o) =
        ([(Text, PersistValue)] -> PersistValue)
-> Parser [(Text, PersistValue)] -> Parser PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, PersistValue)] -> PersistValue
PersistMap (Parser [(Text, PersistValue)] -> Parser PersistValue)
-> Parser [(Text, PersistValue)] -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ (Pair -> Parser (Text, PersistValue))
-> [Pair] -> Parser [(Text, PersistValue)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pair -> Parser (Text, PersistValue)
forall b a. FromJSON b => (a, Value) -> Parser (a, b)
go ([Pair] -> Parser [(Text, PersistValue)])
-> [Pair] -> Parser [(Text, PersistValue)]
forall a b. (a -> b) -> a -> b
$ Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
o
      where
        go :: (a, Value) -> Parser (a, b)
go (a
k, Value
v) = (b -> (a, b)) -> Parser b -> Parser (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) a
k) (Parser b -> Parser (a, b)) -> Parser b -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ Value -> Parser b
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v

-- | A SQL data type. Naming attempts to reflect the underlying Haskell
-- datatypes, eg SqlString instead of SqlVarchar. Different SQL databases may
-- have different translations for these types.
data SqlType = SqlString
             | SqlInt32
             | SqlInt64
             | SqlReal
             | SqlNumeric Word32 Word32
             | SqlBool
             | SqlDay
             | SqlTime
             | SqlDayTime -- ^ Always uses UTC timezone
             | SqlBlob
             | SqlOther T.Text -- ^ a backend-specific name
    deriving (Int -> SqlType -> ShowS
[SqlType] -> ShowS
SqlType -> String
(Int -> SqlType -> ShowS)
-> (SqlType -> String) -> ([SqlType] -> ShowS) -> Show SqlType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqlType] -> ShowS
$cshowList :: [SqlType] -> ShowS
show :: SqlType -> String
$cshow :: SqlType -> String
showsPrec :: Int -> SqlType -> ShowS
$cshowsPrec :: Int -> SqlType -> ShowS
Show, ReadPrec [SqlType]
ReadPrec SqlType
Int -> ReadS SqlType
ReadS [SqlType]
(Int -> ReadS SqlType)
-> ReadS [SqlType]
-> ReadPrec SqlType
-> ReadPrec [SqlType]
-> Read SqlType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SqlType]
$creadListPrec :: ReadPrec [SqlType]
readPrec :: ReadPrec SqlType
$creadPrec :: ReadPrec SqlType
readList :: ReadS [SqlType]
$creadList :: ReadS [SqlType]
readsPrec :: Int -> ReadS SqlType
$creadsPrec :: Int -> ReadS SqlType
Read, SqlType -> SqlType -> Bool
(SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool) -> Eq SqlType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqlType -> SqlType -> Bool
$c/= :: SqlType -> SqlType -> Bool
== :: SqlType -> SqlType -> Bool
$c== :: SqlType -> SqlType -> Bool
Eq, Eq SqlType
Eq SqlType
-> (SqlType -> SqlType -> Ordering)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> SqlType)
-> (SqlType -> SqlType -> SqlType)
-> Ord SqlType
SqlType -> SqlType -> Bool
SqlType -> SqlType -> Ordering
SqlType -> SqlType -> SqlType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SqlType -> SqlType -> SqlType
$cmin :: SqlType -> SqlType -> SqlType
max :: SqlType -> SqlType -> SqlType
$cmax :: SqlType -> SqlType -> SqlType
>= :: SqlType -> SqlType -> Bool
$c>= :: SqlType -> SqlType -> Bool
> :: SqlType -> SqlType -> Bool
$c> :: SqlType -> SqlType -> Bool
<= :: SqlType -> SqlType -> Bool
$c<= :: SqlType -> SqlType -> Bool
< :: SqlType -> SqlType -> Bool
$c< :: SqlType -> SqlType -> Bool
compare :: SqlType -> SqlType -> Ordering
$ccompare :: SqlType -> SqlType -> Ordering
$cp1Ord :: Eq SqlType
Ord)

data PersistFilter = Eq | Ne | Gt | Lt | Ge | Le | In | NotIn
                   | BackendSpecificFilter T.Text
    deriving (ReadPrec [PersistFilter]
ReadPrec PersistFilter
Int -> ReadS PersistFilter
ReadS [PersistFilter]
(Int -> ReadS PersistFilter)
-> ReadS [PersistFilter]
-> ReadPrec PersistFilter
-> ReadPrec [PersistFilter]
-> Read PersistFilter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PersistFilter]
$creadListPrec :: ReadPrec [PersistFilter]
readPrec :: ReadPrec PersistFilter
$creadPrec :: ReadPrec PersistFilter
readList :: ReadS [PersistFilter]
$creadList :: ReadS [PersistFilter]
readsPrec :: Int -> ReadS PersistFilter
$creadsPrec :: Int -> ReadS PersistFilter
Read, Int -> PersistFilter -> ShowS
[PersistFilter] -> ShowS
PersistFilter -> String
(Int -> PersistFilter -> ShowS)
-> (PersistFilter -> String)
-> ([PersistFilter] -> ShowS)
-> Show PersistFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistFilter] -> ShowS
$cshowList :: [PersistFilter] -> ShowS
show :: PersistFilter -> String
$cshow :: PersistFilter -> String
showsPrec :: Int -> PersistFilter -> ShowS
$cshowsPrec :: Int -> PersistFilter -> ShowS
Show)

data UpdateException = KeyNotFound String
                     | UpsertError String
instance Show UpdateException where
    show :: UpdateException -> String
show (KeyNotFound String
key) = String
"Key not found during updateGet: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key
    show (UpsertError String
msg) = String
"Error during upsert: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
instance Exception UpdateException

data OnlyUniqueException = OnlyUniqueException String
instance Show OnlyUniqueException where
    show :: OnlyUniqueException -> String
show (OnlyUniqueException String
uniqueMsg) =
      String
"Expected only one unique key, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
uniqueMsg
instance Exception OnlyUniqueException


data PersistUpdate = Assign | Add | Subtract | Multiply | Divide
                   | BackendSpecificUpdate T.Text
    deriving (ReadPrec [PersistUpdate]
ReadPrec PersistUpdate
Int -> ReadS PersistUpdate
ReadS [PersistUpdate]
(Int -> ReadS PersistUpdate)
-> ReadS [PersistUpdate]
-> ReadPrec PersistUpdate
-> ReadPrec [PersistUpdate]
-> Read PersistUpdate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PersistUpdate]
$creadListPrec :: ReadPrec [PersistUpdate]
readPrec :: ReadPrec PersistUpdate
$creadPrec :: ReadPrec PersistUpdate
readList :: ReadS [PersistUpdate]
$creadList :: ReadS [PersistUpdate]
readsPrec :: Int -> ReadS PersistUpdate
$creadsPrec :: Int -> ReadS PersistUpdate
Read, Int -> PersistUpdate -> ShowS
[PersistUpdate] -> ShowS
PersistUpdate -> String
(Int -> PersistUpdate -> ShowS)
-> (PersistUpdate -> String)
-> ([PersistUpdate] -> ShowS)
-> Show PersistUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistUpdate] -> ShowS
$cshowList :: [PersistUpdate] -> ShowS
show :: PersistUpdate -> String
$cshow :: PersistUpdate -> String
showsPrec :: Int -> PersistUpdate -> ShowS
$cshowsPrec :: Int -> PersistUpdate -> ShowS
Show)