f# check if dir is accessible is not working - f#

try (box (Directory.GetDirectories(dir) ))
with | :? System.UnauthorizedAccessException -> ()
I'm trying to check if the directory is accessible so I won't get an "access denied" error, but it's not working, it's not skipping the loop in for

It's generally discouraged to use exceptions as part of your control flow. It's better to check for the appropriate access to the directory before trying to enumerate its contents. Try something like this:
open System
open System.IO
open System.Linq
open System.Security.AccessControl
open System.Security.Principal
let checkSecurity =
let account = sprintf #"%s\%s" Environment.UserDomainName Environment.UserName
let identity = WindowsIdentity.GetCurrent()
let principal = identity |> WindowsPrincipal
let isAdmin = identity.Owner = identity.User
fun (dir: DirectoryInfo) ->
try
let acl = dir.GetAccessControl(AccessControlSections.All)
let rules = acl.GetAccessRules(true, true, typeof<NTAccount>)
rules.OfType<FileSystemAccessRule>()
|> Seq.filter (fun rule -> rule.IdentityReference.Value.Equals(account, StringComparison.CurrentCultureIgnoreCase) ||
(if rule.IdentityReference.Value.Equals("BUILTIN\Administrators", StringComparison.CurrentCultureIgnoreCase)
then isAdmin && principal.IsInRole(rule.IdentityReference.Value)
else principal.IsInRole(rule.IdentityReference.Value)))
|> Seq.exists (fun rule -> (rule.FileSystemRights &&& FileSystemRights.Read = FileSystemRights.Read) && rule.AccessControlType <> AccessControlType.Deny)
with | _ ->
false
let rec getFiles (dir: DirectoryInfo) =
[ if checkSecurity dir
then for file in dir.GetFiles("*") do yield file
for subDir in dir.GetDirectories("*") do yield! getFiles subDir
]
let dir = DirectoryInfo(#"C:\Temp")
dir |> getFiles

You might have some other issues, if you have an exception the try-with block should be able to handle it, so either you're actually not getting an exception or have some other issues in the surrounding code. Why do you box?
The aversion to using exceptions as control flow makes some sense in .NET. in OCaml exceptions are used extensively for that purpose, but they are cheap. In .NET this is more expensive in performance terms. That said, sometimes you do want catch and handle an exception, so I don't think it's such a big issue. This for example works:
open System.IO
let okdir = #"c:\tmp"
let baddir = #"L:\Finance"
let checkDir dir =
try
Directory.GetDirectories(dir) |> ignore
printfn "%A" "Processed"
with
| :? System.UnauthorizedAccessException as ex -> failwith ex.Message
| :? System.IO.IOException as ex -> failwith ex.Message
// | :? System.Exception as ex -> failwith ex.Message
checkDir okdir
//"Processed"
//val it : unit = ()
checkDir baddir
//System.Exception: Access to the path 'L:\Finance' is denied.

Related

Suave not showing static file

So I have my server set up very simply. If the path is of the form /article/something, it should serve up the static file something.html within the folder static. For some reason, the Files.file webpart is apparently returning None. I tacked on the OK "File Displayed" webpart to verify that this is the case. The OK never executes.
let app =
choose [
pathScan "/article/%s" (fun article ->
let name = sprintf "%s.html" article
Console.WriteLine name
Files.file name >=> OK "File Displayed")
]
let config =
{ defaultConfig with homeFolder = Some (Path.GetFullPath "./static") }
[<EntryPoint>]
let main args =
startWebServer config app
0
Interestingly enough, the Console.WriteLine name line executes perfectly and I see something.html in the console window when I execute this. It appears the problem is exclusively Files.file name returning None.
The file something.html definitely exists in the static folder, so that's not the problem .
Any ideas on what might be causing this?
Here are some parts to troubleshoot static file serving issues
let troubleShootExtensionPart extensionToCheck :WebPart =
fun ctx ->
match extensionToCheck with
| null | "" -> ServerErrors.INTERNAL_ERROR "Extension Error not supplied, part is not set up correctly"
| x when not <| x.StartsWith "." -> ServerErrors.INTERNAL_ERROR "Extensions start with a '.', part is not set up correctly"
| _ ->
let mtm = ctx.runtime.mimeTypesMap
match mtm extensionToCheck with
| None ->
sprintf "%s is not supported by the mime types map, compose your mime type with the `defaultMimeTypesMap`" extensionToCheck
|> RequestErrors.FORBIDDEN
| Some x ->
sprintf "%s is supported and uses '%s', compression on? : %A" extensionToCheck x.name x.compression
|> OK
|> fun wp -> wp ctx
example consumption with a wildcard so if no routes match you get some diagnostic info
#if DEBUG
pathScan "/checkExtension/%s" (fun name -> troubleShootExtensionPart name)
// catch all
(fun ctx -> sprintf "404, also homeFolder resolves to %s" (Path.GetFullPath ".") |> RequestErrors.NOT_FOUND |> fun wp -> wp ctx)
#endif

Pipe Array.reduce FileInfo[][] to FileInfo[]

exception NoDirectory of string
let dir = DirectoryInfo "c:\\"
let dirExists (dir: DirectoryInfo): bool = dir.Exists
let rec getFiles (dir: DirectoryInfo) : FileInfo[] =
let subs =
match dirExists dir with
| true -> dir.GetDirectories ""
| false -> raise (NoDirectory("error"))
subs
|> Array.map (fun (dir: DirectoryInfo) -> getFiles dir)
|> Array.reduce (fun acc elem -> acc.append elem) List.empty
So the last line I'm trying reduce FileInfo[][] to FileInfo[] or more accurately FileInfo[][] to List<FileInfo>.
I assumed that because pipe only works on unary functions so that would mean function currying the Array.reduce but I kind of got stuck there, something like:
let unaryReduce (fileInfoArray: FileInfo[]) = Array.reduce (fun acc elem -> acc.append elem) List.empty
Am I right? Getting close... far away...
Edit
So after some modifying I have got this:
let dir = DirectoryInfo "c:\\"
let dirExists (dir: DirectoryInfo): bool = dir.Exists
let getFiles (dir: DirectoryInfo) : FileInfo[] = dir.GetFiles ""
let rec recursiveGetFiles (dir: DirectoryInfo) : FileInfo[] =
let subs =
match dirExists dir with
| true -> dir.GetDirectories ""
| false -> raise (NoDirectory("error"))
subs
|> Array.collect (fun (dir: DirectoryInfo) -> recursiveGetFiles dir)
|> Array.concat<FileInfo[]> getFiles <| dir
I only started looking at F# yesterday, I want to try out using pipes. The error I get is on the last line:
This expression was expected to have type
FileInfo [] -> 'a -> FileInfo []
but here has type
FileInfo [] []
This says to me that collect isn't being used properly to flatten the arrays...
If you want to use pipelining, something like this ought to work:
exception NoDirectory of string
// DirectoryInfo -> bool
let dirExists (dir: DirectoryInfo) = dir.Exists
// DirectoryInfo -> FileInfo []
let getFiles (dir: DirectoryInfo) = dir.GetFiles "."
// DirectoryInfo -> FileInfo []
let rec recursiveGetFiles dir =
match dirExists dir with
| true -> dir.GetDirectories "."
| false -> raise (NoDirectory "error")
|> Array.collect recursiveGetFiles
|> Array.append (getFiles dir)
I wouldn't recommend throwing exceptions like shown here, but I kept that part in order to keep it as close to the OP as possible. Once you're comfortable with the basics of F# and functional programming, however, you should learn about functional error handling using the Either monad. A good place to start is here: http://fsharpforfunandprofit.com/rop
The error you got from your edit comes from the precedence of back piping (<|) a |> f <| b is seen as (a |> f) <| b when what you want is a |> (f <| b) which is just a |> (f b) (as seen in Mark Seemann's answer)
That said you could write something (IMO) more readable that way :
let getAllFiles (dir: DirectoryInfo) =
let rec aux dir = [
for file in getFiles dir -> file
for subDir in getDirs dir do yield! aux subDir
]
if dirExists dir
then aux dir
else raise <| NoDirectory "error"
That way we separate the recursive part from the check part.
The recursive part is a lot simpler, more readable and returns a list instead of an array as wanted initially (I added a getDirs)
The check part is done with an if because a match for true/false doesn't add value here
and done only for the initial argument as there are little chance getDirs return non-existing directories*
*even though it's possible if someone delete one just at the wrong time, in that case you can rewrite it
let rec getAllFiles (dir: DirectoryInfo) = [
if dirExists dir then
for file in getFiles dir -> file
for subDir in getDirs dir do yield! getAllFiles subDir
]
And that way you don't even need to raise an error you just get an empty list for a non-existing directory.
You can also use EnumarateDirectories if you need a seq, although with IO I would be careful using lazy collections. This returns all the 56 files I have in my project (sub)directories:
open System.IO
let dir = DirectoryInfo __SOURCE_DIRECTORY__
dir.GetDirectories("*",SearchOption.AllDirectories) |> Array.collect (fun x -> x.GetFileSystemInfos())
If you replace Array.collect, with Array.map the top level collection will be that of the directories (exactly 5 as that's what I have).

TypeProvider giving unexpected dev-time behavior

I'm messing with my new statically parameterized type provider that provides a type with statically parameterized static methods. I haven't found documentation about this not being allowed. I'm getting some strange type provider behavior:
This type-provider-consuming code runs correctly but the intellisense gives crappy info. Members just keep getting added but never removed. The OpDef method shouldn't be available without the type parameters but intellisense kinda shows that as an option but still gives an error about a missing invoker if I actually refer to it. The required arguments to the provided OpDef method are not shown - always shows OpDef() -> unit instead of OpDef(suffix : string * id : string) -> unit that I currently expect to see (from this draft of the type provider). But as I've given all the arguments it really needs then it stops complaining.
Am I doing something that isn't supported or correct? Or, doubtfully, is there a bug in the f# stuff (and can you isolate where the bug is apparent)?
Here is the full implementation which uses the starter-pack files.
namespace OfflineSql
open ProviderImplementation.ProvidedTypes
open Microsoft.FSharp.Core.CompilerServices
open System.Text.RegularExpressions
#nowarn "0025"
[<TypeProvider>]
type OfflineSqlProvider (config : TypeProviderConfig) as this =
inherit TypeProviderForNamespaces ()
let ns = "OfflineSql"
let asm = System.Reflection.Assembly.GetExecutingAssembly()
let buildDomainProvider nm schema invariants =
let parameterizedType = ProvidedTypeDefinition(asm, ns, nm, None)
let m = ProvidedMethod("OpDef", list.Empty, typeof<unit>, IsStaticMethod = true)
m.DefineStaticParameters(
[
ProvidedStaticParameter("script", typeof<string>)
],
fun nm [| :? string as operation |] ->
let results =
Regex.Matches(operation, "#([a-zA-Z_][a-zA-Z0-9_]*)") |> Seq.cast
|> Seq.map (fun (regmatch: Match) -> regmatch.Groups.[1].Captures.[0].ToString())
let ps = [ for a in results -> ProvidedParameter(a, typeof<string>) ] |> List.distinct
let opDef = ProvidedMethod(nm, ps, typeof<unit>, IsStaticMethod = true, InvokeCode = (fun _ -> <## () ##>))
opDef.AddXmlDoc("Constructs a guarded method for the operation's script")
parameterizedType.AddMember(opDef)
opDef)
let schemaProp =
ProvidedProperty("Schema", typeof<string>, IsStatic = true,
GetterCode = (fun _ -> <## schema ##>))
let invariantsProp =
ProvidedProperty("Invariants", typeof<string>, IsStatic = true,
GetterCode = (fun _ -> <## invariants ##>))
parameterizedType.AddMember(m)
parameterizedType.AddMember(schemaProp)
parameterizedType.AddMember(invariantsProp)
parameterizedType
do
let root = ProvidedTypeDefinition(asm, ns, "Domain", None)
root.DefineStaticParameters(
[
ProvidedStaticParameter("schema", typeof<string>)
ProvidedStaticParameter("invariants", typeof<string>, "")
],
fun nm [| :? string as schema ; :? string as invariants |] ->
buildDomainProvider nm schema invariants)
this.AddNamespace(ns, [ root ])
[<assembly:TypeProviderAssembly>]
do ()
This is directly related to known bugs with a fix:
https://github.com/Microsoft/visualfsharp/issues/642
https://github.com/Microsoft/visualfsharp/issues/640
https://github.com/Microsoft/visualfsharp/pull/705
Thanks to #gauthier on functionalprogramming.slack.com/fsharp for this find.

Can I call a function by name in f#?

Is there any way to call a function by name in F#? Given a string, I want to pluck a function value from the global namespace (or, in general, a given module), and call it. I know the type of the function already.
Why would I want to do this? I'm trying to work around fsi not having an --eval option. I have a script file that defines many int->() functions, and I want to execute one of them. Like so:
fsianycpu --use:script_with_many_funcs.fsx --eval "analyzeDataSet 1"
My thought was to write a trampoline script, like:
fsianycpu --use:script_with_many_funcs.fsx trampoline.fsx analyzeDataSet 1
In order to write "trampoline.fsx", I'd need to look up the function by name.
There is no built-in function for this, but you can implement it using .NET reflection. The idea is to search through all types available in the current assembly (this is where the current code is compiled) and dynamically invoke the method with the matching name. If you had this in a module, you'd have to check the type name too.
// Some sample functions that we might want to call
let hello() =
printfn "Hello world"
let bye() =
printfn "Bye"
// Loader script that calls function by name
open System
open System.Reflection
let callFunction name =
let asm = Assembly.GetExecutingAssembly()
for t in asm.GetTypes() do
for m in t.GetMethods() do
if m.IsStatic && m.Name = name then
m.Invoke(null, [||]) |> ignore
// Use the first command line argument (after -- in the fsi call below)
callFunction fsi.CommandLineArgs.[1]
This runs hello world when called by:
fsi --use:C:\temp\test.fsx --exec -- "hello"
You can use reflection to get the functions as MethodInfo's by FSharp function name
open System
open System.Reflection
let rec fsharpName (mi:MemberInfo) =
if mi.DeclaringType.IsNestedPublic then
sprintf "%s.%s" (fsharpName mi.DeclaringType) mi.Name
else
mi.Name
let functionsByName =
Assembly.GetExecutingAssembly().GetTypes()
|> Seq.filter (fun t -> t.IsPublic || t.IsNestedPublic)
|> Seq.collect (fun t -> t.GetMethods(BindingFlags.Static ||| BindingFlags.Public))
|> Seq.filter (fun m -> not m.IsSpecialName)
|> Seq.groupBy (fun m -> fsharpName m)
|> Map.ofSeq
|> Map.map (fun k v -> Seq.exactlyOne v)
You can then invoke the MethodInfo
functionsByName.[fsharpFunctionNameString].Invoke(null, objectArrayOfArguments)
But you probably need to do more work to parse your string arguments using the MethodInfo.GetParameters() types as a hint.
You could also use FSharp.Compiler.Service to make your own fsi.exe with an eval flag
open System
open Microsoft.FSharp.Compiler.Interactive.Shell
open System.Text.RegularExpressions
[<EntryPoint>]
let main(argv) =
let argAll = Array.append [| "C:\\fsi.exe" |] argv
let argFix = argAll |> Array.map (fun a -> if a.StartsWith("--eval:") then "--noninteractive" else a)
let optFind = argv |> Seq.tryFind (fun a -> a.StartsWith "--eval:")
let evalData = if optFind.IsSome then
optFind.Value.Replace("--eval:",String.Empty)
else
String.Empty
let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration()
let fsiSession = FsiEvaluationSession(fsiConfig, argFix, Console.In, Console.Out, Console.Error)
if String.IsNullOrWhiteSpace(evalData) then
fsiSession.Run()
else
fsiSession.EvalInteraction(evalData)
0
If the above was compiled into fsieval.exe it could be used as so
fsieval.exe --load:script_with_many_funcs.fsx --eval:analyzeDataSet` 1

How to write a functional file "scanner"

First let me apologize for the scale of this problem but I'm really trying to think functionally and this is one of the more challenging problems I have had to work with.
I wanted to get some suggestions on how I might handle a problem I have in a functional manner, particularly in F#. I am writing a program to go through a list of directories and using a list of regex patterns to filter the list of files retrieved from the directories and using a second list of regex patterns to find matches in the text of the retreived files. I want this thing to return the filename, line index, column index, pattern and matched value for each piece of text that matches a given regex pattern. Also, exceptions need to be recorded and there are 3 possible exceptions scenarios: can't open the directory, can't open the file, reading content from the file failed. The final requirement of this is the the volume of files "scanned" for matches could be very large so this whole thing needs to be lazy. I'm not too worried about a "pure" functional solution as much as I'm interested in a "good" solution that reads well and performs well. One final challenge is to make it interop with C# because I would like to use the winform tools to attach this algorithm to a ui. Here is my first attempt and hopefully this will clarify the problem:
open System.Text.RegularExpressions
open System.IO
type Reader<'t, 'a> = 't -> 'a //=M['a], result varies
let returnM x _ = x
let map f m = fun t -> t |> m |> f
let apply f m = fun t -> t |> m |> (t |> f)
let bind f m = fun t -> t |> (t |> m |> f)
let Scanner dirs =
returnM dirs
|> apply (fun dirExHandler ->
Seq.collect (fun directory ->
try
Directory.GetFiles(directory, "*", SearchOption.AllDirectories)
with | e ->
dirExHandler e directory
Array.empty))
|> map (fun filenames ->
returnM filenames
|> apply (fun (filenamepatterns, lineExHandler, fileExHandler) ->
Seq.filter (fun filename ->
filenamepatterns |> Seq.exists (fun pattern ->
let regex = new Regex(pattern)
regex.IsMatch(filename)))
>> Seq.map (fun filename ->
let fileinfo = new FileInfo(filename)
try
use reader = fileinfo.OpenText()
Seq.unfold (fun ((reader : StreamReader), index) ->
if not reader.EndOfStream then
try
let line = reader.ReadLine()
Some((line, index), (reader, index + 1))
with | e ->
lineExHandler e filename index
None
else
None) (reader, 0)
|> (fun lines -> (filename, lines))
with | e ->
fileExHandler e filename
(filename, Seq.empty))
>> (fun files ->
returnM files
|> apply (fun contentpatterns ->
Seq.collect (fun file ->
let filename, lines = file
lines |>
Seq.collect (fun line ->
let content, index = line
contentpatterns
|> Seq.collect (fun pattern ->
let regex = new Regex(pattern)
regex.Matches(content)
|> (Seq.cast<Match>
>> Seq.map (fun contentmatch ->
(filename,
index,
contentmatch.Index,
pattern,
contentmatch.Value))))))))))
Thanks for any input.
Updated -- here is any updated solution based on feedback I received:
open System.Text.RegularExpressions
open System.IO
type ScannerConfiguration = {
FileNamePatterns : seq<string>
ContentPatterns : seq<string>
FileExceptionHandler : exn -> string -> unit
LineExceptionHandler : exn -> string -> int -> unit
DirectoryExceptionHandler : exn -> string -> unit }
let scanner specifiedDirectories (configuration : ScannerConfiguration) = seq {
let ToCachedRegexList = Seq.map (fun pattern -> new Regex(pattern)) >> Seq.cache
let contentRegexes = configuration.ContentPatterns |> ToCachedRegexList
let filenameRegexes = configuration.FileNamePatterns |> ToCachedRegexList
let getLines exHandler reader =
Seq.unfold (fun ((reader : StreamReader), index) ->
if not reader.EndOfStream then
try
let line = reader.ReadLine()
Some((line, index), (reader, index + 1))
with | e -> exHandler e index; None
else
None) (reader, 0)
for specifiedDirectory in specifiedDirectories do
let files =
try Directory.GetFiles(specifiedDirectory, "*", SearchOption.AllDirectories)
with e -> configuration.DirectoryExceptionHandler e specifiedDirectory; [||]
for file in files do
if filenameRegexes |> Seq.exists (fun (regex : Regex) -> regex.IsMatch(file)) then
let lines =
let fileinfo = new FileInfo(file)
try
use reader = fileinfo.OpenText()
reader |> getLines (fun e index -> configuration.LineExceptionHandler e file index)
with | e -> configuration.FileExceptionHandler e file; Seq.empty
for line in lines do
let content, index = line
for contentregex in contentRegexes do
for mmatch in content |> contentregex.Matches do
yield (file, index, mmatch.Index, contentregex.ToString(), mmatch.Value) }
Again, any input is welcome.
I think that the best approach is to start with the simplest solution and then extend it. Your current approach seems to be quite hard to read to me for two reasons:
The code uses a lot of combinators and function compositions in patterns that are not too common in F#. Some of the processing can be more easily written using sequence expressions.
The code is all written as a single function, but it is fairly complex and would be more readable if it was separated into multiple functions.
I would probably start by splitting the code in a function that tests a single file (say fileMatches) and a function that walks over the files and calls fileMatches. The main iteration can be quite nicely written using F# sequence expressions:
// Checks whether a file name matches a filename pattern
// and a content matches a content pattern.
let fileMatches fileNamePatterns contentPatterns
(fileExHandler, lineExHandler) file =
// TODO: This can be imlemented using
// File.ReadLines which returns a sequence.
// Iterates over all the files and calls 'fileMatches'.
let scanner specifiedDirectories fileNamePatterns contentPatterns
(dirExHandler, fileExHandler, lineExHandler) = seq {
// Iterate over all the specified directories.
for specifiedDir in specifiedDirectories do
// Find all files in the directories (and handle exceptions).
let files =
try Directory.GetFiles(specifiedDir, "*", SearchOption.AllDirectories)
with e -> dirExHandler e specifiedDir; [||]
// Iterate over all files and report those that match.
for file in files do
if fileMatches fileNamePatterns contentPatterns
(fileExHandler, lineExHandler) file then
// Matches! Return this file as part of the result.
yield file }
The function is still quite complicated, because you need to pass a lot of parameters around. Wrapping the parameters in a simple type or a record could be a good idea:
type ScannerArguments =
{ FileNamePatterns:string
ContentPatterns:string
FileExceptionHandler:exn -> string -> unit
LineExceptionHandler:exn -> string -> unit
DirectoryExceptionHandler:exn -> string -> unit }
Then you can define both fileMatches and scanner as functions that take just two parameters, which will make your code a lot more readable. Something like:
// Iterates over all the files and calls 'fileMatches'.
let scanner specifiedDirectories (args:ScannerArguments) = seq {
for specifiedDir in specifiedDirectories do
let files =
try Directory.GetFiles(specifiedDir, "*", SearchOption.AllDirectories)
with e -> args.DirectoryExceptionHandler e specifiedDir; [||]
for file in files do
// No need to propagate all arguments explicitly to other functions.
if fileMatches args file then yield file }

Resources