wrap in try catch

src/Cron.fs

@@ -6,10 +6,6 @@ open Cronos
 open Pentole
 open Datatypes
 
-open Pentole.String
-open Pentole.Map
-open Pentole
-
 type PatternType = After of string
 
 type WhenExpr = | Cron of Instant | Pattern of PatternType

src/Grains.fs

@@ -5,117 +5,140 @@ open System.Threading
 open System.Threading.Tasks
 open NodaTime
 open System
+open Serilog.Events
 
 open Bidello.Datatypes
 open Bidello.Shell
 
+let try_ (lambda: (unit -> ValueTask)) (prefix: string) (level: LogEventLevel) =
+    try
+        lambda ()
+    with exn ->
+        let logger = Logging.logger
+        let msg = sprintf "%s - %s" prefix exn.Message
+        
+        match level with
+        | LogEventLevel.Verbose -> logger.Debug msg
+        | LogEventLevel.Debug -> logger.Debug msg
+        | LogEventLevel.Information -> logger.Information msg
+        | LogEventLevel.Warning -> logger.Warning msg
+        | LogEventLevel.Error -> logger.Error msg
+        | LogEventLevel.Fatal -> logger.Fatal msg
+        | _ -> logger.Fatal msg
+
+        ValueTask ()
+        
 
 type IShellGrain = 
     inherit IGrainWithIntegerKey
     abstract schedule: CancellationToken -> ChainOfJobs -> ValueTask
 
 
-
 type IDbGrain =
     inherit IGrainWithGuidKey
     abstract save_backlog: CancellationToken -> Instant * Instant -> CronJob -> RunResult -> ValueTask
 
 type DbGrain () =
     inherit Orleans.Grain ()
+    member _.save_backlog_ ct (start_: Instant, end_: Instant) (job: CronJob) rc =
+        let stdout = match rc with | Success stdout -> Some stdout | _ -> None
+
+        let code, stderr =
+            match rc with
+            | Failure (c, s) -> (Some c, Some s)
+            | Success _ -> (Some 0, None)
+            | _ -> (None, None)
+
+        let fmsg =
+            match rc with
+            | NoPermissionOnFolder -> Some "No permission on folder"
+            | NoPrivilegeToUser -> Some "No privilege to switch user"
+            | Unknown u -> Some $"Unknown failure '{u}'"
+            | _ -> None
+
+
+        let entry = {
+            started_at = start_.ToDateTimeUtc()
+            done_at = end_.ToDateTimeUtc()
+
+            stdout = stdout
+            stderr = stderr
+            exit_code = code
+            failure_msg = fmsg
+
+            job = job.info_string ()
+            hostname = job.hostname
+            job_name = job.job_name
+        }
+
+        let tsk = async {
+            use! db = Database.make_from_grain ct |> Async.AwaitTask
+            let! res = Database.write_to_backlog entry ct db |> Async.AwaitTask
+
+        return 
+            match res with
+            | Ok () -> ()
+            | Error msg -> Logging.logger.Fatal msg
+        }
+        tsk |> Async.StartAsTask |> ValueTask
+
 
     interface IDbGrain with
