{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DataKinds #-}

module Database.Persist.Sql.Class
    ( RawSql (..)
    , PersistFieldSql (..)
    , EntityWithPrefix(..)
    , unPrefix
    ) where

import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
import Data.Bits (bitSizeMaybe)
import Data.ByteString (ByteString)
import Data.Fixed
import Data.Int
import qualified Data.IntMap as IM
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Proxy (Proxy(..))
import qualified Data.Set as S
import Data.Text (Text, intercalate, pack)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time (UTCTime, TimeOfDay, Day)
import qualified Data.Vector as V
import Data.Word
import Numeric.Natural (Natural)
import Text.Blaze.Html (Html)

import Database.Persist
import Database.Persist.Sql.Types


-- | Class for data types that may be retrived from a 'rawSql'
-- query.
class RawSql a where
    -- | Number of columns that this data type needs and the list
    -- of substitutions for @SELECT@ placeholders @??@.
    rawSqlCols :: (DBName -> Text) -> a -> (Int, [Text])

    -- | A string telling the user why the column count is what
    -- it is.
    rawSqlColCountReason :: a -> String

    -- | Transform a row of the result into the data type.
    rawSqlProcessRow :: [PersistValue] -> Either Text a

instance PersistField a => RawSql (Single a) where
    rawSqlCols :: (DBName -> Text) -> Single a -> (Int, [Text])
rawSqlCols DBName -> Text
_ Single a
_         = (Int
1, [])
    rawSqlColCountReason :: Single a -> String
rawSqlColCountReason Single a
_ = String
"one column for a 'Single' data type"
    rawSqlProcessRow :: [PersistValue] -> Either Text (Single a)
rawSqlProcessRow [PersistValue
pv]  = a -> Single a
forall a. a -> Single a
Single (a -> Single a) -> Either Text a -> Either Text (Single a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistValue -> Either Text a
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
pv
    rawSqlProcessRow [PersistValue]
_     = Text -> Either Text (Single a)
forall a b. a -> Either a b
Left (Text -> Either Text (Single a)) -> Text -> Either Text (Single a)
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
"RawSql (Single a): wrong number of columns."

instance
    (PersistEntity a, PersistEntityBackend a ~ backend, IsPersistBackend backend) =>
    RawSql (Key a) where
    rawSqlCols :: (DBName -> Text) -> Key a -> (Int, [Text])
rawSqlCols DBName -> Text
_ Key a
key         = ([PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PersistValue] -> Int) -> [PersistValue] -> Int
forall a b. (a -> b) -> a -> b
$ Key a -> [PersistValue]
forall record. PersistEntity record => Key record -> [PersistValue]
keyToValues Key a
key, [])
    rawSqlColCountReason :: Key a -> String
rawSqlColCountReason Key a
key = String
"The primary key is composed of "
                               String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PersistValue] -> Int) -> [PersistValue] -> Int
forall a b. (a -> b) -> a -> b
$ Key a -> [PersistValue]
forall record. PersistEntity record => Key record -> [PersistValue]
keyToValues Key a
key)
                               String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" columns"
    rawSqlProcessRow :: [PersistValue] -> Either Text (Key a)
rawSqlProcessRow         = [PersistValue] -> Either Text (Key a)
forall record.
PersistEntity record =>
[PersistValue] -> Either Text (Key record)
keyFromValues

instance
    (PersistEntity record, PersistEntityBackend record ~ backend, IsPersistBackend backend) =>
    RawSql (Entity record) where
    rawSqlCols :: (DBName -> Text) -> Entity record -> (Int, [Text])
rawSqlCols DBName -> Text
escape Entity record
_ent = ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sqlFields, [Text -> [Text] -> Text
intercalate Text
", " [Text]
sqlFields])
        where
          sqlFields :: [Text]
