{-# LANGUAGE GeneralizedNewtypeDeriving, DataKinds #-}
{-# LANGUAGE UndecidableInstances, FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE TypeOperators, DefaultSignatures, ScopedTypeVariables, CPP #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
module Database.Selda.SqlRow
  ( SqlRow (..), ResultReader
  , GSqlRow
  , runResultReader, next
  ) where
import Control.Monad.State.Strict
    ( liftM2,
      StateT(StateT),
      MonadState(state, get),
      State,
      evalState )
import Database.Selda.SqlType
    ( SqlValue(SqlNull), SqlType(fromSql) )
import Data.Typeable ( Typeable, Proxy(..) )
import GHC.Generics
    ( Generic(Rep, to), K1(K1), M1(M1), type (:+:), type (:*:)(..) )
import qualified GHC.TypeLits as TL

newtype ResultReader a = R (State [SqlValue] a)
  deriving (forall a b. a -> ResultReader b -> ResultReader a
forall a b. (a -> b) -> ResultReader a -> ResultReader b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ResultReader b -> ResultReader a
$c<$ :: forall a b. a -> ResultReader b -> ResultReader a
fmap :: forall a b. (a -> b) -> ResultReader a -> ResultReader b
$cfmap :: forall a b. (a -> b) -> ResultReader a -> ResultReader b
Functor, Functor ResultReader
forall a. a -> ResultReader a
forall a b. ResultReader a -> ResultReader b -> ResultReader a
forall a b. ResultReader a -> ResultReader b -> ResultReader b
forall a b.
ResultReader (a -> b) -> ResultReader a -> ResultReader b
forall a b c.
(a -> b -> c) -> ResultReader a -> ResultReader b -> ResultReader c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. ResultReader a -> ResultReader b -> ResultReader a
$c<* :: forall a b. ResultReader a -> ResultReader b -> ResultReader a
*> :: forall a b. ResultReader a -> ResultReader b -> ResultReader b
$c*> :: forall a b. ResultReader a -> ResultReader b -> ResultReader b
liftA2 :: forall a b c.
(a -> b -> c) -> ResultReader a -> ResultReader b -> ResultReader c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ResultReader a -> ResultReader b -> ResultReader c
<*> :: forall a b.
ResultReader (a -> b) -> ResultReader a -> ResultReader b
$c<*> :: forall a b.
ResultReader (a -> b) -> ResultReader a -> ResultReader b
pure :: forall a. a -> ResultReader a
$cpure :: forall a. a -> ResultReader a
Applicative, Applicative ResultReader
forall a. a -> ResultReader a
forall a b. ResultReader a -> ResultReader b -> ResultReader b
forall a b.
ResultReader a -> (a -> ResultReader b) -> ResultReader b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ResultReader a
$creturn :: forall a. a -> ResultReader a
>> :: forall a b. ResultReader a -> ResultReader b -> ResultReader b
$c>> :: forall a b. ResultReader a -> ResultReader b -> ResultReader b
>>= :: forall a b.
ResultReader a -> (a -> ResultReader b) -> ResultReader b
$c>>= :: forall a b.
ResultReader a -> (a -> ResultReader b) -> ResultReader b
Monad)

runResultReader :: ResultReader a -> [SqlValue] -> a
runResultReader :: forall a. ResultReader a -> [SqlValue] -> a
runResultReader (R State [SqlValue] a
m) = forall s a. State s a -> s -> a
evalState State [SqlValue] a
m

next :: ResultReader SqlValue
next :: ResultReader SqlValue
next = forall a. State [SqlValue] a -> ResultReader a
R forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall a b. (a -> b) -> a -> b
$ \[SqlValue]
s -> (forall a. [a] -> a
head [SqlValue]
s, forall a. [a] -> [a]
tail [SqlValue]
s)

class Typeable a => SqlRow a where
  -- | Read the next, potentially composite, result from a stream of columns.
  nextResult :: ResultReader a
  default nextResult :: (Generic a, GSqlRow (Rep a)) => ResultReader a
  nextResult = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) x. GSqlRow f => ResultReader (f x)
gNextResult

  -- | The number of nested columns contained in this type.
  nestedCols :: Proxy a -> Int
  default nestedCols :: (Generic a, GSqlRow (Rep a)) => Proxy a -> Int
  nestedCols Proxy a
_ = forall (f :: * -> *). GSqlRow f => Proxy f -> Int
gNestedCols (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep a))