-        override _.save_backlog ct (start_, end_) (job: CronJob) rc =
+        override x.save_backlog ct (start_, end_) (job: CronJob) rc =
-          try
+            let lambda = fun () ->
-            let stdout = match rc with | Success stdout -> Some stdout | _ -> None
+                x.save_backlog_ ct (start_, end_) job rc
-
+            try_ lambda "DatabaseGrain" LogEventLevel.Fatal
-            let code, stderr =
-                match rc with
-                | Failure (c, s) -> (Some c, Some s)
-                | Success _ -> (Some 0, None)
-                | _ -> (None, None)
-
-            let fmsg =
-                match rc with
-                | NoPermissionOnFolder -> Some "No permission on folder"
-                | NoPrivilegeToUser -> Some "No privilege to switch user"
-                | Unknown u -> Some $"Unknown failure '{u}'"
-                | _ -> None
             
             
-            let entry = {
+let log (job: CronJob) = function
-                started_at = start_.ToDateTimeUtc()
+    | Success _stdout ->
-                done_at = end_.ToDateTimeUtc()
+        $"Action: {job.info_string()}, returned code = 0"
-
+        |> Logging.logger.Information
-                stdout = stdout
+    | Failure (rc, _stderr) ->
-                stderr = stderr
+        $"Action: {job.info_string()}, returned code = {rc}"
-                exit_code = code
+        |> Logging.logger.Error
-                failure_msg = fmsg
+    | NoShell reason ->
-
+        $"Can't call shell: {reason}"
-                job = job.info_string ()
+        |> Logging.logger.Fatal
-                hostname = job.hostname
+    | Unknown reason ->
-                job_name = job.job_name
+        $"Unknown exception in job runner: {reason}"
-            }
+        |> Logging.logger.Error
-
+    | NoPermissionOnFolder ->
-            let tsk = async {
+        $"Action: {job.info_string()}, failed because of insufficient permission on folder"
-               use! db = Database.make_from_grain ct |> Async.AwaitTask
+        |> Logging.logger.Fatal
-               let! res = Database.write_to_backlog entry ct db |> Async.AwaitTask
+    | NoPrivilegeToUser ->
-               
+        $"Action: {job.info_string()}, failed because insufficient permissions to run command as user"
-               return 
+        |> Logging.logger.Fatal
-                match res with
-                | Ok () -> ()
-                | Error msg -> Logging.logger.Fatal msg
-            }
-            tsk |> Async.StartAsTask |> ValueTask
-
-          with exn -> printfn "%A" exn; ValueTask ()
 
 
 type ShellGrain() =
     inherit Orleans.Grain ()
+    member x.schedule_ (ct) (jobs: ChainOfJobs) =
+
+        let db_actor = x.GrainFactory.GetGrain<IDbGrain>(Guid.NewGuid())
+
+        let rec run_ (hd: CronJob) (tl: CronJob list) = async {
+            let start_time = SystemClock.Instance.GetCurrentInstant ()
+            let! rc = run_job ct hd |> Async.AwaitTask
+            let end_time = SystemClock.Instance.GetCurrentInstant ()
+
+            log hd rc
+            db_actor.save_backlog ct (start_time, end_time) hd rc |> ignore
+
+            match tl with
+            | hd'::tl'-> return! run_ hd' tl'
+            | [] -> return ()
+        }
+
+        jobs.jobs
+        |> function | [] -> None | hd::tl -> Some (hd, tl)
+        |> Option.map (fun jobs ->
+                    let tsk = jobs ||> run_
+                    Async.StartAsTask (tsk, TaskCreationOptions.None, ct)
+                    |> ValueTask)
+        |> Option.defaultValue (ValueTask ())
 
     interface IShellGrain with
         member x.schedule (ct) (jobs: ChainOfJobs) =
-
+            let lambda = fun () -> x.schedule_ ct jobs
-            let db_actor = x.GrainFactory.GetGrain<IDbGrain>(Guid.NewGuid())
+            try_ lambda "ShellGrain" LogEventLevel.Error
-
-            let log (job: CronJob) = function
-                | Success _stdout ->
-                    $"Action: {job.info_string()}, returned code = 0"
-                    |> Logging.logger.Information
-                | Failure (rc, _stderr) ->
-                    $"Action: {job.info_string()}, returned code = {rc}"
-                    |> Logging.logger.Error
-                | NoShell reason ->
-                    $"Can't call shell: {reason}"
-                    |> Logging.logger.Fatal
-                | Unknown reason ->
-                    $"Unknown exception in job runner: {reason}"
-                    |> Logging.logger.Error
-                | NoPermissionOnFolder ->
-                    $"Action: {job.info_string()}, failed because of insufficient permission on folder"
-                    |> Logging.logger.Fatal
-                | NoPrivilegeToUser ->
-                    $"Action: {job.info_string()}, failed because insufficient permissions to run command as user"
-                    |> Logging.logger.Fatal
-
-            let rec run_ (hd: CronJob) (tl: CronJob list) = async {
-                let start_time = SystemClock.Instance.GetCurrentInstant ()
-                let! rc = run_job ct hd |> Async.AwaitTask
-                let end_time = SystemClock.Instance.GetCurrentInstant ()
-
-                log hd rc
-                db_actor.save_backlog ct (start_time, end_time) hd rc |> ignore
-                
-                match tl with
-                | hd'::tl'-> return! run_ hd' tl'
-                | [] -> return ()
-            }
-
-            jobs.jobs
-            |> function | [] -> None | hd::tl -> Some (hd, tl)
-            |> Option.map (fun jobs ->
-                        let tsk = jobs ||> run_
-                        Async.StartAsTask (tsk, TaskCreationOptions.None, ct)
-                        |> ValueTask)
-            |> Option.defaultValue (ValueTask ())
-(*TODO: try block?*)

