
   0 | module Oracle.Statement
   1 | 
   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.Pointer
  13 | import Oracle.Types.BindParameter
  14 | import Oracle.Types.DateTime
  15 | import Oracle.Types.Error
  16 | import Oracle.Types.Value
  17 | 
  18 | %default total
  19 | 
  20 | --------------------------------------------------------------------------------
  21 | --          Prepare / Release
  22 | --------------------------------------------------------------------------------
  23 | 
  24 | ||| Prepare a SQL statement.
  25 | |||
  26 | ||| The returned statement must eventually be released with `release` or managed with `withStatement`.
  27 | |||
  28 | export
  29 | prepare : Connection -> String -> IO (Either OracleError Statement)
  30 | prepare conn sql = do
  31 |   ptr <- primIO (prim__prepareStmt conn.ptr sql)
  32 |   case prim__nullAnyPtr ptr == 1 of
  33 |     True => do
  34 |       lasterr <- getLastError
  35 |       pure (Left lasterr)
  36 |     False =>
  37 |       pure (Right $ MkStatement ptr)
  38 | 
  39 | ||| Release a prepared statement.
  40 | |||
  41 | ||| This decrements the underlying ODPI-C statement reference count.
  42 | |||
  43 | export
  44 | release : Statement -> IO ()
  45 | release stmt =
  46 |   primIO (prim__releaseStmt stmt.ptr)
  47 | 
  48 | --------------------------------------------------------------------------------
  49 | --          With Statement
  50 | --------------------------------------------------------------------------------
  51 | 
  52 | ||| Prepare a statement, execute an action, and guarantee that the statement is released afterwards.
  53 | |||
  54 | ||| This is the preferred way to work with prepared statements.
  55 | |||
  56 | ||| Prepare a statement, execute an action, and guarantee cleanup.
  57 | |||
  58 | ||| The statement is released regardless of whether the action succeeds or fails.
  59 | |||
  60 | export
  61 | withStatement : Connection -> String -> (Statement -> IO (Either OracleError a)) -> IO (Either OracleError a)
  62 | withStatement conn sql action = do
  63 |   result <- runElinIO (withStatement' conn sql)
  64 |   case result of
  65 |     Right value =>
  66 |       case value of
  67 |         Left err     =>
  68 |           pure (Left err)
  69 |         Right value' =>
  70 |           pure (Right value')
  71 |     Left err    =>
  72 |       assert_total $ idris_crash "Oracle.Connection.withStatement: \{show err}"
  73 |   where
  74 |     acquire : Connection -> String -> F1 World (Either OracleError Statement)
  75 |     acquire conn sql =
  76 |       ioToF1 (prepare conn sql)
  77 |     use : Either OracleError Statement -> F1 World (Either OracleError a)
  78 |     use stmt =
  79 |       case stmt of
  80 |         Left err    =>
  81 |           ioToF1 (pure (Left err))
  82 |         Right stmt' =>
  83 |           ioToF1 (action stmt')
  84 |     cleanup : Either OracleError Statement -> F1' World
  85 |     cleanup stmt =
  86 |       case stmt of
  87 |         Left err    =>
  88 |           ioToF1 (pure ())
  89 |         Right stmt' =>
  90 |           ioToF1 (release stmt')
  91 |     withStatement' : Connection -> String -> Elin World [] (Either OracleError a)
  92 |     withStatement' conn sql =
  93 |       bracket (runIO (acquire conn sql))
  94 |               (\stmt => runIO (use stmt))
  95 |               (\stmt => runIO (cleanup stmt))
  96 | 
  97 | --------------------------------------------------------------------------------
  98 | --          Execute
  99 | --------------------------------------------------------------------------------
 100 | 
 101 | ||| Execute a prepared statement.
 102 | |||
 103 | ||| For SELECT statements this executes the query.
 104 | ||| For INSERT/UPDATE/DELETE statements this performs the update.
 105 | |||
 106 | export
 107 | execute : Statement -> IO (Either OracleError ())
 108 | execute stmt = do
 109 |   rc <- primIO (prim__executeStmt stmt.ptr)
 110 |   case rc == 0 of
 111 |     True  =>
 112 |       pure (Right ())
 113 |     False => do
 114 |       lasterr <- getLastError
 115 |       pure (Left lasterr)
 116 | 
 117 | --------------------------------------------------------------------------------
 118 | --          Binding
 119 | --------------------------------------------------------------------------------
 120 | 
 121 | ||| Bind a single named parameter.
 122 | |||
 123 | ||| Supported value types:
 124 | ||| - OracleNull
 125 | ||| - OracleString
 126 | ||| - OracleInt
 127 | ||| - OracleUInt
 128 | ||| - OracleDouble
 129 | ||| - OracleBool
 130 | ||| - OracleClob
 131 | ||| - OracleBlob
 132 | ||| - OracleDate
 133 | ||| - OracleTimestamp
 134 | ||| - OracleTimestampTZ
 135 | ||| - OracleTimestampLTZ
 136 | ||| - OracleIntervalYM
 137 | ||| - OracleIntervalDS
 138 | |||
 139 | ||| OracleBytes bindings are not supported as of yet.
 140 | |||
 141 | export
 142 | bindOne : Statement -> BindParameter -> IO (Either OracleError ())
 143 | bindOne stmt param =
 144 |   case param.value of
 145 |     OracleNull            =>
 146 |       primIO (prim__bindNull stmt.ptr param.name)
 147 |         >>= finish
 148 |     OracleString s        =>
 149 |       primIO (prim__bindString stmt.ptr param.name s)
 150 |         >>= finish
 151 |     OracleNumber d        =>
 152 |       primIO (prim__bindDouble stmt.ptr param.name d)
 153 |         >>= finish
 154 |     OracleBool b          =>
 155 |       primIO (prim__bindBool stmt.ptr param.name (if b then 1 else 0))
 156 |         >>= finish
 157 |     OracleClob s          =>
 158 |       primIO (prim__bindClob stmt.ptr param.name s)
 159 |         >>= finish
 160 |     OracleBlob b          =>
 161 |       primIO (prim__bindBlob stmt.ptr param.name (toString b))
 162 |         >>= finish
 163 |     OracleTimestamp ts    =>
 164 |       primIO ( prim__bindTimestamp stmt.ptr
 165 |                                    param.name
 166 |                                    (cast ts.year)
 167 |                                    (cast ts.month)
 168 |                                    (cast ts.day)
 169 |                                    (cast ts.hour)
 170 |                                    (cast ts.minute)
 171 |                                    (cast ts.second)
 172 |                                    (cast ts.nanosecond)
 173 |              )
 174 |         >>= finish
 175 |     OracleTimestampTZ ts  =>
 176 |       primIO ( prim__bindTimestampTZ stmt.ptr
 177 |                                      param.name
 178 |                                      (cast ts.year)
 179 |                                      (cast ts.month)
 180 |                                      (cast ts.day)
 181 |                                      (cast ts.hour)
 182 |                                      (cast ts.minute)
 183 |                                      (cast ts.second)
 184 |                                      (cast ts.nanosecond)
 185 |                                      (cast ts.tzHourOffset)
 186 |                                      (cast ts.tzMinuteOffset)
 187 |              )
 188 |         >>= finish
 189 |     OracleIntervalYM iv   =>
 190 |       primIO ( prim__bindIntervalYM stmt.ptr
 191 |                                     param.name
 192 |                                     (cast iv.years)
 193 |                                     (cast iv.months)
 194 |              )
 195 |         >>= finish
 196 |     OracleIntervalDS iv   =>
 197 |       primIO ( prim__bindIntervalDS stmt.ptr
 198 |                                     param.name
 199 |                                     (cast iv.days)
 200 |                                     (cast iv.hours)
 201 |                                     (cast iv.minutes)
 202 |                                     (cast iv.seconds)
 203 |                                     (cast iv.nanoseconds)
 204 |              )
 205 |         >>= finish
 206 |   where
 207 |     finish : Int32 -> IO (Either OracleError ())
 208 |     finish rc =
 209 |       case rc == 0 of
 210 |         True =>
 211 |           pure (Right ())
 212 |         False => do
 213 |           lasterr <- getLastError
 214 |           pure (Left lasterr)
 215 | 
 216 | ||| Bind a collection of named parameters.
 217 | |||
 218 | export
 219 | bind : Statement -> List BindParameter -> IO (Either OracleError ())
 220 | bind stmt []        =
 221 |   pure (Right ())
 222 | bind stmt (x :: xs) = do
 223 |   res <- bindOne stmt x
 224 |   case res of
 225 |     Left err =>
 226 |       pure (Left err)
 227 |     Right () =>
 228 |       bind stmt xs
 229 | 
 230 | --------------------------------------------------------------------------------
 231 | --          Fetching
 232 | --------------------------------------------------------------------------------
 233 | 
 234 | ||| Fetch a single row from the current result set.
 235 | |||
 236 | ||| Returns:
 237 | ||| - Right Nothing when no rows remain.
 238 | ||| - Right (Just row) when a row was fetched.
 239 | ||| - Left OracleError on failure.
 240 | |||
 241 | export covering
 242 | fetchRow : Statement -> IO (Either OracleError (Maybe (List OracleValue)))
 243 | fetchRow stmt = do
 244 |   rc <- primIO (prim__fetch stmt.ptr)
 245 |   case compare rc 0 of
 246 |     LT =>
 247 |       Left <$> getLastError
 248 |     EQ =>
 249 |       pure (Right Nothing)
 250 |     GT => do
 251 |       count <- primIO (prim__columnCount stmt.ptr)
 252 |       row   <- go count 0 []
 253 |       case row of
 254 |         Left err     =>
 255 |           pure (Left err)
 256 |         Right values =>
 257 |           pure $
 258 |             Right $
 259 |               Just values
 260 |   where
 261 |     go : Int32 -> Int32 -> List OracleValue -> IO (Either OracleError (List OracleValue))
 262 |     go count index acc =
 263 |       case index >= count of
 264 |         True  =>
 265 |           pure (Right $ reverse acc)
 266 |         False => do
 267 |           value <- decodeColumn stmt.ptr index
 268 |           case value of
 269 |             Left err =>
 270 |               pure (Left err)
 271 |             Right v  =>
 272 |               go count
 273 |                  (index + 1)
 274 |                  (v :: acc)
 275 | 
 276 | --------------------------------------------------------------------------------
 277 | --          Fetch All
 278 | --------------------------------------------------------------------------------
 279 | 
 280 | ||| Fetch all remaining rows from the current result set.
 281 | |||
 282 | export covering
 283 | fetchRaw : Statement -> IO (Either OracleError (List (List OracleValue)))
 284 | fetchRaw stmt =
 285 |   loop []
 286 |   where
 287 |     loop : List (List OracleValue) -> IO (Either OracleError (List (List OracleValue)))
 288 |     loop acc = do
 289 |       row <- fetchRow stmt
 290 |       case row of
 291 |         Left err            =>
 292 |           pure (Left err)
 293 |         Right Nothing       =>
 294 |           pure (Right $ reverse acc)
 295 |         Right (Just values) =>
 296 |           loop (values :: acc)
 297 | 
 298 | --------------------------------------------------------------------------------
 299 | --          Query
 300 | --------------------------------------------------------------------------------
 301 | 
 302 | ||| Execute a SQL query and return all rows.
 303 | |||
 304 | export covering
 305 | query : Connection -> String -> List BindParameter -> IO (Either OracleError (List (List OracleValue)))
 306 | query conn sql params =
 307 |   withStatement conn sql $ \stmt => do
 308 |     bound <- bind stmt params
 309 |     case bound of
 310 |       Left err =>
 311 |         pure (Left err)
 312 |       Right () => do
 313 |         executed <- execute stmt
 314 |         case executed of
 315 |           Left err =>
 316 |             pure (Left err)
 317 |           Right () =>
 318 |             fetchRaw stmt
 319 |