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.Statement
 12 | import Oracle.Internal.QueryInfo
 13 | import Oracle.Types.ColumnInfo
 14 | import Oracle.Types.DateTime
 15 | import Oracle.Types.OracleType
 16 | import Oracle.Types.Value
 17 | import Oracle.Types.Error
 18 |
 19 | ||| Retrieve metadata describing a query column.
 20 | |||
 21 | ||| The underlying `dpiQueryInfo` structure is allocated only for the duration of this function.
 22 | |||
 23 | ||| It is always released before returning, regardless of whether the supplied action succeeds.
 24 | |||
 25 | ||| This is the preferred metadata API for query result decoding.
 26 | |||
 27 | export
 28 | getColumnInfo : AnyPtr -> Int32 -> IO (Either OracleError ColumnInfo)
 29 | getColumnInfo stmt column =
 30 |   withQueryInfo stmt column $ \info => do
 31 |     name     <- primIO (prim__queryInfoName info)
 32 |     tynum    <- primIO (prim__queryInfoType info)
 33 |     size     <- primIO (prim__queryInfoSize info)
 34 |     nullable <- primIO (prim__queryInfoNullable info)
 35 |     pure $
 36 |       MkColumnInfo
 37 |         name
 38 |         (fromOracleTypeNum tynum)
 39 |         (cast size)
 40 |         (nullable /= 0)
 41 |
 42 | ||| Decode the value of a single column in the current row.
 43 | |||
 44 | ||| This function:
 45 | ||| - Retrieves column metadata.
 46 | ||| - Retrieves the current row value.
 47 | ||| - Converts the Oracle value into an OracleValue.
 48 | |||
 49 | ||| If Oracle fails to retrieve the value, the Oracle error is propagated instead of being interpreted as OracleNull.
 50 | |||
 51 | export
 52 | decodeColumn : AnyPtr -> Int32 -> IO (Either OracleError OracleValue)
 53 | decodeColumn stmt column = do
 54 |   inforesult <- getColumnInfo stmt column
 55 |   case inforesult of
 56 |     Left err   =>
 57 |       pure (Left err)
 58 |     Right info => do
 59 |       dataptr <- primIO (prim__columnValue stmt column)
 60 |       case prim__nullAnyPtr dataptr == 1 of
 61 |         True => do
 62 |           lasterr <- getLastError
 63 |           pure (Left lasterr)
 64 |         False => do
 65 |           isnull  <- primIO (prim__dataIsNull dataptr)
 66 |           case isnull /= 0 of
 67 |             True  =>
 68 |               pure (Right OracleNull)
 69 |             False => do
 70 |               case info.oracletype of
 71 |                 OracleTypeVarchar     =>
 72 |                   Right . OracleString <$>
 73 |                     primIO (prim__dataString dataptr)
 74 |                 OracleTypeNumber      =>
 75 |                   Right . OracleNumber <$>
 76 |                     primIO (prim__dataDouble dataptr)
 77 |                 OracleTypeRaw         =>
 78 |                   Right . OracleBlob . fromString <$>
 79 |                     primIO (prim__dataString dataptr)
 80 |                 OracleTypeTimestamp   => do
 81 |                   ts <- primIO (prim__dataTimestamp dataptr)
 82 |                   pure $
 83 |                     Right $
 84 |                        OracleTimestamp $
 85 |                          MkOracleTimestamp
 86 |                            !(primIO (prim__timestampYear ts))
 87 |                            !(primIO (prim__timestampMonth ts))
 88 |                            !(primIO (prim__timestampDay ts))
 89 |                            !(primIO (prim__timestampHour ts))
 90 |                            !(primIO (prim__timestampMinute ts))
 91 |                            !(primIO (prim__timestampSecond ts))
 92 |                            !(primIO (prim__timestampNanosecond ts))
 93 |                 OracleTypeTimestampTZ => do
 94 |                   ts <- primIO (prim__dataTimestamp dataptr)
 95 |                   pure $
 96 |                     Right $
 97 |                       OracleTimestampTZ $
 98 |                         MkOracleTimestampTZ
 99 |                           !(primIO (prim__timestampYear ts))