-- * Generic derivation for SqlRow
class GSqlRow f where
  gNextResult :: ResultReader (f x)
  gNestedCols :: Proxy f -> Int

instance SqlType a => GSqlRow (K1 i a) where
  gNextResult :: forall x. ResultReader (K1 i a x)
gNextResult = forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SqlType a => SqlValue -> a
fromSql forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResultReader SqlValue
next
  gNestedCols :: Proxy (K1 i a) -> Int
gNestedCols Proxy (K1 i a)
_ = Int
1

instance GSqlRow f => GSqlRow (M1 c i f) where
  gNextResult :: forall x. ResultReader (M1 c i f x)
gNextResult = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) x. GSqlRow f => ResultReader (f x)
gNextResult
  gNestedCols :: Proxy (M1 c i f) -> Int
gNestedCols Proxy (M1 c i f)
_ = forall (f :: * -> *). GSqlRow f => Proxy f -> Int
gNestedCols (forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

instance (GSqlRow a, GSqlRow b) => GSqlRow (a :*: b) where
  gNextResult :: forall x. ResultReader ((:*:) a b x)
gNextResult = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) x. GSqlRow f => ResultReader (f x)
gNextResult forall (f :: * -> *) x. GSqlRow f => ResultReader (f x)
gNextResult
  gNestedCols :: Proxy (a :*: b) -> Int
gNestedCols Proxy (a :*: b)
_ = forall (f :: * -> *). GSqlRow f => Proxy f -> Int
gNestedCols (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. Num a => a -> a -> a
+ forall (f :: * -> *). GSqlRow f => Proxy f -> Int
gNestedCols (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)

instance
  (TL.TypeError
    ( 'TL.Text "Selda currently does not support creating tables from sum types."
      'TL.:$$:
      'TL.Text "Restrict your table type to a single data constructor."
    )) => GSqlRow (a :+: b) where
  gNextResult :: forall x. ResultReader ((:+:) a b x)
gNextResult = forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable"
  gNestedCols :: Proxy (a :+: b) -> Int
gNestedCols = forall a. HasCallStack => [Char] -> a
error [Char]
"unreachable"

-- * Various instances
instance SqlRow a => SqlRow (Maybe a) where
  nextResult :: ResultReader (Maybe a)
nextResult = do
      [SqlValue]
xs <- forall a. State [SqlValue] a -> ResultReader a
R forall s (m :: * -> *). MonadState s m => m s
get
      if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SqlValue -> Bool
isNull (forall a. Int -> [a] -> [a]
take (forall a. SqlRow a => Proxy a -> Int
nestedCols (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) [SqlValue]
xs)
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SqlRow a => ResultReader a
nextResult
    where
      isNull :: SqlValue -> Bool
isNull SqlValue
SqlNull = Bool
True
      isNull SqlValue
_       = Bool
False
  nestedCols :: Proxy (Maybe a) -> Int
nestedCols Proxy (Maybe a)
_ = forall a. SqlRow a => Proxy a -> Int
nestedCols (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance
  ( Typeable (a, b)
  , GSqlRow (Rep (a, b))
  ) => SqlRow (a, b)
instance
  ( Typeable (a, b, c)
  , GSqlRow (Rep (a, b, c))
  ) => SqlRow (a, b, c)
instance
  ( Typeable (a, b, c, d)
  , GSqlRow (Rep (a, b, c, d))
  ) => SqlRow (a, b, c, d)
instance
  ( Typeable (a, b, c, d, e)
  , GSqlRow (Rep (a, b, c, d, e))
  ) => SqlRow (a, b, c, d, e)
instance
  ( Typeable (a, b, c, d, e, f)
  , GSqlRow (Rep (a, b, c, d, e, f))
  ) => SqlRow (a, b, c, d, e, f)
instance
  ( Typeable (a, b, c, d, e, f, g)
  , GSqlRow (Rep (a, b, c, d, e, f, g))
  ) => SqlRow (a, b, c, d, e, f, g)