{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ConstraintKinds #-}
module Database.Relational.ProjectableClass (
LiteralSQL (..), showLiteral,
StringSQL,
ShowConstantTermsSQL, showConstantTermsSQL', showConstantTermsSQL,
) 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)
showLiteral :: LiteralSQL a
=> a
-> [StringSQL]
showLiteral = toList . showLiteral'
class LiteralSQL a where
showLiteral' :: a -> DList StringSQL
default showLiteral' :: (Generic a, GLiteralSQL (Rep a)) => a -> DList StringSQL
showLiteral' = gShowLiteral . from
class GLiteralSQL f where
gShowLiteral :: f a -> DList StringSQL
instance GLiteralSQL U1 where
gShowLiteral U1 = mempty
instance (GLiteralSQL a, GLiteralSQL b) =>
GLiteralSQL (a :*: b) where
gShowLiteral (a :*: b) = gShowLiteral a <> gShowLiteral b
instance GLiteralSQL a => GLiteralSQL (M1 i c a) where
gShowLiteral (M1 a) = gShowLiteral a
instance ShowConstantTermsSQL a => GLiteralSQL (K1 i a) where
gShowLiteral (K1 a) = showLiteral' a
{-# DEPRECATED ShowConstantTermsSQL "Use `LiteralSQL` instead of this." #-}
type ShowConstantTermsSQL = LiteralSQL
{-# DEPRECATED showConstantTermsSQL' "Use `showLiteral'` instead of this." #-}
showConstantTermsSQL' :: ShowConstantTermsSQL a => a -> DList StringSQL
showConstantTermsSQL' = showLiteral'
{-# DEPRECATED showConstantTermsSQL "Use `showLiteral` instead of this." #-}
showConstantTermsSQL :: ShowConstantTermsSQL a
=> a
-> [StringSQL]
showConstantTermsSQL = toList . showConstantTermsSQL'