I'm writing a Suave app and I want to stop if the origin ip is not in the authorized list for the route. For this I've written a small filter:
let RemoteIp (ipList: System.Net.IPAddress List) (x: Http.HttpContext) =
if (ipList |> List.map (fun ip -> x.clientIpTrustProxy.Equals ip ) |> List.contains true)
then
async.Return (Some x)
else
async.Return None
Then I fiter out with
Filters.path "/cache" >=> RemoteIp authorizedIps >=> Filters.GET >=> Successful.OK ""
so I get to process the call only if it comes from an IP in my authorized list, if not it just continues. However what I really want to do is to return 403. Right now I'm just short circuiting the route search.
Is there anything like a branch combinator?
I endend writing a Branch function:
let Branch (x:WebPart) (y:WebPart) (z:WebPart): WebPart =
fun arg -> async {
let! res = x arg
match res with
| Some v -> return! y arg
| None -> return! z arg
}
So now I have something like
Filters.path "/cache" >=> Branch (RemoteIp authorizedIps) (Successful.OK "Yea!") (RequestErrors.FORBIDDEN "Nope")
It might come handy sometime, but really, what I should have thought of before is Fyodor's suggestion, which I think is more readable:
Filters.path "/cache" >=> choose [
RemoteIp authorizedIps >=> Successful.OK "Yea!"
RequestErrors.FORBIDDEN "Nope"
]
Related
I believe I have some basic misunderstanding about catching exceptions in SML.
I wrote the following code:
fun my_g acc p =
let
val r = my_g acc
in
case p of
Wildcard => acc
| Variable x => if List.exists (fn y => y = x) acc then raise NoAnswer else x::acc
| TupleP ps => List.foldl (fn (p,i) => (my_g i p)) acc ps
| ConstructorP(_,p) => r p
| _ => acc
end
(* val check_pat = fn : pattern -> bool *)
fun check_pat p =
if my_g [] p <> [] then
true
else
true
handle NoAnswer => false
I'm happy to explain the code in gory detail, but basically I'm looking to see if strings are repeated in a list. If I find a string repeated, I raise an exception. Notice I'm handling the exception in function check_pat, which calls function my_g. However, when I run the code with some test methods, I get uncaught exception NoAnswer
Can I catch an exception thrown in one function in another (calling) function?
What am I doing wrong?
Thanks, Dave
Additional details for Andreas and future viewers. The original hints were to first unfold the structure and get a list of strings and only then go through and look for duplicates. I felt that was inefficient and it would be best to look for duplicates as you unfolded. Unfortunately, my SML knowledge is not good enough to come up with a super clean solution. Really, I don't care about the return value of my_g. If it doesn't throw an exception, then there are no duplicates. As simple as that. But it seemed the syntax rules were forcing me to check the return value. Now that you've solved the "handle" issue for me, I might revisit the problem. I was hoping to just write:
(my_g [] p
true)
handle NoAnswer => false
but that didn't seem to work. More broadly, although I think my solution is more efficient than first unfolding the entire list just to then look for duplicates, I suspect the idea of using an exception like I did is not good style. In languages I'm familiar with (C++, C#), an exception means some exceptional or unexpected occurred. Finding a duplicate string is certainly not exceptional. Again, I'm sure there is another way to stop at the first duplicate without using exceptions. I'm just not proficient enough in SML to know it. Thanks!
This is simply a matter of parenthesization: handle binds tighter than if, so you have effectively written
if ... then ... else (... handle ...)
Instead you want
(if ... then ... else ...) handle ...
so you need to put in parentheses.
BTW, I can't make sense of your use of if -- why a conditional when both branches produce the same result? Also, if A then true else B is a verbose way of saying A orelse B.
Edit in reply to edit in the question: If you want to ignore the result of an expression and return something else instead then you can use the semicolon operator:
(my_g [] p; true)
However, in general, using exceptions for non-exceptional control flow is not recommended. There is a cleaner way to write this function:
fun ids (Variable x) = [x]
| ids (Tuple ps) = List.concat (List.map ids ps)
| ids (Constructor(_,p)) = ids p
| ids _ = []
fun hasDups [] = false
| hasDups (x::xs) = List.exists (fn y => y = x) xs orelse hasDups xs
fun checkPat p = not (hasDups (ids p))
Edit 2: In the normal case (where there are no duplicates), this solution isn't slower than the other. So it's not necessarily worth taking the shortcut. If you insist, though, there are various options that don't require exceptions. For example:
fun checkPat'(_, NONE) = NONE
| checkPat'(Variable x, SOME xs) = if List.exists (fn y => y = x) xs then NONE else SOME (x::xs)
| checkPat'(Tuple ps, xso) = List.foldl checkPat' xso ps
| checkPat'(Constructor(_,p), xso) = checkPat'(p, xso)
| checkPat'(_, xso) = xso
fun checkPat p = isSome (checkPat'(p, SOME []))
Or, if you are willing to use a bit of mutable state:
fun checkPat' xs (Variable x) = List.exists (fn y => y = x) (!xs) before (xs := x :: !xs)
| checkPat' xs (Tuple ps) = List.all (checkPat' xs) ps
| checkPat' xs (Constructor(_,p)) = checkPat' xs p
| checkPat' xs _ = true
fun checkPat p = checkPat' (ref []) p
Short version:
I want to sort a list, and then perform operations on that sorted list that filter/extract data to form a new list, all in one function.
Long version:
I am teaching myself Haskell using these lessons. I'm currently on Homework 2 Exercise 5.
I am required to write a function whatWentWrong that takes an unsorted list of LogMessages and returns a list of Strings. The strings are the String portion of LogMessages that were constructed with Error in which the Error code is > 50. They are supposed to be sorted by the TimeStamp portion of LogMessage.
I have a function written for whatWentWrong that works, but it's really really slow (you'll see why).
whatWentWrong :: [LogMessage] -> [String]
whatWentWrong [] = []
whatWentWrong ys#((LogMessage (Error code) _ msg):xs)
| ys /= inOrder (build ys)
= whatWentWrong (inOrder (build ys))
| code > 50
= [msg] ++ whatWentWrong xs
| otherwise
= whatWentWrong xs
whatWentWrong (_:xs) = [] ++ whatWentWrong xs
The functions inOrder (build x) will return a sorted version of x (where x is a list of LogMessages). Obviously I have to either sort the list before I begin processing it with whatWentWrong, or I have to filter out all non relevant messages (Messages which are not Errors or which don't have Error codes above 50), sort, and then grab the strings from each one.
If I wasn't following this example, I would just define another function or something, or just send whatWentWrong an already sorted list. But I imagine there's some reason to do it this way (which I can't figure out).
Anyways, what I've done, and why the program is so slow is this:
The line ys /= inOrder (build ys) is checking that the LogMessage list is sorted every single time it encounters a LogMessage that matches the Error pattern, even though, after the first time that check fails, the list is sorted for good.
That's the only way I could think to do it. Really, what I want to do it sort it once, but I have no idea how to make the function sort the list using my sorting functions and then not do that step ever again. I'm obviously not thinking about this correctly and any help is appreciated. Thanks.
You really just need a one-line list comprehension:
whatWentWrong xs = [ msg | (LogMessage (Error code) _ msg) <- inOrder (build xs), code > 50]
If you are sorting the list to see if the list is sorted, you may as well just work directly on the sorted list. Once you've done that, the list comprehension will automatically filter out the elements that don't pattern match, and the code > 50 filters the rest.
If you want to fix your current code as an exercise, you just need to define a helper function that assumes its input is sorted.
whatWentWrong :: [LogMessage] -> [String]
whatWentWrong ys = www (inOrder (build ys))
where www [] = []
www ((LogMessage (Error code) _ msg):xs) | code > 50 = msg : www xs
| otherwise = www xs
www (_:xs) = www xs
However, you should recognize that www is the combination of
a map and a filter.
whatWentWrong ys = map f $ filter p (inOrder (build ys))
where p (LogMessage (Error code) _ _) = code > 50
p _ = False
f (LogMessage _ _ msg) = msg
or, in point-free style
whatWentWrong = map f . filter p . inOrder . build
where p (LogMessage (Error code) _ _) = code > 50
p _ = False
f (LogMessage _ _ msg) = msg
As I am not completely happy with F#'s regex implementation for my usage, I wanted to implement a so-called regex chain. It basically works as follows:
The given string s will be checked, whether it matches the first pattern. If it does, it should execute a function associated with the first pattern. If it does not, it should continue with the next one.
I tried to implement it as follows:
let RegexMatch ((s : string, c : bool), p : string, f : GroupCollection -> unit) =
if c then
let m = Regex.Match(s, p)
if m.Success then
f m.Groups
(s, false)
else (s, c)
else (s, c)
("my input text", true)
|> RegexMatch("pattern1", fun g -> ...)
|> RegexMatch("pattern2", fun g -> ...)
|> RegexMatch("pattern3", fun g -> ...)
|> .... // more patterns
|> ignore
The problem is, that this code is invalid, as the forward-pipe operator does not seem to pipe tuples or does not like my implementation 'design'.
My question is: Can I fix this code above easily or should I rather implement some other kind of regex chain?
Your function RegexMatch won't support piping, because it has tupled parameters.
First, look at the definition of the pipe:
let (|>) x f = f x
From this, one can clearly see that this expression:
("text", true)
|> RegexMatch("pattern", fun x -> ...)
would be equivalent to this:
RegexMatch("pattern", fun x -> ...) ("text", true)
Does this match your function signature? Obviously not. In your signature, the text/bool pair comes first, and is part of the triple of parameters, together with pattern and function.
To make it work, you need to take the "piped" parameter in curried form and last:
let RegexMatch p f (s, c) = ...
Then you can do the piping:
("input", true)
|> RegexMatch "pattern1" (fun x -> ...)
|> RegexMatch "pattern2" (fun x -> ...)
|> RegexMatch "pattern3" (fun x -> ...)
As an aside, I must note that your approach is not very, ahem, functional. You're basing your whole logic on side effects, which will make your program not composable and hard to test, and probably prone to bugs. You're not reaping the benefits of F#, effectively using it as "C# with nicer syntax".
Also, there are actually well researched ways to achieve what you want. For one, check out Railway-oriented programming (also known as monadic computations).
To me this sounds like what you are trying to implement is Active Patterns.
Using Active Patterns you can use regular pattern matching syntax to match against RegEx patterns:
let (|RegEx|_|) p i =
let m = System.Text.RegularExpressions.Regex.Match (i, p)
if m.Success then
Some m.Groups
else
None
[<EntryPoint>]
let main argv =
let text = "123"
match text with
| RegEx #"\d+" g -> printfn "Digit: %A" g
| RegEx #"\w+" g -> printfn "Word : %A" g
| _ -> printfn "Not recognized"
0
Another approach is to use what Fyodor refers to as Railway Oriented Programming:
type RegexResult<'T> =
| Found of 'T
| Searching of string
let lift p f = function
| Found v -> Found v
| Searching i ->
let m = System.Text.RegularExpressions.Regex.Match (i, p)
if m.Success then
m.Groups |> f |> Found
else
Searching i
[<EntryPoint>]
let main argv =
Searching "123"
|> lift #"\d+" (fun g -> printfn "Digit: %A" g)
|> lift #"\w+" (fun g -> printfn "Word : %A" g)
|> ignore
0
Well this Parse error: "in" expected after [binding] (in [expr])
is a common error as far I have searched in Ocaml users, but in the examples I saw I didnt found the answer for my error, then I will explain my problem:
I declared this function:
let rec unit_propag xs =
let cuAux = teste xs
let updatelist = funfilter (List.hd(List.hd cuAux)) (xs)
let updatelist2 = filtraelem (negar(List.hd(List.hd cuAux))) (updatelist)
if(not(List.mem [] xs) && (teste xs <> []))
then
unit_propag updatelist2
;;
The functions I am using inside this code were declared before like this:
let funfilter elem xs = List.filter (fun inner -> not (List.mem elem inner)) xs;;
let filtraele elem l = List.map( fun y -> List.filter (fun x -> x <> elem) y)l;;
let teste xs = List.filter(fun inner ->(is_single inner)inner)xs;;
let is_single xs = function
|[_] -> true
|_ -> false
;;
let negar l =
match l with
V x -> N x
|N x -> V x
|B -> T
|T -> B
;;
But not by this order.
Well they were all doing what I wanted to do, but now when I declared unit_propag and tried to compile, I had an error in line of
let cuAux = teste xs
It said:
File "exc.ml", line 251, characters 20-22:
Parse error: "in" expected after [binding] (in [expr])
Error while running external preprocessor
Command line: camlp4o 'exc.ml' > /tmp/ocamlpp5a7c3d
Then I tried to add a ; on the end of each function, and then my "in" error appeared on the line of the last function, is this case unit_propag updatelist2
What I am doing wrong? people usually say that this kind of errors occurs before that code, but when i comment this function the program compiles perfectly.
I need to post more of my code? Or i need to be more clear in my question?
Is that possible to do in Ocaml or I am doing something that I cant?
Thanks
The error message says you're missing in, so it seems strange to solve it by adding ; :-)
Anyway, you're missing the keyword in after all the let keywords in your function unit_propag.
You should write it like this:
let rec unit_propag xs =
let cuAux = teste xs in
let updatelist = funfilter (List.hd(List.hd cuAux)) (xs) in
let updatelist2 =
filtraelem (negar(List.hd(List.hd cuAux))) (updatelist)
in
if (not (List.mem [] xs) && (teste xs <> [])) then
unit_propag updatelist2
The basic issue has been explained many times here (as you note). Basically there are two uses of the keyword let. At the outer level it defines the values in a module. Inside another definition it defines a local variable and must be followed by in. These three lets are inside the definition of unit_propag.
Another attempt to explain the use of let is here: OCaml: Call function within another function.
I have sorted list of integer values:
let ls = [1..4]
How can I get a sublist without first and the last element? (In the most optimal way)
The expected result is [2; 3].
This is what I have so far, and yeah, it's working, but I in my opinion it's just not the best approach.
[1..4] |> List.tail |> List.rev |> List.tail |> List.sort
A somewhat long answer incoming in response to your innocently worded qualifier: "In the most optimal way"
Optimal in terms of what?
Performance? (Most likely)
Performance but also include GC performance?
Memory usage?
x86?
x64?
And so on...
So I decided to measure some aspects of the problem.
I measured the different answers (added a non-idiomatic version as well) in this thread in various different context.
Without further ado here is the program I used to measure
open System
open System.Diagnostics
open System.IO
module so29100251 =
// Daystate solution (OP)
module Daystate =
// Applied minor fixes to it
let trim = function
| [] | [_] | [_;_] -> []
| ls -> ls |> List.tail |> List.rev |> List.tail |> List.rev
// kaefer solution
module kaefer =
type 'a State = Zero | One | Other of 'a
let skipFirstAndLast xss =
let rec aux acc = function
| _, [] -> List.rev acc
| Zero, x::xs -> aux acc (One, xs)
| One, x::xs -> aux acc (Other x, xs)
| (Other prev), x::xs -> aux (prev :: acc) (Other x, xs)
aux [] (Zero, xss)
// Petr solution
module Petr =
let rec trimImpl ls acc =
match ls, acc with
| [], _ -> acc
| h::[], acc -> List.rev acc
| h::n::t, [] -> trimImpl t [n]
| h::t, acc -> trimImpl t (h::acc)
let trim ls = trimImpl ls []
// NonIdiomatic solution
module NonIdiomatic =
let trim (hint : int) (ls : 'T list) =
// trims last of rest
// Can't ask for ls.Length as that is O(n)
let ra = ResizeArray<_> (hint)
// Can't use for x in list do as it relies on .GetEnumerator ()
let mutable c = ls
while not c.IsEmpty do
ra.Add c.Head
c <- c.Tail
let count = ra.Count
let mutable result = []
for i in (count - 2)..(-1)..1 do
result <- ra.[i]::result
result
open so29100251
type Time = MilliSeconds of int64
type TestKind<'T> =
| Functional of 'T
| MeasurePerformance of int*int
[<EntryPoint>]
let main argv =
let factor = 10000000
// let maxHint = Int32.MaxValue
let maxHint = 100
let time (action : unit -> 'T) : 'T*Time =
let sw = Stopwatch ()
sw.Start ()
let r = action ()
sw.Stop ()
r, MilliSeconds sw.ElapsedMilliseconds
let adapt fn hint ls = fn ls
let trimmers =
[|
"Daystate" , adapt Daystate.trim
"kaefer" , adapt kaefer.skipFirstAndLast
"Petr" , adapt Petr.trim
"NonIdiomatic" , NonIdiomatic.trim
|]
#if DEBUG
let functionalTestCases =
[|
Functional [] , "empty" , []
Functional [] , "singleton" , [1]
Functional [] , "duoton" , [1;2]
Functional [2] , "triplet" , [1;2;3]
Functional [2;3] , "quartet" , [1;2;3;4]
|]
let performanceMeasurements = [||]
#else
let functionalTestCases = [||]
let performanceMeasurements =
[|
"small" , 10
"big" , 1000
"bigger" , 100000
// "huge" , 10000000
|] |> Array.map (fun (name, size) -> MeasurePerformance (size, (factor / size)) , name , [for x in 1..size -> x])
#endif
let testCases =
[|
functionalTestCases
performanceMeasurements
|] |> Array.concat
use tsv = File.CreateText ("result.tsv")
tsv.WriteLine (sprintf "TRIMMER\tTESTCASE\tSIZE\tHINT\tRUNS\tMEMORY_BEFORE\tMEMORY_AFTER\tGC_TIME\tRUN_TIME")
for trimName, trim in trimmers do
for testKind, testCaseName, testCase in testCases do
match testKind with
| Functional expected ->
let actual = trim 0 testCase
if actual = expected then
printfn "SUCCESS: Functional test of %s trim on testcase %s successful" trimName testCaseName
else
printfn "FAILURE: Functional test of %s trim on testcase %s failed" trimName testCaseName
| MeasurePerformance (size,testRuns) ->
let hint = min size maxHint
let before = GC.GetTotalMemory(true)
printfn "MEASURE: Running performance measurement on %s trim using testcase %s..." trimName testCaseName
let timeMe () =
for x in 1..testRuns do
ignore <| trim hint testCase
let _, MilliSeconds ms = time timeMe
let after = GC.GetTotalMemory(false)
let timeGC () =
ignore <| GC.GetTotalMemory(true)
let _, MilliSeconds msGC = time timeMe
printfn "...%d ms (%d runs), %d (before) %d (after) %d ms (GC)" ms testRuns before after msGC
tsv.WriteLine (sprintf "%s\t%s\t%d\t%d\t%d\t%d\t%d\t%d\t%d" trimName testCaseName size hint testRuns before after msGC ms)
0
I then measured the execution time and GC time on x64 and max size hint allowed:
(size hints is only used by the non-idiomatic version)
x86 and max size hint allowed:
x64 and max 100 hint allowed:
x86 and max 100 hint allowed:
Looking at the performance charts we can note some somewhat surprising things:
All variants are iterating 10000000 times. One would expect the execution time to not differ between the different variants but they do.
The crusty old x86 scores consistently better overall. I won't speculate why.
OPs initial version while seemingly wasteful scores pretty good. It's probably helped by that List.rev is very optimized (IIRC it does some safe cheating available only to F# devs)
The kaefer version while on paper a better solution seems to score the worst. I think it's because it allocates extra State objects which are heap based. (This should obviously not be interpreted as a criticism of kaefers skills)
The non-idiomatic solution scores good with good size hints but not as good as I expected. It might be that building the final lists is what costs most cycles. It might also be that tail recursive functions over lists are more efficient than while loops as IIRC pattern matching are more effective than calling List.Tail/List.Head/List.IsEmpty
GC time is almost as big as the execution time.
I expected the GC time of the non-idiomatic solution to be significantly lower than the rest. However, while the ResizeArray<_> are probably quick to collect the list objects aren't.
On x86 arch the performance difference between Petr solution and the non-idiomatic one might not warrant the extra complexity.
Some final thoughts:
OPs original solution did pretty good
Garbage Collection takes time
Always measure...
Hopefully it was somewhat interesting
Edit:
The GC performance measurement numbers should not be over-interpreted into some thing more than: "GC can be expensive"
I later changed from a while loop to tail-recursion over a list which did improve the performance somewhat but not enough to warrant an update of the charts.
This is one of the ways:
let rec trim ls acc =
match ls, acc with
| [], _ -> acc
| h::[], acc -> List.rev acc
| h::n::t, [] -> trim t [n]
| h::t, acc -> trim t (h::acc)
let reslt = trim ls []
You didn't require standard library functions to achieve this, your're just asking for an efficient way. Defining a recursive function with an accumulator which holds the intermediate results would then appear a viable solution, even when the list has to be reversed at its termination.
I'm providing a custom Discriminated Union to keep track of the state, this is modelled along the lines of the Option type with an extra case.
type 'a State = Zero | One | Other of 'a
let skipFirstAndLast xss =
let rec aux acc = function
| _, [] -> List.rev acc
| Zero, x::xs -> aux acc (One, xs)
| One, x::xs -> aux acc (Other x, xs)
| (Other prev), x::xs -> aux (prev :: acc) (Other x, xs)
aux [] (Zero, xss)
[1..4] |> skipFirstAndLast // val it : int list = [2; 3]