sqlFields = (DBName -> Text) -> [DBName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (((Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (DBName -> Text) -> DBName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBName -> Text
escape)
              ([DBName] -> [Text]) -> [DBName] -> [Text]
forall a b. (a -> b) -> a -> b
$ (FieldDef -> DBName) -> [FieldDef] -> [DBName]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> DBName
fieldDB
              -- Hacky for a composite key because
              -- it selects the same field multiple times
              ([FieldDef] -> [DBName]) -> [FieldDef] -> [DBName]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityKeyFields EntityDef
entDef [FieldDef] -> [FieldDef] -> [FieldDef]
forall a. [a] -> [a] -> [a]
++ EntityDef -> [FieldDef]
entityFields EntityDef
entDef
          name :: Text
name = DBName -> Text
escape (EntityDef -> DBName
entityDB EntityDef
entDef)
          entDef :: EntityDef
entDef = Maybe record -> EntityDef
forall record (m :: * -> *).
(PersistEntity record, Monad m) =>
m record -> EntityDef
entityDef (Maybe record
forall a. Maybe a
Nothing :: Maybe record)
    rawSqlColCountReason :: Entity record -> String
rawSqlColCountReason Entity record
a =
        case (Int, [Text]) -> Int
forall a b. (a, b) -> a
fst ((DBName -> Text) -> Entity record -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols (String -> DBName -> Text
forall a. HasCallStack => String -> a
error String
"RawSql") Entity record
a) of
          Int
1 -> String
"one column for an 'Entity' data type without fields"
          Int
n -> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" columns for an 'Entity' data type"
    rawSqlProcessRow :: [PersistValue] -> Either Text (Entity record)
rawSqlProcessRow [PersistValue]
row = case Int -> [PersistValue] -> ([PersistValue], [PersistValue])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
nKeyFields [PersistValue]
row of
      ([PersistValue]
rowKey, [PersistValue]
rowVal) -> Key record -> record -> Entity record
forall record. Key record -> record -> Entity record
Entity (Key record -> record -> Entity record)
-> Either Text (Key record)
-> Either Text (record -> Entity record)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PersistValue] -> Either Text (Key record)
forall record.
PersistEntity record =>
[PersistValue] -> Either Text (Key record)
keyFromValues [PersistValue]
rowKey
                                 Either Text (record -> Entity record)
-> Either Text record -> Either Text (Entity record)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PersistValue] -> Either Text record
forall record.
PersistEntity record =>
[PersistValue] -> Either Text record
fromPersistValues [PersistValue]
rowVal
      where
        nKeyFields :: Int
nKeyFields = [FieldDef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([FieldDef] -> Int) -> [FieldDef] -> Int
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityKeyFields EntityDef
entDef
        entDef :: EntityDef
entDef = Maybe record -> EntityDef
forall record (m :: * -> *).
(PersistEntity record, Monad m) =>
m record -> EntityDef
entityDef (Maybe record
forall a. Maybe a
Nothing :: Maybe record)

-- | This newtype wrapper is useful when selecting an entity out of the
-- database and you want to provide a prefix to the table being selected.
--
-- Consider this raw SQL query:
--
-- > SELECT ??
-- > FROM my_long_table_name AS mltn
-- > INNER JOIN other_table AS ot
-- >    ON mltn.some_col = ot.other_col
-- > WHERE ...
--
-- We don't want to refer to @my_long_table_name@ every time, so we create
-- an alias. If we want to select it, we have to tell the raw SQL
-- quasi-quoter that we expect the entity to be prefixed with some other
-- name.
--
-- We can give the above query a type with this, like:
--
-- @
-- getStuff :: 'SqlPersistM' ['EntityWithPrefix' \"mltn\" MyLongTableName]
-- getStuff = rawSql queryText []
-- @
--
-- The 'EntityWithPrefix' bit is a boilerplate newtype wrapper, so you can
-- remove it with 'unPrefix', like this:
--
-- @
-- getStuff :: 'SqlPersistM' ['Entity' MyLongTableName]
-- getStuff = 'unPrefix' @\"mltn\" '<$>' 'rawSql' queryText []
-- @
--
-- The @ symbol is a "type application" and requires the @TypeApplications@
-- language extension.
--
-- @since 2.10.5
newtype EntityWithPrefix (prefix :: Symbol) record
    = EntityWithPrefix { EntityWithPrefix prefix record -> Entity record
unEntityWithPrefix :: Entity record }

-- | A helper function to tell GHC what the 'EntityWithPrefix' prefix
-- should be. This allows you to use a type application to specify the
-- prefix, instead of specifying the etype on the result.
--
-- As an example, here's code that uses this:
--
-- @
-- myQuery :: 'SqlPersistM' ['Entity' Person]
-- myQuery = map (unPrefix @\"p\") <$> rawSql query []
--   where
--     query = "SELECT ?? FROM person AS p"
-- @
--
-- @since 2.10.5
unPrefix :: forall prefix record. EntityWithPrefix prefix record -> Entity record
unPrefix :: EntityWithPrefix prefix record -> Entity record
unPrefix = EntityWithPrefix prefix record -> Entity record
forall (prefix :: Symbol) record.
EntityWithPrefix prefix record -> Entity record
unEntityWithPrefix

instance
    ( PersistEntity record
    , KnownSymbol prefix
    , PersistEntityBackend record ~ backend
    , IsPersistBackend backend
    )
  => RawSql (EntityWithPrefix prefix record) where
    rawSqlCols :: (DBName -> Text) -> EntityWithPrefix prefix record -> (Int, [Text])
rawSqlCols DBName -> Text
escape EntityWithPrefix prefix record
_ent = ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
sqlFields, [Text -> [Text] -> Text
intercalate Text
", " [Text]
sqlFields])
        where
          sqlFields :: [Text]
sqlFields = (DBName -> Text) -> [DBName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (((Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (DBName -> Text) -> DBName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBName -> Text
escape)
              ([DBName] -> [Text]) -> [DBName] -> [Text]
forall a b. (a -> b) -> a -> b
$ (FieldDef -> DBName) -> [FieldDef] -> [DBName]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> DBName
fieldDB
              -- Hacky for a composite key because
              -- it selects the same field multiple times
              ([FieldDef] -> [DBName]) -> [FieldDef] -> [DBName]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityKeyFields EntityDef
entDef [FieldDef] -> [FieldDef] -> [FieldDef]
forall a. [a] -> [a] -> [a]
++ EntityDef -> [FieldDef]
entityFields EntityDef
entDef
          name :: Text
name = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy prefix -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy prefix
forall k (t :: k). Proxy t
Proxy :: Proxy prefix)
          entDef :: EntityDef
entDef = Maybe record -> EntityDef
forall record (m :: * -> *).
(PersistEntity record, Monad m) =>
m record -> EntityDef
entityDef (Maybe record
forall a. Maybe a
Nothing :: Maybe record)
    rawSqlColCountReason :: EntityWithPrefix prefix record -> String
rawSqlColCountReason EntityWithPrefix prefix record
a =
        case (Int, [Text]) -> Int
forall a b. (a, b) -> a
fst ((DBName -> Text) -> EntityWithPrefix prefix record -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols (String -> DBName -> Text
forall a. HasCallStack => String -> a
error String
"RawSql") EntityWithPrefix prefix record
a) of
          Int
1 -> String
"one column for an 'Entity' data type without fields"
          Int
n -> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" columns for an 'Entity' data type"
    rawSqlProcessRow :: [PersistValue] -> Either Text (EntityWithPrefix prefix record)
rawSqlProcessRow [PersistValue]
row = case Int -> [PersistValue] -> ([PersistValue], [PersistValue])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
nKeyFields [PersistValue]
row of
      ([PersistValue]
rowKey, [PersistValue]
rowVal) -> (Entity record -> EntityWithPrefix prefix record)
-> Either Text (Entity record)
-> Either Text (EntityWithPrefix prefix record)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity record -> EntityWithPrefix prefix record
forall (prefix :: Symbol) record.
Entity record -> EntityWithPrefix prefix record
EntityWithPrefix (Either Text (Entity record)
 -> Either Text (EntityWithPrefix prefix record))
-> Either Text (Entity record)
-> Either Text (EntityWithPrefix prefix record)
forall a b. (a -> b) -> a -> b
$ Key record -> record -> Entity record
forall record. Key record -> record -> Entity record
Entity (Key record -> record -> Entity record)
-> Either Text (Key record)
-> Either Text (record -> Entity record)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PersistValue] -> Either Text (Key record)
forall record.
PersistEntity record =>
[PersistValue] -> Either Text (Key record)
keyFromValues [PersistValue]
rowKey
                                 Either Text (record -> Entity record)
-> Either Text record -> Either Text (Entity record)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PersistValue] -> Either Text record
forall record.
PersistEntity record =>
[PersistValue] -> Either Text record
fromPersistValues [PersistValue]
rowVal
      where
        nKeyFields :: Int
nKeyFields = [FieldDef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([FieldDef] -> Int) -> [FieldDef] -> Int
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityKeyFields EntityDef
entDef
        entDef :: EntityDef
entDef = Maybe record -> EntityDef
forall record (m :: * -> *).
(PersistEntity record, Monad m) =>
m record -> EntityDef
entityDef (Maybe record
forall a. Maybe a
Nothing :: Maybe record)

-- | @since 1.0.1
instance RawSql a => RawSql (Maybe a) where
    rawSqlCols :: (DBName -> Text) -> Maybe a -> (Int, [Text])
rawSqlCols DBName -> Text
e = (DBName -> Text) -> a -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e (a -> (Int, [Text])) -> (Maybe a -> a) -> Maybe a -> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> a
forall a. Maybe a -> a
extractMaybe
    rawSqlColCountReason :: Maybe a -> String
rawSqlColCountReason = a -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (a -> String) -> (Maybe a -> a) -> Maybe a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> a
forall a. Maybe a -> a
extractMaybe
    rawSqlProcessRow :: [PersistValue] -> Either Text (Maybe a)
rawSqlProcessRow [PersistValue]
cols
      | (PersistValue -> Bool) -> [PersistValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PersistValue -> Bool
isNull [PersistValue]
cols = Maybe a -> Either Text (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
      | Bool
otherwise       =
        case [PersistValue] -> Either Text a
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow [PersistValue]
cols of
          Right a
v  -> Maybe a -> Either Text (Maybe a)
forall a b. b -> Either a b
Right (a -> Maybe a
forall a. a -> Maybe a
Just a
v)
          Left Text
msg -> Text -> Either Text (Maybe a)
forall a b. a -> Either a b
Left (Text -> Either Text (Maybe a)) -> Text -> Either Text (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text
"RawSql (Maybe a): not all columns were Null " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                             Text
"but the inner parser has failed.  Its message " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                             Text
"was \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\".  Did you apply Maybe " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                             Text
"to a tuple, perhaps?  The main use case for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                             Text
"Maybe is to allow OUTER JOINs to be written, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                             Text
"in which case 'Maybe (Entity v)' is used."
      where isNull :: PersistValue -> Bool
isNull PersistValue
PersistNull = Bool
True
            isNull PersistValue
_           = Bool
False

instance (RawSql a, RawSql b) => RawSql (a, b) where
    rawSqlCols :: (DBName -> Text) -> (a, b) -> (Int, [Text])
rawSqlCols DBName -> Text
e (a, b)
x = (DBName -> Text) -> a -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x) (Int, [Text]) -> (Int, [Text]) -> (Int, [Text])
forall a a. Num a => (a, [a]) -> (a, [a]) -> (a, [a])
# (DBName -> Text) -> b -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e ((a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
x)
        where (a
cnta, [a]
lsta) # :: (a, [a]) -> (a, [a]) -> (a, [a])
# (a
cntb, [a]
lstb) = (a
cnta a -> a -> a
forall a. Num a => a -> a -> a
+ a
cntb, [a]
lsta [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
lstb)
    rawSqlColCountReason :: (a, b) -> String
rawSqlColCountReason (a, b)
x = a -> String
forall a. RawSql a => a -> String
rawSqlColCountReason ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                             b -> String
forall a. RawSql a => a -> String
rawSqlColCountReason ((a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
x)
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b)
rawSqlProcessRow =
        let x :: (a, b)
x = ([PersistValue] -> Either Text (a, b)) -> (a, b)
forall z y x. (z -> Either y x) -> x
getType [PersistValue] -> Either Text (a, b)
processRow
            getType :: (z -> Either y x) -> x
            getType :: (z -> Either y x) -> x
getType = String -> (z -> Either y x) -> x
forall a. HasCallStack => String -> a
error String
"RawSql.getType"

            colCountFst :: Int
colCountFst = (Int, [Text]) -> Int
forall a b. (a, b) -> a
fst ((Int, [Text]) -> Int) -> (Int, [Text]) -> Int
forall a b. (a -> b) -> a -> b
$ (DBName -> Text) -> a -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols (String -> DBName -> Text
forall a. HasCallStack => String -> a
error String
"RawSql.getType2") ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
x)
            processRow :: [PersistValue] -> Either Text (a, b)
processRow [PersistValue]
row =
                let ([PersistValue]
rowFst, [PersistValue]
rowSnd) = Int -> [PersistValue] -> ([PersistValue], [PersistValue])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
colCountFst [PersistValue]
row
                in (,) (a -> b -> (a, b)) -> Either Text a -> Either Text (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PersistValue] -> Either Text a
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow [PersistValue]
rowFst
                       Either Text (b -> (a, b)) -> Either Text b -> Either Text (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PersistValue] -> Either Text b
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow [PersistValue]
rowSnd

        in Int
colCountFst Int
-> ([PersistValue] -> Either Text (a, b))
-> [PersistValue]
-> Either Text (a, b)
`seq` [PersistValue] -> Either Text (a, b)
processRow
           -- Avoids recalculating 'colCountFst'.

instance (RawSql a, RawSql b, RawSql c) => RawSql (a, b, c) where
    rawSqlCols :: (DBName -> Text) -> (a, b, c) -> (Int, [Text])
rawSqlCols DBName -> Text
e         = (DBName -> Text) -> ((a, b), c) -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e         (((a, b), c) -> (Int, [Text]))
-> ((a, b, c) -> ((a, b), c)) -> (a, b, c) -> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c) -> ((a, b), c)
forall a b c. (a, b, c) -> ((a, b), c)
from3
    rawSqlColCountReason :: (a, b, c) -> String
rawSqlColCountReason = ((a, b), c) -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (((a, b), c) -> String)
-> ((a, b, c) -> ((a, b), c)) -> (a, b, c) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c) -> ((a, b), c)
forall a b c. (a, b, c) -> ((a, b), c)
from3
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b, c)
rawSqlProcessRow     = (((a, b), c) -> (a, b, c))
-> Either Text ((a, b), c) -> Either Text (a, b, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, b), c) -> (a, b, c)
forall a b c. ((a, b), c) -> (a, b, c)
to3 (Either Text ((a, b), c) -> Either Text (a, b, c))
-> ([PersistValue] -> Either Text ((a, b), c))
-> [PersistValue]
-> Either Text (a, b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((a, b), c)
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow

from3 :: (a,b,c) -> ((a,b),c)
from3 :: (a, b, c) -> ((a, b), c)
from3 (a
a,b
b,c
c) = ((a
a,b
b),c
c)

to3 :: ((a,b),c) -> (a,b,c)
to3 :: ((a, b), c) -> (a, b, c)
to3 ((a
a,b
b),c
c) = (a
a,b
b,c
c)

instance (RawSql a, RawSql b, RawSql c, RawSql d) => RawSql (a, b, c, d) where
    rawSqlCols :: (DBName -> Text) -> (a, b, c, d) -> (Int, [Text])
rawSqlCols DBName -> Text
e         = (DBName -> Text) -> ((a, b), (c, d)) -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e         (((a, b), (c, d)) -> (Int, [Text]))
-> ((a, b, c, d) -> ((a, b), (c, d)))
-> (a, b, c, d)
-> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d) -> ((a, b), (c, d))
forall a b c d. (a, b, c, d) -> ((a, b), (c, d))
from4
    rawSqlColCountReason :: (a, b, c, d) -> String