src/LoggingHelpers.fs

@@ -1,118 +0,0 @@
-module Pentole.LoggingHelpers
-
-open System
-
-open Serilog
-open Serilog.Events
-open Serilog.Sinks.SystemConsole.Themes
-open Serilog.Sinks.File
-
-
-type Override =
-    | Verbose of string
-    | Debug of string
-    | Information of string
-    | Warning of string
-    | Error of string
-    | Fatal of string
-
-type Buffered = Yes | No
-type Shared = Yes | No
-type RollOnSizeLimit = Yes | No
-
-
-type FileConfiguration = {
-    path: string
-    level: LogEventLevel
-    template: string
-    format_provider: System.IFormatProvider
-    file_size_bytes_limit: uint64
-    level_switch: Core.LoggingLevelSwitch option
-    buffered: Buffered
-    shared: Shared
-    flush_interval: TimeSpan option
-    rolling_interval: RollingInterval
-    roll_on_size_limit: RollOnSizeLimit
-    retained_files: uint
-    lifecycle_hooks: FileLifecycleHooks option
-}
-
-type Configuration = {
-    theme: SystemConsoleTheme
-    overrides: Override list
-    template: string
-    files: FileConfiguration list
-}
-
-let from_config (c: Configuration) =
-
-    let override_ (lc: LoggerConfiguration) = function
-        | Verbose namespace_ ->
-            lc.MinimumLevel.Override (namespace_, LogEventLevel.Verbose)
-        | Debug namespace_ ->
-            lc.MinimumLevel.Override (namespace_, LogEventLevel.Debug)
-        | Information namespace_ ->
-            lc.MinimumLevel.Override (namespace_, LogEventLevel.Information)
-        | Warning namespace_ ->
-            lc.MinimumLevel.Override (namespace_, LogEventLevel.Warning)
-        | Error namespace_ ->
-            lc.MinimumLevel.Override (namespace_, LogEventLevel.Error)
-        | Fatal namespace_ ->
-            lc.MinimumLevel.Override (namespace_, LogEventLevel.Fatal)
-
-    let lc =
-        c.overrides
-        |> List.fold (fun lc target -> override_ lc target) (LoggerConfiguration())
-
-    let null_or = function | Some a -> a | None -> null
-    let buffered = function | Buffered.Yes -> true | Buffered.No -> false
-    let shared = function | Shared.Yes -> true | Shared.No -> false
-    let roll = function | RollOnSizeLimit.Yes -> true | RollOnSizeLimit.No -> false
-
-    let flush_interval = function Some ts -> Nullable ts | None -> Nullable<TimeSpan> ()
-        
-    let lc =
-        c.files
-        |> List.fold (fun (lc: LoggerConfiguration) (fc: FileConfiguration) ->
-                        lc.WriteTo.File(
-                            path = fc.path,
-                            restrictedToMinimumLevel = fc.level,
-                            outputTemplate = fc.template,
-                            formatProvider = fc.format_provider,
-                            fileSizeLimitBytes = Nullable (int64 fc.file_size_bytes_limit),
-                            levelSwitch = null_or fc.level_switch,
-                            buffered = buffered fc.buffered,
-                            shared = shared fc.shared,
-                            flushToDiskInterval = flush_interval fc.flush_interval,
-                            rollingInterval = fc.rolling_interval,
-                            rollOnFileSizeLimit = roll fc.roll_on_size_limit,
-                            retainedFileCountLimit = Nullable (int fc.retained_files),
-                            encoding = System.Text.Encoding.UTF8,
-                            hooks = null_or fc.lifecycle_hooks,
-                            retainedFileTimeLimit = TimeSpan.Zero))
-                      lc
-
-    lc
-      .WriteTo.Console(theme=c.theme, outputTemplate=c.template)
-      .CreateLogger()
-
-module Default =
-    let retained_files = 31 (* one month *)
-    let file_size_bytes = 1 * 1024 * 1024 * 1024 (* 1GB *)
-    let size_limit = 1 * 1024 * 1024 * 1024 (* 1GB *)
-    let template = "{Timestamp:yyyy-MM-dd HH:mm:ss.fff zzz} [{Level:u3}] {Message:lj}{NewLine}{Exception}";
-    let debug_template = "[{Timestamp:HH:mm:ss} {Level:u3}] |{SourceContext}| {Message:lj}{NewLine}{Exception}"
-    let theme = Serilog.Sinks.SystemConsole.Themes.SystemConsoleTheme.Literate
-
-    let overrides = [
-        Warning "Orleans.Runtime"
-        Warning "Orleans.Hosting"
-        Warning "Microsoft"
-        // Warning "Microsoft.AspNetCore"
-        // Warning "Microsoft.AspNetCore.Hosting"
-        // Warning "Microsoft.AspNetCore.Mvc"
-        // Warning "Microsoft.AspNetCore.Routing"
-        // Warning "Orleans.Runtime.Silo"
-//        Warning "Orleans.Runtime.SiloOptionsLogger"
-        // Warning "Orleans.Runtime.SiloHostedService"
-    ]

