khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2025-01-08 14:26:33 +03:00
Code Issues Projects Releases Wiki Activity

relational-query: add generic definitions of ShowConstantTermsSQL.

Browse Source
This commit is contained in:
Kei Hibino 2017-03-30 14:39:31 +09:00
parent e021813827
commit 9db8458198
1 changed files with 25 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
relational-query/src/Database/Relational/Query/ProjectableClass.hs
View File

@ -1,4 +1,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DefaultSignatures #-}
-- |
-- Module : Database.Relational.Query.ProjectableClass
@ -24,6 +26,10 @@ module Database.Relational.Query.ProjectableClass (
) where
import GHC.Generics (Generic, Rep, U1 (..), K1 (..), M1 (..), (:*:)(..), from)
import Data.Monoid (mempty, (<>))
import Data.DList (DList, fromList, toList)
import Database.Relational.Query.Internal.SQL (StringSQL)
@ -53,3 +59,22 @@ infixl 4 |$|, |*|
-- | Interface for constant SQL term list.
class ShowConstantTermsSQL a where
showConstantTermsSQL :: a -> [StringSQL]
default showConstantTermsSQL :: (Generic a, GShowConstantTermsSQL (Rep a)) => a -> [StringSQL]
showConstantTermsSQL = toList . 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) = fromList $ showConstantTermsSQL a