{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Database.Groundhog.Instances (Selector (..)) where

import qualified Data.Aeson as A
import Data.Bits (finiteBitSize)
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString, unpack)
import qualified Data.ByteString.Lazy.Char8 as Lazy
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Kind (Type)
import Data.Maybe (fromMaybe)
import qualified Data.Scientific
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import qualified Data.Text.Lazy as TL
import Data.Time (Day, TimeOfDay, UTCTime)
import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
import Data.Word (Word16, Word32, Word64, Word8)
import Database.Groundhog.Core
import Database.Groundhog.Generic (getUniqueFields, primFromPersistValue, primFromPurePersistValues, primFromSinglePersistValue, primToPersistValue, primToPurePersistValues, primToSinglePersistValue)

instance (PersistField a', PersistField b') => Embedded (a', b') where
  data Selector (a', b') constr where
    Tuple2_0Selector :: Selector (a, b) a
    Tuple2_1Selector :: Selector (a, b) b
  selectorNum :: Selector (a', b') a -> Int
selectorNum Selector (a', b') a
Tuple2_0Selector = Int
0
  selectorNum Selector (a', b') a
Tuple2_1Selector = Int
1

instance (PersistField a', PersistField b', PersistField c') => Embedded (a', b', c') where
  data Selector (a', b', c') constr where
    Tuple3_0Selector :: Selector (a, b, c) a
    Tuple3_1Selector :: Selector (a, b, c) b
    Tuple3_2Selector :: Selector (a, b, c) c
  selectorNum :: Selector (a', b', c') a -> Int
selectorNum Selector (a', b', c') a
Tuple3_0Selector = Int
0
  selectorNum Selector (a', b', c') a
Tuple3_1Selector = Int
1
  selectorNum Selector (a', b', c') a
Tuple3_2Selector = Int
2

instance (PersistField a', PersistField b', PersistField c', PersistField d') => Embedded (a', b', c', d') where
  data Selector (a', b', c', d') constr where
    Tuple4_0Selector :: Selector (a, b, c, d) a
    Tuple4_1Selector :: Selector (a, b, c, d) b
    Tuple4_2Selector :: Selector (a, b, c, d) c
    Tuple4_3Selector :: Selector (a, b, c, d) d
  selectorNum :: Selector (a', b', c', d') a -> Int
selectorNum Selector (a', b', c', d') a
Tuple4_0Selector = Int
0
  selectorNum Selector (a', b', c', d') a
Tuple4_1Selector = Int
1
  selectorNum Selector (a', b', c', d') a
Tuple4_2Selector = Int
2
  selectorNum Selector (a', b', c', d') a
Tuple4_3Selector = Int
3

instance (PersistField a', PersistField b', PersistField c', PersistField d', PersistField e') => Embedded (a', b', c', d', e') where
  data Selector (a', b', c', d', e') constr where
    Tuple5_0Selector :: Selector (a, b, c, d, e) a
    Tuple5_1Selector :: Selector (a, b, c, d, e) b
    Tuple5_2Selector :: Selector (a, b, c, d, e) c
    Tuple5_3Selector :: Selector (a, b, c, d, e) d
    Tuple5_4Selector :: Selector (a, b, c, d, e) e
  selectorNum :: Selector (a', b', c', d', e') a -> Int
selectorNum Selector (a', b', c', d', e') a
Tuple5_0Selector = Int
0
  selectorNum Selector (a', b', c', d', e') a
Tuple5_1Selector = Int
1
  selectorNum Selector (a', b', c', d', e') a
Tuple5_2Selector = Int
2
  selectorNum Selector (a', b', c', d', e') a
Tuple5_3Selector = Int
3
  selectorNum Selector (a', b', c', d', e') a
Tuple5_4Selector = Int
4

instance PurePersistField () where
  toPurePersistValues :: () -> [PersistValue] -> [PersistValue]
toPurePersistValues ()
_ = [PersistValue] -> [PersistValue]
forall a. a -> a
id
  fromPurePersistValues :: [PersistValue] -> ((), [PersistValue])
fromPurePersistValues [PersistValue]
xs = ((), [PersistValue]
xs)

instance (PurePersistField a, PurePersistField b) => PurePersistField (a, b) where
  toPurePersistValues :: (a, b) -> [PersistValue] -> [PersistValue]
toPurePersistValues (a
a, b
b) = a -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues a
a ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues b
b
  fromPurePersistValues :: [PersistValue] -> ((a, b), [PersistValue])
fromPurePersistValues [PersistValue]
xs =
    let (a
a, [PersistValue]
rest0) = [PersistValue] -> (a, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
xs
        (b
b, [PersistValue]
rest1) = [PersistValue] -> (b, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
rest0
     in ((a
a, b
b), [PersistValue]
rest1)

instance (PurePersistField a, PurePersistField b, PurePersistField c) => PurePersistField (a, b, c) where
  toPurePersistValues :: (a, b, c) -> [PersistValue] -> [PersistValue]
toPurePersistValues (a
a, b
b, c
c) = a -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues a
a ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues b
b ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues c
c
  fromPurePersistValues :: [PersistValue] -> ((a, b, c), [PersistValue])
fromPurePersistValues [PersistValue]
xs =
    let (a
a, [PersistValue]
rest0) = [PersistValue] -> (a, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
xs
        (b
b, [PersistValue]
rest1) = [PersistValue] -> (b, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
rest0
        (c
c, [PersistValue]
rest2) = [PersistValue] -> (c, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
rest1
     in ((a
a, b
b, c
c), [PersistValue]
rest2)

instance (PurePersistField a, PurePersistField b, PurePersistField c, PurePersistField d) => PurePersistField (a, b, c, d) where
  toPurePersistValues :: (a, b, c, d) -> [PersistValue] -> [PersistValue]
toPurePersistValues (a
a, b
b, c
c, d
d) = a -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues a
a ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues b
b ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues c
c ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues d
d
  fromPurePersistValues :: [PersistValue] -> ((a, b, c, d), [PersistValue])
fromPurePersistValues [PersistValue]
xs =
    let (a
a, [PersistValue]
rest0) = [PersistValue] -> (a, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
xs
        (b
b, [PersistValue]
rest1) = [PersistValue] -> (b, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
rest0
        (c
c, [PersistValue]
rest2) = [PersistValue] -> (c, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
rest1
        (d
d, [PersistValue]
rest3) = [PersistValue] -> (d, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
rest2
     in ((a
a, b
b, c
c, d
d), [PersistValue]
rest3)

instance (PurePersistField a, PurePersistField b, PurePersistField c, PurePersistField d, PurePersistField e) => PurePersistField (a, b, c, d, e) where
  toPurePersistValues :: (a, b, c, d, e) -> [PersistValue] -> [PersistValue]
toPurePersistValues (a
a, b
b, c
c, d
d, e
e) = a -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues a
a ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues b
b ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues c
c ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues d
d ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues e
e
  fromPurePersistValues :: [PersistValue] -> ((a, b, c, d, e), [PersistValue])
fromPurePersistValues [PersistValue]
xs =
    let (a
a, [PersistValue]
rest0) = [PersistValue] -> (a, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
xs
        (b
b, [PersistValue]
rest1) = [PersistValue] -> (b, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
rest0
        (c
c, [PersistValue]
rest2) = [PersistValue] -> (c, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
rest1
        (d
d, [PersistValue]
rest3) = [PersistValue] -> (d, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
rest2
        (e
e, [PersistValue]
rest4) = [PersistValue] -> (e, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
rest3
     in ((a
a, b
b, c
c, d
d, e
e), [PersistValue]
rest4)

instance PrimitivePersistField String where
  toPrimitivePersistValue :: String -> PersistValue
toPrimitivePersistValue String
s = Text -> PersistValue
PersistText (String -> Text
T.pack String
s)
  fromPrimitivePersistValue :: PersistValue -> String
fromPrimitivePersistValue (PersistString String
s) = String
s
  fromPrimitivePersistValue (PersistText Text
s) = Text -> String
T.unpack Text
s
  fromPrimitivePersistValue (PersistByteString ByteString
bs) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode ByteString
bs
  fromPrimitivePersistValue (PersistInt64 Int64
i) = Int64 -> String
forall a. Show a => a -> String
show Int64
i
  fromPrimitivePersistValue (PersistDouble Double
d) = Double -> String
forall a. Show a => a -> String
show Double
d
  fromPrimitivePersistValue (PersistDay Day
d) = Day -> String
forall a. Show a => a -> String
show Day
d
  fromPrimitivePersistValue (PersistTimeOfDay TimeOfDay
d) = TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
d
  fromPrimitivePersistValue (PersistUTCTime UTCTime
d) = UTCTime -> String
forall a. Show a => a -> String
show UTCTime
d
  fromPrimitivePersistValue (PersistZonedTime ZT
z) = ZT -> String
forall a. Show a => a -> String
show ZT
z
  fromPrimitivePersistValue (PersistBool Bool
b) = Bool -> String
forall a. Show a => a -> String
show Bool
b
  fromPrimitivePersistValue PersistValue
PersistNull = String -> String
forall a. HasCallStack => String -> a
error String
"Unexpected NULL"
  fromPrimitivePersistValue (PersistCustom Utf8
_ [PersistValue]
_) = String -> String
forall a. HasCallStack => String -> a
error String
"Unexpected PersistCustom"

instance PrimitivePersistField T.Text where
  toPrimitivePersistValue :: Text -> PersistValue
toPrimitivePersistValue Text
s = Text -> PersistValue
PersistText Text
s
  fromPrimitivePersistValue :: PersistValue -> Text
fromPrimitivePersistValue (PersistText Text
s) = Text
s
  fromPrimitivePersistValue (PersistByteString ByteString
bs) = OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode ByteString
bs
  fromPrimitivePersistValue PersistValue
x = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PersistValue -> String
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
x

instance PrimitivePersistField TL.Text where
  toPrimitivePersistValue :: Text -> PersistValue
toPrimitivePersistValue Text
s = Text -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue (Text -> Text
TL.toStrict Text
s)
  fromPrimitivePersistValue :: PersistValue -> Text
fromPrimitivePersistValue PersistValue
x = Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ PersistValue -> Text
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
x

instance PrimitivePersistField ByteString where
  toPrimitivePersistValue :: ByteString -> PersistValue
toPrimitivePersistValue ByteString
s = ByteString -> PersistValue
PersistByteString ByteString
s
  fromPrimitivePersistValue :: PersistValue -> ByteString
fromPrimitivePersistValue (PersistByteString ByteString
a) = ByteString
a
  fromPrimitivePersistValue PersistValue
x = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ PersistValue -> String
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
x

instance PrimitivePersistField Lazy.ByteString where
  toPrimitivePersistValue :: ByteString -> PersistValue
toPrimitivePersistValue ByteString
s = ByteString -> PersistValue
PersistByteString (ByteString -> PersistValue) -> ByteString -> PersistValue
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.toStrict ByteString
s
  fromPrimitivePersistValue :: PersistValue -> ByteString
fromPrimitivePersistValue (PersistByteString ByteString
a) = ByteString -> ByteString
Lazy.fromStrict ByteString
a
  fromPrimitivePersistValue PersistValue
x = ByteString -> ByteString
Lazy.fromStrict (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ PersistValue -> String
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
x

instance PrimitivePersistField Int where
  toPrimitivePersistValue :: Int -> PersistValue
toPrimitivePersistValue Int
a = Int64 -> PersistValue
PersistInt64 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a)
  fromPrimitivePersistValue :: PersistValue -> Int
fromPrimitivePersistValue (PersistInt64 Int64
a) = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a
  fromPrimitivePersistValue (PersistDouble Double
a) = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Int
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Integer, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField Int8 where
  toPrimitivePersistValue :: Int8 -> PersistValue
toPrimitivePersistValue Int8
a = Int64 -> PersistValue
PersistInt64 (Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
a)
  fromPrimitivePersistValue :: PersistValue -> Int8
fromPrimitivePersistValue (PersistInt64 Int64
a) = Int64 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a
  fromPrimitivePersistValue (PersistDouble Double
a) = Double -> Int8
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Int8
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Integer, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField Int16 where
  toPrimitivePersistValue :: Int16 -> PersistValue
toPrimitivePersistValue Int16
a = Int64 -> PersistValue
PersistInt64 (Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
a)
  fromPrimitivePersistValue :: PersistValue -> Int16
fromPrimitivePersistValue (PersistInt64 Int64
a) = Int64 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a
  fromPrimitivePersistValue (PersistDouble Double
a) = Double -> Int16
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Int16
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Integer, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField Int32 where
  toPrimitivePersistValue :: Int32 -> PersistValue
toPrimitivePersistValue Int32
a = Int64 -> PersistValue
PersistInt64 (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
a)
  fromPrimitivePersistValue :: PersistValue -> Int32
fromPrimitivePersistValue (PersistInt64 Int64
a) = Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a
  fromPrimitivePersistValue (PersistDouble Double
a) = Double -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Int32
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Integer, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField Int64 where
  toPrimitivePersistValue :: Int64 -> PersistValue
toPrimitivePersistValue Int64
a = Int64 -> PersistValue
PersistInt64 (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a)
  fromPrimitivePersistValue :: PersistValue -> Int64
fromPrimitivePersistValue (PersistInt64 Int64
a) = Int64
a
  fromPrimitivePersistValue (PersistDouble Double
a) = Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Int64
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Integer, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField Word8 where
  toPrimitivePersistValue :: Word8 -> PersistValue
toPrimitivePersistValue Word8
a = Int64 -> PersistValue
PersistInt64 (Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a)
  fromPrimitivePersistValue :: PersistValue -> Word8
fromPrimitivePersistValue (PersistInt64 Int64
a) = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a
  fromPrimitivePersistValue (PersistDouble Double
a) = Double -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Word8
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Integer, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField Word16 where
  toPrimitivePersistValue :: Word16 -> PersistValue
toPrimitivePersistValue Word16
a = Int64 -> PersistValue
PersistInt64 (Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a)
  fromPrimitivePersistValue :: PersistValue -> Word16
fromPrimitivePersistValue (PersistInt64 Int64
a) = Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a
  fromPrimitivePersistValue (PersistDouble Double
a) = Double -> Word16
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Word16
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Integer, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField Word32 where
  toPrimitivePersistValue :: Word32 -> PersistValue
toPrimitivePersistValue Word32
a = Int64 -> PersistValue
PersistInt64 (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a)
  fromPrimitivePersistValue :: PersistValue -> Word32
fromPrimitivePersistValue (PersistInt64 Int64
a) = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a
  fromPrimitivePersistValue (PersistDouble Double
a) = Double -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Word32
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Integer, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField Word64 where
  toPrimitivePersistValue :: Word64 -> PersistValue
toPrimitivePersistValue Word64
a = Int64 -> PersistValue
PersistInt64 (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a)
  fromPrimitivePersistValue :: PersistValue -> Word64
fromPrimitivePersistValue (PersistInt64 Int64
a) = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a
  fromPrimitivePersistValue (PersistDouble Double
a) = Double -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Word64
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Integer, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField Double where
  toPrimitivePersistValue :: Double -> PersistValue
toPrimitivePersistValue Double
a = Double -> PersistValue
PersistDouble Double
a
  fromPrimitivePersistValue :: PersistValue -> Double
fromPrimitivePersistValue (PersistDouble Double
a) = Double
a
  fromPrimitivePersistValue (PersistInt64 Int64
a) = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Double
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Double, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField Bool where
  toPrimitivePersistValue :: Bool -> PersistValue
toPrimitivePersistValue Bool
a = Bool -> PersistValue
PersistBool Bool
a
  fromPrimitivePersistValue :: PersistValue -> Bool
fromPrimitivePersistValue (PersistBool Bool
a) = Bool
a
  fromPrimitivePersistValue (PersistInt64 Int64
i) = Int64
i Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
0
  fromPrimitivePersistValue PersistValue
x = String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Expected Bool, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x

instance PrimitivePersistField Day where
  toPrimitivePersistValue :: Day -> PersistValue
toPrimitivePersistValue Day
a = Day -> PersistValue
PersistDay Day
a
  fromPrimitivePersistValue :: PersistValue -> Day
fromPrimitivePersistValue (PersistDay Day
a) = Day
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> Day
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected Day, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField TimeOfDay where
  toPrimitivePersistValue :: TimeOfDay -> PersistValue
toPrimitivePersistValue TimeOfDay
a = TimeOfDay -> PersistValue
PersistTimeOfDay TimeOfDay
a
  fromPrimitivePersistValue :: PersistValue -> TimeOfDay
fromPrimitivePersistValue (PersistTimeOfDay TimeOfDay
a) = TimeOfDay
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> TimeOfDay
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected TimeOfDay, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField UTCTime where
  toPrimitivePersistValue :: UTCTime -> PersistValue
toPrimitivePersistValue UTCTime
a = UTCTime -> PersistValue
PersistUTCTime UTCTime
a
  fromPrimitivePersistValue :: PersistValue -> UTCTime
fromPrimitivePersistValue (PersistUTCTime UTCTime
a) = UTCTime
a
  fromPrimitivePersistValue (PersistZonedTime (ZT ZonedTime
a)) = ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> UTCTime
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected UTCTime, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField ZonedTime where
  toPrimitivePersistValue :: ZonedTime -> PersistValue
toPrimitivePersistValue ZonedTime
a = ZT -> PersistValue
PersistZonedTime (ZonedTime -> ZT
ZT ZonedTime
a)
  fromPrimitivePersistValue :: PersistValue -> ZonedTime
fromPrimitivePersistValue (PersistZonedTime (ZT ZonedTime
a)) = ZonedTime
a
  fromPrimitivePersistValue (PersistUTCTime UTCTime
a) = TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
utc UTCTime
a
  fromPrimitivePersistValue PersistValue
x = PersistValue -> String -> ZonedTime
forall a. Read a => PersistValue -> String -> a
readHelper PersistValue
x (String
"Expected ZonedTime, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x)

instance PrimitivePersistField A.Value where
  toPrimitivePersistValue :: Value -> PersistValue
toPrimitivePersistValue Value
a = ByteString -> PersistValue
PersistByteString (ByteString -> PersistValue) -> ByteString -> PersistValue
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode Value
a
  fromPrimitivePersistValue :: PersistValue -> Value
fromPrimitivePersistValue PersistValue
x =
    case PersistValue
x of
      PersistString String
str -> ByteString -> Value
forall p. FromJSON p => ByteString -> p
decode' (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
str
      PersistText Text
str -> ByteString -> Value
forall p. FromJSON p => ByteString -> p
decode' (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
str
      PersistByteString ByteString
str -> ByteString -> Value
forall p. FromJSON p => ByteString -> p
decode' ByteString
str
      PersistValue
_ -> String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"Expected Aeson.Value, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
x
    where
      decode' :: ByteString -> p
decode' ByteString
str = case ByteString -> Either String p
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode (ByteString -> Either String p) -> ByteString -> Either String p
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.fromStrict ByteString
str of
        Right p
val -> p
val
        Left String
err -> String -> p
forall a. HasCallStack => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
"Error decoding Aeson.Value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err

instance (PrimitivePersistField a, NeverNull a) => PrimitivePersistField (Maybe a) where
  toPrimitivePersistValue :: Maybe a -> PersistValue
toPrimitivePersistValue Maybe a
a = PersistValue -> (a -> PersistValue) -> Maybe a -> PersistValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PersistValue
PersistNull a -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Maybe a
a
  fromPrimitivePersistValue :: PersistValue -> Maybe a
fromPrimitivePersistValue PersistValue
PersistNull = Maybe a
forall a. Maybe a
Nothing
  fromPrimitivePersistValue PersistValue
x = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ PersistValue -> a
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
x

instance (DbDescriptor db, PersistEntity v, PersistField v) => PrimitivePersistField (KeyForBackend db v) where
  toPrimitivePersistValue :: KeyForBackend db v -> PersistValue
toPrimitivePersistValue (KeyForBackend AutoKeyType db
a) = AutoKeyType db -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue AutoKeyType db
a
  fromPrimitivePersistValue :: PersistValue -> KeyForBackend db v
fromPrimitivePersistValue PersistValue
x = AutoKeyType db -> KeyForBackend db v
forall db v.
(DbDescriptor db, PersistEntity v) =>
AutoKeyType db -> KeyForBackend db v
KeyForBackend (PersistValue -> AutoKeyType db
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
x)

instance {-# OVERLAPPABLE #-} (PersistField a, PrimitivePersistField a) => PurePersistField a where
  toPurePersistValues :: a -> [PersistValue] -> [PersistValue]
toPurePersistValues = a -> [PersistValue] -> [PersistValue]
forall a.
PrimitivePersistField a =>
a -> [PersistValue] -> [PersistValue]
primToPurePersistValues
  fromPurePersistValues :: [PersistValue] -> (a, [PersistValue])
fromPurePersistValues = [PersistValue] -> (a, [PersistValue])
forall a.
PrimitivePersistField a =>
[PersistValue] -> (a, [PersistValue])
primFromPurePersistValues

instance {-# OVERLAPPABLE #-} (PersistField a, PrimitivePersistField a) => SinglePersistField a where
  toSinglePersistValue :: a -> m PersistValue
toSinglePersistValue = a -> m PersistValue
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m PersistValue
primToSinglePersistValue
  fromSinglePersistValue :: PersistValue -> m a
fromSinglePersistValue = PersistValue -> m a
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
PersistValue -> m a
primFromSinglePersistValue

instance NeverNull String

instance NeverNull T.Text

instance NeverNull TL.Text

instance NeverNull ByteString

instance NeverNull Lazy.ByteString

instance NeverNull Int

instance NeverNull Int8

instance NeverNull Int16

instance NeverNull Int32

instance NeverNull Int64

instance NeverNull Word8

instance NeverNull Word16

instance NeverNull Word32

instance NeverNull Word64

instance NeverNull Double

instance NeverNull Bool

instance NeverNull Day

instance NeverNull TimeOfDay

instance NeverNull UTCTime

instance NeverNull ZonedTime

instance NeverNull A.Value

instance PrimitivePersistField (Key v u) => NeverNull (Key v u)

instance NeverNull (KeyForBackend db v)

readHelper :: Read a => PersistValue -> String -> a
readHelper :: PersistValue -> String -> a
readHelper PersistValue
s String
errMessage = case PersistValue
s of
  PersistString String
str -> String -> a
readHelper' String
str
  PersistText Text
str -> String -> a
readHelper' (Text -> String
T.unpack Text
str)
  PersistByteString ByteString
str -> String -> a
readHelper' (ByteString -> String
unpack ByteString
str)
  PersistValue
_ -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"readHelper: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errMessage
  where
    readHelper' :: String -> a
readHelper' String
str = case ReadS a
forall a. Read a => ReadS a
reads String
str of
      (a
a, String
_) : [(a, String)]
_ -> a
a
      [(a, String)]
_ -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"readHelper: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errMessage

instance PersistField ByteString where
  persistName :: ByteString -> String
persistName ByteString
_ = String
"ByteString"
  toPersistValues :: ByteString -> m ([PersistValue] -> [PersistValue])
toPersistValues = ByteString -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (ByteString, [PersistValue])
fromPersistValues = [PersistValue] -> m (ByteString, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> ByteString -> DbType
dbType proxy db
_ ByteString
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbBlob Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Lazy.ByteString where
  persistName :: ByteString -> String
persistName ByteString
_ = String
"ByteString"
  toPersistValues :: ByteString -> m ([PersistValue] -> [PersistValue])
toPersistValues = ByteString -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (ByteString, [PersistValue])
fromPersistValues = [PersistValue] -> m (ByteString, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> ByteString -> DbType
dbType proxy db
_ ByteString
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbBlob Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField A.Value where
  persistName :: Value -> String
persistName Value
_ = String
"JsonValue"
  toPersistValues :: Value -> m ([PersistValue] -> [PersistValue])
toPersistValues = Value -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Value, [PersistValue])
fromPersistValues = [PersistValue] -> m (Value, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Value -> DbType
dbType proxy db
_ Value
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbBlob Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField String where
  persistName :: String -> String
persistName String
_ = String
"String"
  toPersistValues :: String -> m ([PersistValue] -> [PersistValue])
toPersistValues = String -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (String, [PersistValue])
fromPersistValues = [PersistValue] -> m (String, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> String -> DbType
dbType proxy db
_ String
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbString Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField T.Text where
  persistName :: Text -> String
persistName Text
_ = String
"Text"
  toPersistValues :: Text -> m ([PersistValue] -> [PersistValue])
toPersistValues = Text -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Text, [PersistValue])
fromPersistValues = [PersistValue] -> m (Text, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Text -> DbType
dbType proxy db
_ Text
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbString Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField TL.Text where
  persistName :: Text -> String
persistName Text
_ = String
"Text"
  toPersistValues :: Text -> m ([PersistValue] -> [PersistValue])
toPersistValues = Text -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Text, [PersistValue])
fromPersistValues = [PersistValue] -> m (Text, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Text -> DbType
dbType proxy db
_ Text
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbString Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Int where
  persistName :: Int -> String
persistName Int
_ = String
"Int"
  toPersistValues :: Int -> m ([PersistValue] -> [PersistValue])
toPersistValues = Int -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Int, [PersistValue])
fromPersistValues = [PersistValue] -> m (Int, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Int -> DbType
dbType proxy db
_ Int
a = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive (if Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 then DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt32 else DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt64) Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing where

#if !MIN_VERSION_base(4, 7, 0)
    finiteBitSize = bitSize
#endif

instance PersistField Int8 where
  persistName :: Int8 -> String
persistName Int8
_ = String
"Int8"
  toPersistValues :: Int8 -> m ([PersistValue] -> [PersistValue])
toPersistValues = Int8 -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Int8, [PersistValue])
fromPersistValues = [PersistValue] -> m (Int8, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Int8 -> DbType
dbType proxy db
_ Int8
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt32 Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Int16 where
  persistName :: Int16 -> String
persistName Int16
_ = String
"Int16"
  toPersistValues :: Int16 -> m ([PersistValue] -> [PersistValue])
toPersistValues = Int16 -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Int16, [PersistValue])
fromPersistValues = [PersistValue] -> m (Int16, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Int16 -> DbType
dbType proxy db
_ Int16
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt32 Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Int32 where
  persistName :: Int32 -> String
persistName Int32
_ = String
"Int32"
  toPersistValues :: Int32 -> m ([PersistValue] -> [PersistValue])
toPersistValues = Int32 -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Int32, [PersistValue])
fromPersistValues = [PersistValue] -> m (Int32, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Int32 -> DbType
dbType proxy db
_ Int32
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt32 Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Int64 where
  persistName :: Int64 -> String
persistName Int64
_ = String
"Int64"
  toPersistValues :: Int64 -> m ([PersistValue] -> [PersistValue])
toPersistValues = Int64 -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Int64, [PersistValue])
fromPersistValues = [PersistValue] -> m (Int64, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Int64 -> DbType
dbType proxy db
_ Int64
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt64 Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Word8 where
  persistName :: Word8 -> String
persistName Word8
_ = String
"Word8"
  toPersistValues :: Word8 -> m ([PersistValue] -> [PersistValue])
toPersistValues = Word8 -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Word8, [PersistValue])
fromPersistValues = [PersistValue] -> m (Word8, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Word8 -> DbType
dbType proxy db
_ Word8
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt32 Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Word16 where
  persistName :: Word16 -> String
persistName Word16
_ = String
"Word16"
  toPersistValues :: Word16 -> m ([PersistValue] -> [PersistValue])
toPersistValues = Word16 -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Word16, [PersistValue])
fromPersistValues = [PersistValue] -> m (Word16, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Word16 -> DbType
dbType proxy db
_ Word16
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt32 Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Word32 where
  persistName :: Word32 -> String
persistName Word32
_ = String
"Word32"
  toPersistValues :: Word32 -> m ([PersistValue] -> [PersistValue])
toPersistValues = Word32 -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Word32, [PersistValue])
fromPersistValues = [PersistValue] -> m (Word32, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Word32 -> DbType
dbType proxy db
_ Word32
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt64 Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Word64 where
  persistName :: Word64 -> String
persistName Word64
_ = String
"Word64"
  toPersistValues :: Word64 -> m ([PersistValue] -> [PersistValue])
toPersistValues = Word64 -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Word64, [PersistValue])
fromPersistValues = [PersistValue] -> m (Word64, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Word64 -> DbType
dbType proxy db
_ Word64
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt64 Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Double where
  persistName :: Double -> String
persistName Double
_ = String
"Double"
  toPersistValues :: Double -> m ([PersistValue] -> [PersistValue])
toPersistValues = Double -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Double, [PersistValue])
fromPersistValues = [PersistValue] -> m (Double, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Double -> DbType
dbType proxy db
_ Double
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbReal Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Bool where
  persistName :: Bool -> String
persistName Bool
_ = String
"Bool"
  toPersistValues :: Bool -> m ([PersistValue] -> [PersistValue])
toPersistValues = Bool -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Bool, [PersistValue])
fromPersistValues = [PersistValue] -> m (Bool, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Bool -> DbType
dbType proxy db
_ Bool
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbBool Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField Day where
  persistName :: Day -> String
persistName Day
_ = String
"Day"
  toPersistValues :: Day -> m ([PersistValue] -> [PersistValue])
toPersistValues = Day -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Day, [PersistValue])
fromPersistValues = [PersistValue] -> m (Day, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Day -> DbType
dbType proxy db
_ Day
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbDay Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField TimeOfDay where
  persistName :: TimeOfDay -> String
persistName TimeOfDay
_ = String
"TimeOfDay"
  toPersistValues :: TimeOfDay -> m ([PersistValue] -> [PersistValue])
toPersistValues = TimeOfDay -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (TimeOfDay, [PersistValue])
fromPersistValues = [PersistValue] -> m (TimeOfDay, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> TimeOfDay -> DbType
dbType proxy db
_ TimeOfDay
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbTime Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField UTCTime where
  persistName :: UTCTime -> String
persistName UTCTime
_ = String
"UTCTime"
  toPersistValues :: UTCTime -> m ([PersistValue] -> [PersistValue])
toPersistValues = UTCTime -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (UTCTime, [PersistValue])
fromPersistValues = [PersistValue] -> m (UTCTime, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> UTCTime -> DbType
dbType proxy db
_ UTCTime
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbDayTime Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PersistField ZonedTime where
  persistName :: ZonedTime -> String
persistName ZonedTime
_ = String
"ZonedTime"
  toPersistValues :: ZonedTime -> m ([PersistValue] -> [PersistValue])
toPersistValues = ZonedTime -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (ZonedTime, [PersistValue])
fromPersistValues = [PersistValue] -> m (ZonedTime, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> ZonedTime -> DbType
dbType proxy db
_ ZonedTime
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
forall str. DbTypePrimitive' str
DbDayTimeZoned Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

-- There is a weird bug in GHC 7.4.1 which causes program to hang. See ticket 7126.
-- instance (PersistField a, NeverNull a) => PersistField (Maybe a) where -- OK
-- instance (SinglePersistField a, NeverNull a) => PersistField (Maybe a) where -- HANGS
instance (PersistField a, NeverNull a) => PersistField (Maybe a) where
  persistName :: Maybe a -> String
persistName Maybe a
a = String
"Maybe" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
forall a. PersistField a => a -> String
persistName ((forall a. Maybe a -> a
forall a. HasCallStack => a
undefined :: Maybe a -> a) Maybe a
a)
  toPersistValues :: Maybe a -> m ([PersistValue] -> [PersistValue])
toPersistValues Maybe a
Nothing = ([PersistValue] -> [PersistValue])
-> m ([PersistValue] -> [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PersistValue
PersistNull PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
:)
  toPersistValues (Just a
a) = a -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues a
a
  fromPersistValues :: [PersistValue] -> m (Maybe a, [PersistValue])
fromPersistValues [] = String -> m (Maybe a, [PersistValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"fromPersistValues Maybe: empty list"
  fromPersistValues (PersistValue
PersistNull : [PersistValue]
xs) = (Maybe a, [PersistValue]) -> m (Maybe a, [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
forall a. Maybe a
Nothing, [PersistValue]
xs)
  fromPersistValues [PersistValue]
xs = [PersistValue] -> m (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
xs m (a, [PersistValue])
-> ((a, [PersistValue]) -> m (Maybe a, [PersistValue]))
-> m (Maybe a, [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x, [PersistValue]
xs') -> (Maybe a, [PersistValue]) -> m (Maybe a, [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x, [PersistValue]
xs')
  dbType :: proxy db -> Maybe a -> DbType
dbType proxy db
db Maybe a
a = case proxy db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a. Maybe a -> a
forall a. HasCallStack => a
undefined :: Maybe a -> a) Maybe a
a) of
    DbTypePrimitive DbTypePrimitive
t Bool
_ Maybe String
def Maybe ParentTableReference
ref -> DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
t Bool
True Maybe String
def Maybe ParentTableReference
ref
    DbEmbedded (EmbeddedDef Bool
concatName [(String
field, DbTypePrimitive DbTypePrimitive
t Bool
_ Maybe String
def Maybe ParentTableReference
ref')]) Maybe ParentTableReference
ref ->
      EmbeddedDef' String DbType -> Maybe ParentTableReference -> DbType
DbEmbedded (Bool -> [(String, DbType)] -> EmbeddedDef' String DbType
forall str dbType.
Bool -> [(str, dbType)] -> EmbeddedDef' str dbType
EmbeddedDef Bool
concatName [(String
field, DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive DbTypePrimitive
t Bool
True Maybe String
def Maybe ParentTableReference
ref')]) Maybe ParentTableReference
ref
    DbType
t -> String -> DbType
forall a. HasCallStack => String -> a
error (String -> DbType) -> String -> DbType
forall a b. (a -> b) -> a -> b
$ String
"dbType " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe a -> String
forall a. PersistField a => a -> String
persistName Maybe a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": expected DbTypePrimitive or DbEmbedded with one field, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DbType -> String
forall a. Show a => a -> String
show DbType
t

instance {-# OVERLAPPABLE #-} (PersistField a) => PersistField [a] where
  persistName :: [a] -> String
persistName [a]
a = String
"List" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
forall a. PersistField a => a -> String
persistName ((forall a. [a] -> a
forall a. HasCallStack => a
undefined :: [] a -> a) [a]
a)
  toPersistValues :: [a] -> m ([PersistValue] -> [PersistValue])
toPersistValues [a]
l = [a] -> m Int64
forall conn a (m :: * -> *).
(PersistBackendConn conn, PersistField a, PersistBackend m,
 Conn m ~ conn) =>
[a] -> m Int64
insertList [a]
l m Int64
-> (Int64 -> m ([PersistValue] -> [PersistValue]))
-> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64 -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues
  fromPersistValues :: [PersistValue] -> m ([a], [PersistValue])
fromPersistValues [] = String -> m ([a], [PersistValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"fromPersistValues []: empty list"
  fromPersistValues (PersistValue
x : [PersistValue]
xs) = Int64 -> m [a]
forall conn a (m :: * -> *).
(PersistBackendConn conn, PersistField a, PersistBackend m,
 Conn m ~ conn) =>
Int64 -> m [a]
getList (PersistValue -> Int64
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
x) m [a]
-> ([a] -> m ([a], [PersistValue])) -> m ([a], [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[a]
l -> ([a], [PersistValue]) -> m ([a], [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a]
l, [PersistValue]
xs)
  dbType :: proxy db -> [a] -> DbType
dbType proxy db
db [a]
a = String -> DbType -> DbType
DbList ([a] -> String
forall a. PersistField a => a -> String
persistName [a]
a) (DbType -> DbType) -> DbType -> DbType
forall a b. (a -> b) -> a -> b
$ proxy db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a. [a] -> a
forall a. HasCallStack => a
undefined :: [] a -> a) [a]
a)

instance PersistField () where
  persistName :: () -> String
persistName ()
_ = String
"Unit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
delim]
  toPersistValues :: () -> m ([PersistValue] -> [PersistValue])
toPersistValues ()
_ = ([PersistValue] -> [PersistValue])
-> m ([PersistValue] -> [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure [PersistValue] -> [PersistValue]
forall a. a -> a
id
  fromPersistValues :: [PersistValue] -> m ((), [PersistValue])
fromPersistValues [PersistValue]
xs = ((), [PersistValue]) -> m ((), [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), [PersistValue]
xs)
  dbType :: proxy db -> () -> DbType
dbType proxy db
_ ()
_ = EmbeddedDef' String DbType -> Maybe ParentTableReference -> DbType
DbEmbedded (Bool -> [(String, DbType)] -> EmbeddedDef' String DbType
forall str dbType.
Bool -> [(str, dbType)] -> EmbeddedDef' str dbType
EmbeddedDef Bool
False []) Maybe ParentTableReference
forall a. Maybe a
Nothing

instance (PersistField a, PersistField b) => PersistField (a, b) where
  persistName :: (a, b) -> String
persistName (a, b)
a = String
"Tuple2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
forall a. PersistField a => a -> String
persistName ((forall a b. (a, b) -> a
forall a. HasCallStack => a
undefined :: (a, b) -> a) (a, b)
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: b -> String
forall a. PersistField a => a -> String
persistName ((forall a b. (a, b) -> b
forall a. HasCallStack => a
undefined :: (a, b) -> b) (a, b)
a)
  toPersistValues :: (a, b) -> m ([PersistValue] -> [PersistValue])
toPersistValues (a
a, b
b) = do
    [PersistValue] -> [PersistValue]
a' <- a -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues a
a
    [PersistValue] -> [PersistValue]
b' <- b -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues b
b
    ([PersistValue] -> [PersistValue])
-> m ([PersistValue] -> [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([PersistValue] -> [PersistValue])
 -> m ([PersistValue] -> [PersistValue]))
-> ([PersistValue] -> [PersistValue])
-> m ([PersistValue] -> [PersistValue])
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> [PersistValue]
a' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
b'
  fromPersistValues :: [PersistValue] -> m ((a, b), [PersistValue])
fromPersistValues [PersistValue]
xs = do
    (a
a, [PersistValue]
rest0) <- [PersistValue] -> m (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
xs
    (b
b, [PersistValue]
rest1) <- [PersistValue] -> m (b, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
rest0
    ((a, b), [PersistValue]) -> m ((a, b), [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
a, b
b), [PersistValue]
rest1)
  dbType :: proxy db -> (a, b) -> DbType
dbType proxy db
db (a, b)
a = EmbeddedDef' String DbType -> Maybe ParentTableReference -> DbType
DbEmbedded (Bool -> [(String, DbType)] -> EmbeddedDef' String DbType
forall str dbType.
Bool -> [(str, dbType)] -> EmbeddedDef' str dbType
EmbeddedDef Bool
False [(String
"val0", proxy db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b. (a, b) -> a
forall a. HasCallStack => a
undefined :: (a, b) -> a) (a, b)
a)), (String
"val1", proxy db -> b -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b. (a, b) -> b
forall a. HasCallStack => a
undefined :: (a, b) -> b) (a, b)
a))]) Maybe ParentTableReference
forall a. Maybe a
Nothing

instance (PersistField a, PersistField b, PersistField c) => PersistField (a, b, c) where
  persistName :: (a, b, c) -> String
persistName (a, b, c)
a = String
"Tuple3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
forall a. PersistField a => a -> String
persistName ((forall a b c. (a, b, c) -> a
forall a. HasCallStack => a
undefined :: (a, b, c) -> a) (a, b, c)
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: b -> String
forall a. PersistField a => a -> String
persistName ((forall a b c. (a, b, c) -> b
forall a. HasCallStack => a
undefined :: (a, b, c) -> b) (a, b, c)
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: c -> String
forall a. PersistField a => a -> String
persistName ((forall a b c. (a, b, c) -> c
forall a. HasCallStack => a
undefined :: (a, b, c) -> c) (a, b, c)
a)
  toPersistValues :: (a, b, c) -> m ([PersistValue] -> [PersistValue])
toPersistValues (a
a, b
b, c
c) = do
    [PersistValue] -> [PersistValue]
a' <- a -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues a
a
    [PersistValue] -> [PersistValue]
b' <- b -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues b
b
    [PersistValue] -> [PersistValue]
c' <- c -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues c
c
    ([PersistValue] -> [PersistValue])
-> m ([PersistValue] -> [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([PersistValue] -> [PersistValue])
 -> m ([PersistValue] -> [PersistValue]))
-> ([PersistValue] -> [PersistValue])
-> m ([PersistValue] -> [PersistValue])
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> [PersistValue]
a' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
b' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
c'
  fromPersistValues :: [PersistValue] -> m ((a, b, c), [PersistValue])
fromPersistValues [PersistValue]
xs = do
    (a
a, [PersistValue]
rest0) <- [PersistValue] -> m (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
xs
    (b
b, [PersistValue]
rest1) <- [PersistValue] -> m (b, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
rest0
    (c
c, [PersistValue]
rest2) <- [PersistValue] -> m (c, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
rest1
    ((a, b, c), [PersistValue]) -> m ((a, b, c), [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
a, b
b, c
c), [PersistValue]
rest2)
  dbType :: proxy db -> (a, b, c) -> DbType
dbType proxy db
db (a, b, c)
a = EmbeddedDef' String DbType -> Maybe ParentTableReference -> DbType
DbEmbedded (Bool -> [(String, DbType)] -> EmbeddedDef' String DbType
forall str dbType.
Bool -> [(str, dbType)] -> EmbeddedDef' str dbType
EmbeddedDef Bool
False [(String
"val0", proxy db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c. (a, b, c) -> a
forall a. HasCallStack => a
undefined :: (a, b, c) -> a) (a, b, c)
a)), (String
"val1", proxy db -> b -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c. (a, b, c) -> b
forall a. HasCallStack => a
undefined :: (a, b, c) -> b) (a, b, c)
a)), (String
"val2", proxy db -> c -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c. (a, b, c) -> c
forall a. HasCallStack => a
undefined :: (a, b, c) -> c) (a, b, c)
a))]) Maybe ParentTableReference
forall a. Maybe a
Nothing

instance (PersistField a, PersistField b, PersistField c, PersistField d) => PersistField (a, b, c, d) where
  persistName :: (a, b, c, d) -> String
persistName (a, b, c, d)
a = String
"Tuple4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
forall a. PersistField a => a -> String
persistName ((forall a b c d. (a, b, c, d) -> a
forall a. HasCallStack => a
undefined :: (a, b, c, d) -> a) (a, b, c, d)
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: b -> String
forall a. PersistField a => a -> String
persistName ((forall a b c d. (a, b, c, d) -> b
forall a. HasCallStack => a
undefined :: (a, b, c, d) -> b) (a, b, c, d)
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: c -> String
forall a. PersistField a => a -> String
persistName ((forall a b c d. (a, b, c, d) -> c
forall a. HasCallStack => a
undefined :: (a, b, c, d) -> c) (a, b, c, d)
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: d -> String
forall a. PersistField a => a -> String
persistName ((forall a b c d. (a, b, c, d) -> d
forall a. HasCallStack => a
undefined :: (a, b, c, d) -> d) (a, b, c, d)
a)
  toPersistValues :: (a, b, c, d) -> m ([PersistValue] -> [PersistValue])
toPersistValues (a
a, b
b, c
c, d
d) = do
    [PersistValue] -> [PersistValue]
a' <- a -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues a
a
    [PersistValue] -> [PersistValue]
b' <- b -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues b
b
    [PersistValue] -> [PersistValue]
c' <- c -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues c
c
    [PersistValue] -> [PersistValue]
d' <- d -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues d
d
    ([PersistValue] -> [PersistValue])
-> m ([PersistValue] -> [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([PersistValue] -> [PersistValue])
 -> m ([PersistValue] -> [PersistValue]))
-> ([PersistValue] -> [PersistValue])
-> m ([PersistValue] -> [PersistValue])
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> [PersistValue]
a' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
b' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
c' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
d'
  fromPersistValues :: [PersistValue] -> m ((a, b, c, d), [PersistValue])
fromPersistValues [PersistValue]
xs = do
    (a
a, [PersistValue]
rest0) <- [PersistValue] -> m (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
xs
    (b
b, [PersistValue]
rest1) <- [PersistValue] -> m (b, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
rest0
    (c
c, [PersistValue]
rest2) <- [PersistValue] -> m (c, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
rest1
    (d
d, [PersistValue]
rest3) <- [PersistValue] -> m (d, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
rest2
    ((a, b, c, d), [PersistValue]) -> m ((a, b, c, d), [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
a, b
b, c
c, d
d), [PersistValue]
rest3)
  dbType :: proxy db -> (a, b, c, d) -> DbType
dbType proxy db
db (a, b, c, d)
a = EmbeddedDef' String DbType -> Maybe ParentTableReference -> DbType
DbEmbedded (Bool -> [(String, DbType)] -> EmbeddedDef' String DbType
forall str dbType.
Bool -> [(str, dbType)] -> EmbeddedDef' str dbType
EmbeddedDef Bool
False [(String
"val0", proxy db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c d. (a, b, c, d) -> a
forall a. HasCallStack => a
undefined :: (a, b, c, d) -> a) (a, b, c, d)
a)), (String
"val1", proxy db -> b -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c d. (a, b, c, d) -> b
forall a. HasCallStack => a
undefined :: (a, b, c, d) -> b) (a, b, c, d)
a)), (String
"val2", proxy db -> c -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c d. (a, b, c, d) -> c
forall a. HasCallStack => a
undefined :: (a, b, c, d) -> c) (a, b, c, d)
a)), (String
"val3", proxy db -> d -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c d. (a, b, c, d) -> d
forall a. HasCallStack => a
undefined :: (a, b, c, d) -> d) (a, b, c, d)
a))]) Maybe ParentTableReference
forall a. Maybe a
Nothing

instance (PersistField a, PersistField b, PersistField c, PersistField d, PersistField e) => PersistField (a, b, c, d, e) where
  persistName :: (a, b, c, d, e) -> String
persistName (a, b, c, d, e)
a = String
"Tuple5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: a -> String
forall a. PersistField a => a -> String
persistName ((forall a b c d e. (a, b, c, d, e) -> a
forall a. HasCallStack => a
undefined :: (a, b, c, d, e) -> a) (a, b, c, d, e)
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: b -> String
forall a. PersistField a => a -> String
persistName ((forall a b c d e. (a, b, c, d, e) -> b
forall a. HasCallStack => a
undefined :: (a, b, c, d, e) -> b) (a, b, c, d, e)
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: c -> String
forall a. PersistField a => a -> String
persistName ((forall a b c d e. (a, b, c, d, e) -> c
forall a. HasCallStack => a
undefined :: (a, b, c, d, e) -> c) (a, b, c, d, e)
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: d -> String
forall a. PersistField a => a -> String
persistName ((forall a b c d e. (a, b, c, d, e) -> d
forall a. HasCallStack => a
undefined :: (a, b, c, d, e) -> d) (a, b, c, d, e)
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: e -> String
forall a. PersistField a => a -> String
persistName ((forall a b c d e. (a, b, c, d, e) -> e
forall a. HasCallStack => a
undefined :: (a, b, c, d, e) -> e) (a, b, c, d, e)
a)
  toPersistValues :: (a, b, c, d, e) -> m ([PersistValue] -> [PersistValue])
toPersistValues (a
a, b
b, c
c, d
d, e
e) = do
    [PersistValue] -> [PersistValue]
a' <- a -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues a
a
    [PersistValue] -> [PersistValue]
b' <- b -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues b
b
    [PersistValue] -> [PersistValue]
c' <- c -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues c
c
    [PersistValue] -> [PersistValue]
d' <- d -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues d
d
    [PersistValue] -> [PersistValue]
e' <- e -> m ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues e
e
    ([PersistValue] -> [PersistValue])
-> m ([PersistValue] -> [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([PersistValue] -> [PersistValue])
 -> m ([PersistValue] -> [PersistValue]))
-> ([PersistValue] -> [PersistValue])
-> m ([PersistValue] -> [PersistValue])
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> [PersistValue]
a' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
b' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
c' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
d' ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
e'
  fromPersistValues :: [PersistValue] -> m ((a, b, c, d, e), [PersistValue])
fromPersistValues [PersistValue]
xs = do
    (a
a, [PersistValue]
rest0) <- [PersistValue] -> m (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
xs
    (b
b, [PersistValue]
rest1) <- [PersistValue] -> m (b, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
rest0
    (c
c, [PersistValue]
rest2) <- [PersistValue] -> m (c, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
rest1
    (d
d, [PersistValue]
rest3) <- [PersistValue] -> m (d, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
rest2
    (e
e, [PersistValue]
rest4) <- [PersistValue] -> m (e, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues [PersistValue]
rest3
    ((a, b, c, d, e), [PersistValue])
-> m ((a, b, c, d, e), [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a
a, b
b, c
c, d
d, e
e), [PersistValue]
rest4)
  dbType :: proxy db -> (a, b, c, d, e) -> DbType
dbType proxy db
db (a, b, c, d, e)
a = EmbeddedDef' String DbType -> Maybe ParentTableReference -> DbType
DbEmbedded (Bool -> [(String, DbType)] -> EmbeddedDef' String DbType
forall str dbType.
Bool -> [(str, dbType)] -> EmbeddedDef' str dbType
EmbeddedDef Bool
False [(String
"val0", proxy db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c d e. (a, b, c, d, e) -> a
forall a. HasCallStack => a
undefined :: (a, b, c, d, e) -> a) (a, b, c, d, e)
a)), (String
"val1", proxy db -> b -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c d e. (a, b, c, d, e) -> b
forall a. HasCallStack => a
undefined :: (a, b, c, d, e) -> b) (a, b, c, d, e)
a)), (String
"val2", proxy db -> c -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c d e. (a, b, c, d, e) -> c
forall a. HasCallStack => a
undefined :: (a, b, c, d, e) -> c) (a, b, c, d, e)
a)), (String
"val3", proxy db -> d -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c d e. (a, b, c, d, e) -> d
forall a. HasCallStack => a
undefined :: (a, b, c, d, e) -> d) (a, b, c, d, e)
a)), (String
"val4", proxy db -> e -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall a b c d e. (a, b, c, d, e) -> e
forall a. HasCallStack => a
undefined :: (a, b, c, d, e) -> e) (a, b, c, d, e)
a))]) Maybe ParentTableReference
forall a. Maybe a
Nothing

instance (DbDescriptor db, PersistEntity v, PersistField v) => PersistField (KeyForBackend db v) where
  persistName :: KeyForBackend db v -> String
persistName KeyForBackend db v
a = String
"KeyForBackend" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: v -> String
forall a. PersistField a => a -> String
persistName ((forall db v. KeyForBackend db v -> v
forall a. HasCallStack => a
undefined :: KeyForBackend db v -> v) KeyForBackend db v
a)
  toPersistValues :: KeyForBackend db v -> m ([PersistValue] -> [PersistValue])
toPersistValues = KeyForBackend db v -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (KeyForBackend db v, [PersistValue])
fromPersistValues = [PersistValue] -> m (KeyForBackend db v, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> KeyForBackend db v -> DbType
dbType proxy db
db KeyForBackend db v
a = proxy db -> DefaultKey v -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db ((forall db v. KeyForBackend db v -> DefaultKey v
forall a. HasCallStack => a
undefined :: KeyForBackend db v -> DefaultKey v) KeyForBackend db v
a)

instance (EntityConstr v c, PersistField a) => Projection (Field v c a) a where
  type ProjectionDb (Field v c a) db = ()
  type ProjectionRestriction (Field v c a) r = r ~ RestrictionHolder v c
  projectionExprs :: Field v c a -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs Field v c a
f = [UntypedExpr db r] -> [UntypedExpr db r]
result
    where
      result :: [UntypedExpr db r] -> [UntypedExpr db r]
result = (FieldChain -> UntypedExpr db r
forall db r. FieldChain -> UntypedExpr db r
ExprField (Any db -> Field v c a -> FieldChain
forall f a db (proxy :: * -> *).
(FieldLike f a, DbDescriptor db, ProjectionDb f db) =>
proxy db -> f -> FieldChain
fieldChain Any db
db Field v c a
f) UntypedExpr db r -> [UntypedExpr db r] -> [UntypedExpr db r]
forall a. a -> [a] -> [a]
:)
      db :: Any db
db = (forall db r (proxy :: * -> *).
([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db
forall a. HasCallStack => a
undefined :: ([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db) [UntypedExpr db r] -> [UntypedExpr db r]
result
  projectionResult :: Field v c a -> [PersistValue] -> m (a, [PersistValue])
projectionResult Field v c a
_ = [PersistValue] -> m (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues

instance (EntityConstr v c, PersistField a) => Projection (SubField db v c a) a where
  type ProjectionDb (SubField db v c a) db' = db ~ db'
  type ProjectionRestriction (SubField db v c a) r = r ~ RestrictionHolder v c
  projectionExprs :: SubField db v c a -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs SubField db v c a
f = [UntypedExpr db r] -> [UntypedExpr db r]
result
    where
      result :: [UntypedExpr db r] -> [UntypedExpr db r]
result = (FieldChain -> UntypedExpr db r
forall db r. FieldChain -> UntypedExpr db r
ExprField (Any db -> SubField db v c a -> FieldChain
forall f a db (proxy :: * -> *).
(FieldLike f a, DbDescriptor db, ProjectionDb f db) =>
proxy db -> f -> FieldChain
fieldChain Any db
db SubField db v c a
f) UntypedExpr db r -> [UntypedExpr db r] -> [UntypedExpr db r]
forall a. a -> [a] -> [a]
:)
      db :: Any db
db = (forall db r (proxy :: * -> *).
([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db
forall a. HasCallStack => a
undefined :: ([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db) [UntypedExpr db r] -> [UntypedExpr db r]
result
  projectionResult :: SubField db v c a -> [PersistValue] -> m (a, [PersistValue])
projectionResult SubField db v c a
_ = [PersistValue] -> m (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues

instance PersistField a => Projection (Expr db r a) a where
  type ProjectionDb (Expr db r a) db' = db ~ db'
  type ProjectionRestriction (Expr db r a) r' = r ~ r'
  projectionExprs :: Expr db r a -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs (Expr UntypedExpr db r
e) = (UntypedExpr db r
UntypedExpr db r
e UntypedExpr db r -> [UntypedExpr db r] -> [UntypedExpr db r]
forall a. a -> [a] -> [a]
:)
  projectionResult :: Expr db r a -> [PersistValue] -> m (a, [PersistValue])
projectionResult Expr db r a
_ = [PersistValue] -> m (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues

instance a ~ Bool => Projection (Cond db r) a where
  type ProjectionDb (Cond db r) db' = db ~ db'
  type ProjectionRestriction (Cond db r) r' = r ~ r'
  projectionExprs :: Cond db r -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs Cond db r
cond = (Cond db r -> UntypedExpr db r
forall db r. Cond db r -> UntypedExpr db r
ExprCond Cond db r
cond UntypedExpr db r -> [UntypedExpr db r] -> [UntypedExpr db r]
forall a. a -> [a] -> [a]
:)
  projectionResult :: Cond db r -> [PersistValue] -> m (a, [PersistValue])
projectionResult Cond db r
_ = [PersistValue] -> m (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues

instance (EntityConstr v c, a ~ AutoKey v) => Projection (AutoKeyField v c) a where
  type ProjectionDb (AutoKeyField v c) db = ()
  type ProjectionRestriction (AutoKeyField v c) r = r ~ RestrictionHolder v c
  projectionExprs :: AutoKeyField v c -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs AutoKeyField v c
f = [UntypedExpr db r] -> [UntypedExpr db r]
result
    where
      result :: [UntypedExpr db r] -> [UntypedExpr db r]
result = (FieldChain -> UntypedExpr db r
forall db r. FieldChain -> UntypedExpr db r
ExprField (Any db -> AutoKeyField v c -> FieldChain
forall f a db (proxy :: * -> *).
(FieldLike f a, DbDescriptor db, ProjectionDb f db) =>
proxy db -> f -> FieldChain
fieldChain Any db
db AutoKeyField v c
f) UntypedExpr db r -> [UntypedExpr db r] -> [UntypedExpr db r]
forall a. a -> [a] -> [a]
:)
      db :: Any db
db = (forall db r (proxy :: * -> *).
([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db
forall a. HasCallStack => a
undefined :: ([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db) [UntypedExpr db r] -> [UntypedExpr db r]
result
  projectionResult :: AutoKeyField v c -> [PersistValue] -> m (a, [PersistValue])
projectionResult AutoKeyField v c
_ = [PersistValue] -> m (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues

instance EntityConstr v c => Projection (c (ConstructorMarker v)) v where
  type ProjectionDb (c (ConstructorMarker v)) db = ()
  type ProjectionRestriction (c (ConstructorMarker v)) r = r ~ RestrictionHolder v c
  projectionExprs :: c (ConstructorMarker v) -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs c (ConstructorMarker v)
c = [UntypedExpr db r] -> [UntypedExpr db r]
result
    where
      result :: [UntypedExpr db r] -> [UntypedExpr db r]
result = ((FieldChain -> UntypedExpr db r)
-> [FieldChain] -> [UntypedExpr db r]
forall a b. (a -> b) -> [a] -> [b]
map FieldChain -> UntypedExpr db r
forall db r. FieldChain -> UntypedExpr db r
ExprField [FieldChain]
chains [UntypedExpr db r] -> [UntypedExpr db r] -> [UntypedExpr db r]
forall a. [a] -> [a] -> [a]
++)
      chains :: [FieldChain]
chains = ((String, DbType) -> FieldChain)
-> [(String, DbType)] -> [FieldChain]
forall a b. (a -> b) -> [a] -> [b]
map (\(String, DbType)
f -> ((String, DbType)
f, [])) ([(String, DbType)] -> [FieldChain])
-> [(String, DbType)] -> [FieldChain]
forall a b. (a -> b) -> a -> b
$ ConstructorDef' String DbType -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef' String DbType
constr
      e :: EntityDef' String DbType
e = Any db -> v -> EntityDef' String DbType
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef' String DbType
entityDef Any db
db ((forall a. HasCallStack => a
forall (c :: (* -> *) -> *) v. c (ConstructorMarker v) -> v
undefined :: c (ConstructorMarker v) -> v) c (ConstructorMarker v)
c)
      cNum :: Int
cNum = Any v -> c (ConstructorMarker v) -> Int
forall v (c :: (* -> *) -> *) (proxy :: * -> *) (a :: * -> *).
EntityConstr v c =>
proxy v -> c a -> Int
entityConstrNum ((forall a. HasCallStack => a
forall (c :: (* -> *) -> *) v (proxy :: * -> *).
c (ConstructorMarker v) -> proxy v
undefined :: c (ConstructorMarker v) -> proxy v) c (ConstructorMarker v)
c) c (ConstructorMarker v)
c
      constr :: ConstructorDef' String DbType
constr = EntityDef' String DbType -> [ConstructorDef' String DbType]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef' String DbType
e [ConstructorDef' String DbType]
-> Int -> ConstructorDef' String DbType
forall a. [a] -> Int -> a
!! Int
cNum
      db :: Any db
db = (forall db r (proxy :: * -> *).
([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db
forall a. HasCallStack => a
undefined :: ([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db) [UntypedExpr db r] -> [UntypedExpr db r]
result
  projectionResult :: c (ConstructorMarker v) -> [PersistValue] -> m (v, [PersistValue])
projectionResult c (ConstructorMarker v)
c [PersistValue]
xs = Int -> m PersistValue
forall a (m :: * -> *).
(SinglePersistField a, PersistBackend m) =>
a -> m PersistValue
toSinglePersistValue Int
cNum m PersistValue
-> (PersistValue -> m (v, [PersistValue])) -> m (v, [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PersistValue
cNum' -> [PersistValue] -> m (v, [PersistValue])
forall v (m :: * -> *).
(PersistEntity v, PersistBackend m) =>
[PersistValue] -> m (v, [PersistValue])
fromEntityPersistValues (PersistValue
cNum' PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
: [PersistValue]
xs)
    where
      cNum :: Int
cNum = Any v -> c (ConstructorMarker v) -> Int
forall v (c :: (* -> *) -> *) (proxy :: * -> *) (a :: * -> *).
EntityConstr v c =>
proxy v -> c a -> Int
entityConstrNum ((forall a. HasCallStack => a
forall (c :: (* -> *) -> *) v (proxy :: * -> *).
c (ConstructorMarker v) -> proxy v
undefined :: c (ConstructorMarker v) -> proxy v) c (ConstructorMarker v)
c) c (ConstructorMarker v)
c

instance
  (PersistEntity v, IsUniqueKey k, k ~ Key v (Unique u)) =>
  Projection (u (UniqueMarker v)) k
  where
  type ProjectionDb (u (UniqueMarker v)) db = ()
  type ProjectionRestriction (u (UniqueMarker v)) (RestrictionHolder v' c) = v ~ v'
  projectionExprs :: u (UniqueMarker v) -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs u (UniqueMarker v)
u = [UntypedExpr db r] -> [UntypedExpr db r]
result
    where
      result :: [UntypedExpr db r] -> [UntypedExpr db r]
result = ((FieldChain -> UntypedExpr db r)
-> [FieldChain] -> [UntypedExpr db r]
forall a b. (a -> b) -> [a] -> [b]
map FieldChain -> UntypedExpr db r
forall db r. FieldChain -> UntypedExpr db r
ExprField [FieldChain]
chains [UntypedExpr db r] -> [UntypedExpr db r] -> [UntypedExpr db r]
forall a. [a] -> [a] -> [a]
++)
      uDef :: UniqueDef' String (Either (String, DbType) String)
uDef = ConstructorDef' String DbType
-> [UniqueDef' String (Either (String, DbType) String)]
forall str dbType.
ConstructorDef' str dbType
-> [UniqueDef' str (Either (str, dbType) str)]
constrUniques ConstructorDef' String DbType
constr [UniqueDef' String (Either (String, DbType) String)]
-> Int -> UniqueDef' String (Either (String, DbType) String)
forall a. [a] -> Int -> a
!! Key v (Unique u) -> Int
forall uKey. IsUniqueKey uKey => uKey -> Int
uniqueNum ((forall a. HasCallStack => a
forall (u :: (* -> *) -> *) v.
u (UniqueMarker v) -> Key v (Unique u)
undefined :: u (UniqueMarker v) -> Key v (Unique u)) u (UniqueMarker v)
u)
      chains :: [FieldChain]
chains = ((String, DbType) -> FieldChain)
-> [(String, DbType)] -> [FieldChain]
forall a b. (a -> b) -> [a] -> [b]
map (\(String, DbType)
f -> ((String, DbType)
f, [])) ([(String, DbType)] -> [FieldChain])
-> [(String, DbType)] -> [FieldChain]
forall a b. (a -> b) -> a -> b
$ UniqueDef' String (Either (String, DbType) String)
-> [(String, DbType)]
forall str field. UniqueDef' str (Either field str) -> [field]
getUniqueFields UniqueDef' String (Either (String, DbType) String)
uDef
      constr :: ConstructorDef' String DbType
constr = [ConstructorDef' String DbType] -> ConstructorDef' String DbType
forall a. [a] -> a
head ([ConstructorDef' String DbType] -> ConstructorDef' String DbType)
-> [ConstructorDef' String DbType] -> ConstructorDef' String DbType
forall a b. (a -> b) -> a -> b
$ EntityDef' String DbType -> [ConstructorDef' String DbType]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors (Any db -> v -> EntityDef' String DbType
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef' String DbType
entityDef Any db
db ((forall a. HasCallStack => a
forall (u :: (* -> *) -> *) v. u (UniqueMarker v) -> v
undefined :: u (UniqueMarker v) -> v) u (UniqueMarker v)
u))
      db :: Any db
db = (forall db r (proxy :: * -> *).
([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db
forall a. HasCallStack => a
undefined :: ([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db) [UntypedExpr db r] -> [UntypedExpr db r]
result
  projectionResult :: u (UniqueMarker v) -> [PersistValue] -> m (k, [PersistValue])
projectionResult u (UniqueMarker v)
_ = [PersistValue] -> m (k, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues

instance (Projection a1 a1', Projection a2 a2') => Projection (a1, a2) (a1', a2') where
  type ProjectionDb (a1, a2) db = (ProjectionDb a1 db, ProjectionDb a2 db)
  type ProjectionRestriction (a1, a2) r = (ProjectionRestriction a1 r, ProjectionRestriction a2 r)
  projectionExprs :: (a1, a2) -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs (a1
a1, a2
a2) = a1 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a1
a1 ([UntypedExpr db r] -> [UntypedExpr db r])
-> ([UntypedExpr db r] -> [UntypedExpr db r])
-> [UntypedExpr db r]
-> [UntypedExpr db r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a2 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a2
a2
  projectionResult :: (a1, a2) -> [PersistValue] -> m ((a1', a2'), [PersistValue])
projectionResult (a1
a', a2
b') [PersistValue]
xs = do
    (a1'
a, [PersistValue]
rest0) <- a1 -> [PersistValue] -> m (a1', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a1
a' [PersistValue]
xs
    (a2'
b, [PersistValue]
rest1) <- a2 -> [PersistValue] -> m (a2', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a2
b' [PersistValue]
rest0
    ((a1', a2'), [PersistValue]) -> m ((a1', a2'), [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a1'
a, a2'
b), [PersistValue]
rest1)

instance (Projection a1 a1', Projection a2 a2', Projection a3 a3') => Projection (a1, a2, a3) (a1', a2', a3') where
  type ProjectionDb (a1, a2, a3) db = (ProjectionDb (a1, a2) db, ProjectionDb a3 db)
  type ProjectionRestriction (a1, a2, a3) r = (ProjectionRestriction (a1, a2) r, ProjectionRestriction a3 r)
  projectionExprs :: (a1, a2, a3) -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs (a1
a1, a2
a2, a3
a3) = a1 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a1
a1 ([UntypedExpr db r] -> [UntypedExpr db r])
-> ([UntypedExpr db r] -> [UntypedExpr db r])
-> [UntypedExpr db r]
-> [UntypedExpr db r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a2 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a2
a2 ([UntypedExpr db r] -> [UntypedExpr db r])
-> ([UntypedExpr db r] -> [UntypedExpr db r])
-> [UntypedExpr db r]
-> [UntypedExpr db r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a3 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a3
a3
  projectionResult :: (a1, a2, a3)
-> [PersistValue] -> m ((a1', a2', a3'), [PersistValue])
projectionResult (a1
a', a2
b', a3
c') [PersistValue]
xs = do
    (a1'
a, [PersistValue]
rest0) <- a1 -> [PersistValue] -> m (a1', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a1
a' [PersistValue]
xs
    (a2'
b, [PersistValue]
rest1) <- a2 -> [PersistValue] -> m (a2', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a2
b' [PersistValue]
rest0
    (a3'
c, [PersistValue]
rest2) <- a3 -> [PersistValue] -> m (a3', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a3
c' [PersistValue]
rest1
    ((a1', a2', a3'), [PersistValue])
-> m ((a1', a2', a3'), [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a1'
a, a2'
b, a3'
c), [PersistValue]
rest2)

instance (Projection a1 a1', Projection a2 a2', Projection a3 a3', Projection a4 a4') => Projection (a1, a2, a3, a4) (a1', a2', a3', a4') where
  type ProjectionDb (a1, a2, a3, a4) db = (ProjectionDb (a1, a2, a3) db, ProjectionDb a4 db)
  type ProjectionRestriction (a1, a2, a3, a4) r = (ProjectionRestriction (a1, a2, a3) r, ProjectionRestriction a4 r)
  projectionExprs :: (a1, a2, a3, a4) -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs (a1
a1, a2
a2, a3
a3, a4
a4) = a1 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a1
a1 ([UntypedExpr db r] -> [UntypedExpr db r])
-> ([UntypedExpr db r] -> [UntypedExpr db r])
-> [UntypedExpr db r]
-> [UntypedExpr db r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a2 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a2
a2 ([UntypedExpr db r] -> [UntypedExpr db r])
-> ([UntypedExpr db r] -> [UntypedExpr db r])
-> [UntypedExpr db r]
-> [UntypedExpr db r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a3 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a3
a3 ([UntypedExpr db r] -> [UntypedExpr db r])
-> ([UntypedExpr db r] -> [UntypedExpr db r])
-> [UntypedExpr db r]
-> [UntypedExpr db r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a4 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a4
a4
  projectionResult :: (a1, a2, a3, a4)
-> [PersistValue] -> m ((a1', a2', a3', a4'), [PersistValue])
projectionResult (a1
a', a2
b', a3
c', a4
d') [PersistValue]
xs = do
    (a1'
a, [PersistValue]
rest0) <- a1 -> [PersistValue] -> m (a1', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a1
a' [PersistValue]
xs
    (a2'
b, [PersistValue]
rest1) <- a2 -> [PersistValue] -> m (a2', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a2
b' [PersistValue]
rest0
    (a3'
c, [PersistValue]
rest2) <- a3 -> [PersistValue] -> m (a3', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a3
c' [PersistValue]
rest1
    (a4'
d, [PersistValue]
rest3) <- a4 -> [PersistValue] -> m (a4', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a4
d' [PersistValue]
rest2
    ((a1', a2', a3', a4'), [PersistValue])
-> m ((a1', a2', a3', a4'), [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a1'
a, a2'
b, a3'
c, a4'
d), [PersistValue]
rest3)

instance (Projection a1 a1', Projection a2 a2', Projection a3 a3', Projection a4 a4', Projection a5 a5') => Projection (a1, a2, a3, a4, a5) (a1', a2', a3', a4', a5') where
  type ProjectionDb (a1, a2, a3, a4, a5) db = (ProjectionDb (a1, a2, a3, a4) db, ProjectionDb a5 db)
  type ProjectionRestriction (a1, a2, a3, a4, a5) r = (ProjectionRestriction (a1, a2, a3, a4) r, ProjectionRestriction a5 r)
  projectionExprs :: (a1, a2, a3, a4, a5) -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5) = a1 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a1
a1 ([UntypedExpr db r] -> [UntypedExpr db r])
-> ([UntypedExpr db r] -> [UntypedExpr db r])
-> [UntypedExpr db r]
-> [UntypedExpr db r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a2 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a2
a2 ([UntypedExpr db r] -> [UntypedExpr db r])
-> ([UntypedExpr db r] -> [UntypedExpr db r])
-> [UntypedExpr db r]
-> [UntypedExpr db r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a3 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a3
a3 ([UntypedExpr db r] -> [UntypedExpr db r])
-> ([UntypedExpr db r] -> [UntypedExpr db r])
-> [UntypedExpr db r]
-> [UntypedExpr db r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a4 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a4
a4 ([UntypedExpr db r] -> [UntypedExpr db r])
-> ([UntypedExpr db r] -> [UntypedExpr db r])
-> [UntypedExpr db r]
-> [UntypedExpr db r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a5 -> [UntypedExpr db r] -> [UntypedExpr db r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs a5
a5
  projectionResult :: (a1, a2, a3, a4, a5)
-> [PersistValue] -> m ((a1', a2', a3', a4', a5'), [PersistValue])
projectionResult (a1
a', a2
b', a3
c', a4
d', a5
e') [PersistValue]
xs = do
    (a1'
a, [PersistValue]
rest0) <- a1 -> [PersistValue] -> m (a1', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a1
a' [PersistValue]
xs
    (a2'
b, [PersistValue]
rest1) <- a2 -> [PersistValue] -> m (a2', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a2
b' [PersistValue]
rest0
    (a3'
c, [PersistValue]
rest2) <- a3 -> [PersistValue] -> m (a3', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a3
c' [PersistValue]
rest1
    (a4'
d, [PersistValue]
rest3) <- a4 -> [PersistValue] -> m (a4', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a4
d' [PersistValue]
rest2
    (a5'
e, [PersistValue]
rest4) <- a5 -> [PersistValue] -> m (a5', [PersistValue])
forall p a (m :: * -> *).
(Projection p a, PersistBackend m) =>
p -> [PersistValue] -> m (a, [PersistValue])
projectionResult a5
e' [PersistValue]
rest3
    ((a1', a2', a3', a4', a5'), [PersistValue])
-> m ((a1', a2', a3', a4', a5'), [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a1'
a, a2'
b, a3'
c, a4'
d, a5'
e), [PersistValue]
rest4)

instance (EntityConstr v c, a ~ AutoKey v) => Assignable (AutoKeyField v c) a

instance (EntityConstr v c, PersistField a) => Assignable (SubField db v c a) a

instance (EntityConstr v c, PersistField a) => Assignable (Field v c a) a

instance (PersistEntity v, IsUniqueKey k, k ~ Key v (Unique u)) => Assignable (u (UniqueMarker v)) k

instance (EntityConstr v c, a ~ AutoKey v) => FieldLike (AutoKeyField v c) a where
  fieldChain :: proxy db -> AutoKeyField v c -> FieldChain
fieldChain proxy db
db AutoKeyField v c
a = FieldChain
chain
    where
      chain :: FieldChain
chain = ((String
name, proxy db -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType proxy db
db a
AutoKey v
k), [])
      -- if it is Nothing, the name would not be used because the type will be () with no columns
      name :: String
name = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"will_be_ignored" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ ConstructorDef' String DbType -> Maybe String
forall str dbType. ConstructorDef' str dbType -> Maybe str
constrAutoKeyName (ConstructorDef' String DbType -> Maybe String)
-> ConstructorDef' String DbType -> Maybe String
forall a b. (a -> b) -> a -> b
$ EntityDef' String DbType -> [ConstructorDef' String DbType]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef' String DbType
e [ConstructorDef' String DbType]
-> Int -> ConstructorDef' String DbType
forall a. [a] -> Int -> a
!! Int
cNum
      k :: AutoKey v
k = (forall v (c :: (* -> *) -> *). AutoKeyField v c -> AutoKey v
forall a. HasCallStack => a
undefined :: AutoKeyField v c -> AutoKey v) AutoKeyField v c
a

      e :: EntityDef' String DbType
e = proxy db -> v -> EntityDef' String DbType
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef' String DbType
entityDef proxy db
db ((forall v (c :: (* -> *) -> *). AutoKeyField v c -> v
forall a. HasCallStack => a
undefined :: AutoKeyField v c -> v) AutoKeyField v c
a)
      cNum :: Int
cNum = Any v -> c (ConstructorMarker v) -> Int
forall v (c :: (* -> *) -> *) (proxy :: * -> *) (a :: * -> *).
EntityConstr v c =>
proxy v -> c a -> Int
entityConstrNum ((forall v (c :: (* -> *) -> *) (proxy :: * -> *).
AutoKeyField v c -> proxy v
forall a. HasCallStack => a
undefined :: AutoKeyField v c -> proxy v) AutoKeyField v c
a) ((forall v (c :: (* -> *) -> *).
AutoKeyField v c -> c (ConstructorMarker v)
forall a. HasCallStack => a
undefined :: AutoKeyField v c -> c (ConstructorMarker v)) AutoKeyField v c
a)

instance (EntityConstr v c, PersistField a) => FieldLike (SubField db v c a) a where
  fieldChain :: proxy db -> SubField db v c a -> FieldChain
fieldChain proxy db
_ (SubField FieldChain
a) = FieldChain
a

instance (EntityConstr v c, PersistField a) => FieldLike (Field v c a) a where
  fieldChain :: proxy db -> Field v c a -> FieldChain
fieldChain = proxy db -> Field v c a -> FieldChain
forall v db (proxy :: * -> *) (c :: (* -> *) -> *) a.
(PersistEntity v, DbDescriptor db) =>
proxy db -> Field v c a -> FieldChain
entityFieldChain

instance
  (PersistEntity v, IsUniqueKey k, k ~ Key v (Unique u)) =>
  FieldLike (u (UniqueMarker v)) k
  where
  fieldChain :: proxy db -> u (UniqueMarker v) -> FieldChain
fieldChain proxy db
db u (UniqueMarker v)
u = FieldChain
chain
    where
      uDef :: UniqueDef' String (Either (String, DbType) String)
uDef = ConstructorDef' String DbType
-> [UniqueDef' String (Either (String, DbType) String)]
forall str dbType.
ConstructorDef' str dbType
-> [UniqueDef' str (Either (str, dbType) str)]
constrUniques ConstructorDef' String DbType
constr [UniqueDef' String (Either (String, DbType) String)]
-> Int -> UniqueDef' String (Either (String, DbType) String)
forall a. [a] -> Int -> a
!! Key v (Unique u) -> Int
forall uKey. IsUniqueKey uKey => uKey -> Int
uniqueNum ((forall a. HasCallStack => a
forall (u :: (* -> *) -> *) v.
u (UniqueMarker v) -> Key v (Unique u)
undefined :: u (UniqueMarker v) -> Key v (Unique u)) u (UniqueMarker v)
u)
      chain :: FieldChain
chain = ((String
"will_be_ignored", EmbeddedDef' String DbType -> Maybe ParentTableReference -> DbType
DbEmbedded (Bool -> [(String, DbType)] -> EmbeddedDef' String DbType
forall str dbType.
Bool -> [(str, dbType)] -> EmbeddedDef' str dbType
EmbeddedDef Bool
True ([(String, DbType)] -> EmbeddedDef' String DbType)
-> [(String, DbType)] -> EmbeddedDef' String DbType
forall a b. (a -> b) -> a -> b
$ UniqueDef' String (Either (String, DbType) String)
-> [(String, DbType)]
forall str field. UniqueDef' str (Either field str) -> [field]
getUniqueFields UniqueDef' String (Either (String, DbType) String)
uDef) Maybe ParentTableReference
forall a. Maybe a
Nothing), [])
      constr :: ConstructorDef' String DbType
constr = [ConstructorDef' String DbType] -> ConstructorDef' String DbType
forall a. [a] -> a
head ([ConstructorDef' String DbType] -> ConstructorDef' String DbType)
-> [ConstructorDef' String DbType] -> ConstructorDef' String DbType
forall a b. (a -> b) -> a -> b
$ EntityDef' String DbType -> [ConstructorDef' String DbType]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors (proxy db -> v -> EntityDef' String DbType
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef' String DbType
entityDef proxy db
db ((forall a. HasCallStack => a
forall (u :: (* -> *) -> *) v. u (UniqueMarker v) -> v
undefined :: u (UniqueMarker v) -> v) u (UniqueMarker v)
u))

instance (PersistEntity v, EntityConstr' (IsSumType v) c) => EntityConstr v c where
  entityConstrNum :: proxy v -> c a -> Int
entityConstrNum proxy v
v = IsSumType v -> c a -> Int
forall flag (c :: (* -> *) -> *) (a :: * -> *).
EntityConstr' flag c =>
flag -> c a -> Int
entityConstrNum' (IsSumType v -> c a -> Int) -> IsSumType v -> c a -> Int
forall a b. (a -> b) -> a -> b
$ (forall a. HasCallStack => a
forall (proxy :: * -> *) v. proxy v -> IsSumType v
undefined :: proxy v -> IsSumType v) proxy v
v

class EntityConstr' flag c where
  entityConstrNum' :: flag -> c (a :: Type -> Type) -> Int

instance EntityConstr' HFalse c where
  entityConstrNum' :: HFalse -> c a -> Int
entityConstrNum' HFalse
_ c a
_ = Int
0

instance Constructor c => EntityConstr' HTrue c where
  entityConstrNum' :: HTrue -> c a -> Int
entityConstrNum' HTrue
_ = c a -> Int
forall (c :: (* -> *) -> *) (a :: * -> *).
Constructor c =>
c a -> Int
phantomConstrNum

instance A.FromJSON PersistValue where
  parseJSON :: Value -> Parser PersistValue
parseJSON (A.String Text
t) = PersistValue -> Parser PersistValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PersistValue -> Parser PersistValue)
-> PersistValue -> Parser PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> PersistValue
PersistText Text
t
  parseJSON (A.Number Scientific
n) =
    PersistValue -> Parser PersistValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 (f :: * -> *) a. Applicative f => a -> f a
pure PersistValue
PersistNull
  parseJSON Value
a = 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
"parseJSON PersistValue: unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
a

instance A.ToJSON PersistValue where
  toJSON :: PersistValue -> Value
toJSON (PersistString String
t) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
t
  toJSON (PersistText Text
t) = Text -> Value
A.String Text
t
  toJSON (PersistByteString ByteString
b) = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.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 (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
$ 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
$ 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
$ Day -> String
forall a. Show a => a -> String
show Day
d
  toJSON (PersistZonedTime (ZT ZonedTime
z)) = 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
$ ZonedTime -> String
forall a. Show a => a -> String
show ZonedTime
z
  toJSON PersistValue
PersistNull = Value
A.Null
  toJSON a :: PersistValue
a@(PersistCustom Utf8
_ [PersistValue]
_) = String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"toJSON: unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
a

instance Read (Key v u) => A.FromJSON (Key v u) where
  parseJSON :: Value -> Parser (Key v u)
parseJSON Value
a = String -> Key v u
forall a. Read a => String -> a
read (String -> Key v u) -> Parser String -> Parser (Key v u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
a

instance Show (Key v u) => A.ToJSON (Key v u) where
  toJSON :: Key v u -> Value
toJSON Key v u
k = String -> Value
forall a. ToJSON a => a -> Value
A.toJSON (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Key v u -> String
forall a. Show a => a -> String
show Key v u
k