khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2024-11-25 08:19:14 +03:00
Code Issues Projects Releases Wiki Activity

Merge b168e4b50e into 2805670712

Browse Source
This commit is contained in:
Fumiaki Kinoshita 2023-12-03 02:09:50 +09:00 committed by GitHub
commit 83acf2827b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 20 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
relational-query/relational-query.cabal
View File

@ -36,6 +36,11 @@ tested-with: GHC == 9.6.2
, GHC == 7.4.1, GHC == 7.4.2
extra-source-files: ChangeLog.md
flag IsLabel
default: True
manual: True
description: Define an IsLabel instance for Database.Relational.Typed.Record.PI
library
exposed-modules:
Database.Relational.Arrow
@ -142,6 +147,9 @@ library
ghc-options: -Wnoncanonical-monadfail-instances
default-language: Haskell2010
if flag(IsLabel)
ghc-options: -DISLABEL
test-suite sqls
build-depends: base <5

22
relational-query/src/Database/Relational/OverloadedProjection.hs
View File

@ -7,6 +7,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
#if __GLASGOW_HASKELL__ >= 800
-- |
@ -20,6 +21,7 @@
--
-- This module provides interfaces of overloaded projections.
module Database.Relational.OverloadedProjection (
PiLabel(..),
HasProjection (..),
) where
@ -40,23 +42,23 @@ class HasProjection l a b | l a -> b where
projection :: PiLabel l -> Pi a b
#if __GLASGOW_HASKELL__ >= 802
-- | Derive 'IsLabel' instance from 'HasProjection'.
instance HasProjection l a b => IsLabel l (Pi a b) where
fromLabel = projection (GetPi :: PiLabel l)
-- | Derive 'PI' label.
instance (PersistableWidth a, HasProjection l a b)
=> IsLabel l (PI c a b) where
fromLabel = (! projection (GetPi :: PiLabel l))
#define FROM_LABEL fromLabel
#else
#define FROM_LABEL fromLabel _
#endif
instance l ~ l' => IsLabel l (PiLabel l') where -- a type equality constraint makes better type inference
FROM_LABEL = GetPi
-- | Derive 'IsLabel' instance from 'HasProjection'.
instance HasProjection l a b => IsLabel l (Pi a b) where
fromLabel _ = projection (GetPi :: PiLabel l)
FROM_LABEL = projection (GetPi :: PiLabel l)
#if defined(ISLABEL)
-- | Derive 'PI' label.
instance (PersistableWidth a, HasProjection l a b)
=> IsLabel l (PI c a b) where
fromLabel _ = (! projection (GetPi :: PiLabel l))
FROM_LABEL = (! projection (GetPi :: PiLabel l))
#endif
#else
module Database.Relational.OverloadedProjection () where