module Database.Relational.Query.ProjectableClass (
ProductConstructor (..),
ProjectableFunctor (..), ProjectableApplicative (..), ipfmap,
ShowConstantTermsSQL (..), showConstantTermsSQL,
StringSQL,
) where
import GHC.Generics (Generic, Rep, U1 (..), K1 (..), M1 (..), (:*:)(..), from)
import Data.Monoid (mempty, (<>))
import Data.DList (DList, toList)
import Database.Relational.Query.Internal.SQL (StringSQL)
class ProductConstructor r where
productConstructor :: r
class ProjectableFunctor p where
(|$|) :: ProductConstructor (a -> b) => (a -> b) -> p a -> p b
ipfmap :: (ProjectableFunctor p, ProductConstructor (a -> b))
=> p a -> p b
ipfmap = (|$|) productConstructor
class ProjectableFunctor p => ProjectableApplicative p where
(|*|) :: p (a -> b) -> p a -> p b
infixl 4 |$|, |*|
showConstantTermsSQL :: ShowConstantTermsSQL a
=> a
-> [StringSQL]
showConstantTermsSQL = toList . showConstantTermsSQL'
class ShowConstantTermsSQL a where
showConstantTermsSQL' :: a -> DList StringSQL
default showConstantTermsSQL' :: (Generic a, GShowConstantTermsSQL (Rep a)) => a -> DList StringSQL
showConstantTermsSQL' = gShowConstantTermsSQL . from
class GShowConstantTermsSQL f where
gShowConstantTermsSQL :: f a -> DList StringSQL
instance GShowConstantTermsSQL U1 where
gShowConstantTermsSQL U1 = mempty
instance (GShowConstantTermsSQL a, GShowConstantTermsSQL b) =>
GShowConstantTermsSQL (a :*: b) where
gShowConstantTermsSQL (a :*: b) = gShowConstantTermsSQL a <> gShowConstantTermsSQL b
instance GShowConstantTermsSQL a => GShowConstantTermsSQL (M1 i c a) where
gShowConstantTermsSQL (M1 a) = gShowConstantTermsSQL a
instance ShowConstantTermsSQL a => GShowConstantTermsSQL (K1 i a) where
gShowConstantTermsSQL (K1 a) = showConstantTermsSQL' a