rawSqlColCountReason = ((a, b), (c, d)) -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (((a, b), (c, d)) -> String)
-> ((a, b, c, d) -> ((a, b), (c, d))) -> (a, b, c, d) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d) -> ((a, b), (c, d))
forall a b c d. (a, b, c, d) -> ((a, b), (c, d))
from4
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b, c, d)
rawSqlProcessRow     = (((a, b), (c, d)) -> (a, b, c, d))
-> Either Text ((a, b), (c, d)) -> Either Text (a, b, c, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, b), (c, d)) -> (a, b, c, d)
forall a b c d. ((a, b), (c, d)) -> (a, b, c, d)
to4 (Either Text ((a, b), (c, d)) -> Either Text (a, b, c, d))
-> ([PersistValue] -> Either Text ((a, b), (c, d)))
-> [PersistValue]
-> Either Text (a, b, c, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((a, b), (c, d))
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow

from4 :: (a,b,c,d) -> ((a,b),(c,d))
from4 :: (a, b, c, d) -> ((a, b), (c, d))
from4 (a
a,b
b,c
c,d
d) = ((a
a,b
b),(c
c,d
d))

to4 :: ((a,b),(c,d)) -> (a,b,c,d)
to4 :: ((a, b), (c, d)) -> (a, b, c, d)
to4 ((a
a,b
b),(c
c,d
d)) = (a
a,b
b,c
c,d
d)

instance (RawSql a, RawSql b, RawSql c,
          RawSql d, RawSql e)
       => RawSql (a, b, c, d, e) where
    rawSqlCols :: (DBName -> Text) -> (a, b, c, d, e) -> (Int, [Text])
rawSqlCols DBName -> Text
e         = (DBName -> Text) -> ((a, b), (c, d), e) -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e         (((a, b), (c, d), e) -> (Int, [Text]))
-> ((a, b, c, d, e) -> ((a, b), (c, d), e))
-> (a, b, c, d, e)
-> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e) -> ((a, b), (c, d), e)
forall a b c d e. (a, b, c, d, e) -> ((a, b), (c, d), e)
from5
    rawSqlColCountReason :: (a, b, c, d, e) -> String
