erlang-mysql-driver source code, why little endianness to fetch the result - mysql

I'm new to erlang and studying erlang-mysql-driver. Can anyone help to make me understand why little endianness here when parsing the binary in function "get_lcb"?
Following is the code in mysql_conn.erl
%%--------------------------------------------------------------------
%% Function: get_query_response(LogFun, RecvPid)
%% LogFun = undefined | function() with arity 3
%% RecvPid = pid(), mysql_recv process
%% Version = integer(), Representing MySQL version used
%% Descrip.: Wait for frames until we have a complete query response.
%% Returns : {data, #mysql_result}
%% {updated, #mysql_result}
%% {error, #mysql_result}
%% FieldInfo = list() of term()
%% Rows = list() of [string()]
%% AffectedRows = int()
%% Reason = term()
%%--------------------------------------------------------------------
get_query_response(LogFun, RecvPid, Version) ->
case do_recv(LogFun, RecvPid, undefined) of
{ok, Packet, _} ->
{Fieldcount, Rest} = get_lcb(Packet),
case Fieldcount of
0 ->
%% No Tabular data
<<AffectedRows:8, Rest2/binary>> = Rest,
io:format("Rest2=~p~n", [Rest2]),
{InsertId, _} = get_lcb(Rest2),
io:format("InsertId=~p~n", [InsertId]),
{updated, #mysql_result{affectedrows=AffectedRows, insertid=InsertId}};
255 ->
<<_Code:16/little, Message/binary>> = Rest,
{error, #mysql_result{error=Message}};
_ ->
%% Tabular data received
case get_fields(LogFun, RecvPid, [], Version) of
{ok, Fields} ->
case get_rows(Fields, LogFun, RecvPid, []) of
{ok, Rows} ->
{data, #mysql_result{fieldinfo=Fields,
rows=Rows}};
{error, Reason} ->
{error, #mysql_result{error=Reason}}
end;
{error, Reason} ->
{error, #mysql_result{error=Reason}}
end
end;
{error, Reason} ->
{error, #mysql_result{error=Reason}}
end.
get_lcb(<<251:8, Rest/binary>>) ->
{null, Rest};
get_lcb(<<252:8, Value:16/little, Rest/binary>>) ->
io:format("Value=~p~n",[Value]),
io:format("Rest=~p~n",[Rest]),
{Value, Rest};
get_lcb(<<253:8, Value:24/little, Rest/binary>>) ->
{Value, Rest};
get_lcb(<<254:8, Value:32/little, Rest/binary>>) ->
{Value, Rest};
get_lcb(<<Value:8, Rest/binary>>) when Value < 251 ->
{Value, Rest};
get_lcb(<<255:8, Rest/binary>>) ->
{255, Rest}.
%%--------------------------------------------------------------------
%% Function: do_recv(LogFun, RecvPid, SeqNum)
%% LogFun = undefined | function() with arity 3
%% RecvPid = pid(), mysql_recv process
%% SeqNum = undefined | integer()
%% Descrip.: Wait for a frame decoded and sent to us by RecvPid.
%% Either wait for a specific frame if SeqNum is an integer,
%% or just any frame if SeqNum is undefined.
%% Returns : {ok, Packet, Num} |
%% {error, Reason}
%% Reason = term()
%%
%% Note : Only to be used externally by the 'mysql_auth' module.
%%--------------------------------------------------------------------
do_recv(LogFun, RecvPid, SeqNum) when is_function(LogFun);
LogFun == undefined,
SeqNum == undefined ->
receive
{mysql_recv, RecvPid, data, Packet, Num} ->
{ok, Packet, Num};
{mysql_recv, RecvPid, closed, _E} ->
{error, "mysql_recv: socket was closed"}
end;
do_recv(LogFun, RecvPid, SeqNum) when is_function(LogFun);
LogFun == undefined,
is_integer(SeqNum) ->
ResponseNum = SeqNum + 1,
receive
{mysql_recv, RecvPid, data, Packet, ResponseNum} ->
{ok, Packet, ResponseNum};
{mysql_recv, RecvPid, closed, _E} ->
{error, "mysql_recv: socket was closed"}
end.

I suppose you mean these lines: Value:16/little, Value:24/little, etc...? Well, it's because MySQL server will always fill these parts of the response packet with little-endian values - but Erlang machine by default will operate with whatever endianness is native to the CPU.

Related

How to assert that a function throws an exception?

I can catch exceptions:
try some_fn () with | e -> print_endline "exception caught!"
but what about the other way around, detecting that a function does not throw an exception (when it should)?
I managed to write some very hacky way to achieve that: I create a wrapper around the function I want to test, which throws some specific exception at the end. I catch anything but that exception.
exception Finished
let check (fn : unit -> unit) =
let wrapper _ = (
fn ();
raise Finished)
in
try wrapper () with e when e <> Finished -> ()
in utop this works:
utop # check (fun _ -> ());;
Exception: Finished.
utop # check (fun _ -> failwith "hey");;
- : unit = ()
EDIT: my coworker suggested:
let should_fail fn =
if Result.try_with fn |> Result.is_ok then failwith "this test should fail"
Exceptions can be handled within pattern matching cases, allowing very clean expression for this check:
match some_fn () with
| exception _ -> print_endline "exception caught!"
| _ -> print_endline "error: no exception raised!"
We can abstract this check into a function:
let throws_exception f =
match f () with
| exception _ -> true
| _ -> false
Which we can use in an assertion like so:
assert (throws_exception (fun () -> raise (Failure "msg")))

Haskell JSON parser not parsing objects

I have been building this small JSON parser from scratch and I can't get an object to parse for some reason.
Code:
import Data.Char
import Control.Monad
import Control.Applicative
import Control.Monad (liftM, ap)
newtype Parser a = Parser (String -> [(String, a)])
parse :: Parser a -> (String -> [(String, a)])
parse (Parser p) = p
item :: Parser Char
item = Parser (\s ->
case s of
[] -> []
(x:xs) -> [(xs,x)])
failure :: Parser a
failure = Parser (\ts -> [])
produce :: a -> Parser a --parse (item >>= produce) "hello"
produce x = Parser (\ts -> [(ts, x)])
instance Applicative Parser where
pure x = produce x
Parser pf <*> Parser px = Parser (\ts -> [ (ts'', f x )| (ts', f) <- pf ts,
(ts'', x) <- px ts'] )
instance Functor Parser where
fmap f (Parser px) = Parser (\ts -> [ (ts', f x) | (ts', x) <- px ts])
instance Monad Parser where
--return :: a -> Parser a
return = produce
--(>>=) :: Parser a -> (a -> Parser b) -> Parser b
(Parser px) >>= f = Parser (\ts ->
concat [parse (f x) ts' | (ts', x) <- px ts])
satisfy :: (Char -> Bool) -> Parser Char
satisfy p = item >>= (\c ->
if p c then
produce c
else failure)
char :: Char -> Parser Char
char c = satisfy (c == )
string :: String -> Parser String --parse (string "hello") "hello"
string [] = produce []
string (c:cs) = char c >>= (\c' ->
string cs >>= (\cs' ->
produce (c:cs)))
instance Alternative Parser where
empty = failure
(<|>) = orElse
many p = some p <|> produce []
some p = (:) <$> p <*> many p
orElse :: Parser a -> Parser a -> Parser a
orElse (Parser px) (Parser py) = Parser (\ts ->
case px ts of
[] -> py ts
xs -> xs)
---------------Parsec bits---------------------------
oneOf :: [Char] -> Parser Char
oneOf s = satisfy (flip elem s)
noneOf :: [Char] -> Parser Char
noneOf cs = satisfy (\c -> not (elem c cs))
sepBy :: Parser a -> Parser String -> Parser [a]
sepBy p sep = sepBy1 p sep <|> return []
sepBy1 :: Parser a -> Parser String -> Parser [a]
sepBy1 p sep = do{ x <- p
; xs <- many (sep >> p)
; return (x:xs)
}
-------------------------------------------------------
data Value = StrJson String
| IntJson Int
| BoolJson Bool
| ObjectJson [Pair]
| ArrayJson [Value]
| NullJson
deriving (Eq, Ord, Show)
type Pair = (String, Value)
type NullJson = String
tok :: String -> Parser String
tok t = string t <* whitespace
whitespace :: Parser ()
whitespace = many (oneOf " \t") *> pure ()
var :: Parser Char
var = oneOf ['A' .. 'Z'] <* whitespace
val :: Parser Value
val = IntJson <$> jIntParser
<|> NullJson <$ tok "null"
<|> BoolJson <$> jBoolParser
<|> StrJson <$> jStrParser
<|> ArrayJson <$> jArrParser
<|> ObjectJson <$> jObjParser
jStrParser :: Parser String
jStrParser = some (noneOf ("\n\r\"=[]{},")) <* whitespace
jIntParser :: Parser Int
jIntParser = (some (oneOf ['0' .. '9']) >>= produce . read) <* whitespace
jBoolParser :: Parser Bool
jBoolParser = ((string "False" *> produce False) <|> (string "True" *> produce True))
jObjParser :: Parser [Pair]
jObjParser = do
char '{'
jp <- jPairParser `sepBy1` (tok ",")
char '}'
produce jp
jPairParser :: Parser (String, Value)
jPairParser = do
jStr <- jStrParser
tok ":"
jVal <- val
produce (jStr, jVal)
jArrParser :: Parser [Value]
jArrParser = do
char '['
jArr <- val `sepBy1` (tok ",")
char ']'
produce jArr
When I run my parser with "parse jObjParser "{asd:asd}"" it will fail and when I go further and run with "parse jPairParser "asd:asd"" it will also fail. So I assume the pair parser is the problem but I can't work out why. I'm probably just being dumb so any help would be very much appreciated, Thanks in advance.
First of all let me point out that a lot of the functions in your sample code are already available in many parser combinator packages such as parsec, attoparsec or trifecta - depending on your particular needs. Not to mention Aeson and such. But that is not much of an answer so I will assume you are doing a sort of coding excercise and are not using those on purpose.
My best guess by glancing at your code is that the problem is here:
jStrParser :: Parser String
jStrParser = some (noneOf ("\n\r\"=[]{},")) <* whitespace
And here:
jPairParser :: Parser (String, Value)
jPairParser = do
jStr <- jStrParser
tok ":"
jVal <- val
produce (jStr, jVal)
jStrParser is greedy and it will eat through ":". jPairParser will then fail at tok ":" because ":" it has already been consumed.
Basically, your problem is in jStrParser. It accepts "asd:asd". But is wrong. Secondly, your jStrParser isn't correct, because, it must accept only strings that begin on '"' and end on '"'.
So, you can fix like this:
readS_to_Parser :: ReadS a -> Parser a
readS_to_Parser r = Parser (map swap . r)
jStrParser = readS_to_Parser reads <* whitespace

F# exception handling multiple "Tries"

I'm trying to read a bunch of csv files in SQL Server using SQL Bulk Insert and DataContext.ExecuteCommand. (Maybe this isn't the best way to do it, but it does allow me stay in the Type Provider context--as opposed to with SqlBulkCopy I think.) Now the upload is glitchy with intermittent success. Some files read in, some fail with "Data conversion error (truncation)". I think this has to do with the row terminators not always working.
When the upload works, it seems to be with the '0x0A' terminator. But when that fails, I want to try repeatedly again with other row terminators. So I want to go into a Try statement, and on failure go into another Try statement, and another if that one fails, ... . This may not be the best way to upload, but I am still curious about the Try logic for it's own state.
Here's what I've come up with so far and it's not too pretty (but it works). Cutting out a few nested layers:
let FileRead path =
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='0x0A')") |> ignore
true
with
| exn ->
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='\r')") |> ignore
true
with
| exn ->
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='\n')") |> ignore
true
with
| exn ->
false
This doens't feel right but I haven't figured out any other syntax.
EDIT: What I ended up doing, just for the record. Appreciate being put on a productive path. There's plenty to improve in this. With one of the more significant things being to use Async's and run it Parallel (which I have gotten experience with in other sections).
type dbSchema = SqlDataConnection<dbConnection>
let db = dbSchema.GetDataContext()
let TryUpLd table pathFile rowTerm =
try
db.DataContext.ExecuteCommand( #"BULK INSERT " + table + " FROM '" + pathFile +
#"' WITH (FIELDTERMINATOR=',', FIRSTROW = 2, ROWTERMINATOR='"
+ rowTerm + "')" ) |> ignore
File.Delete (pathFile) |> Some
with
| exn -> None
let NxtUpLd UL intOpt =
match intOpt with
| None -> UL
| _ -> intOpt
let MoveTable ID table1 table2 =
//...
()
let NxtMoveTable MT intOpt =
match intOpt with
| Some i -> MT
| _ -> ()
let UpLdFile path (file:string) =
let (table1, table2) =
match path with
| p when p = dlXPath -> ("Data.dbo.ImportXs", "Data.dbo.Xs")
| p when p = dlYPath -> ("Data.dbo.ImportYs", "Data.dbo.Ys")
| _ -> ("ERROR path to tables", "")
let ID = file.Replace(fileExt, "")
let TryRowTerm = TryUpLd table1 (path + file)
TryRowTerm "0x0A"
|> NxtUpLd (TryRowTerm "\r")
|> NxtUpLd (TryRowTerm "\n")
|> NxtUpLd (TryRowTerm "\r\n")
|> NxtUpLd (TryRowTerm "\n\r")
|> NxtUpLd (TryRowTerm "\0")
|> NxtMoveTable (MoveTable ID table1 table2)
let UpLdData path =
let dir = new DirectoryInfo(path)
let fileList = dir.GetFiles()
fileList |> Array.iter (fun file -> UpLdFile path file.Name ) |> ignore
Here's one way to do it, using monadic composition.
First, define a function that takes another function as input, but converts any exception to a None value:
let attempt f =
try f () |> Some
with | _ -> None
This function has the type (unit -> 'a) -> 'a option; that is: f is inferred to be any function that takes unit as input, and returns a value. As you can see, if no exception happens, the return value from invoking f is wrapped in a Some case. The attempt function suppresses all exceptions, which you shouldn't normally do.
Next, define this attemptNext function:
let attemptNext f = function
| Some x -> Some x
| None -> attempt f
This function has the type (unit -> 'a) -> 'a option -> 'a option. If the input 'a option is Some then it's simply returned. In other words, the value is interpreted as already successful, so there's no reason to try the next function.
Otherwise, if the input 'a option is None, this is interpreted as though the previous step resulted in a failure. In that case, the input function f is attempted, using the attempt function.
This means that you can now compose functions together, and get the first successful result.
Here are some functions to test with:
let throwyFunction () = raise (new System.InvalidOperationException("Boo"))
let throwyFunction' x y = raise (new System.InvalidOperationException("Hiss"))
let goodFunction () = "Hooray"
let goodFunction' x y = "Yeah"
Try them out in F# Interactive:
> let res1 =
attempt throwyFunction
|> attemptNext (fun () -> throwyFunction' 42 "foo")
|> attemptNext goodFunction
|> attemptNext (fun () -> goodFunction' true 13.37);;
val res1 : string option = Some "Hooray"
> let res2 =
attempt goodFunction
|> attemptNext throwyFunction
|> attemptNext (fun () -> throwyFunction' 42 "foo")
|> attemptNext (fun () -> goodFunction' true 13.37);;
val res2 : string option = Some "Hooray"
> let res3 =
attempt (fun () -> throwyFunction' 42 "foo")
|> attemptNext throwyFunction
|> attemptNext (fun () -> goodFunction' true 13.37)
|> attemptNext goodFunction;;
val res3 : string option = Some "Yeah"
> let res4 =
attempt (fun () -> throwyFunction' 42 "foo")
|> attemptNext (fun () -> goodFunction' true 13.37)
|> attemptNext throwyFunction
|> attemptNext goodFunction;;
val res4 : string option = Some "Yeah"

Erlang Function call with default values and or without specific order

I'm new to Erlang and trying to find out the best way have defaults values for a function call, which requires several variables and / or also don't want to enter the arguments in a specific order. I'm currently using this format based loosely around Clojure's way. Is there a better way or method to achieve this in Erlang? I've also included a Clojure example as reference:
Erlang Version:
some_function_with_defaults() ->
some_function_with_defaults(#{}).
some_function_with_defaults(Map) ->
Defaults = #{
arg1 => 0, % arg1 default value
arg2 => 1, % arg2 default value
arg3 => 2 % arg3 default value
},
Arguments = maps:merge(Defaults,Map),
#{arg1 := Arg1} = Arguments,
#{arg2 := Arg2} = Arguments,
#{arg3 := Arg3} = Arguments,
%% Do something with arguments
[Arg1,Arg2,Arg3].
%% Example call using only defaults
%% some_function_with_defaults().
%%
%% [0,1,2]
%% Example call specifying a specific value
%% some_function_with_defaults(#{arg1 => 99}).
%%
%% [99,1,2]
Clojure Reference:
(defn some-function-with-defaults
[
& {:keys
[
arg1
arg2
arg3
]
:or
{
arg1 0 ;; arg1_default_value
arg2 1 ;; arg2_default_value
arg3 2 ;; arg3_default_value
}
}
]
;; Do something with arguments
[arg1,arg2,arg3]
)
;; Example call using only defaults
;; (some-function-with-defaults)
;;
;; [0,1,2]
;; Example call specifying a specific value
;; (some-function-with-defaults :arg1 99)
;;
;; [99,1,2]
One of the approaches I often seen before maps arrived is to have:
proplist with optional arguments
record with default values
function witch take values from proplist and put it into a record.
-record(options, {
opt_int = 42 :: integer(), % default is 42
opt_bool = false :: boolean(), % default false
opt_atom :: undefined | val % default undefined
}).
parse_opts(Opts) ->
parse_opts(Opts, #options{}).
parse_opts([], Res) ->
Res;
parse_opts([{opt_int, Val} | RestOpts], Res) when is_integer(Val) ->
parse_opts(RestOpts, Res#options{opt_int = Val});
parse_opts([{opt_bool, Val} | RestOpts], Res) when is_boolean(Val) ->
parse_opts(RestOpts, Res#options{opt_bool = Val});
parse_opts([{opt_atom, Val} | RestOpts], Res) when Val == undefined; Val == val ->
parse_opts(RestOpts, Res#options{opt_atom = Val}).
parse_opts([{opt_int, 55}]) will give you #options{opt_int = 55, opt_bool = false, opt_atom = undefined}
This is little bit awkward, mainly because records is compile-time syntax sugar over tuples. You can do more elegant thing with maps though.
P.S. didn't test this, so may contain few errors.
P.P.S. It will throw exception if you pass unknown option.

Interaction between optimizations and testing for error calls

I have a function in a module that looks something like this:
module MyLibrary (throwIfNegative) where
throwIfNegative :: Integral i => i -> String
throwIfNegative n | n < 0 = error "negative"
| otherwise = "no worries"
I could of course return Maybe String or some other variant, but I think it's fair to say that it's a programmer error to call this function with a negative number so using error is justified here.
Now, since I like having my test coverage at 100% I want to have a test case that checks this behavior. I have tried this
import Control.Exception
import Test.HUnit
import MyLibrary
case_negative =
handleJust errorCalls (const $ return ()) $ do
evaluate $ throwIfNegative (-1)
assertFailure "must throw when given a negative number"
where errorCalls (ErrorCall _) = Just ()
main = runTestTT $ TestCase case_negative
and it sort of works, but it fails when compiling with optimizations:
$ ghc --make -O Test.hs
$ ./Test
### Failure:
must throw when given a negative number
Cases: 1 Tried: 1 Errors: 0 Failures: 1
I'm not sure what's happening here. It seems like despite my use of evaluate, the function does not get evaluated. Also, it works again if I do any of these steps:
Remove HUnit and call the code directly
Move throwIfNegative to the same module as the test case
Remove the type signature of throwIfNegative
I assume this is because it causes the optimizations to be applied differently. Any pointers?
Optimizations, strictness, and imprecise exceptions can be a bit tricky.
The easiest way to reproduce this problem above is with a NOINLINE on throwIfNegative (the function isn't being inlined across module boundaries either):
import Control.Exception
import Test.HUnit
throwIfNegative :: Int -> String
throwIfNegative n | n < 0 = error "negative"
| otherwise = "no worries"
{-# NOINLINE throwIfNegative #-}
case_negative =
handleJust errorCalls (const $ return ()) $ do
evaluate $ throwIfNegative (-1)
assertFailure "must throw when given a negative number"
where errorCalls (ErrorCall _) = Just ()
main = runTestTT $ TestCase case_negative
Reading the core, with optimizations on, the GHC inlines evaluate properly (?):
catch#
# ()
# SomeException
(\ _ ->
case throwIfNegative (I# (-1)) of _ -> ...
and then floats out the call to throwIfError, outside of the case scrutinizer:
lvl_sJb :: String
lvl_sJb = throwIfNegative lvl_sJc
lvl_sJc = I# (-1)
throwIfNegative =
\ (n_adO :: Int) ->
case n_adO of _ { I# x_aBb ->
case <# x_aBb 0 of _ {
False -> lvl_sCw; True -> error lvl_sCy
and strangely, at this point, no other code now calls lvl_sJb, so the entire test becomes dead code, and is stripped out -- GHC has determined that it is unused!
Using seq instead of evaluate is happy enough:
case_negative =
handleJust errorCalls (const $ return ()) $ do
throwIfNegative (-1) `seq` assertFailure "must throw when given a negative number"
where errorCalls (ErrorCall _) = Just ()
or a bang pattern:
case_negative =
handleJust errorCalls (const $ return ()) $ do
let !x = throwIfNegative (-1)
assertFailure "must throw when given a negative number"
where errorCalls (ErrorCall _) = Just ()
so I think we should look at the semantics of evaluate:
-- | Forces its argument to be evaluated to weak head normal form when
-- the resultant 'IO' action is executed. It can be used to order
-- evaluation with respect to other 'IO' operations; its semantics are
-- given by
--
-- > evaluate x `seq` y ==> y
-- > evaluate x `catch` f ==> (return $! x) `catch` f
-- > evaluate x >>= f ==> (return $! x) >>= f
--
-- /Note:/ the first equation implies that #(evaluate x)# is /not/ the
-- same as #(return $! x)#. A correct definition is
--
-- > evaluate x = (return $! x) >>= return
--
evaluate :: a -> IO a
evaluate a = IO $ \s -> let !va = a in (# s, va #) -- NB. see #2273
That #2273 bug is a pretty interesting read.
I think GHC is doing something suspicious here, and recommend not using evalaute (instead, use seq directly). This needs more thinking about what GHC is doing with the strictness.
I've filed a bug report to help get a determination from GHC HQ.