0 | module Oracle.Internal.Decode
  1 |
  2 | import Control.Monad.Elin
  3 | import Control.Monad.MCancel
  4 | import Data.ByteString
  5 | import Data.Linear.Ref1
  6 | import Oracle.Error
  7 | import Oracle.FFI.Data
  8 | import Oracle.FFI.DateTime
  9 | import Oracle.FFI.Lob
 10 | import Oracle.FFI.QueryInfo
 11 | import Oracle.FFI.Raw
 12 | import Oracle.FFI.Statement
 13 | import Oracle.Internal.Hex
 14 | import Oracle.Internal.QueryInfo
 15 | import Oracle.Types.ColumnInfo
 16 | import Oracle.Types.DateTime
 17 | import Oracle.Types.OracleType
 18 | import Oracle.Types.Value
 19 | import Oracle.Types.Error
 20 |
 21 | ||| Retrieve metadata describing a query column.
 22 | |||
 23 | ||| The underlying `dpiQueryInfo` structure is allocated only for the duration of this function.
 24 | |||
 25 | ||| It is always released before returning, regardless of whether the supplied action succeeds.
 26 | |||
 27 | ||| This is the preferred metadata API for query result decoding.
 28 | |||
 29 | export
 30 | getColumnInfo : AnyPtr -> Int32 -> IO (Either OracleError ColumnInfo)
 31 | getColumnInfo stmt column =
 32 |   withQueryInfo stmt column $ \info => do
 33 |     name     <- primIO (prim__queryInfoName info)
 34 |     tynum    <- primIO (prim__queryInfoType info)
 35 |     size     <- primIO (prim__queryInfoSize info)
 36 |     nullable <- primIO (prim__queryInfoNullable info)
 37 |     pure $
 38 |       MkColumnInfo
 39 |         name
 40 |         (fromOracleTypeNum tynum)
 41 |         (cast size)
 42 |         (nullable /= 0)
 43 |
 44 | ||| Decode the value of a single column in the current row.
 45 | |||
 46 | ||| This function:
 47 | ||| - Retrieves column metadata.
 48 | ||| - Retrieves the current row value.
 49 | ||| - Converts the Oracle value into an OracleValue.
 50 | |||
 51 | ||| If Oracle fails to retrieve the value, the Oracle error is propagated instead of being interpreted as OracleNull.
 52 | |||
 53 | export
 54 | decodeColumn : AnyPtr -> Int32 -> IO (Either OracleError OracleValue)
 55 | decodeColumn stmt column = do
 56 |   inforesult <- getColumnInfo stmt column
 57 |   case inforesult of
 58 |     Left err   =>
 59 |       pure (Left err)
 60 |     Right info => do
 61 |       dataptr <- primIO (prim__columnValue stmt column)
 62 |       case prim__nullAnyPtr dataptr == 1 of
 63 |         True => do
 64 |           lasterr <- getLastError
 65 |           pure (Left lasterr)
 66 |         False => do
 67 |           isnull  <- primIO (prim__dataIsNull dataptr)
 68 |           case isnull /= 0 of
 69 |             True  =>
 70 |               pure (Right OracleNull)
 71 |             False => do
 72 |               case info.oracletype of
 73 |                 OracleTypeVarchar      =>
 74 |                   Right . OracleString <$>
 75 |                     primIO (prim__dataString dataptr)
 76 |                 OracleTypeChar         =>
 77 |                   Right . OracleString <$>
 78 |                     primIO (prim__dataString dataptr)
 79 |                 OracleTypeNVarchar     =>
 80 |                   Right . OracleString <$>
 81 |                     primIO (prim__dataString dataptr)
 82 |                 OracleTypeNChar        =>
 83 |                   Right . OracleString <$>
 84 |                     primIO (prim__dataString dataptr)
 85 |                 OracleTypeNumber       =>
 86 |                   Right . OracleNumber <$>
 87 |                     primIO (prim__dataDouble dataptr)
 88 |                 OracleTypeBinaryFloat  =>
 89 |                   Right . OracleBinaryFloat <$>
 90 |                     primIO (prim__dataBinaryFloat dataptr)
 91 |                 OracleTypeBinaryDouble =>
 92 |                   Right . OracleBinaryDouble <$>
 93 |                     primIO (prim__dataBinaryDouble dataptr)
 94 |                 OracleTypeDate => do
 95 |                   dt <- primIO (prim__dataTimestamp dataptr)
 96 |                   pure $
 97 |                     Right $
 98 |                       OracleDate $
 99 |                         MkOracleDate