rawSqlColCountReason = ((a, b), (c, d), e) -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (((a, b), (c, d), e) -> String)
-> ((a, b, c, d, e) -> ((a, b), (c, d), e))
-> (a, b, c, d, e)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e) -> ((a, b), (c, d), e)
forall a b c d e. (a, b, c, d, e) -> ((a, b), (c, d), e)
from5
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b, c, d, e)
rawSqlProcessRow     = (((a, b), (c, d), e) -> (a, b, c, d, e))
-> Either Text ((a, b), (c, d), e) -> Either Text (a, b, c, d, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, b), (c, d), e) -> (a, b, c, d, e)
forall a b c d e. ((a, b), (c, d), e) -> (a, b, c, d, e)
to5 (Either Text ((a, b), (c, d), e) -> Either Text (a, b, c, d, e))
-> ([PersistValue] -> Either Text ((a, b), (c, d), e))
-> [PersistValue]
-> Either Text (a, b, c, d, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((a, b), (c, d), e)
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow

from5 :: (a,b,c,d,e) -> ((a,b),(c,d),e)
from5 :: (a, b, c, d, e) -> ((a, b), (c, d), e)
from5 (a
a,b
b,c
c,d
d,e
e) = ((a
a,b
b),(c
c,d
d),e
e)

to5 :: ((a,b),(c,d),e) -> (a,b,c,d,e)
to5 :: ((a, b), (c, d), e) -> (a, b, c, d, e)
to5 ((a
a,b
b),(c
c,d
d),e
e) = (a
a,b
b,c
c,d
d,e
e)

instance (RawSql a, RawSql b, RawSql c,
          RawSql d, RawSql e, RawSql f)
       => RawSql (a, b, c, d, e, f) where
    rawSqlCols :: (DBName -> Text) -> (a, b, c, d, e, f) -> (Int, [Text])
rawSqlCols DBName -> Text
e         = (DBName -> Text) -> ((a, b), (c, d), (e, f)) -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e         (((a, b), (c, d), (e, f)) -> (Int, [Text]))
-> ((a, b, c, d, e, f) -> ((a, b), (c, d), (e, f)))
-> (a, b, c, d, e, f)
-> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f) -> ((a, b), (c, d), (e, f))
forall a b c d e f. (a, b, c, d, e, f) -> ((a, b), (c, d), (e, f))
from6
    rawSqlColCountReason :: (a, b, c, d, e, f) -> String
rawSqlColCountReason = ((a, b), (c, d), (e, f)) -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (((a, b), (c, d), (e, f)) -> String)
-> ((a, b, c, d, e, f) -> ((a, b), (c, d), (e, f)))
-> (a, b, c, d, e, f)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f) -> ((a, b), (c, d), (e, f))
forall a b c d e f. (a, b, c, d, e, f) -> ((a, b), (c, d), (e, f))
from6
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b, c, d, e, f)
rawSqlProcessRow     = (((a, b), (c, d), (e, f)) -> (a, b, c, d, e, f))
-> Either Text ((a, b), (c, d), (e, f))
-> Either Text (a, b, c, d, e, f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, b), (c, d), (e, f)) -> (a, b, c, d, e, f)
forall a b c d e f. ((a, b), (c, d), (e, f)) -> (a, b, c, d, e, f)
to6 (Either Text ((a, b), (c, d), (e, f))
 -> Either Text (a, b, c, d, e, f))
-> ([PersistValue] -> Either Text ((a, b), (c, d), (e, f)))
-> [PersistValue]
-> Either Text (a, b, c, d, e, f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((a, b), (c, d), (e, f))
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow

from6 :: (a,b,c,d,e,f) -> ((a,b),(c,d),(e,f))
from6 :: (a, b, c, d, e, f) -> ((a, b), (c, d), (e, f))
from6 (a
a,b
b,c
c,d
d,e
e,f
f) = ((a
a,b
b),(c
c,d
d),(e
e,f
f))

to6 :: ((a,b),(c,d),(e,f)) -> (a,b,c,d,e,f)
to6 :: ((a, b), (c, d), (e, f)) -> (a, b, c, d, e, f)
to6 ((a
a,b
b),(c
c,d
d),(e
e,f
f)) = (a
a,b
b,c
c,d
d,e
e,f
f)

instance (RawSql a, RawSql b, RawSql c,
          RawSql d, RawSql e, RawSql f,
          RawSql g)
       => RawSql (a, b, c, d, e, f, g) where
    rawSqlCols :: (DBName -> Text) -> (a, b, c, d, e, f, g) -> (Int, [Text])
rawSqlCols DBName -> Text
e         = (DBName -> Text) -> ((a, b), (c, d), (e, f), g) -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e         (((a, b), (c, d), (e, f), g) -> (Int, [Text]))
-> ((a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g))
-> (a, b, c, d, e, f, g)
-> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g)
forall a b c d e f g.
(a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g)
from7
    rawSqlColCountReason :: (a, b, c, d, e, f, g) -> String