src/Result.fs

@@ -1,50 +0,0 @@
-namespace Pentole
-
-module Result =
-
-    let inline protect ([<InlineIfLambda>]f) x =
-        try
-            Ok (f x)
-        with e -> Error e
-
-    let inline pairwise_map fun_ (x: 'a, y: 'a) =
-        match fun_ x with
-        | Error e -> Error e
-        | Ok o ->
-            match fun_ y with | Ok o' -> Ok (o, o') | Error e -> Error e
-
-    let of_option = function | Some s -> Ok s | None -> Error ()
-
-    let zip a b =
-        match (a, b) with
-        | Ok a, Ok b -> Ok (a, b)
-        | Error e, _ -> Error e
-        | _, Error e -> Error e
-
-    let inline get r =
-        match r with
-        | Ok o -> o
-        | Error e ->
-             $"Tried to access value from Result r, error={e}"
-             |> System.ArgumentException
-             |> raise
-
-
-    type ToStringWrapper(toString) =
-        override _.ToString() = toString ()
-
-    let Result l = ToStringWrapper(fun _ ->
-                                     match l with
-                                     | Ok o -> sprintf "Ok %O" o
-                                     | _ -> failwith "")
-                                     
-module ResultList =
-    let collect (lambda: 'a -> Result<'ok, 'err>) (seq_: 'a seq) =
-        let rec iter_ acc seq_ =
-            match Seq.tryHead seq_ with
-            | None -> Ok acc
-            | Some x ->
-                match lambda x with
-                | Error e -> Error e
-                | Ok o -> iter_ (o::acc) (Seq.tail seq_)
-        iter_ [] seq_

src/String.fs

@@ -1,7 +0,0 @@
-module Pentole.String
-
-let (|Prefix|_|) (p: string) (s: string) =
-    if s.StartsWith p then
-        s.Substring p.Length |> Some
-    else
-        None

src/src.fsproj

@@ -8,11 +8,8 @@
 
   <ItemGroup>
     <Compile Include="Environment.fs" />
-    <Compile Include="LoggingHelpers.fs" />
     <Compile Include="Map.fs" />
     <Compile Include="Seq.fs" />
-    <Compile Include="Result.fs" />
-    <Compile Include="String.fs" />
     <Compile Include="Datatypes.fs" />
     <Compile Include="Logging.fs" />
     <Compile Include="Shell.fs" />
