--- /dev/null
+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
--- /dev/null
+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"
+
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
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
</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>
--- /dev/null
+# 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);
+~~~
+
+
+
--- /dev/null
+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
--- /dev/null
+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
win.ShowDialog () |> ignore
- Logger.Log.RmListener (logListener)
+ Logger.Log.RemoveListener (logListener)
lock monitor (
fun () ->
<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>
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 ->
Some ()
) "Whole analyze" |> ignore
- Log.RmListener listener
+ Log.RemoveListener listener
0
| Window fileToOpen ->
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 =
{
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 =
[