rawSqlColCountReason = ((a, b), (c, d), (e, f), g) -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (((a, b), (c, d), (e, f), g) -> String)
-> ((a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g))
-> (a, b, c, d, e, f, g)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g)
forall a b c d e f g.
(a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g)
from7
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b, c, d, e, f, g)
rawSqlProcessRow     = (((a, b), (c, d), (e, f), g) -> (a, b, c, d, e, f, g))
-> Either Text ((a, b), (c, d), (e, f), g)
-> Either Text (a, b, c, d, e, f, g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, b), (c, d), (e, f), g) -> (a, b, c, d, e, f, g)
forall a b c d e f g.
((a, b), (c, d), (e, f), g) -> (a, b, c, d, e, f, g)
to7 (Either Text ((a, b), (c, d), (e, f), g)
 -> Either Text (a, b, c, d, e, f, g))
-> ([PersistValue] -> Either Text ((a, b), (c, d), (e, f), g))
-> [PersistValue]
-> Either Text (a, b, c, d, e, f, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((a, b), (c, d), (e, f), g)
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow

from7 :: (a,b,c,d,e,f,g) -> ((a,b),(c,d),(e,f),g)
from7 :: (a, b, c, d, e, f, g) -> ((a, b), (c, d), (e, f), g)
from7 (a
a,b
b,c
c,d
d,e
e,f
f,g
g) = ((a
a,b
b),(c
c,d
d),(e
e,f
f),g
g)

to7 :: ((a,b),(c,d),(e,f),g) -> (a,b,c,d,e,f,g)
to7 :: ((a, b), (c, d), (e, f), g) -> (a, b, c, d, e, f, g)
to7 ((a
a,b
b),(c
c,d
d),(e
e,f
f),g
g) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g)

instance (RawSql a, RawSql b, RawSql c,
          RawSql d, RawSql e, RawSql f,
          RawSql g, RawSql h)
       => RawSql (a, b, c, d, e, f, g, h) where
    rawSqlCols :: (DBName -> Text) -> (a, b, c, d, e, f, g, h) -> (Int, [Text])
rawSqlCols DBName -> Text
e         = (DBName -> Text)
-> ((a, b), (c, d), (e, f), (g, h)) -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e         (((a, b), (c, d), (e, f), (g, h)) -> (Int, [Text]))
-> ((a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h)))
-> (a, b, c, d, e, f, g, h)
-> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h))
forall a b c d e f g h.
(a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h))
from8
    rawSqlColCountReason :: (a, b, c, d, e, f, g, h) -> String
rawSqlColCountReason = ((a, b), (c, d), (e, f), (g, h)) -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (((a, b), (c, d), (e, f), (g, h)) -> String)
-> ((a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h)))
-> (a, b, c, d, e, f, g, h)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h))
forall a b c d e f g h.
(a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h))
from8
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b, c, d, e, f, g, h)
rawSqlProcessRow     = (((a, b), (c, d), (e, f), (g, h)) -> (a, b, c, d, e, f, g, h))
-> Either Text ((a, b), (c, d), (e, f), (g, h))
-> Either Text (a, b, c, d, e, f, g, h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, b), (c, d), (e, f), (g, h)) -> (a, b, c, d, e, f, g, h)
forall a b c d e f g h.
((a, b), (c, d), (e, f), (g, h)) -> (a, b, c, d, e, f, g, h)
to8 (Either Text ((a, b), (c, d), (e, f), (g, h))
 -> Either Text (a, b, c, d, e, f, g, h))
-> ([PersistValue] -> Either Text ((a, b), (c, d), (e, f), (g, h)))
-> [PersistValue]
-> Either Text (a, b, c, d, e, f, g, h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((a, b), (c, d), (e, f), (g, h))
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow

from8 :: (a,b,c,d,e,f,g,h) -> ((a,b),(c,d),(e,f),(g,h))
from8 :: (a, b, c, d, e, f, g, h) -> ((a, b), (c, d), (e, f), (g, h))
from8 (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h))

to8 :: ((a,b),(c,d),(e,f),(g,h)) -> (a,b,c,d,e,f,g,h)
to8 :: ((a, b), (c, d), (e, f), (g, h)) -> (a, b, c, d, e, f, g, h)
to8 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h)) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h)

-- | @since 2.10.2
instance (RawSql a, RawSql b, RawSql c,
          RawSql d, RawSql e, RawSql f,
          RawSql g, RawSql h, RawSql i)
       => RawSql (a, b, c, d, e, f, g, h, i) where
    rawSqlCols :: (DBName -> Text) -> (a, b, c, d, e, f, g, h, i) -> (Int, [Text])
rawSqlCols DBName -> Text
e         = (DBName -> Text)
-> ((a, b), (c, d), (e, f), (g, h), i) -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e         (((a, b), (c, d), (e, f), (g, h), i) -> (Int, [Text]))
-> ((a, b, c, d, e, f, g, h, i)
    -> ((a, b), (c, d), (e, f), (g, h), i))
-> (a, b, c, d, e, f, g, h, i)
-> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h, i) -> ((a, b), (c, d), (e, f), (g, h), i)
forall a b c d e f g h i.
(a, b, c, d, e, f, g, h, i) -> ((a, b), (c, d), (e, f), (g, h), i)
from9
    rawSqlColCountReason :: (a, b, c, d, e, f, g, h, i) -> String
rawSqlColCountReason = ((a, b), (c, d), (e, f), (g, h), i) -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (((a, b), (c, d), (e, f), (g, h), i) -> String)
-> ((a, b, c, d, e, f, g, h, i)
    -> ((a, b), (c, d), (e, f), (g, h), i))
-> (a, b, c, d, e, f, g, h, i)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h, i) -> ((a, b), (c, d), (e, f), (g, h), i)
forall a b c d e f g h i.
(a, b, c, d, e, f, g, h, i) -> ((a, b), (c, d), (e, f), (g, h), i)
from9
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b, c, d, e, f, g, h, i)
rawSqlProcessRow     = (((a, b), (c, d), (e, f), (g, h), i)
 -> (a, b, c, d, e, f, g, h, i))
-> Either Text ((a, b), (c, d), (e, f), (g, h), i)
-> Either Text (a, b, c, d, e, f, g, h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, b), (c, d), (e, f), (g, h), i) -> (a, b, c, d, e, f, g, h, i)
forall a b c d e f g h i.
((a, b), (c, d), (e, f), (g, h), i) -> (a, b, c, d, e, f, g, h, i)
to9 (Either Text ((a, b), (c, d), (e, f), (g, h), i)
 -> Either Text (a, b, c, d, e, f, g, h, i))
-> ([PersistValue]
    -> Either Text ((a, b), (c, d), (e, f), (g, h), i))
-> [PersistValue]
-> Either Text (a, b, c, d, e, f, g, h, i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text ((a, b), (c, d), (e, f), (g, h), i)
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow

-- | @since 2.10.2
from9 :: (a,b,c,d,e,f,g,h,i) -> ((a,b),(c,d),(e,f),(g,h),i)
from9 :: (a, b, c, d, e, f, g, h, i) -> ((a, b), (c, d), (e, f), (g, h), i)
from9 (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),i
i)