@@ -38,7 +35,7 @@
     <PackageReference Include="Microsoft.Orleans.Streaming" Version="8.2.0" />
     <PackageReference Include="NodaTime" Version="3.2.0" />
     <PackageReference Include="Npgsql" Version="8.0.5" />
-    <PackageReference Include="Pentole" Version="0.0.4" />
+    <PackageReference Include="Pentole" Version="0.0.6" />
     <PackageReference Include="Serilog.Extensions.Hosting" Version="8.0.0" />
     <PackageReference Include="Serilog.Sinks.Console" Version="6.0.0" />
     <PackageReference Include="Serilog.Sinks.File" Version="6.0.0" />

tests/UnitTest1.fs

@@ -1,12 +1,10 @@
 module tests
 
 open NUnit.Framework
-open Pentole.TestsExtensions
+open Pentole
 open Bidello.Datatypes
 open Bidello
 
-open Pentole.String
-
 let now = NodaTime.SystemClock.Instance.GetCurrentInstant ()
 
 [<Test>]
@@ -34,7 +32,7 @@ let run_function x =
 
     Cron.sort_jobs now x
     |> Result.map (List.map reduce)
-    |> Pentole.Result.get
+    |> Result.Unsafe.get
 
 [<Test>]
 let job_deps_simple () =
@@ -46,7 +44,7 @@ let job_deps_simple () =
     let expected = [[("h1", "j1")]]
 
 
-    setEqual expected cjs
+    Assert.setEqual expected cjs
 
 [<Test>]
 let job_deps () =
@@ -61,7 +59,7 @@ let job_deps () =
     let cjs = run_function requirements
 
     let expected = [[("h1", "j1"); ("h1", "j1_after")]; [("h2", "j1")]; [("h1", "j2")]]
-    setEqual expected cjs
+    Assert.setEqual expected cjs
 
 [<Test>]
 let job_deps2 () =
@@ -79,7 +77,7 @@ let job_deps2 () =
     let expected = [[("h1", "j1"); ("h1", "j1_after")];
                     [("h1", "j2"); ("h1", "j2_after")];
                     [("h2", "j1")]]
-    setEqual expected cjs
+    Assert.setEqual expected cjs
 
 [<Test>]
 let should_fail_no_host () =
@@ -95,7 +93,7 @@ let should_fail_no_host () =
     
     Cron.sort_jobs now requirements
     |> Result.isError
-    |> isTrue
+    |> Assert.isTrue
 
 [<Test>]
 let job_deps_chain0 () =
@@ -108,11 +106,10 @@ let job_deps_chain0 () =
     ]
 
     let cjs = run_function requirements
-    printfn "GOT: %A" cjs
     let expected = [[("h1", "j1"); ("h1", "j2_after_j1"); ("h1", "j3_after_j2")];
                      [("h2", "j1")]]
 
-    setEqual expected cjs
+    Assert.setEqual expected cjs
 
 [<Test>]
 let job_deps_chain1 () =
@@ -131,7 +128,7 @@ let job_deps_chain1 () =
                      ("h1", "j2_after_j1"); ("h1", "j3_after_j2")];
                     [("h2", "j1")]]
 
-    setEqual expected cjs
+    Assert.setEqual expected cjs
 
 [<Test>]
 let job_deps_chain_failure () =
@@ -142,4 +139,4 @@ let job_deps_chain_failure () =
 
     Cron.sort_jobs now requirements
     |> Result.isError
-    |> isTrue
+    |> Assert.isTrue

tests/tests.fsproj

@@ -19,7 +19,7 @@
     <PackageReference Include="NUnit3TestAdapter" Version="4.6.0" />
     <PackageReference Include="NUnit.Analyzers" Version="3.6.1" />
     <PackageReference Include="coverlet.collector" Version="6.0.0" />
-    <PackageReference Include="Pentole" Version="0.0.4" />
+    <PackageReference Include="Pentole" Version="0.0.6" />
   </ItemGroup>
 
     <ItemGroup>