100 |                           !(primIO (prim__timestampYear dt))
101 |                           !(primIO (prim__timestampMonth dt))
102 |                           !(primIO (prim__timestampDay dt))
103 |                           !(primIO (prim__timestampHour dt))
104 |                           !(primIO (prim__timestampMinute dt))
105 |                           !(primIO (prim__timestampSecond dt))
106 |                 OracleTypeTimestamp    => do
107 |                   ts <- primIO (prim__dataTimestamp dataptr)
108 |                   pure $
109 |                     Right $
110 |                        OracleTimestamp $
111 |                          MkOracleTimestamp
112 |                            !(primIO (prim__timestampYear ts))
113 |                            !(primIO (prim__timestampMonth ts))
114 |                            !(primIO (prim__timestampDay ts))
115 |                            !(primIO (prim__timestampHour ts))
116 |                            !(primIO (prim__timestampMinute ts))
117 |                            !(primIO (prim__timestampSecond ts))
118 |                            !(primIO (prim__timestampNanosecond ts))
119 |                 OracleTypeTimestampTZ  => do
120 |                   ts <- primIO (prim__dataTimestamp dataptr)
121 |                   pure $
122 |                     Right $
123 |                       OracleTimestampTZ $
124 |                         MkOracleTimestampTZ
125 |                           !(primIO (prim__timestampYear ts))
126 |                           !(primIO (prim__timestampMonth ts))
127 |                           !(primIO (prim__timestampDay ts))
128 |                           !(primIO (prim__timestampHour ts))
129 |                           !(primIO (prim__timestampMinute ts))
130 |                           !(primIO (prim__timestampSecond ts))
131 |                           !(primIO (prim__timestampNanosecond ts))
132 |                           !(primIO (prim__timestampTZHour ts))
133 |                           !(primIO (prim__timestampTZMinute ts))
134 |                 OracleTypeIntervalYM   => do
135 |                   iv <- primIO (prim__dataIntervalYM dataptr)
136 |                   pure $
137 |                     Right $
138 |                       OracleIntervalYM $
139 |                         MkOracleIntervalYM
140 |                           !(primIO (prim__intervalYMYears iv))
141 |                           !(primIO (prim__intervalYMMonths iv))
142 |                 OracleTypeIntervalDS   => do
143 |                   iv <- primIO (prim__dataIntervalDS dataptr)
144 |                   pure $
145 |                     Right $
146 |                       OracleIntervalDS $
147 |                         MkOracleIntervalDS
148 |                           !(primIO (prim__intervalDSDays iv))
149 |                           !(primIO (prim__intervalDSHours iv))
150 |                           !(primIO (prim__intervalDSMinutes iv))
151 |                           !(primIO (prim__intervalDSSeconds iv))
152 |                           !(primIO (prim__intervalDSNanoseconds iv))
153 |                 OracleTypeRaw          => do
154 |                   result <- runElinIO (withDataPtrAndOracleType dataptr OracleTypeRaw) 
155 |                   case result of
156 |                     Right value =>
157 |                       case value of
158 |                         Left err     =>
159 |                           pure (Left err)
160 |                         Right value' =>
161 |                           pure (Right value')
162 |                     Left err    =>
163 |                       assert_total $ idris_crash "Oracle.Internal.Decode.decodeColumn: \{show err}"
164 |                 OracleTypeBlob         => do
165 |                   result <- runElinIO (withDataPtrAndOracleType dataptr OracleTypeBlob) 
166 |                   case result of
167 |                     Right value =>
168 |                       case value of
169 |                         Left err     =>
170 |                           pure (Left err)
171 |                         Right value' =>
172 |                           pure (Right value')
173 |                     Left err    =>
174 |                       assert_total $ idris_crash "Oracle.Internal.Decode.decodeColumn: \{show err}"
175 |                 OracleTypeClob         => do
176 |                   result <- runElinIO (withDataPtrAndOracleType dataptr OracleTypeClob) 
177 |                   case result of
178 |                     Right value =>
179 |                       case value of
180 |                         Left err     =>
181 |                           pure (Left err)
182 |                         Right value' =>
183 |                           pure (Right value')
184 |                     Left err    =>
185 |                       assert_total $ idris_crash "Oracle.Internal.Decode.decodeColumn: \{show err}"
186 |                 OracleTypeBoolean      => do
187 |                   b <- primIO (prim__dataBool dataptr)
188 |                   case b of
189 |                     0 =>
190 |                       pure (Right $ OracleBool False)
191 |                     1 =>
192 |                       pure (Right $ OracleBool True)
193 |                     n =>
194 |                       pure $
195 |                         Left $
196 |                           MkOracleError
197 |                             (-1)
198 |                             "Unsupported BOOLEAN: \{show n}"
199 |                             "Oracle.Internal.Decode.decodeColumn"
200 |                             False
201 |                 OracleTypeUnknown n    =>
202 |                   pure $
203 |                     Left $
204 |                       MkOracleError
205 |                         (-1)
206 |                         ("Unsupported Oracle type: " ++ show n)
207 |                         "Oracle.Internal.Decode.decodeColumn"
208 |                         False
209 |   where
210 |     acquire : AnyPtr -> OracleType -> F1 World AnyPtr
211 |     acquire dataptr oracletype =
212 |       case oracletype of
213 |         OracleTypeRaw =>
214 |           ioToF1 (pure dataptr)
215 |         _             =>
216 |           ioToF1 (primIO (prim__dataLob dataptr))
217 |     use : AnyPtr -> OracleType -> F1 World (Either OracleError OracleValue)
218 |     use ptr oracletype =
219 |       case oracletype of
220 |         OracleTypeBlob =>
221 |           ioToF1 ( do case prim__nullAnyPtr ptr == 1 of
222 |                         True  => do
223 |                           lasterr <- getLastError
224 |                           pure (Left lasterr)
225 |                         False => do
226 |                           size <- primIO (prim__lobSize ptr)
227 |                           case size < 0 of
228 |                             True  => do
229 |                               lasterr <- getLastError
230 |                               pure (Left lasterr)
231 |                             False => do
232 |                               bytes <- primIO (prim__lobRead ptr 1 size)
233 |                               pure (Right $ OracleBlob $ fromString bytes)
234 |                  )
235 |         OracleTypeClob =>
236 |           ioToF1 ( do case prim__nullAnyPtr ptr == 1 of
237 |                         True  => do
238 |                           lasterr <- getLastError
239 |                           pure (Left lasterr)
240 |                         False => do
241 |                           text <- primIO (prim__clobRead ptr)
242 |                           pure (Right $ OracleClob text)
243 |                  )
244 |         OracleTypeRaw =>
245 |           ioToF1 (do case prim__nullAnyPtr ptr == 1 of
246 |                        True  => do
247 |                          lasterr <- getLastError
248 |                          pure (Left lasterr)
249 |                        False => do
250 |                          hex <- primIO (prim__dataBytesHex ptr)
251 |                          case hexDecode hex of
252 |                            Nothing    =>
253 |                              pure $
254 |                                Left $
255 |                                  MkOracleError
256 |                                    (-1)
257 |                                    ("Invalid RAW hexadecimal value: " ++ hex)
258 |                                    "Oracle.Internal.Decode.decodeColumn.use"
259 |                                    False
260 |                            Just bytes =>
261 |                              pure (Right $ OracleRaw $ pack bytes)
262 |                  )
263 |         ty             =>
264 |           ioToF1 ( pure $
265 |                      Left $
266 |                        MkOracleError
267 |                          (-1)
268 |                          "Unsupported type: \{show ty}"
269 |                          "Oracle.Internal.Decode.decodeColumn.use"
270 |                          False
271 |                  )
272 |     release : AnyPtr -> OracleType -> F1' World
273 |     release ptr oracletype =
274 |       case oracletype of
275 |         OracleTypeRaw =>
276 |           ioToF1 (pure ())
277 |         _             =>
278 |           ioToF1 (primIO (prim__lobRelease ptr))
279 |     withDataPtrAndOracleType : AnyPtr -> OracleType -> Elin World [] (Either OracleError OracleValue)
280 |     withDataPtrAndOracleType dataptr oracletype =
281 |       bracket (runIO (acquire dataptr oracletype))
282 |               (\ptr => runIO (use ptr oracletype))
283 |               (\ptr => runIO (release ptr oracletype))
284 |