-- | @since 2.10.2
to9 :: ((a,b),(c,d),(e,f),(g,h),i) -> (a,b,c,d,e,f,g,h,i)
to9 :: ((a, b), (c, d), (e, f), (g, h), i) -> (a, b, c, d, e, f, g, h, i)
to9 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),i
i) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i)

-- | @since 2.10.2
instance (RawSql a, RawSql b, RawSql c,
          RawSql d, RawSql e, RawSql f,
          RawSql g, RawSql h, RawSql i,
          RawSql j)
       => RawSql (a, b, c, d, e, f, g, h, i, j) where
    rawSqlCols :: (DBName -> Text) -> (a, b, c, d, e, f, g, h, i, j) -> (Int, [Text])
rawSqlCols DBName -> Text
e         = (DBName -> Text)
-> ((a, b), (c, d), (e, f), (g, h), (i, j)) -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e         (((a, b), (c, d), (e, f), (g, h), (i, j)) -> (Int, [Text]))
-> ((a, b, c, d, e, f, g, h, i, j)
    -> ((a, b), (c, d), (e, f), (g, h), (i, j)))
-> (a, b, c, d, e, f, g, h, i, j)
-> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h, i, j)
-> ((a, b), (c, d), (e, f), (g, h), (i, j))
forall a b c d e f g h i j.
(a, b, c, d, e, f, g, h, i, j)
-> ((a, b), (c, d), (e, f), (g, h), (i, j))
from10
    rawSqlColCountReason :: (a, b, c, d, e, f, g, h, i, j) -> String
rawSqlColCountReason = ((a, b), (c, d), (e, f), (g, h), (i, j)) -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (((a, b), (c, d), (e, f), (g, h), (i, j)) -> String)
-> ((a, b, c, d, e, f, g, h, i, j)
    -> ((a, b), (c, d), (e, f), (g, h), (i, j)))
-> (a, b, c, d, e, f, g, h, i, j)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h, i, j)
-> ((a, b), (c, d), (e, f), (g, h), (i, j))
forall a b c d e f g h i j.
(a, b, c, d, e, f, g, h, i, j)
-> ((a, b), (c, d), (e, f), (g, h), (i, j))
from10
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b, c, d, e, f, g, h, i, j)
rawSqlProcessRow     = (((a, b), (c, d), (e, f), (g, h), (i, j))
 -> (a, b, c, d, e, f, g, h, i, j))
-> Either Text ((a, b), (c, d), (e, f), (g, h), (i, j))
-> Either Text (a, b, c, d, e, f, g, h, i, j)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, b), (c, d), (e, f), (g, h), (i, j))
-> (a, b, c, d, e, f, g, h, i, j)
forall a b c d e f g h i j.
((a, b), (c, d), (e, f), (g, h), (i, j))
-> (a, b, c, d, e, f, g, h, i, j)
to10 (Either Text ((a, b), (c, d), (e, f), (g, h), (i, j))
 -> Either Text (a, b, c, d, e, f, g, h, i, j))
-> ([PersistValue]
    -> Either Text ((a, b), (c, d), (e, f), (g, h), (i, j)))
-> [PersistValue]
-> Either Text (a, b, c, d, e, f, g, h, i, j)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either Text ((a, b), (c, d), (e, f), (g, h), (i, j))
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow

-- | @since 2.10.2
from10 :: (a,b,c,d,e,f,g,h,i,j) -> ((a,b),(c,d),(e,f),(g,h),(i,j))
from10 :: (a, b, c, d, e, f, g, h, i, j)
-> ((a, b), (c, d), (e, f), (g, h), (i, j))
from10 (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j) = ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j))

-- | @since 2.10.2
to10 :: ((a,b),(c,d),(e,f),(g,h),(i,j)) -> (a,b,c,d,e,f,g,h,i,j)
to10 :: ((a, b), (c, d), (e, f), (g, h), (i, j))
-> (a, b, c, d, e, f, g, h, i, j)
to10 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j)) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j)

-- | @since 2.10.2
instance (RawSql a, RawSql b, RawSql c,
          RawSql d, RawSql e, RawSql f,
          RawSql g, RawSql h, RawSql i,
          RawSql j, RawSql k)
       => RawSql (a, b, c, d, e, f, g, h, i, j, k) where
    rawSqlCols :: (DBName -> Text)
-> (a, b, c, d, e, f, g, h, i, j, k) -> (Int, [Text])
rawSqlCols DBName -> Text
e         = (DBName -> Text)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), k) -> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e         (((a, b), (c, d), (e, f), (g, h), (i, j), k) -> (Int, [Text]))
-> ((a, b, c, d, e, f, g, h, i, j, k)
    -> ((a, b), (c, d), (e, f), (g, h), (i, j), k))
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h, i, j, k)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), k)
forall a b c d e f g h i j k.
(a, b, c, d, e, f, g, h, i, j, k)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), k)
from11
    rawSqlColCountReason :: (a, b, c, d, e, f, g, h, i, j, k) -> String
rawSqlColCountReason = ((a, b), (c, d), (e, f), (g, h), (i, j), k) -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (((a, b), (c, d), (e, f), (g, h), (i, j), k) -> String)
-> ((a, b, c, d, e, f, g, h, i, j, k)
    -> ((a, b), (c, d), (e, f), (g, h), (i, j), k))
-> (a, b, c, d, e, f, g, h, i, j, k)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h, i, j, k)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), k)
forall a b c d e f g h i j k.
(a, b, c, d, e, f, g, h, i, j, k)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), k)
from11
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b, c, d, e, f, g, h, i, j, k)
rawSqlProcessRow     = (((a, b), (c, d), (e, f), (g, h), (i, j), k)
 -> (a, b, c, d, e, f, g, h, i, j, k))
-> Either Text ((a, b), (c, d), (e, f), (g, h), (i, j), k)
-> Either Text (a, b, c, d, e, f, g, h, i, j, k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, b), (c, d), (e, f), (g, h), (i, j), k)
-> (a, b, c, d, e, f, g, h, i, j, k)
forall a b c d e f g h i j k.
((a, b), (c, d), (e, f), (g, h), (i, j), k)
-> (a, b, c, d, e, f, g, h, i, j, k)
to11 (Either Text ((a, b), (c, d), (e, f), (g, h), (i, j), k)
 -> Either Text (a, b, c, d, e, f, g, h, i, j, k))
-> ([PersistValue]
    -> Either Text ((a, b), (c, d), (e, f), (g, h), (i, j), k))
