@@ -1,139 +0,0 @@
1−{-# language DataKinds #-}
2−{-# language DeriveTraversable #-}
3−{-# language DerivingStrategies #-}
4−{-# language FlexibleContexts #-}
5−{-# language FlexibleInstances #-}
6−{-# language GeneralizedNewtypeDeriving #-}
7−{-# language NamedFieldPuns #-}
8−{-# language StandaloneKindSignatures #-}
9−{-# language TypeFamilies #-}
10−{-# language UndecidableInstances #-}
11−
12−{-# options_ghc -fno-warn-redundant-constraints #-}
13−
14−module Rel8.Type.Array1D
15− ( Array1D( Array1D )
16− , NotArray
17− , getArray1D
18− )
19−where
20−
21−-- aeson
22−import Data.Aeson
23− ( ToJSON
24− , ToJSON1
25− , ToJSONKey
26− , FromJSON
27− , FromJSON1
28− , FromJSONKey
29− )
30−
31−-- base
32−import Control.Applicative ( Alternative, (<|>) )
33−import Control.Monad ( MonadPlus )
34−import Data.Functor.Classes ( Eq1, Ord1, Read1, Show1 )
35−import Data.Kind ( Type )
36−import GHC.Exts ( IsList )
37−import Prelude hiding ( null )
38−
39−-- hasql
40−import qualified Hasql.Decoders as Hasql
41−
42−-- opaleye
43−import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
44−
45−-- rel8
46−import Rel8.Expr.Opaleye ( zipPrimExprsWith )
47−import Rel8.Expr.Serialize ( litExpr )
48−import Rel8.Schema.Null ( Unnullify, Nullity( Null, NotNull ), Sql, nullable )
49−import Rel8.Type ( DBType, typeInformation )
50−import Rel8.Type.Eq ( DBEq )
51−import Rel8.Type.Information ( TypeInformation(..) )
52−import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
53−import Rel8.Type.Ord ( DBMax, DBMin, DBOrd )
54−import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
55−
56−-- semigroupoids
57−import Data.Functor.Alt ( Alt, (<!>) )
58−import Data.Functor.Apply ( Apply )
59−import Data.Functor.Bind ( Bind )
60−import Data.Functor.Plus ( Plus )
61−
62−-- semialign
63−import Data.Align ( Align )
64−import Data.Semialign ( Semialign )
65−import Data.Zip ( Repeat, Unzip, Zip )
66−
67−
68−-- | A one dimensional array.
69−newtype Array1D a = Array1D [a]
70− deriving stock Traversable
71− deriving newtype
72− ( Eq, Ord, Read, Show, Semigroup, Monoid, IsList
73− , Functor, Foldable
74− , Eq1, Ord1, Read1, Show1
75− , FromJSON1, ToJSON1, FromJSON, FromJSONKey, ToJSON, ToJSONKey
76− , Apply, Applicative, Alternative, Plus, Bind, Monad, MonadPlus
77− , Align, Semialign, Repeat, Unzip, Zip
78− )
79−
80−
81−instance Alt Array1D where
82− (<!>) = (<|>)
83−
84−
85−getArray1D :: Array1D a -> [a]
86−getArray1D (Array1D a) = a
87−
88−
89−type IsArray1D :: Type -> Bool
90−type family IsArray1D a where
91− IsArray1D (Array1D _) = 'True
92− IsArray1D _ = 'False
93−
94−
95−class IsArray1D a ~ 'False => NotArray a
96−instance IsArray1D a ~ 'False => NotArray a
97−
98−
99−array1DTypeInformation :: Sql NotArray a
100− => Nullity a
101− -> TypeInformation (Unnullify a)
102− -> TypeInformation (Array1D a)
103−array1DTypeInformation nullity info =
104− case info of
105− TypeInformation{ encode, decode, typeName } -> TypeInformation
106− { decode = case nullity of
107− Null -> Array1D <$> Hasql.listArray (Hasql.nullable decode)
108− NotNull -> Array1D <$> Hasql.listArray (Hasql.nonNullable decode)
109− , encode = case nullity of
110− Null -> Opaleye.ArrayExpr . fmap (maybe null encode) . getArray1D
111− NotNull -> Opaleye.ArrayExpr . fmap encode . getArray1D
112− , typeName = typeName <> "[]"
113− }
114− where
115− null = Opaleye.ConstExpr Opaleye.NullLit
116−
117−
118−instance (Sql DBType a, Sql NotArray a) => DBType (Array1D a) where
119− typeInformation = array1DTypeInformation nullable typeInformation
120−
121−
122−instance (Sql DBEq a, Sql NotArray a) => DBEq (Array1D a)
123−
124−
125−instance (Sql DBOrd a, Sql NotArray a) => DBOrd (Array1D a)
126−
127−
128−instance (Sql DBMax a, Sql NotArray a) => DBMax (Array1D a)
129−
130−
131−instance (Sql DBMin a, Sql NotArray a) => DBMin (Array1D a)
132−
133−
134−instance (Sql DBType a, Sql NotArray a) => DBSemigroup (Array1D a) where
135− (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
136−
137−
138−instance (Sql DBType a, Sql NotArray a) => DBMonoid (Array1D a) where
139− memptyExpr = litExpr mempty