Upgrade the logger component
authorGreg Burri <greg.burri@gmail.com>
Fri, 26 Mar 2021 20:52:36 +0000 (21:52 +0100)
committerGreg Burri <greg.burri@gmail.com>
Fri, 26 Mar 2021 20:52:36 +0000 (21:52 +0100)
14 files changed:
Parasitemia/Logger/ConsoleWriter.fs [new file with mode: 0644]
Parasitemia/Logger/Constants.fs [new file with mode: 0644]
Parasitemia/Logger/FileWriter.fs [new file with mode: 0644]
Parasitemia/Logger/Interfaces.fs [new file with mode: 0644]
Parasitemia/Logger/Listeners.fs [new file with mode: 0644]
Parasitemia/Logger/Logger.fs
Parasitemia/Logger/Logger.fsproj
Parasitemia/Logger/Readme.md [new file with mode: 0644]
Parasitemia/Logger/Types.fs [new file with mode: 0644]
Parasitemia/Logger/Utils.fs [new file with mode: 0644]
Parasitemia/ParasitemiaUI/Analysis.fs
Parasitemia/ParasitemiaUI/ParasitemiaUI.fsproj
Parasitemia/ParasitemiaUI/Program.fs
Parasitemia/ParasitemiaUI/Types.fs

diff --git a/Parasitemia/Logger/ConsoleWriter.fs b/Parasitemia/Logger/ConsoleWriter.fs
new file mode 100644 (file)
index 0000000..f453abb
--- /dev/null
@@ -0,0 +1,26 @@
+namespace Logger
+
+open System
+open System.Threading
+
+open Logger.Types
+
+type internal ConsoleWriter () =
+
+    interface IWriter with
+        member val DebugLoggingEnabled = false with get, set
+        member val AvoidRepeatingIdenticalMessages = false with get, set // Not implemented: TODO.
+
+        member this.LogDir = "" // Not relevant.
+        member val MaxSizeFile = 0L with get, set // Not relevant.
+        member this.LogFiles = Seq.empty // Not relevant.
+
+        member this.Write (message : Message) =
+            let header = Utils.formatHeader message
+            Console.WriteLine (Utils.formatMessage header message.Message)
+
+        member this.Flush () = () // Not relevant.
+        member this.ClearLogFilesOlderThan (timeOld : TimeSpan) = () // Not relevant.
+
+    interface IDisposable with
+        member this.Dispose () = ()
\ No newline at end of file
diff --git a/Parasitemia/Logger/Constants.fs b/Parasitemia/Logger/Constants.fs
new file mode 100644 (file)
index 0000000..339ac07
--- /dev/null
@@ -0,0 +1,22 @@
+module internal Logger.Constants
+
+open System.Text
+open System.Text.RegularExpressions
+
+let [<Literal>] DEFAULT_MAX_SIZE_FILE = 52428800L // [byte] (50 MB).
+
+// Each 100 entries added we check the size of the log file to test if it is greater than 'MAX_SIZE_FILE'.
+let [<Literal>] NB_ENTRIES_CHECK_SIZE = 100;
+
+let [<Literal>] MAX_NB_OF_MESSAGE_HASHES_WHEN_AVOIDING_REPEATING_IDENTICAL_MESSAGES = 10;
+let [<Literal>] MIN_MESSAGE_LENGTH_TO_NOT_BE_REPEATED = 40;
+
+let [<Literal>] COMPRESS_ARCHIVED_FILES = true
+
+let [<Literal>] FILENAME_FORMAT = "{0:D4}.log"
+let [<Literal>] COMPRESSED_FILE_POSTFIX = ".gzip"
+let FILENAME_PATTERN = Regex @"\d{4}\.log"
+let FILENAME_PATTERN_COMPRESSED = Regex (string FILENAME_PATTERN + COMPRESSED_FILE_POSTFIX.Replace (".", @"\."))
+let encoding = Encoding.GetEncoding "UTF-8"
+let [<Literal>] DEFAULT_LOG_DIR = "log"
+
diff --git a/Parasitemia/Logger/FileWriter.fs b/Parasitemia/Logger/FileWriter.fs
new file mode 100644 (file)
index 0000000..4183237
--- /dev/null
@@ -0,0 +1,187 @@
+namespace Logger
+
+open System
+open System.Collections.Generic
+open System.IO
+open System.Reflection
+open System.Threading
+
+open Logger.Constants
+open Logger.Types
+
+type internal FileWriter (logDir : string) =
+    let mutable maxSizeFile = DEFAULT_MAX_SIZE_FILE
+    let mutable stream : StreamWriter = null
+    let mutable filename : string = null
+
+    let mutable avoidRepeatingIdenticalMessages : bool = false
+    let lastMessageHashes = Queue<int * DateTime> ()
+
+    do
+        try
+            if not <| Directory.Exists logDir then
+                Directory.CreateDirectory logDir |> ignore
+        with
+        | _ -> Console.Error.WriteLine ("Unable to create the log directory: {0}", logDir)
+
+    // Open a file to log into. Each file has a number ('entryNumber').
+    let openLogFile (entryNumber : int64) =
+        if not (isNull logDir) then
+            try
+                if isNull stream || (entryNumber % (int64 NB_ENTRIES_CHECK_SIZE) = 0L) && stream.BaseStream.Length > maxSizeFile then
+                    if not (isNull stream) then
+                        stream.Close ()
+                        if COMPRESS_ARCHIVED_FILES then
+                            Utils.compress filename
+                            File.Delete filename
+
+                    // Search the last id among the log files.
+                    let mutable n = 1
+                    for existingFile in Directory.GetFiles logDir do
+                        match Utils.extractNumberFromLogfilepath existingFile with
+                        | Some n' when n' > n -> n <- n'
+                        | _ -> ()
+
+                    filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n))
+                    try
+                        if File.Exists (filename + COMPRESSED_FILE_POSTFIX) || (FileInfo filename).Length > maxSizeFile then
+                            filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n + 1))
+                    with
+                    | :? FileNotFoundException -> () // The file may not exist.
+
+                    let fileStream = File.Open (filename, FileMode.Append, FileAccess.Write, FileShare.Read)
+                    stream <- new StreamWriter (fileStream, encoding)
+            with
+            | ex -> Console.Error.WriteLine ("Can't open the file log: {0}", ex)
+
+    let write (msg : Message) (entryNumber : int64) =
+        openLogFile entryNumber
+
+        let header = Utils.formatHeader msg
+
+        if not <| isNull stream then
+            try
+                let writeAndFlush (header : string) (message : string) =
+                    stream.WriteLine (Utils.formatMessage header message)
+                    stream.Flush ()
+
+                if avoidRepeatingIdenticalMessages && msg.Message.Length > Constants.MIN_MESSAGE_LENGTH_TO_NOT_BE_REPEATED then
+                    let newMessageHash = hash msg.Message
+                    match lastMessageHashes |> Seq.tryPick (fun (hash, dateTime) -> if hash = newMessageHash then Some dateTime else None) with
+                    | Some dateTime ->
+                        writeAndFlush header (String.Format ("<Same as {0:yyyy-MM-dd HH:mm:ss.fff}>", dateTime))
+                    | None ->
+                        lastMessageHashes.Enqueue (hash msg.Message, msg.DateTime)
+                        if lastMessageHashes.Count > Constants.MAX_NB_OF_MESSAGE_HASHES_WHEN_AVOIDING_REPEATING_IDENTICAL_MESSAGES then
+                            lastMessageHashes.Dequeue () |> ignore
+                        writeAndFlush header msg.Message
+                else
+                    writeAndFlush header msg.Message
+            with
+            | :? IOException as ex -> Console.Error.WriteLine ("Unable to write to the log file: {0}", ex)
+
+    let closeCurrentStream () =
+        if not <| isNull stream then
+            stream.Dispose ()
+            stream <- null
+
+    let logFiles () =
+        Directory.EnumerateFiles logDir
+        |> Seq.filter (fun file -> FILENAME_PATTERN.IsMatch file || FILENAME_PATTERN_COMPRESSED.IsMatch file)
+        |> Seq.sort
+
+    let clearLogFiles (timeOld : TimeSpan) =
+        closeCurrentStream ()
+
+        for file in logFiles () do
+            let fileInfo = FileInfo file
+            if fileInfo.LastWriteTime.Add timeOld <= DateTime.Now then
+                // Special case for 0001.log to keep the file opened in text editor (developer convenience)
+                if fileInfo.Name = String.Format (FILENAME_FORMAT, 1) then
+                    File.WriteAllText (file, "")
+                else
+                    fileInfo.Delete ()
+
+    let logInternalErrorMessage (message : string) (entryNumber : int64) =
+        write
+            {
+                Message = sprintf "Logger internal error: %s" message
+                ThreadName = Thread.CurrentThread.Name
+                ThreadId = Thread.CurrentThread.ManagedThreadId
+                ModuleCaller = Assembly.GetExecutingAssembly().GetName().Name
+                Severity = Severity.ERROR
+                DateTime = TimeZone.CurrentTimeZone.ToLocalTime DateTime.UtcNow
+            }
+            entryNumber
+
+    let mailbox =
+        new MailboxProcessor<Command> (
+            fun inbox ->
+                let rec loop (nbEntries : int64) =
+                    async {
+                        try
+                            let! command = inbox.Receive ()
+                            match command with
+                            | Write message ->
+                                write message nbEntries
+                                return! loop (nbEntries + 1L)
+
+                            | Flush replyChannel ->
+                                replyChannel.Reply ()
+                                return! loop nbEntries
+
+                            | Shutdown replyChannel ->
+                                closeCurrentStream ()
+                                replyChannel.Reply ()
+
+                            | ClearLogFilesOlderThan timeOld ->
+                                clearLogFiles timeOld
+                                return! loop 1L
+
+                            | SetAvoidRepeatingIdenticalMessage enabled ->
+                                avoidRepeatingIdenticalMessages <- enabled
+                                if not avoidRepeatingIdenticalMessages then
+                                    lastMessageHashes.Clear ()
+                                return! loop nbEntries
+                        with
+                        | ex ->
+                            logInternalErrorMessage (string ex) nbEntries
+                            return! loop (nbEntries + 1L)
+                    }
+                loop 1L
+        )
+
+    do
+        mailbox.Start ()
+
+    interface IWriter with
+        member val DebugLoggingEnabled = false with get, set
+
+        member this.AvoidRepeatingIdenticalMessages
+            with get () = avoidRepeatingIdenticalMessages
+            and set value = mailbox.Post (SetAvoidRepeatingIdenticalMessage value)
+
+        member this.LogDir = logDir
+
+        member this.MaxSizeFile
+            with get () = maxSizeFile
+            and set value = maxSizeFile <- value
+
+        member this.LogFiles = logFiles ()
+
+        member this.Write (message : Message) =
+            mailbox.Post (Write message)
+
+        member this.Flush () =
+            mailbox.PostAndReply (fun replyChannel -> Flush replyChannel)
+
+        member this.ClearLogFilesOlderThan (timeOld : TimeSpan) =
+            mailbox.Post (ClearLogFilesOlderThan timeOld)
+
+    interface IDisposable with
+        member this.Dispose () =
+            mailbox.PostAndReply (
+                fun replyChannel ->
+                    Shutdown replyChannel
+            )
+            (mailbox :> IDisposable).Dispose()
\ No newline at end of file
diff --git a/Parasitemia/Logger/Interfaces.fs b/Parasitemia/Logger/Interfaces.fs
new file mode 100644 (file)
index 0000000..668ae54
--- /dev/null
@@ -0,0 +1,23 @@
+namespace Logger
+
+open System
+
+open Logger.Types
+
+/// <summary>
+/// Interface for log listeners
+/// </summary>
+type IListener =
+    abstract NewEntry : severity : Severity -> header : string -> message : string -> unit
+
+type internal IWriter =
+    inherit IDisposable
+
+    abstract DebugLoggingEnabled : bool with get, set
+    abstract AvoidRepeatingIdenticalMessages : bool with get, set
+    abstract LogDir : string
+    abstract MaxSizeFile : int64 with get, set
+    abstract LogFiles : string seq
+    abstract Write : message:Message -> unit
+    abstract Flush : unit -> unit
+    abstract ClearLogFilesOlderThan : TimeSpan -> unit
\ No newline at end of file
diff --git a/Parasitemia/Logger/Listeners.fs b/Parasitemia/Logger/Listeners.fs
new file mode 100644 (file)
index 0000000..8c5c835
--- /dev/null
@@ -0,0 +1,32 @@
+namespace Logger
+
+open System.Collections.Generic
+
+open Logger.Types
+
+type internal Listeners () =
+    let monitor = obj ()
+
+    let listeners = List<IListener> ()
+
+    member this.Add (listener : IListener) =
+        lock monitor (
+            fun () ->
+                if not <| listeners.Contains listener then
+                    listeners.Add listener
+        )
+
+    member this.Remove (listener : IListener) =
+        lock monitor (
+            fun () ->
+                listeners.Remove listener |> ignore
+        )
+
+    member this.NewEntry (message : Message) =
+        lock monitor (
+            fun () ->
+                if listeners.Count > 0 then
+                    let header = Utils.formatHeader message
+                    for listener in listeners do
+                        listener.NewEntry message.Severity header message.Message
+        )
\ No newline at end of file
index 7d54843..b964517 100644 (file)
 namespace Logger
 
 open System
