{-# LANGUAGE ScopedTypeVariables, TypeOperators #-}
{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
-- | Utilities for creating selectors for non-record types.
--   In general, you should really use record types for your tables and
--   their record labels (i.e. #label) as selectors using
--   the @OverloadedLabels@ extension instead.
module Database.Selda.MakeSelectors
 ( Selectors, GSelectors
 , selectors, tableWithSelectors
 ) where
import Control.Monad.State.Strict
    ( MonadState(state), State, evalState )
import Data.Proxy ( Proxy(..) )
import GHC.Generics ( Generic(Rep), K1, M1 )
import qualified GHC.Generics as G
import Database.Selda.Generic (Relational)
import Database.Selda.Selectors ( Selector, unsafeSelector )
import Database.Selda.SqlRow ( SqlRow )
import Database.Selda.SqlType ( SqlType )
import Database.Selda.Table ( Table, Attr, table )
import Database.Selda.Types ( type (:*:)(..), TableName )

-- | Generate selector functions for the given table.
--   Selectors can be used to access the fields of a query result tuple, avoiding
--   the need to pattern match on the entire tuple.
--
-- > tbl :: Table (Int, Text)
-- > tbl = table "foo" []
-- > (tblBar :*: tblBaz) = selectors tbl
-- >
-- > q :: Query s Text
-- > q = do
-- >   row <- select tbl
-- >   return (row ! tblBaz)
selectors :: forall a. (Relational a, GSelectors a (Rep a))
          => Table a
          -> Selectors a
selectors :: forall a.
(Relational a, GSelectors a (Rep a)) =>
Table a -> Selectors a
selectors Table a
_ = forall r. GSelectors r (Rep r) => Proxy r -> Selectors r
selectorsFor (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

-- | A pair of the table with the given name and columns, and all its selectors.
--   For example:
--
-- > tbl :: Table (Int, Text)
-- > (tbl, tblBar :*: tblBaz)
-- >   =  tableWithSelectors "foo" []
-- >
-- > q :: Query s Text
-- > q = tblBaz `from` select tbl
tableWithSelectors :: forall a. (Relational a, GSelectors a (Rep a))
                   => TableName
                   -> [Attr a]
                   -> (Table a, Selectors a)
tableWithSelectors :: forall a.
(Relational a, GSelectors a (Rep a)) =>
TableName -> [Attr a] -> (Table a, Selectors a)
tableWithSelectors TableName
name [Attr a]
cs = (Table a
t, Selectors a
s)
  where
    t :: Table a
t = forall a. Relational a => TableName -> [Attr a] -> Table a
table TableName
name [Attr a]
cs
    s :: Selectors a
s = forall a.
(Relational a, GSelectors a (Rep a)) =>
Table a -> Selectors a
selectors Table a
t

-- | Generate selectors for the given type.
selectorsFor :: forall r. GSelectors r (Rep r) => Proxy r -> Selectors r
selectorsFor :: forall r. GSelectors r (Rep r) => Proxy r -> Selectors r
selectorsFor = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (f :: * -> *).
GSelectors t f =>
Proxy f -> Proxy t -> State Int (Sels t f)
mkSel (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep r))

-- | An inductive tuple of selectors for the given relation.
type Selectors r = Sels r (Rep r)

type family Sels t f where
  Sels t ((a G.:*: b) G.:*: c) = Sels t (a G.:*: (b G.:*: c))
  Sels t (a G.:*: b)           = Sels t a :*: Sels t b
  Sels t (M1 x y f)            = Sels t f
  Sels t (K1 i a)              = Selector t a

-- | Any table type that can have selectors generated.
class GSelectors t (f :: * -> *) where
  mkSel :: Proxy f -> Proxy t -> State Int (Sels t f)

instance (SqlRow t, SqlType a) => GSelectors t (K1 i a) where
  mkSel :: Proxy (K1 i a) -> Proxy t -> State Int (Sels t (K1 i a))
mkSel Proxy (K1 i a)
_ Proxy t
_ = forall a b. (SqlRow a, SqlType b) => Int -> Selector a b
unsafeSelector forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\Int
n -> (Int
n, Int
nforall a. Num a => a -> a -> a
+Int
1))

instance (GSelectors t f, Sels t f ~ Sels t (M1 x y f)) =>
         GSelectors t (M1 x y f) where
  mkSel :: Proxy (M1 x y f) -> Proxy t -> State Int (Sels t (M1 x y f))
mkSel Proxy (M1 x y f)
_ = forall t (f :: * -> *).
GSelectors t f =>
Proxy f -> Proxy t -> State Int (Sels t f)
mkSel (forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

instance GSelectors t (a G.:*: (b G.:*: c)) =>
         GSelectors t ((a G.:*: b) G.:*: c) where
  mkSel :: Proxy ((a :*: b) :*: c)
-> Proxy t -> State Int (Sels t ((a :*: b) :*: c))
mkSel Proxy ((a :*: b) :*: c)
_ = forall t (f :: * -> *).
GSelectors t f =>
Proxy f -> Proxy t -> State Int (Sels t f)
mkSel (forall {k} (t :: k). Proxy t
Proxy :: Proxy (a G.:*: (b G.:*: c)))

instance {-# OVERLAPPABLE #-}
  ( GSelectors t a
  , GSelectors t b
  , Sels t (a G.:*: b) ~ (Sels t a :*: Sels t b)
  ) => GSelectors t (a G.:*: b) where
    mkSel :: Proxy (a :*: b) -> Proxy t -> State Int (Sels t (a :*: b))
mkSel Proxy (a :*: b)
_ Proxy t
p = do
      Sels t a
x <- forall t (f :: * -> *).
GSelectors t f =>
Proxy f -> Proxy t -> State Int (Sels t f)
mkSel (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) Proxy t
p
      Sels t b
xs <- forall t (f :: * -> *).
GSelectors t f =>
Proxy f -> Proxy t -> State Int (Sels t f)
mkSel (forall {k} (t :: k). Proxy t
Proxy :: Proxy b) Proxy t
p
      forall (m :: * -> *) a. Monad m => a -> m a
return (Sels t a
x forall a b. a -> b -> a :*: b
:*: Sels t b
xs)