{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DefaultSignatures #-}
module Database.Relational.ProjectableClass (
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.Internal.String (StringSQL)
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