I decided to learn F#. One of the programs I write to learn a new language is a "jpg-renamer", A command line app that takes file-paths as args, reads the DateTimeOriginal EXIF tag and renames the files using the DateTimeOriginal to YYYY-MM-dd_hh.mm.ss.jpg which is a valid filename.
The function that does the actual renaming is this:
let renameFile (path:string) =
let newName = (getOriginalDateTime path |> changeTimeStampString) + Path.GetExtension(path)
printfn "%s -> %s" <| path <| newName
File.Move(path, newName)
When I run the program, this happens:
mono srenamer.exe IMG_20180303_153239.jpg
IMG_20180303_153239.jpg -> 2018-03-03_15.32.40.jpg
Unhandled Exception:
System.ArgumentException: The file name is not valid.
at System.IO.File.Move (System.String sourceFileName, System.String
destFileName) [0x0008d] in <b64e2aa77b4f4d60b739d6ceaf49caa4>:0
at Srenamer.renameFile (System.String path) [0x0005f] in <5aa45864019ff926a74503836458a45a>:0
at Srenamer.renameFiles[a](Microsoft.FSharp.Collections.FSharpList`1[T] paths) [0x00030] in <5aa45864019ff926a74503836458a45a>:0
at Srenamer.main (System.String[] args) [0x00006] in <5aa45864019ff926a74503836458a45a>:0
[ERROR] FATAL UNHANDLED EXCEPTION: System.ArgumentException: The file name is not valid.
at System.IO.File.Move (System.String sourceFileName, System.String destFileName) [0x0008d] in <b64e2aa77b4f4d60b739d6ceaf49caa4>:0
at Srenamer.renameFile (System.String path) [0x0005f] in <5aa45864019ff926a74503836458a45a>:0
at Srenamer.renameFiles[a] (Microsoft.FSharp.Collections.FSharpList`1[T] paths) [0x00030] in <5aa45864019ff926a74503836458a45a>:0
at Srenamer.main (System.String[] args) [0x00006] in <5aa45864019ff926a74503836458a45a>:0
Notice how the printfn prints the correct and valid new filename.
As part of my investigation I tried to just put the new filename as a string literal into the code like this:
let newName = "2018-03-03_15.32.40.jpg"
File.Move(path, newName)
Which works as expected. I also checked Path.GetInvalidFileNameChars which only returns / (Linux).
So why is the string that the code generates an invalid filename when the exact same hardcoded string works just fine?
For reference, here is the entire source code:
open System.Drawing
open System.Text.RegularExpressions
open System.IO
/// Changes timestamp string 'yyyy:dd:mm hh:mm:ss' to 'yyyy-mm-dd_hh.mm.ss'.
let changeTimeStampString (dt:string) =
let t = dt.Split(':', ' ')
// [yyyy; mm; dd; hh; mm; ss]
t.[0] + "-" + t.[1] + "-" + t.[2] + "_" + t.[3] + "." + t.[4] + "." + t.[5]
let rec getOrigDateTimeProp (propertyItems:Imaging.PropertyItem list) =
match propertyItems with
| x::xs -> match x.Id.ToString("x") with
| "9003" -> System.Text.Encoding.ASCII.GetString x.Value
| _-> getOrigDateTimeProp xs
| [] -> ""
let getOriginalDateTime (path:string) =
let img = new Bitmap(path)
let propItems = img.PropertyItems
getOrigDateTimeProp (propItems |> Array.toList)
let renameFile (path:string) =
let newName = (getOriginalDateTime path |> changeTimeStampString) + Path.GetExtension(path)
printfn "%s -> %s" <| path <| newName
File.Move(path, newName)
let rec renameFiles (paths:string list) =
match paths with
| x::xs -> match x with
| a when Regex.Match(a,#".+\.[jpg|JPG]").Success ->
renameFile x
renameFiles xs
| a when Regex.Match(a,#".+\.[mp4|MP4]").Success ->
printfn "this is an mp4"
renameFiles xs
| _ -> renameFiles xs
| [] -> ignore
[<EntryPoint>]
let main args=
renameFiles (args |> Array.toList)
0
Looking at the actual bytes of the EXIF tag value
printfn "%A" <| x.Value
shows this:
[|50uy; 48uy; 49uy; 56uy; 58uy; 48uy; 51uy; 58uy; 48uy; 51uy; 32uy; 49uy; 53uy; 58uy; 51uy; 50uy; 58uy; 52uy; 48uy; 0uy|]
The last character is null. Removing that makes the file name valid. Thanks #FyodorSoikin for pointing me in the right direction.
Related
F# 6.0.3
I have seen some solutions on Google that are close to what I need; but being a Newbie I can't quite get how to use bind and map to get the solution.
I have many working procedures of the following format:
Example #1:
let saveAllDiagnosis =
let savealldiagnosis = match m.Encounter with
| None -> failwith "No encounter found"
| Some e -> match e.EncounterId with
| None -> failwith "No Encounter id found"
| Some id -> m.AllDiagnosisList
|> List.iter ( fun dx -> match dx.Key with
| None -> ()
| Some k -> Async.RunSynchronously (editAllDiagnosisInPreviousEncountersAsync id dx))
savealldiagnosis
Example #2
let saveEncounterDiagnosis =
let savedx = match m.Encounter with
| None -> failwith "No encounter found"
| Some e -> match e.EncounterId with
| None -> failwith "No Encounter id found"
| Some id -> m.BillingDiagnosisList |> List.iter ( fun dx -> Async.RunSynchronously (saveDxAsync id dx))
savedx
As can be seen, these are nested methods with almost identical behavior--differing only in the async procedure being called and the initializing list. What I would like to do is something along the lines of:
let runProcedures (fn: Model->Async) Model = ????
That is, a single procedue that encapsulates everything except the Async method and it's parameters but manages all the "None"s in a better way.
I hope my intent is clear.
TIA
If you are happy with using exceptions, then you do not even need railway-oriented programming (ROP). ROP is useful for more complex validation tasks, but I think exceptions are often perfectly reasonable and easy way of handling errors. In your case, you could define a helper that extracts a value of option<'T> or fails with a given error message:
let orFailWith msg opt =
match opt with
| Some v -> v
| None -> failwithf "%s" msg
Using this, you can then rewrite your code as follows:
let saveAllDiagnosis =
let e = m.Encounter |> orFailWith "No encounter found"
let id = e.EncounterId |> orFailWith "No Encounter id found"
for dx in m.AllDiagnosisList do
dx.Key |> Option.iter (fun k ->
editAllDiagnosisInPreviousEncountersAsync id dx |> Async.RunSynchronously)
let saveEncounterDiagnosis =
let e = m.Encounter |> orFailWith "No encounter found"
let id = e.EncounterId |> orFailWith "No Encounter id found"
for dx in m.BillingDiagnosisList do
saveDxAsync id dx |> Async.RunSynchronously
As I do not know the broader context of this, it is hard to say more - your code is imperative, but that may be perfectly fine if you are following the sandwich pattern.
Using mentioned ROP code can be rewritten as such. Result is used to track error and throw it at the end of pipeline. With current design is possible to avoid exceptions by just logging error instead of throwing at before last line.
type Encounter = { EncounterId : int option }
type Diagnostic = { Key : int option }
type Thing = {
Encounter : Encounter option
AllDiagnosisList : Diagnostic list
}
let editAllDiagnosisInPreviousEncountersAsync id diag = async { return () }
module Result =
let ofOption err opt =
match opt with
| Some v -> Ok v
| None -> Error err
let join res =
match res with
| Error v
| Ok v -> v
let saveAllDiagnosis m =
m.Encounter
|> Result.ofOption "No encounter found" // get value from option or log error
|> Result.map (fun e -> e.EncounterId)
|> Result.bind (Result.ofOption "No Encounter id found") // get EncounterId or log error
|> Result.map (fun id -> (
m.AllDiagnosisList
|> Seq.where (fun dx -> dx.Key.IsSome)
|> Seq.iter (fun dx -> Async.RunSynchronously (editAllDiagnosisInPreviousEncountersAsync id dx))
))
|> Result.mapError failwith // throw error
|> Result.join // Convert Result<unit, unit> into unit
The solutions posted above are very helpful to this newbie. But adding my own two cents worth, I going with this:
let _deleteDxFromEncounterAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = deleteDxFromEncounterAsync encounterId dx.Description
let _deleteDxFromAllPreviousEncountersAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = deleteDxFromAllPreviousEncountersAsync encounterId dx.Description
let _saveDxAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = saveDxAsync encounterId dx
let _editAllDiagnosisInPreviousEncountersAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = editAllDiagnosisInPreviousEncountersAsync encounterId dx
let listchk (dxs:Diagnosis list) : Diagnosis list option =
match dxs with
| [] -> None
| _ -> Some dxs
let _save (fn:int -> Diagnosis-> Async<unit>) (dxs:Diagnosis list) : unit =
match dxs |> listchk, m.Encounter |> Option.bind (fun v -> v.EncounterId) with
| Some dxs, Some id -> dxs |> List.iter (fun dx -> Async.RunSynchronously(fn id dx))
| _,_ -> failwith "Missing Encounter or EncounterId or Empty List"
m.DeletedBillingDiagnosis |>_save _deleteDxFromEncounterAsync
m.DeletedAllDiagnosis |>_save _deleteDxFromAllPreviousEncountersAsync
m.BillingDiagnosisList |>_save _saveDxAsync
m.AllDiagnosisList |> List.filter (fun dx -> dx.Key.IsSome) |>_save _editAllDiagnosisInPreviousEncountersAsync
For speed, in the future, I will probably have the Async functions act on the entire list at one time rather then one item; but for now, this code comes closest to my intent in asking the question. IMPROVEMENTS AND CRITISM IS GLADDLY APPRECIATED! F# is fun!
Thanks to all.
The following string is not a valid file name.
"File name\r\n\t\t\t\t\r\n\t\t\t\t (Revised 2018-05-31 15:35:41.16).txt"
The following code converts it to a valid file name.
let fn = """File name
(Revised 2018-05-31 15:35:41.16).txt""";;
let invalid = System.IO.Path.GetInvalidFileNameChars();;
String.Join("",
fn |> Seq.filter(fun x ->
not (Array.exists (fun y -> y = x) invalid)
)
)
// "File name (Revised 2018-05-31 153541.16).txt"
It just removes these invalid characters. How to convert these invalid to a _? For these multiple consequent invalid characters, I want them to be replaced to only one _. So the expected result should be
"File name_ (Revised 2018-05-31 15_35_41.16).txt"
This should work:
open System.Text.RegularExpressions
let normalizeFileName name =
let invalidPattern =
System.IO.Path.GetInvalidFileNameChars()
|> Seq.map (string >> Regex.Escape)
|> String.concat ""
|> sprintf "[%s]+"
Regex.Replace(name, invalidPattern, "_")
How can I get get a list of names visible in the scope with FSC?
I tried this:
#r "../../packages/FSharp.Compiler.Service.16.0.2/lib/net45/FSharp.Compiler.Service.dll"
open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.SourceCodeServices
do
let file = "TestFileName.fsx"
let checker = SourceCodeServices.FSharpChecker.Create()
let code =
"""
let testStr = "x"
t
"""
async{
let! options, _ = checker.GetProjectOptionsFromScript(file,code)
let! parseRes,checkAnser = checker.ParseAndCheckFileInProject(file, 0, code, options)
match checkAnser with
| FSharpCheckFileAnswer.Succeeded checkRes ->
let! decls =
checkRes.GetDeclarationListInfo(
Some parseRes, //ParsedFileResultsOpt
3 , //line
1 , //colAtEndOfPartialName
"t" , //lineText
[ "t" ] , //qualifyingNames
"" , //partialName
( fun _ -> [] ) //getAllSymbols: (unit -> AssemblySymbol list)
)
if Seq.isEmpty decls.Items then
printfn "*no declarations found*"
else
decls.Items
|> Seq.sortBy (fun d -> d.Name)
|> Seq.truncate 10
|> Seq.iter (fun d -> printfn "decl: %s" d.Name)
| _ -> failwithf "*Parsing did not finish... "
} |> Async.RunSynchronously
but it only prints "no declarations found". I would expect not only testStr but also all the other names that are available by default.
I did not find an example in the documentation.
qualifyingNames should be an empty list, it’s for dot separated prefix, excluding the last (possibly partial) ident. However, there is no a method in FCS that returns unfiltered list of names for scope, yet it’s really easy to add one.
With the answer of vasily-kirichenko and using the current FCS 17.0.1 I came up with this solution:
#r "../../packages/FSharp.Compiler.Service.17.0.1/lib/net45/FSharp.Compiler.Service.dll"
open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.SourceCodeServices
do
let file = "TestFileName.fsx"
let checker = SourceCodeServices.FSharpChecker.Create()
let code =
"""
let testStr = "x"
testStr.
"""
async{
let! options, _ = checker.GetProjectOptionsFromScript(file,code)
let! parseRes,checkAnser = checker.ParseAndCheckFileInProject(file, 0, code, options)
match checkAnser with
| FSharpCheckFileAnswer.Succeeded checkRes ->
let! decls =
let partialName = PartialLongName.Empty 6 //use any location before before the dot to get all declarations in scope
//let partialName = PartialLongName.Empty 7 //use the loacation of the dot (7) to get memebers of string
checkRes.GetDeclarationListInfo(
Some parseRes, // ParsedFileResultsOpt
3 , // line
"testStr." , // lineText
partialName, // PartialLongName
( fun _ -> [] ) // getAllSymbols: (unit -> AssemblySymbol list)
)
if Seq.isEmpty decls.Items then
printfn "*no declarations found*"
else
decls.Items
|> Seq.sortBy (fun d -> d.Name)
|> Seq.truncate 10
|> Seq.iter (fun d -> printfn "decl: %s" d.Name)
| _ -> failwithf "*Parsing did not finish... "
} |> Async.RunSynchronously
Is there a way to use F#'s sprintf float formating with a decimal comma? It would be nice if this worked:
sprintf "%,1f" 23.456
// expected: "23,456"
Or can I only use String.Format Method (IFormatProvider, String, Object()) ?
EDIT: I would like to have a comma not a point as a decimal separator. Like most non-English speaking countries use it.
It's quite a pain, but you can write your own version of sprintf that does exactly what you want:
open System
open System.Text.RegularExpressions
open System.Linq.Expressions
let printfRegex = Regex(#"^(?<text>[^%]*)((?<placeholder>%(%|((0|-|\+| )?([0-9]+)?(\.[0-9]+)?b|c|s|d|i|u|x|X|o|e|E|f|F|g|G|M|O|A|\+A|a|t)))(?<text>[^%]*))*$", RegexOptions.ExplicitCapture ||| RegexOptions.Compiled)
type PrintfExpr =
| K of Expression
| F of ParameterExpression * Expression
let sprintf' (c:System.Globalization.CultureInfo) (f:Printf.StringFormat<'a>) : 'a =
//'a has form 't1 -> 't2 -> ... -> string
let cultureExpr = Expression.Constant(c) :> Expression
let m = printfRegex.Match(f.Value)
let prefix = m.Groups.["text"].Captures.[0].Value
let inputTypes =
let rec loop t =
if Reflection.FSharpType.IsFunction t then
let dom, rng = Reflection.FSharpType.GetFunctionElements t
dom :: loop rng
else
if t <> typeof<string> then
failwithf "Unexpected return type: %A" t
[]
ref(loop typeof<'a>)
let pop() =
let (t::ts) = !inputTypes
inputTypes := ts
t
let exprs =
K(Expression.Constant(prefix)) ::
[for i in 0 .. m.Groups.["placeholder"].Captures.Count - 1 do
let ph = m.Groups.["placeholder"].Captures.[i].Value
let text = m.Groups.["text"].Captures.[i+1].Value
// TODO: handle flags, width, precision, other placeholder types, etc.
if ph = "%%" then yield K(Expression.Constant("%" + text))
else
match ph with
| "%f" ->
let t = pop()
if t <> typeof<float> && t <> typeof<float32> then
failwithf "Unexpected type for %%f placeholder: %A" t
let e = Expression.Variable t
yield F(e, Expression.Call(e, t.GetMethod("ToString", [| typeof<System.Globalization.CultureInfo> |]), [cultureExpr]))
| "%s" ->
let t = pop()
if t <> typeof<string> then
failwithf "Unexpected type for %%s placeholder: %A" t
let e = Expression.Variable t
yield F(e, e)
| _ ->
failwithf "unhandled placeholder: %s" ph
yield K (Expression.Constant text)]
let innerExpr =
Expression.Call(typeof<string>.GetMethod("Concat", [|typeof<string[]>|]), Expression.NewArrayInit(typeof<string>, exprs |> Seq.map (fun (K e | F(_,e)) -> e)))
:> Expression
let funcConvert =
typeof<FuncConvert>.GetMethods()
|> Seq.find (fun mi -> mi.Name = "ToFSharpFunc" && mi.GetParameters().[0].ParameterType.GetGenericTypeDefinition() = typedefof<Converter<_,_>>)
let body =
List.foldBack (fun pe (e:Expression) ->
match pe with
| K _ -> e
| F(p,_) ->
let m = funcConvert.MakeGenericMethod(p.Type, e.Type)
Expression.Call(m, Expression.Lambda(m.GetParameters().[0].ParameterType, e, p))
:> Expression) exprs innerExpr
Expression.Lambda(body, [||]).Compile().DynamicInvoke() :?> 'a
sprintf' (Globalization.CultureInfo.GetCultureInfo "fr-FR") "%s %f > %f" "It worked!" 1.5f -12.3
Taking a look at source code of Printf module, it uses invariantCulture. I don't think printf-like functions are culture aware.
If you always need a comma, you could use sprintf and string.Replace function. If your code is culture-dependent, using ToString or String.Format is your best bet.
let useConnection expr =
let Expr(conn : MySqlConnection) =
try
try
conn.Open()
with
| :? MySqlException as ex
-> printfn "Exception! %s" ex.Message
expr(conn)
finally
try
conn.Close() |> ignore
with
| :? MySqlException as ex
-> printfn "Exception! %s" ex.Message
using (new MySqlConnection(ConnectionString =
"server = " + MySQLServer + ";
uid = " + MySQLUID + ";
pwd = " + MySQLPW + ";
database = " + MySQLDB + ";
Charset=utf8;")) Expr
member x.reportToDB (msg:string) =
useConnection // <--- SO HERE I WANT TO KNOW WHAT IS conn
(let cmd = new MySqlCommand(Connection = conn)
cmd.CommandText <- ("insert into "+MySQLTable+"(system,dt,logMessage);")
ignore <| cmd.Parameters.AddWithValue("?system", Net.Dns.GetHostName())
ignore <| cmd.Parameters.AddWithValue("?dt", DateTime.Now.ToString() )
ignore <| cmd.Parameters.AddWithValue("?logMessage", msg )
try
try
cmd.ExecuteNonQuery() |> ignore
with
| :? MySqlException as ex when ex.Message.Contains("Duplicate entry")
-> printfn "MySQL Duplicate entry Exception: discarding the data set! %s" ex.Message
printfn ""
| :? MySqlException as ex
-> printfn "MySQL Exception, requeing data set and trying again later! %s" ex.Message
reraise()
with
| :? MySqlException as ex
-> printfn "Exception! %s" ex.Message)
It's hard to explain but I want to use delegate conn from useConnection to x.reportToDB , how can I do it ?
thank you.
#Tim Robinson , yes I don't know about conn there and that is a problem I want to solve,
why you think that lambda is bad idea here ?
useConnection appears to want a function that takes a MySqlConnection. It supplies this function with the connection object that you want.
The fix is:
useConnection (fun conn (* here's your connection *) ->
let cmd = new MySqlCommand(Connection = conn)
// etc.
Edit: It's maybe clearer with type annotations added to the useConnection function:
let useConnection (expr : MySqlConnection -> 'a) : 'a =
let Expr(conn : MySqlConnection) : 'a =
// etc.