-> [PersistValue]
-> Either Text (a, b, c, d, e, f, g, h, i, j, k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either Text ((a, b), (c, d), (e, f), (g, h), (i, j), k)
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow

-- | @since 2.10.2
from11 :: (a,b,c,d,e,f,g,h,i,j,k) -> ((a,b),(c,d),(e,f),(g,h),(i,j),k)
from11 :: (a, b, c, d, e, f, g, h, i, j, k)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), k)
from11 (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k) = ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j),k
k)

-- | @since 2.10.2
to11 :: ((a,b),(c,d),(e,f),(g,h),(i,j),k) -> (a,b,c,d,e,f,g,h,i,j,k)
to11 :: ((a, b), (c, d), (e, f), (g, h), (i, j), k)
-> (a, b, c, d, e, f, g, h, i, j, k)
to11 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j),k
k) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k)

-- | @since 2.10.2
instance (RawSql a, RawSql b, RawSql c,
          RawSql d, RawSql e, RawSql f,
          RawSql g, RawSql h, RawSql i,
          RawSql j, RawSql k, RawSql l)
       => RawSql (a, b, c, d, e, f, g, h, i, j, k, l) where
    rawSqlCols :: (DBName -> Text)
-> (a, b, c, d, e, f, g, h, i, j, k, l) -> (Int, [Text])
rawSqlCols DBName -> Text
e         = (DBName -> Text)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
-> (Int, [Text])
forall a. RawSql a => (DBName -> Text) -> a -> (Int, [Text])
rawSqlCols DBName -> Text
e         (((a, b), (c, d), (e, f), (g, h), (i, j), (k, l)) -> (Int, [Text]))
-> ((a, b, c, d, e, f, g, h, i, j, k, l)
    -> ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l)))
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (Int, [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h, i, j, k, l)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
forall a b c d e f g h i j k l.
(a, b, c, d, e, f, g, h, i, j, k, l)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
from12
    rawSqlColCountReason :: (a, b, c, d, e, f, g, h, i, j, k, l) -> String
rawSqlColCountReason = ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l)) -> String
forall a. RawSql a => a -> String
rawSqlColCountReason (((a, b), (c, d), (e, f), (g, h), (i, j), (k, l)) -> String)
-> ((a, b, c, d, e, f, g, h, i, j, k, l)
    -> ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l)))
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b, c, d, e, f, g, h, i, j, k, l)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
forall a b c d e f g h i j k l.
(a, b, c, d, e, f, g, h, i, j, k, l)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
from12
    rawSqlProcessRow :: [PersistValue] -> Either Text (a, b, c, d, e, f, g, h, i, j, k, l)
rawSqlProcessRow     = (((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
 -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Either Text ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
-> Either Text (a, b, c, d, e, f, g, h, i, j, k, l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
-> (a, b, c, d, e, f, g, h, i, j, k, l)
forall a b c d e f g h i j k l.
((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
-> (a, b, c, d, e, f, g, h, i, j, k, l)
to12 (Either Text ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
 -> Either Text (a, b, c, d, e, f, g, h, i, j, k, l))
-> ([PersistValue]
    -> Either Text ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l)))
-> [PersistValue]
-> Either Text (a, b, c, d, e, f, g, h, i, j, k, l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> Either Text ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
forall a. RawSql a => [PersistValue] -> Either Text a
rawSqlProcessRow

-- | @since 2.10.2
from12 :: (a,b,c,d,e,f,g,h,i,j,k,l) -> ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l))
from12 :: (a, b, c, d, e, f, g, h, i, j, k, l)
-> ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
from12 (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l) = ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j),(k
k,l
l))

-- | @since 2.10.2
to12 :: ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l)) -> (a,b,c,d,e,f,g,h,i,j,k,l)
to12 :: ((a, b), (c, d), (e, f), (g, h), (i, j), (k, l))
-> (a, b, c, d, e, f, g, h, i, j, k, l)
to12 ((a
a,b
b),(c
c,d
d),(e
e,f
f),(g
g,h
h),(i
i,j
j),(k
k,l
l)) = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l)

extractMaybe :: Maybe a -> a
extractMaybe :: Maybe a -> a
extractMaybe = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
"Database.Persist.GenericSql.extractMaybe")

-- | Tells Persistent what database column type should be used to store a Haskell type.
--
-- ==== __Examples__
--
-- ===== Simple Boolean Alternative
--
-- @
-- data Switch = On | Off
--   deriving (Show, Eq)
--
-- instance 'PersistField' Switch where
--   'toPersistValue' s = case s of
--     On -> 'PersistBool' True
--     Off -> 'PersistBool' False
--   'fromPersistValue' ('PersistBool' b) = if b then 'Right' On else 'Right' Off
--   'fromPersistValue' x = Left $ "File.hs: When trying to deserialize a Switch: expected PersistBool, received: " <> T.pack (show x)
--
-- instance 'PersistFieldSql' Switch where
--   'sqlType' _ = 'SqlBool'
-- @
--
-- ===== Non-Standard Database Types
--
-- If your database supports non-standard types, such as Postgres' @uuid@, you can use 'SqlOther' to use them:
--
-- @
-- import qualified Data.UUID as UUID
-- instance 'PersistField' UUID where
--   'toPersistValue' = 'PersistDbSpecific' . toASCIIBytes
--   'fromPersistValue' ('PersistDbSpecific' uuid) =
--     case fromASCIIBytes uuid of
--       'Nothing' -> 'Left' $ "Model/CustomTypes.hs: Failed to deserialize a UUID; received: " <> T.pack (show uuid)
--       'Just' uuid' -> 'Right' uuid'
--   'fromPersistValue' x = Left $ "File.hs: When trying to deserialize a UUID: expected PersistDbSpecific, received: "-- >  <> T.pack (show x)
--
-- instance 'PersistFieldSql' UUID where
--   'sqlType' _ = 'SqlOther' "uuid"
-- @
--
-- ===== User Created Database Types
--
-- Similarly, some databases support creating custom types, e.g. Postgres' <https://www.postgresql.org/docs/current/static/sql-createdomain.html DOMAIN> and <https://www.postgresql.org/docs/current/static/datatype-enum.html ENUM> features. You can use 'SqlOther' to specify a custom type:
--
-- > CREATE DOMAIN ssn AS text
-- >       CHECK ( value ~ '^[0-9]{9}$');
--
-- @
-- instance 'PersistFieldSQL' SSN where
--   'sqlType' _ = 'SqlOther' "ssn"
-- @
--
-- > CREATE TYPE rainbow_color AS ENUM ('red', 'orange', 'yellow', 'green', 'blue', 'indigo', 'violet');
--
-- @
-- instance 'PersistFieldSQL' RainbowColor where
--   'sqlType' _ = 'SqlOther' "rainbow_color"
-- @
class PersistField a => PersistFieldSql a where
    sqlType :: Proxy a -> SqlType

