on db40580 help sign in
rel8/src/Rel8/Type/Semigroup.hs
90 lines 2.4 kB history raw
1{-# language BlockArguments #-}
2{-# language DataKinds #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language MultiParamTypeClasses #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeFamilies #-}
8{-# language UndecidableInstances #-}
10module Rel8.Type.Semigroup
11 ( DBSemigroup( (<>.))
12 )
13where
15-- base
16import Data.Function ( on )
17import Data.Kind ( Constraint, Type )
18import Data.List.NonEmpty ( NonEmpty )
19import Prelude
21-- bytestring
22import Data.ByteString ( ByteString )
23import qualified Data.ByteString.Lazy as Lazy ( ByteString )
25-- case-insensitive
26import Data.CaseInsensitive ( CI )
28-- opaleye
29import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
31-- rel8
32import {-# SOURCE #-} Rel8.Expr ( Expr )
33import Rel8.Expr.Opaleye ( zipPrimExprsWith )
34import Rel8.Schema.Null ( Sql )
35import Rel8.Type ( DBType )
36import Rel8.Type.Array ( fromPrimArray, toPrimArray )
38-- text
39import Data.Text ( Text )
40import qualified Data.Text.Lazy as Lazy ( Text )
42-- time
43import Data.Time.LocalTime ( CalendarDiffTime )
46-- | The class of 'Rel8.DBType's that form a semigroup. This class is purely a
47-- Rel8 concept, and exists to mirror the 'Semigroup' class.
48type DBSemigroup :: Type -> Constraint
49class DBType a => DBSemigroup a where
50 -- | An associative operation.
51 (<>.) :: Expr a -> Expr a -> Expr a
52 infixr 6 <>.
55instance Sql DBType a => DBSemigroup [a] where
56 (<>.) = zipPrimExprsWith do
57 (fromPrimArray .) . Opaleye.BinExpr (Opaleye.:||) `on` toPrimArray
60instance Sql DBType a => DBSemigroup (NonEmpty a) where
61 (<>.) = zipPrimExprsWith do
62 (fromPrimArray .) . Opaleye.BinExpr (Opaleye.:||) `on` toPrimArray
65instance DBSemigroup CalendarDiffTime where
66 (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:+))
69instance DBSemigroup Text where
70 (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
73instance DBSemigroup Lazy.Text where
74 (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
77instance DBSemigroup (CI Text) where
78 (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
81instance DBSemigroup (CI Lazy.Text) where
82 (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
85instance DBSemigroup ByteString where
86 (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
89instance DBSemigroup Lazy.ByteString where
90 (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))