-open System.Text
-open System.IO
-open System.IO.Compression
 open System.Diagnostics
+open System.IO
 open System.Threading
-open System.Collections.Generic
-
-type Severity = DEBUG = 1 | INFO = 2 | WARNING = 3 | ERROR = 4 | FATAL = 5
-
-type IListener =
-    abstract NewEntry : severity : Severity -> header : string -> message : string -> unit
-
-type private Message =
-    {
-        Message : string
-        ThreadName : string
-        ThreadId : int
-        ModuleCaller : string
-        Severity : Severity
-    }
 
-type private Command =
-    | Write of Message
-    | Stop of AsyncReplyChannel<unit>
+open Logger
+open Logger.Types
 
 [<Sealed>]
 type Log () =
+    static let mutable writer : IWriter = new ConsoleWriter () :> IWriter
+    static let monitor = obj ()
+    static let listeners = Listeners ()
 
-    let extractNumberFromLogfilepath (path : string) : int option =
-        if isNull path then
-            None
-        else
-            let filename = path.Substring (path.LastIndexOf Path.DirectorySeparatorChar + 1)
-            let filenameWithoutExtension = filename.Remove (filename.IndexOf '.')
-            match Int32.TryParse filenameWithoutExtension with
-            | (true, n) -> Some n
-            | _ -> None
-
-    let [<Literal>] MAX_SIZE_FILE = 52428800L // [byte] (50 MB).
-    let [<Literal>] NB_ENTRIES_CHECK_SIZE = 100; // Each 100 entries added we check the size of the log file to test if it is greater than 'MAX_SIZE_FILE'.
-    let [<Literal>] COMPRESS_ARCHIVED_FILES = true
-    let [<Literal>] FILENAME_FORMAT = "{0:D4}.log"
-    let [<Literal>] COMPRESSED_FILE_POSTFIX = ".gzip"
-    let encoding = Encoding.GetEncoding "UTF-8"
-
-    let compress (filename : string) =
-        use inputStream = new FileStream (filename, FileMode.Open, FileAccess.Read)
-        let filenameCompressed = filename + COMPRESSED_FILE_POSTFIX
-        use compressedStream = new GZipStream (new FileStream (filenameCompressed, FileMode.Create, FileAccess.Write), CompressionLevel.Optimal)
-        inputStream.CopyTo compressedStream
-
-    let moduleName = System.Diagnostics.StackFrame(1).GetMethod().Module.Name
-
-    let mutable stream : StreamWriter = null
-    let mutable filename : string = null
-
-    let mutable logDir : string = null
-
-    let monitor = Object ()
-
-    let listeners = List<IListener> ()
-
-    let debug =
-#if DEBUG
-        true
-#else
-        false
-#endif
-
-    static let instance = new Log ()
-
-    let openLogFile (entryNumber : int64) =
-        if not (isNull logDir) then
-            try
-                if isNull stream || (entryNumber % (int64 NB_ENTRIES_CHECK_SIZE) = 0L) && stream.BaseStream.Length > MAX_SIZE_FILE
-                then
-                    if not (isNull stream)
-                    then
-                        stream.Close ()
-                        if COMPRESS_ARCHIVED_FILES then
-                            compress filename
-                            File.Delete filename
-
-                    // Search the last id among the log files.
-                    let mutable n = 1
-                    for existingFile in Directory.GetFiles logDir do
-                        match extractNumberFromLogfilepath existingFile with
-                        | Some n' when n' > n -> n <- n'
-                        | _ -> ()
-
-                    filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n))
-                    try
-                        if File.Exists (filename + COMPRESSED_FILE_POSTFIX) || FileInfo(filename).Length > MAX_SIZE_FILE
-                        then
-                            filename <- Path.Combine (logDir, String.Format (FILENAME_FORMAT, n + 1))
-                    with
-                    | :? FileNotFoundException -> () // The file may not exist.
-
-                    stream <- new StreamWriter (filename, true, encoding)
-            with
-            | ex -> Console.Error.WriteLine ("Can't open the file log: {0}", ex)
-
-    let write (msg : Message) (entryNumber : int64) =
-        openLogFile entryNumber
-
-        let header =
-            String.Format (
-                "{0:yyyy-MM-dd HH:mm:ss.fff} [{1}] {{{2}}} ({3})",
-                DateTime.Now,
-                string msg.Severity,
-                msg.ModuleCaller,
-                (if String.IsNullOrEmpty msg.ThreadName then string msg.ThreadId else sprintf "%s-%i" msg.ThreadName msg.ThreadId)
+    /// <summary>
+    /// Must be called first before any other action.
+    /// </summary>
+    static member LogDirectory
+        with get () = lock monitor (fun () -> writer.LogDir)
+        and set value =
+            lock monitor (
+                fun () ->
+                    Log.Close ()
+                    if String.IsNullOrWhiteSpace value then
+                        writer <- new ConsoleWriter ()
+                    else
+                        writer <- new FileWriter (value)
             )
 
-        for listener in listeners do
-            listener.NewEntry msg.Severity header msg.Message
-
-        if not (isNull stream)
-        then
-            try
-                stream.WriteLine ("{0} : {1}", header, msg.Message)
-                stream.Flush ()
-            with
-            | :? IOException as ex -> Console.Error.WriteLine ("Unable to write to the log file: {0}", ex)
-
-    let writeAgent =
-        new MailboxProcessor<Command> (
-            fun inbox ->
-                let rec loop (nbEntries : int64) =
-                    async {
-                        let! command = inbox.Receive ()
-                        match command with
-                        | Write message ->
-                            write message nbEntries
-                            return! loop (nbEntries + 1L)
-                        | Stop replyChannel ->
-                            replyChannel.Reply ()
-                    }
-                loop 1L
+    /// <summary>
+    /// Close the log. 'LogDirectory' must be set again to reopen it.
+    /// </summary>
+    static member Close () =
+        lock monitor (
+             fun () ->
+                writer.Flush ()
+                (writer :> IDisposable).Dispose ()
+                writer <- new ConsoleWriter () :> IWriter
         )
 
-    do
-        writeAgent.Start ()
+    /// <summary>
+    /// Return all log files (the current one and the archived) as full paths.
+    /// </summary>
+    static member LogFiles = writer.LogFiles
 
-    let setLogDirectory (dir : string) =
-        lock monitor (
-            fun () ->
-                logDir <- dir
-
-                if not <| isNull stream then
-                    stream.Close ()
-                    stream <- null
-
-                try
-                    if not <| Directory.Exists logDir
-                    then
-                        Directory.CreateDirectory logDir |> ignore
-                with
-                | _ -> Console.Error.WriteLine ("Unable to create the log directory: {0}", logDir)
-       )
-
-    interface IDisposable with
-        member this.Dispose () =
-            if not (isNull stream)
-            then
-                stream.Dispose ()
-            (writeAgent :> IDisposable).Dispose ()
-
-    member private this.Write (message : string) (severity : Severity) =
-        let moduleNameCaller =
-            match StackTrace().GetFrames() |> Array.tryPick (fun frame -> let name = frame.GetMethod().Module.Name
-                                                                          if name <> moduleName then Some name else None) with
-            | Some name -> name
-            | _ -> moduleName
-
-        let command =
-            Write
-                {
-                    Message = message
-                    ThreadName = Thread.CurrentThread.Name
-                    ThreadId = Thread.CurrentThread.ManagedThreadId
-                    ModuleCaller = moduleNameCaller
-                    Severity = severity
-                }
-
-        writeAgent.Post command
-
-    /// <summary>
-    /// Will stop and wait a reply. Used to flush the remaining messages.
-    /// </summary>
-    member private this.Stop () =
-        writeAgent.PostAndReply (
-            fun replyChannel ->
-                Stop replyChannel
-        )
+    /// <summary>
+    /// Wait that all the previous messages are written.
+    /// </summary>
+    static member Flush () = writer.Flush ()
 
-    member this.LogDirectory
-        with get () = logDir
-        and set value = setLogDirectory value
+    static member DebugLoggingEnabled
+        with get () = writer.DebugLoggingEnabled
+        and set value = writer.DebugLoggingEnabled <- value
 
-    static member SetLogDirectory (dir : string) =
-        instance.LogDirectory <- dir
+    /// <summary>
+    /// Avoid to repeat a message by writting a reference to a previous message instead of the message.
+    /// 'false' by default.
+    /// </summary>
+    static member AvoidRepeatingIdenticalMessages
+        with get () = writer.AvoidRepeatingIdenticalMessages
+        and set value = writer.AvoidRepeatingIdenticalMessages <- value
 
-    member this.AddListener (listener : IListener) =
-        lock monitor (
-            fun () ->
-                if not <| listeners.Contains listener
-                then
-                    listeners.Add listener
-        )
+    /// <summary>
+    /// The maximum size of the current file log. If the file exceed this value it will be zipped and a new file will be created.
+    /// The file size is only tested each time a certain number of messages have been written so the file may exceed this value a bit.
+    /// </summary>
+    /// <param name="size"></param>
+    static member SetLogFilesMaxSize (size : int64) =
+        writer.MaxSizeFile <- size
 
-    member this.RmListener (listener : IListener) =
-        lock monitor (fun () -> listeners.Remove listener |> ignore)
+    static member ClearLogFilesOlderThan (timeOld : TimeSpan) =
+        writer.ClearLogFilesOlderThan timeOld
 
-    static member AddListener (listener : IListener) = instance.AddListener listener
-    static member RmListener (listener : IListener) = instance.RmListener listener
+    /// <summary>
+    /// Remove all archived log files and empty the current one.
+    /// </summary>
+    static member ClearLogFiles () =
+        Log.ClearLogFilesOlderThan (TimeSpan 0L)
+
+    /// <summary>
+    /// Total size in bytes.
+    /// </summary>
+    static member CurrentLogSize () : int64 =
+        Log.LogFiles
+        |> Seq.map (fun file -> try (FileInfo file).Length with | _ex -> 0L)
+        |> Seq.sum
+
+    static member AddListener (listener : IListener) =
+        listeners.Add listener
+
+    static member RemoveListener (listener : IListener) =
+        listeners.Remove listener
+
+    static member private Write (message : string) (severity : Severity) =
+        let msg =
+            {
+                Message = message
+                ThreadName = Thread.CurrentThread.Name
+                ThreadId = Thread.CurrentThread.ManagedThreadId
+                ModuleCaller = Utils.callerModuleName ()
+                Severity = severity
+                DateTime = TimeZone.CurrentTimeZone.ToLocalTime DateTime.UtcNow
+            }
+        listeners.NewEntry msg
+        writer.Write msg
 
+    /// <summary>
+    /// [F#] Execute the given function and measure its time.
+    /// </summary>
+    /// <param name="severity">Severity for writing to log</param>
+    /// <param name="f">Function to test</param>
+    /// <param name="format">Format string for output</param>
     static member LogWithTime (severity : Severity) (f : unit -> 'a) (format : Printf.StringFormat<'b, 'a>) : 'b =
         let sw = Stopwatch ()
         sw.Start ()
         let res = f ()
         sw.Stop ()
-        Printf.kprintf (fun s -> instance.Write (s + sprintf " (time: %d ms)" sw.ElapsedMilliseconds) severity; res) format
+        Printf.kprintf (fun s -> Log.Write (s + sprintf " (time: %d ms)" sw.ElapsedMilliseconds) severity; res) format
 
+    /// <summary>
+    /// [F#] Write Debug message to log (if DebugLoggingEnabled = true)
+    /// </summary>
     static member Debug format =
-#if DEBUG
-        Printf.kprintf (fun s -> instance.Write s Severity.DEBUG) format
-#else
-        Printf.kprintf (fun _ -> ()) format // TODO: can it be simplify?
-#endif
+        if writer.DebugLoggingEnabled then
+            Printf.kprintf (fun s -> Log.Write s Severity.DEBUG) format
+        else
+            // [BGR] FIXME: is it possible to simplify a bit here? It's more CPU consuming than the C# couterpart.
+            Printf.kprintf (fun _ -> ()) format
 
+    /// <summary>
+    /// [F#] Write Info message to log
+    /// </summary>
     static member Info format =
-        Printf.kprintf (fun s -> instance.Write s Severity.INFO) format
+        Printf.kprintf (fun s -> Log.Write s Severity.INFO) format
 
+    /// <summary>
+    /// [F#] Write Warning message to log
+    /// </summary>
     static member Warning format =
-        Printf.kprintf (fun s -> instance.Write s Severity.WARNING) format
+        Printf.kprintf (fun s -> Log.Write s Severity.WARNING) format
 
+    /// <summary>
+    /// [F#] Write Error message to log
+    /// </summary>
     static member Error format =
-        Printf.kprintf (fun s -> instance.Write s Severity.ERROR) format
+        Printf.kprintf (fun s -> Log.Write s Severity.ERROR) format
 
+    /// <summary>
+    /// [F#] Write Fatal message to log
+    /// </summary>
     static member Fatal format =
-        Printf.kprintf (fun s -> instance.Write s Severity.FATAL) format
+        Printf.kprintf (fun s -> Log.Write s Severity.FATAL) format
+
+    /// <summary>
+    /// Write DEBUG message to log (if DebugLoggingEnabled = true)
+    /// </summary>
+    static member DEBUG (message : string, [<ParamArray>] args : obj array) =
+        if writer.DebugLoggingEnabled then
+            if isNull args || args.Length = 0 then
+                Log.Write message Severity.DEBUG
+            else
+                Log.Write (String.Format (message, args)) Severity.DEBUG
+
+    /// <summary>
+    /// Write DEBUG message to log (if DebugLoggingEnabled = true)
+    /// </summary>
+    static member DEBUG (message : string) = Log.DEBUG (message, [| |])
 
-    static member Shutdown () =
-        instance.Stop ()
+    /// <summary>
+    /// Write INFO message to log
+    /// </summary>
+    static member  INFO (message : string, [<ParamArray>] args : obj array) =
+        if isNull args || args.Length = 0 then
+            Log.Write message Severity.INFO
+        else
+            Log.Write (String.Format (message, args)) Severity.INFO
+
+    /// <summary>
+    /// Write INFO message to log
+    /// </summary>
+    static member INFO (message : string) = Log.INFO (message, [| |])
+
+    /// <summary>
+    /// Write WARNING message to log
+    /// </summary>
+    static member WARNING (message : string, [<ParamArray>] args : obj array) =
+        if isNull args || args.Length = 0 then
+            Log.Write message Severity.WARNING
+        else
+            Log.Write (String.Format (message, args)) Severity.WARNING
+
+    /// <summary>
+    /// Write WARNING message to log
+    /// </summary>
+    static member WARNING (message : string) = Log.WARNING (message, [| |])
+
+    /// <summary>
+    /// Write ERROR message to log
+    /// </summary>
+    static member ERROR (message : string, [<ParamArray>] args : obj array) =
+        if isNull args || args.Length = 0 then
+            Log.Write message Severity.ERROR
+        else
+            Log.Write (String.Format (message, args)) Severity.ERROR
+
+    /// <summary>
+    /// Write ERROR message to log
+    /// </summary>
+    static member ERROR (message : string) = Log.ERROR (message, [| |])
+
+    /// <summary>
+    /// Write FATAL message to log
+    /// </summary>
+    static member FATAL (message : string, [<ParamArray>] args : obj array) =
+        if isNull args || args.Length = 0 then
+            Log.Write message Severity.FATAL
+        else
+            Log.Write (String.Format (message, args)) Severity.FATAL
+
+    /// <summary>
+    /// Write FATAL message to log
+    /// </summary>
+    static member FATAL (message : string) = Log.FATAL (message, [| |])
\ No newline at end of file
index 618ff42..58258bb 100644 (file)
@@ -6,7 +6,13 @@
   </PropertyGroup>
 
   <ItemGroup>
-    <Compile Include="AssemblyInfo.fs" />
+    <Compile Include="Constants.fs" />
+    <Compile Include="Types.fs" />
+    <Compile Include="Interfaces.fs" />
+    <Compile Include="Utils.fs" />
+    <Compile Include="Listeners.fs" />
+    <Compile Include="ConsoleWriter.fs" />
+    <Compile Include="FileWriter.fs" />
     <Compile Include="Logger.fs" />
   </ItemGroup>
 
diff --git a/Parasitemia/Logger/Readme.md b/Parasitemia/Logger/Readme.md
new file mode 100644 (file)
index 0000000..59f7ac2
--- /dev/null
@@ -0,0 +1,42 @@
+# Logger
+
+Logger is a small component to log various messages to disk.
+
+
+## Features
+
+* Split log file after a certain size (50 MB) and zip old files.
+* Multi level logging: debug, info, warning, error, fatal
+* Log these informations:
+  * Date + time
+  * Level
+  * Caller assembly
+  * Thread name and its number
+  * Message
+
+## Usage
+
+Samples to log to a directory located in the user space:
+
+### F#
+
+~~~F#
+let userApplicationDirectory = System.IO.Path.Combine (System.Environment.GetFolderPath System.Environment.SpecialFolder.ApplicationData, "My Application")
+Log.LogDirectory <- System.IO.Path.Combine (userApplicationDirectory, "Log")
+
+let v = 42
+Log.Info "V equals %i" 42
+~~~
+
+### C#
+
+~~~C#
+var userApplicationDirectory = System.IO.Path.Combine(System.Environment.GetFolderPath(System.Environment.SpecialFolder.ApplicationData), "My Application");
+Log.LogDirectory = System.IO.Path.Combine(userApplicationDirectory, "Log");
+
+var v = 42;
+Log.INFO("V equals {0}", 42);
+~~~
+
+
+
diff --git a/Parasitemia/Logger/Types.fs b/Parasitemia/Logger/Types.fs
new file mode 100644 (file)
index 0000000..45a5a64
--- /dev/null
@@ -0,0 +1,24 @@
+namespace Logger.Types
+
+open System
+
+type Severity = DEBUG = 1 | INFO = 2 | WARNING = 3 | ERROR = 4 | FATAL = 5
+
+type internal Message =
+    {
+        Message : string
+        ThreadName : string
+        ThreadId : int
+        ModuleCaller : string
+        Severity : Severity
+        DateTime : DateTime
+    }
+
+type internal Command =
+    | Write of Message
+    | Shutdown of AsyncReplyChannel<unit>
+    | Flush of AsyncReplyChannel<unit>
+    | ClearLogFilesOlderThan of TimeSpan
+    | SetAvoidRepeatingIdenticalMessage of bool
+
+exception NoLogDirectoryDefinedException
\ No newline at end of file
diff --git a/Parasitemia/Logger/Utils.fs b/Parasitemia/Logger/Utils.fs
new file mode 100644 (file)
index 0000000..ba7f191
--- /dev/null
@@ -0,0 +1,52 @@
+module internal Logger.Utils
+
+open System
+open System.Diagnostics
+open System.IO
+open System.IO.Compression
+
+open Constants
+open Logger.Types
+
+let extractNumberFromLogfilepath (path : string) : int option =
+    if isNull path then
+        None
+    else
+        let filename = path.Substring (path.LastIndexOf Path.DirectorySeparatorChar + 1)
+        let filenameWithoutExtension = filename.Remove (filename.IndexOf '.')
+        match Int32.TryParse filenameWithoutExtension with
+        | (true, n) -> Some n
+        | _ -> None
+
+let compress (filename : string) =
+    use inputStream = new FileStream (filename, FileMode.Open, FileAccess.Read)
+    let filenameCompressed = filename + COMPRESSED_FILE_POSTFIX
+    use compressedStream = new GZipStream (new FileStream (filenameCompressed, FileMode.Create, FileAccess.Write), CompressionLevel.Optimal)
+    inputStream.CopyTo compressedStream
+
+let formatHeader (msg : Message) =
+    String.Format (
+        "{0:yyyy-MM-dd HH:mm:ss.fff} [{1}] {{{2}}} ({3})",
+        msg.DateTime,
+        string msg.Severity,
+        msg.ModuleCaller,
+        (if String.IsNullOrEmpty msg.ThreadName then sprintf "%2i" msg.ThreadId else sprintf "%s-%i" msg.ThreadName msg.ThreadId)
+    )
+
+let formatMessage (formatedHeader : string) (msg : string) =
+    String.Format ("{0} : {1}", formatedHeader, msg)
+
+let moduleName = (System.Diagnostics.StackFrame 1).GetMethod().Module.Name
+
+let callerModuleName () =
+    match
+        (
+            StackTrace().GetFrames ()
+            |> Array.tryPick (
+                fun frame ->
+                    let name = frame.GetMethod().Module.Name
+                    if name <> moduleName then Some name else None
+            )
+        ) with
+    | Some name -> name
+    | _ -> moduleName
\ No newline at end of file
index 928c15f..a1b253f 100644 (file)
@@ -181,7 +181,7 @@ let showWindow (parent : Window) (state : State.State) : bool =
 
     win.ShowDialog () |> ignore
 
-    Logger.Log.RmListener (logListener)
+    Logger.Log.RemoveListener (logListener)
 
     lock monitor (
         fun () ->
index 4e02997..1583816 100644 (file)
@@ -39,7 +39,7 @@
     <PackageReference Include="Emgu.CV.Bitmap" Version="4.5.1.4349" />
     <PackageReference Include="Emgu.CV.runtime.windows" Version="4.5.1.4349" />
     <PackageReference Include="FSharp.ViewModule.Core" Version="1.0.7" />
-    <PackageReference Include="Newtonsoft.Json" Version="12.0.3" />
+    <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
     <PackageReference Include="System.Drawing.Common" Version="5.0.2" />
   </ItemGroup>
 
index 63bd963..b3ca81d 100644 (file)
@@ -84,7 +84,7 @@ let main args =
 
                         let images = [ for file in files -> Path.GetFileNameWithoutExtension (FileInfo(file).Name), config.Copy (), new Image<Bgr, byte> (file) ]
 
-                        Log.LogWithTime Severity.INFO (
+                        Log.LogWithTime Types.Severity.INFO (
                             fun () ->
                                 match ParasitemiaCore.Analysis.doMultipleAnalysis images None with
                                 | Some results ->
@@ -98,7 +98,7 @@ let main args =
                                 Some ()
                         ) "Whole analyze" |> ignore
 
-                        Log.RmListener listener
+                        Log.RemoveListener listener
                         0
 
                     | Window fileToOpen ->
index 1da2dea..a98d7b0 100644 (file)
@@ -26,9 +26,8 @@ type PredefinedPPI =
         ppi : int<ppi>
         label : string
     }
-    with
-        override this.ToString () =
-            sprintf "%s: %d" this.label this.ppi
+    override this.ToString () =
+        sprintf "%s: %d" this.label this.ppi
 
 type SensorSize =
     {
@@ -36,9 +35,8 @@ type SensorSize =
         h : float<mm>
         label : string
     }
-    with
-        override this.ToString () =
-            sprintf "%g mm × %g mm%s" this.w this.h (if this.label = "" then "" else " (" + this.label + ")")
+    override this.ToString () =
+        sprintf "%g mm × %g mm%s" this.w this.h (if this.label = "" then "" else " (" + this.label + ")")
 
 let defaultPredefinedPPI =
     [