100 |                           !(primIO (prim__timestampMonth ts))
101 |                           !(primIO (prim__timestampDay ts))
102 |                           !(primIO (prim__timestampHour ts))
103 |                           !(primIO (prim__timestampMinute ts))
104 |                           !(primIO (prim__timestampSecond ts))
105 |                           !(primIO (prim__timestampNanosecond ts))
106 |                           !(primIO (prim__timestampTZHour ts))
107 |                           !(primIO (prim__timestampTZMinute ts))
108 |                 OracleTypeIntervalYM  => do
109 |                   iv <- primIO (prim__dataIntervalYM dataptr)
110 |                   pure $
111 |                     Right $
112 |                       OracleIntervalYM $
113 |                         MkOracleIntervalYM
114 |                           !(primIO (prim__intervalYMYears iv))
115 |                           !(primIO (prim__intervalYMMonths iv))
116 |                 OracleTypeIntervalDS  => do
117 |                   iv <- primIO (prim__dataIntervalDS dataptr)
118 |                   pure $
119 |                     Right $
120 |                       OracleIntervalDS $
121 |                         MkOracleIntervalDS
122 |                           !(primIO (prim__intervalDSDays iv))
123 |                           !(primIO (prim__intervalDSHours iv))
124 |                           !(primIO (prim__intervalDSMinutes iv))
125 |                           !(primIO (prim__intervalDSSeconds iv))
126 |                           !(primIO (prim__intervalDSNanoseconds iv))
127 |                 OracleTypeBlob        => do
128 |                   result <- runElinIO (withDataPtrAndOracleType dataptr OracleTypeBlob) 
129 |                   case result of
130 |                     Right value =>
131 |                       case value of
132 |                         Left err     =>
133 |                           pure (Left err)
134 |                         Right value' =>
135 |                           pure (Right value')
136 |                     Left err    =>
137 |                       assert_total $ idris_crash "Oracle.Internal.Decode.decodeColumn: \{show err}"
138 |                 OracleTypeClob        => do
139 |                   result <- runElinIO (withDataPtrAndOracleType dataptr OracleTypeClob) 
140 |                   case result of
141 |                     Right value =>
142 |                       case value of
143 |                         Left err     =>
144 |                           pure (Left err)
145 |                         Right value' =>
146 |                           pure (Right value')
147 |                     Left err    =>
148 |                       assert_total $ idris_crash "Oracle.Internal.Decode.decodeColumn: \{show err}"
149 |                 OracleTypeBoolean     => do
150 |                   b <- primIO (prim__dataBool dataptr)
151 |                   case b of
152 |                     0 =>
153 |                       pure (Right $ OracleBool False)
154 |                     1 =>
155 |                       pure (Right $ OracleBool True)
156 |                     n =>
157 |                       pure $
158 |                         Left $
159 |                           MkOracleError
160 |                             (-1)
161 |                             "Unsupported BOOLEAN: \{show n}"
162 |                             "Oracle.Internal.Decode.decodeColumn"
163 |                             False
164 |                 OracleTypeUnknown n   =>
165 |                   pure $
166 |                     Left $
167 |                       MkOracleError
168 |                         (-1)
169 |                         ("Unsupported Oracle type: " ++ show n)
170 |                         "Oracle.Internal.Decode.decodeColumn"
171 |                         False
172 |   where
173 |     acquire : AnyPtr -> F1 World AnyPtr
174 |     acquire dataptr =
175 |       ioToF1 (primIO (prim__dataLob dataptr))
176 |     use : AnyPtr -> OracleType -> F1 World (Either OracleError OracleValue)
177 |     use ptr oracletype =
178 |       case oracletype of
179 |         OracleTypeBlob =>
180 |           ioToF1 ( do case prim__nullAnyPtr ptr == 1 of
181 |                         True  => do
182 |                           lasterr <- getLastError
183 |                           pure (Left lasterr)
184 |                         False => do
185 |                           size <- primIO (prim__lobSize ptr)
186 |                           case size < 0 of
187 |                             True  => do
188 |                               lasterr <- getLastError
189 |                               pure (Left lasterr)
190 |                             False => do
191 |                               bytes <- primIO (prim__lobRead ptr 1 size)
192 |                               pure (Right $ OracleBlob $ fromString bytes)
193 |                  )
194 |         OracleTypeClob =>
195 |           ioToF1 ( do case prim__nullAnyPtr ptr == 1 of
196 |                         True  => do
197 |                           lasterr <- getLastError
198 |                           pure (Left lasterr)
199 |                         False => do
200 |                           text <- primIO (prim__clobRead ptr)
201 |                           pure (Right $ OracleClob text)
202 |                  )
203 |         ty             =>
204 |           ioToF1 ( pure $
205 |                      Left $
206 |                        MkOracleError
207 |                          (-1)
208 |                          "Unsupported type: \{show ty}"
209 |                          "Oracle.Internal.Decode.decodeColumn.use"
210 |                          False
211 |                  )
212 |     release : AnyPtr -> F1' World
213 |     release ptr =
214 |       ioToF1 (primIO (prim__lobRelease ptr))
215 |     withDataPtrAndOracleType : AnyPtr -> OracleType -> Elin World [] (Either OracleError OracleValue)
216 |     withDataPtrAndOracleType dataptr oracletype =
217 |       bracket (runIO (acquire dataptr))
218 |               (\ptr => runIO (use ptr oracletype))
219 |               (\ptr => runIO (release ptr))
220 |