{-# LANGUAGE DeriveDataTypeable #-}
{-# 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 qualified Data.HashMap.Strict as HM
import Data.Int (Int64)
import Data.Map (Map)
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 Data.Typeable (Typeable)
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)

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

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 inormation 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 -> [Text]
fieldAttrs     :: ![Attr]
    -- ^ 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 -> 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
    }
    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)


-- | 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 -> [((HaskellName, DBName), (HaskellName, DBName))]
foreignFields                :: ![(ForeignFieldDef, ForeignFieldDef)] -- this entity plus the primary entity
    , ForeignDef -> [Text]
foreignAttrs                 :: ![Attr]
    , ForeignDef -> Bool
foreignNullable              :: Bool
    }
    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)

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, Typeable)

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
                  | 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, Typeable, 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)


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. See the documentation of PersistDbSpecific for an example of using a custom database type with Persistent."

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 (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
'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, Typeable, 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
    deriving Typeable
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 deriving Typeable
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)