#ifndef NO_OVERLAP
instance {-# OVERLAPPING #-} PersistFieldSql [Char] where
    sqlType :: Proxy String -> SqlType
sqlType Proxy String
_ = SqlType
SqlString
#endif

instance PersistFieldSql ByteString where
    sqlType :: Proxy ByteString -> SqlType
sqlType Proxy ByteString
_ = SqlType
SqlBlob
instance PersistFieldSql T.Text where
    sqlType :: Proxy Text -> SqlType
sqlType Proxy Text
_ = SqlType
SqlString
instance PersistFieldSql TL.Text where
    sqlType :: Proxy Text -> SqlType
sqlType Proxy Text
_ = SqlType
SqlString
instance PersistFieldSql Html where
    sqlType :: Proxy Html -> SqlType
sqlType Proxy Html
_ = SqlType
SqlString
instance PersistFieldSql Int where
    sqlType :: Proxy Int -> SqlType
sqlType Proxy Int
_
        | Just Int
x <- Int -> Maybe Int
forall a. Bits a => a -> Maybe Int
bitSizeMaybe (Int
0 :: Int), Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 = SqlType
SqlInt32
        | Bool
otherwise = SqlType
SqlInt64
instance PersistFieldSql Int8 where
    sqlType :: Proxy Int8 -> SqlType
sqlType Proxy Int8
_ = SqlType
SqlInt32
instance PersistFieldSql Int16 where
    sqlType :: Proxy Int16 -> SqlType
sqlType Proxy Int16
_ = SqlType
SqlInt32
instance PersistFieldSql Int32 where
    sqlType :: Proxy Int32 -> SqlType
sqlType Proxy Int32
_ = SqlType
SqlInt32
instance PersistFieldSql Int64 where
    sqlType :: Proxy Int64 -> SqlType
sqlType Proxy Int64
_ = SqlType
SqlInt64
instance PersistFieldSql Word where
    sqlType :: Proxy Word -> SqlType
sqlType Proxy Word
_ = SqlType
SqlInt64
instance PersistFieldSql Word8 where
    sqlType :: Proxy Word8 -> SqlType
sqlType Proxy Word8
_ = SqlType
SqlInt32
instance PersistFieldSql Word16 where
    sqlType :: Proxy Word16 -> SqlType
sqlType Proxy Word16
_ = SqlType
SqlInt32
instance PersistFieldSql Word32 where
    sqlType :: Proxy Word32 -> SqlType
sqlType Proxy Word32
_ = SqlType
SqlInt64
instance PersistFieldSql Word64 where
    sqlType :: Proxy Word64 -> SqlType
sqlType Proxy Word64
_ = SqlType
SqlInt64
instance PersistFieldSql Double where
    sqlType :: Proxy Double -> SqlType
sqlType Proxy Double
_ = SqlType
SqlReal
instance PersistFieldSql Bool where
    sqlType :: Proxy Bool -> SqlType
sqlType Proxy Bool
_ = SqlType
SqlBool
instance PersistFieldSql Day where
    sqlType :: Proxy Day -> SqlType
sqlType Proxy Day
_ = SqlType
SqlDay
instance PersistFieldSql TimeOfDay where
    sqlType :: Proxy TimeOfDay -> SqlType
sqlType Proxy TimeOfDay
_ = SqlType
SqlTime
instance PersistFieldSql UTCTime where
    sqlType :: Proxy UTCTime -> SqlType
sqlType Proxy UTCTime
_ = SqlType
SqlDayTime
instance {-# OVERLAPPABLE #-} PersistFieldSql a => PersistFieldSql [a] where
    sqlType :: Proxy [a] -> SqlType
sqlType Proxy [a]
_ = SqlType
SqlString
instance PersistFieldSql a => PersistFieldSql (V.Vector a) where
  sqlType :: Proxy (Vector a) -> SqlType
sqlType Proxy (Vector a)
_ = SqlType
SqlString
instance (Ord a, PersistFieldSql a) => PersistFieldSql (S.Set a) where
    sqlType :: Proxy (Set a) -> SqlType
sqlType Proxy (Set a)
_ = SqlType
SqlString
instance (PersistFieldSql a, PersistFieldSql b) => PersistFieldSql (a,b) where
    sqlType :: Proxy (a, b) -> SqlType
sqlType Proxy (a, b)
_ = SqlType
SqlString
instance PersistFieldSql v => PersistFieldSql (IM.IntMap v) where
    sqlType :: Proxy (IntMap v) -> SqlType
sqlType Proxy (IntMap v)
_ = SqlType
SqlString
instance PersistFieldSql v => PersistFieldSql (M.Map T.Text v) where
    sqlType :: Proxy (Map Text v) -> SqlType
sqlType Proxy (Map Text v)
_ = SqlType
SqlString
instance PersistFieldSql PersistValue where
    sqlType :: Proxy PersistValue -> SqlType
sqlType Proxy PersistValue
_ = SqlType
SqlInt64 -- since PersistValue should only be used like this for keys, which in SQL are Int64
instance PersistFieldSql Checkmark where
    sqlType :: Proxy Checkmark -> SqlType
sqlType    Proxy Checkmark
_ = SqlType
SqlBool
instance (HasResolution a) => PersistFieldSql (Fixed a) where
    sqlType :: Proxy (Fixed a) -> SqlType
sqlType Proxy (Fixed a)
a =
        Word32 -> Word32 -> SqlType
SqlNumeric Word32
long Word32
prec
      where
        prec :: Word32
prec = Double -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word32) -> Double -> Word32
forall a b. (a -> b) -> a -> b
$ (Double -> Double
forall a. Floating a => a -> a
log (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ Fixed a -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
n) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double -> Double
forall a. Floating a => a -> a
log Double
10 :: Double) --  FIXME: May lead to problems with big numbers
        long :: Word32
long = Word32
prec Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
10                                                        --  FIXME: Is this enough ?
        n :: Fixed a
n = Fixed a
0
        _mn :: Proxy (Fixed a)
_mn = Fixed a -> Proxy (Fixed a)
forall (m :: * -> *) a. Monad m => a -> m a
return Fixed a
n Proxy (Fixed a) -> Proxy (Fixed a) -> Proxy (Fixed a)
forall a. a -> a -> a
`asTypeOf` Proxy (Fixed a)
a
instance PersistFieldSql Rational where
    sqlType :: Proxy Rational -> SqlType
sqlType Proxy Rational
_ = Word32 -> Word32 -> SqlType
SqlNumeric Word32
32 Word32
20   --  need to make this field big enough to handle Rational to Mumber string conversion for ODBC

instance PersistFieldSql Natural where
  sqlType :: Proxy Natural -> SqlType
sqlType Proxy Natural
_ = SqlType
SqlInt64

-- An embedded Entity
instance (PersistField record, PersistEntity record) => PersistFieldSql (Entity record) where
    sqlType :: Proxy (Entity record) -> SqlType
sqlType Proxy (Entity record)
_ = SqlType
SqlString