git.iko.soy/rel8
on ae2ce41 help sign in
rel8/src/Rel8/Type/Array1D.hs
139 lines 3.7 kB history raw
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 #-}
12{-# options_ghc -fno-warn-redundant-constraints #-}
14module Rel8.Type.Array1D
15 ( Array1D( Array1D )
16 , NotArray
17 , getArray1D
18 )
19where
21-- aeson
22import Data.Aeson
23 ( ToJSON
24 , ToJSON1
25 , ToJSONKey
26 , FromJSON
27 , FromJSON1
28 , FromJSONKey
29 )
31-- base
32import Control.Applicative ( Alternative, (<|>) )
33import Control.Monad ( MonadPlus )
34import Data.Functor.Classes ( Eq1, Ord1, Read1, Show1 )
35import Data.Kind ( Type )
36import GHC.Exts ( IsList )
37import Prelude hiding ( null )
39-- hasql
40import qualified Hasql.Decoders as Hasql
42-- opaleye
43import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
45-- rel8
46import Rel8.Expr.Opaleye ( zipPrimExprsWith )
47import Rel8.Expr.Serialize ( litExpr )
48import Rel8.Schema.Null ( Unnullify, Nullity( Null, NotNull ), Sql, nullable )
49import Rel8.Type ( DBType, typeInformation )
50import Rel8.Type.Eq ( DBEq )
51import Rel8.Type.Information ( TypeInformation(..) )
52import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
53import Rel8.Type.Ord ( DBMax, DBMin, DBOrd )
54import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
56-- semigroupoids
57import Data.Functor.Alt ( Alt, (<!>) )
58import Data.Functor.Apply ( Apply )
59import Data.Functor.Bind ( Bind )
60import Data.Functor.Plus ( Plus )
62-- semialign
63import Data.Align ( Align )
64import Data.Semialign ( Semialign )
65import Data.Zip ( Repeat, Unzip, Zip )
68-- | A one dimensional array.
69newtype 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 )
81instance Alt Array1D where
82 (<!>) = (<|>)
85getArray1D :: Array1D a -> [a]
86getArray1D (Array1D a) = a
89type IsArray1D :: Type -> Bool
90type family IsArray1D a where
91 IsArray1D (Array1D _) = 'True
92 IsArray1D _ = 'False
95class IsArray1D a ~ 'False => NotArray a
96instance IsArray1D a ~ 'False => NotArray a
99array1DTypeInformation :: Sql NotArray a
100 => Nullity a
101 -> TypeInformation (Unnullify a)
102 -> TypeInformation (Array1D a)
103array1DTypeInformation 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
118instance (Sql DBType a, Sql NotArray a) => DBType (Array1D a) where
119 typeInformation = array1DTypeInformation nullable typeInformation
122instance (Sql DBEq a, Sql NotArray a) => DBEq (Array1D a)
125instance (Sql DBOrd a, Sql NotArray a) => DBOrd (Array1D a)
128instance (Sql DBMax a, Sql NotArray a) => DBMax (Array1D a)
131instance (Sql DBMin a, Sql NotArray a) => DBMin (Array1D a)
134instance (Sql DBType a, Sql NotArray a) => DBSemigroup (Array1D a) where
135 (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))
138instance (Sql DBType a, Sql NotArray a) => DBMonoid (Array1D a) where
139 memptyExpr = litExpr mempty