0 | module Oracle.Statement

  2 | import Control.Monad.Elin

  3 | import Control.Monad.MCancel

  4 | import Data.ByteString

  5 | import Data.Linear.Ref1

  6 | import Oracle.Connection

  7 | import Oracle.Error

  8 | import Oracle.FFI.Bind

  9 | import Oracle.FFI.DateTime

 10 | import Oracle.FFI.Statement

 11 | import Oracle.Internal.Decode

 12 | import Oracle.Internal.Hex

 13 | import Oracle.Internal.Pointer

 14 | import Oracle.Types.BindParameter

 15 | import Oracle.Types.DateTime

 16 | import Oracle.Types.Error

 17 | import Oracle.Types.Value

 19 | %default total

 30 | prepare : Connection -> String -> IO (Either OracleError Statement)

 31 | prepare conn sql = do

 32 |   ptr <- primIO (prim__prepareStmt conn.ptr sql)

 33 |   case prim__nullAnyPtr ptr == 1 of

 34 |     True => do

 35 |       lasterr <- getLastError

 36 |       pure (Left lasterr)

 37 |     False =>

 38 |       pure (Right $ MkStatement ptr)

 45 | release : Statement -> IO ()

 46 | release stmt =

 47 |   primIO (prim__releaseStmt stmt.ptr)

 62 | withStatement : Connection -> String -> (Statement -> IO (Either OracleError a)) -> IO (Either OracleError a)

 63 | withStatement conn sql action = do

 64 |   result <- runElinIO (withStatement' conn sql)

 65 |   case result of

 66 |     Right value =>

 67 |       case value of

 68 |         Left err     =>

 69 |           pure (Left err)

 70 |         Right value' =>

 71 |           pure (Right value')

 72 |     Left err    =>

 73 |       assert_total $ idris_crash "Oracle.Connection.withStatement: \{show err}"

 74 |   where

 75 |     acquire : Connection -> String -> F1 World (Either OracleError Statement)

 76 |     acquire conn sql =

 77 |       ioToF1 (prepare conn sql)

 78 |     use : Either OracleError Statement -> F1 World (Either OracleError a)

 79 |     use stmt =

 80 |       case stmt of

 81 |         Left err    =>

 82 |           ioToF1 (pure (Left err))

 83 |         Right stmt' =>

 84 |           ioToF1 (action stmt')

 85 |     cleanup : Either OracleError Statement -> F1' World

 86 |     cleanup stmt =

 87 |       case stmt of

 88 |         Left err    =>

 89 |           ioToF1 (pure ())

 90 |         Right stmt' =>

 91 |           ioToF1 (release stmt')

 92 |     withStatement' : Connection -> String -> Elin World [] (Either OracleError a)

 93 |     withStatement' conn sql =

 94 |       bracket (runIO (acquire conn sql))

 95 |               (\stmt => runIO (use stmt))

 96 |               (\stmt => runIO (cleanup stmt))

108 | execute : Statement -> IO (Either OracleError ())

109 | execute stmt = do

110 |   rc <- primIO (prim__executeStmt stmt.ptr)

111 |   case rc == 0 of

112 |     True  =>

113 |       pure (Right ())

114 |     False => do

115 |       lasterr <- getLastError

116 |       pure (Left lasterr)

144 | bindOne : Statement -> BindParameter -> IO (Either OracleError ())

145 | bindOne stmt param =

146 |   case param.value of

147 |     OracleNull            =>

148 |       primIO (prim__bindNull stmt.ptr param.name)

149 |         >>= finish

150 |     OracleString s        =>

151 |       primIO (prim__bindString stmt.ptr param.name s)

152 |         >>= finish

153 |     OracleNumber d        =>

154 |       primIO (prim__bindDouble stmt.ptr param.name d)

155 |         >>= finish

156 |     OracleBinaryFloat f   =>

157 |       primIO (prim__bindBinaryFloat stmt.ptr param.name f)

158 |         >>= finish

159 |     OracleBinaryDouble d  =>

160 |       primIO (prim__bindBinaryDouble stmt.ptr param.name d)

161 |         >>= finish 

162 |     OracleBool b          =>

163 |       primIO (prim__bindBool stmt.ptr param.name (if b then 1 else 0))

164 |         >>= finish

165 |     OracleRaw b           =>

166 |       primIO (prim__bindRaw stmt.ptr param.name (hexEncode $ unpack b))

167 |         >>= finish

168 |     OracleClob s          =>

169 |       primIO (prim__bindClob stmt.ptr param.name s)

170 |         >>= finish

171 |     OracleBlob b          =>

172 |       primIO (prim__bindBlob stmt.ptr param.name (toString b))

173 |         >>= finish

174 |     OracleDate ts         =>

175 |       primIO ( prim__bindDate stmt.ptr

176 |                               param.name

177 |                               (cast ts.year)

178 |                               (cast ts.month)

179 |                               (cast ts.day)

180 |                               (cast ts.hour)

181 |                               (cast ts.minute)

182 |                               (cast ts.second)

183 |              )

184 |         >>= finish

185 |     OracleTimestamp ts    =>

186 |       primIO ( prim__bindTimestamp stmt.ptr

187 |                                    param.name

188 |                                    (cast ts.year)

189 |                                    (cast ts.month)

190 |                                    (cast ts.day)

191 |                                    (cast ts.hour)

192 |                                    (cast ts.minute)

193 |                                    (cast ts.second)

194 |                                    (cast ts.nanosecond)

195 |              )

196 |         >>= finish

197 |     OracleTimestampTZ ts  =>

198 |       primIO ( prim__bindTimestampTZ stmt.ptr

199 |                                      param.name

200 |                                      (cast ts.year)

201 |                                      (cast ts.month)

202 |                                      (cast ts.day)

203 |                                      (cast ts.hour)

204 |                                      (cast ts.minute)

205 |                                      (cast ts.second)

206 |                                      (cast ts.nanosecond)

207 |                                      (cast ts.tzHourOffset)

208 |                                      (cast ts.tzMinuteOffset)

209 |              )

210 |         >>= finish

211 |     OracleIntervalYM iv   =>

212 |       primIO ( prim__bindIntervalYM stmt.ptr

213 |                                     param.name

214 |                                     (cast iv.years)

215 |                                     (cast iv.months)

216 |              )

217 |         >>= finish

218 |     OracleIntervalDS iv   =>

219 |       primIO ( prim__bindIntervalDS stmt.ptr

220 |                                     param.name

221 |                                     (cast iv.days)

222 |                                     (cast iv.hours)

223 |                                     (cast iv.minutes)

224 |                                     (cast iv.seconds)

225 |                                     (cast iv.nanoseconds)

226 |              )

227 |         >>= finish

228 |   where

229 |     finish : Int32 -> IO (Either OracleError ())

230 |     finish rc =

231 |       case rc == 0 of

232 |         True =>

233 |           pure (Right ())

234 |         False => do

235 |           lasterr <- getLastError

236 |           pure (Left lasterr)

241 | bind : Statement -> List BindParameter -> IO (Either OracleError ())

242 | bind stmt []        =

243 |   pure (Right ())

244 | bind stmt (x :: xs) = do

245 |   res <- bindOne stmt x

246 |   case res of

247 |     Left err =>

248 |       pure (Left err)

249 |     Right () =>

250 |       bind stmt xs

263 | export covering

264 | fetchRow : Statement -> IO (Either OracleError (Maybe (List OracleValue)))

265 | fetchRow stmt = do

266 |   rc <- primIO (prim__fetch stmt.ptr)

267 |   case compare rc 0 of

268 |     LT =>

269 |       Left <$> getLastError

270 |     EQ =>

271 |       pure (Right Nothing)

272 |     GT => do

273 |       count <- primIO (prim__columnCount stmt.ptr)

274 |       row   <- go count 0 []

275 |       case row of

276 |         Left err     =>

277 |           pure (Left err)

278 |         Right values =>

279 |           pure $

280 |             Right $

281 |               Just values

282 |   where

283 |     go : Int32 -> Int32 -> List OracleValue -> IO (Either OracleError (List OracleValue))

284 |     go count index acc =

285 |       case index >= count of

286 |         True  =>

287 |           pure (Right $ reverse acc)

288 |         False => do

289 |           value <- decodeColumn stmt.ptr index

290 |           case value of

291 |             Left err =>

292 |               pure (Left err)

293 |             Right v  =>

294 |               go count

295 |                  (index + 1)

296 |                  (v :: acc)

304 | export covering

305 | fetchRaw : Statement -> IO (Either OracleError (List (List OracleValue)))

306 | fetchRaw stmt =

307 |   loop []

308 |   where

309 |     loop : List (List OracleValue) -> IO (Either OracleError (List (List OracleValue)))

310 |     loop acc = do

311 |       row <- fetchRow stmt

312 |       case row of

313 |         Left err            =>

314 |           pure (Left err)

315 |         Right Nothing       =>

316 |           pure (Right $ reverse acc)

317 |         Right (Just values) =>

318 |           loop (values :: acc)

326 | export covering

327 | query : Connection -> String -> List BindParameter -> IO (Either OracleError (List (List OracleValue)))

328 | query conn sql params =

329 |   withStatement conn sql $ \stmt => do

330 |     bound <- bind stmt params

331 |     case bound of

332 |       Left err =>

333 |         pure (Left err)

334 |       Right () => do

335 |         executed <- execute stmt

336 |         case executed of

337 |           Left err =>

338 |             pure (Left err)

339 |           Right () =>

340 |             fetchRaw stmt