8000 Moved out high-level decoders · postgres-haskell/postgres-wire@d4cb443 · GitHub
[go: up one dir, main page]
Skip to content

Commit d4cb443

Browse files
VyacheslavHashovVyacheslavHashov
committed
Moved out high-level decoders
1 parent 3afc091 commit d4cb443

File tree

1 file changed

+0
-130
lines changed

1 file changed

+0
-130
lines changed

‎src/Database/PostgreSQL/Protocol/Codecs/Decoders.hs

Lines changed: 0 additions & 130 deletions
Original file line numberDiff line numberDiff line change
@@ -87,133 +87,3 @@ int8 _ = getInt64BE
8787
bool :: FieldDecoder Bool
8888
bool _ = (== 1) <$> getWord8
8989

90-
data FieldF r a
91-
= Single !(FieldDecoder a)
92-
| Row !(r a)
93-
94-
{-# INLINE getFieldDec #-}
95-
getFieldDec :: FieldF CompositeValue a -> FieldDecoder a
96-
getFieldDec (Single fd) = fd
97-
getFieldDec (Row r) = composite r
98-
99-
-- High level
100-
--
101-
102-
class PrimField a where
103-
104-
primField :: RowDecoder r => FieldF r a
105-
106-
{-# INLINE field #-}
107-
field :: RowDecoder r => r a
108-
field = getRowNonNullValue $ getFieldDec primField
109-
110-
type IsArrayField a :: Bool
111-
type IsArrayField a = 'False
112-
113-
type IsNullableField a :: Bool
114-
type IsNullableField a = 'False
115-
116-
arrayDim :: Proxy a -> Int
117-
arrayDim _ = 0
118-
119-
asArrayData :: V.Vector Int -> Decode a
120-
asArrayData _ = runRowDecoder (field :: RowValue a)
121-
122-
instance PrimField Int16 where
123-
primField = Single int2
124-
125-
instance PrimField Int32 where
126-
primField = Single int4
127-
128-
instance PrimField Int64 where
129-
primField = Single int8
130-
131-
instance PrimField Bool where
132-
primField = Single bool
133-
134-
instance PrimField B.ByteString where
135-
primField = Single getByteString
136-
137-
instance PrimField a => PrimField (Maybe a) where
138-
primField = undefined
139-
140-
type IsNullableField (Maybe a) = 'True
141-
type IsArrayField (Maybe a) = IsArrayField a
142-
{-# INLINE field #-}
143-
field = getRowNullValue $ getFieldDec primField
144-
145-
instance (IsAllowedArray (IsNullableField a) (IsArrayField a) ~ 'True,
146-
PrimField a)
147-
=> PrimField (V.Vector a) where
148-
primField = Single $ arrayFieldDecoder
149-
(arrayDim (Proxy :: Proxy (V.Vector a)))
150-
asArrayData
151-
152-
type IsArrayField (V.Vector a) = 'True
153-
arrayDim _ = arrayDim (Proxy :: Proxy a) + 1
154-
155-
asArrayData vec = V.replicateM (vec V.! arrayDim (Proxy :: Proxy a))
156-
$ asArrayData vec
157-
158-
type family IsAllowedArray (n :: Bool) (a :: Bool) :: Bool where
159-
IsAllowedArray 'True 'True = 'False
160-
IsAllowedArray _ _ = 'True
161-
162-
163-
-- TODO add array value
164-
newtype RowValue a = RowValue { unRowValue :: Decode a }
165-
deriving (Functor, Applicative, Monad)
166-
newtype CompositeValue a = CompositeValue { unCompositeValue :: Decode a }
167-
deriving (Functor, Applicative, Monad)
168-
169-
class (Functor r, Applicative r, Monad r) => RowDecoder r where
170-
getRowNonNullValue :: FieldDecoder a -> r a
171-
getRowNullValue :: FieldDecoder a -> r (Maybe a)
172-
runRowDecoder :: r a -> Decode a
173-
174-
instance RowDecoder RowValue where
175-
{-# INLINE getRowNonNullValue #-}
176-
getRowNonNullValue = RowValue . getNonNullable
177-
{-# INLINE getRowNullValue #-}
178-
getRowNullValue = RowValue . getNullable
179-
{-# INLINE runRowDecoder #-}
180-
runRowDecoder = unRowValue
181-
182-
instance RowDecoder CompositeValue where
183-
{-# INLINE getRowNonNullValue #-}
184-
getRowNonNullValue = CompositeValue
185-
. fmap (compositeValue *>) getNonNullable
186-
{-# INLINE getRowNullValue #-}
187-
getRowNullValue = CompositeValue
188-
. fmap (compositeValue *>) getNullable
189-
{-# INLINE runRowDecoder #-}
190-
runRowDecoder = unCompositeValue
191-
192-
instance (PrimField a1, PrimField a2, PrimField a3)
193-
=> PrimField (a1, a2, a3) where
194-
195-
{-# INLINE primField #-}
196-
primField = Row $ (,,) <$> field <*> field <*> field
197-
198-
instance (PrimField a1, PrimField a2, PrimField a3, PrimField a4,
199-
PrimField a5, PrimField a6, PrimField a7, PrimField a8,
200-
PrimField a9, PrimField a10, PrimField a11, PrimField a12)
201-
=> PrimField (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12)
202-
where
203-
{-# INLINE primField #-}
204-
primField = Row $ (,,,,,,,,,,,) <$> field <*> field <*> field <*> field
205-
<*> field <*> field <*> field <*> field
206-
<*> field <*> field <*> field <*> field
207-
208-
209-
composite :: CompositeValue a -> FieldDecoder a
210-
composite dec _ = compositeHeader *> runRowDecoder dec
211-
212-
{-# INLINE rowDecoder #-}
213-
rowDecoder :: forall a. PrimField a => Decode a
214-
rowDecoder = case primField of
215-
Single f -> skipDataRowHeader *> runRowDecoder
216-
(getRowNonNullValue f :: RowValue a)
217-
Row r -> skipDataRowHeader *> runRowDecoder (r :: RowValue a)
218-
219-

0 commit comments

Comments
 (0)
0