Add app (#4)

Co-authored-by: Smaug123 <patrick+github@patrickstevens.co.uk>
Reviewed-on: #4

AnkiStatic.Lib/AnkiStatic.Lib.fsproj

@@ -21,11 +21,12 @@
     <Compile Include="JsonDomain.fs" />
     <Compile Include="Base91.fs" />
     <Compile Include="Sqlite.fs"/>
-    <Content Include="Examples\example-collection-conf.json"/>
-    <Content Include="Examples\example-collection-models.json"/>
-    <Content Include="Examples\example-collection-decks.json"/>
-    <Content Include="Examples\example-collection-deck-conf.json"/>
-    <Content Include="anki.schema.json" />
+    <Compile Include="ConfigSchema.fs" />
+    <None Include="Examples\example-collection-conf.json"/>
+    <None Include="Examples\example-collection-models.json"/>
+    <None Include="Examples\example-collection-decks.json"/>
+    <None Include="Examples\example-collection-deck-conf.json"/>
+    <EmbeddedResource Include="anki.schema.json" />
   </ItemGroup>
 
   <ItemGroup>

AnkiStatic.Lib/ConfigSchema.fs

@@ -0,0 +1,15 @@
+namespace AnkiStatic
+
+open System.IO
+
+[<RequireQualifiedAccess>]
+module AnkiStatic =
+
+    let getSchema () : Stream =
+        let resource = "AnkiStatic.Lib.anki.schema.json"
+        let assembly = System.Reflection.Assembly.GetExecutingAssembly ()
+        let stream = assembly.GetManifestResourceStream resource
+
+        match stream with
+        | null -> failwithf "The resource %s was not found. This is a bug in the tool." resource
+        | stream -> stream

AnkiStatic.Lib/JsonDomain.fs

@@ -2,8 +2,10 @@ namespace AnkiStatic
 
 open System
 open System.Collections.Generic
+open System.IO
 open System.Text.Json
 open System.Text.Json.Serialization
+open System.Threading.Tasks
 
 type private LeechActionJsonConverter () =
     inherit JsonConverter<LeechAction> ()
@@ -129,7 +131,9 @@ module JsonCollection =
             =
             {
                 Deck = deck
-                CreationDate = this.CreationDate |> Option.defaultValue DateTimeOffset.UnixEpoch
+                CreationDate =
+                    this.CreationDate
+                    |> Option.defaultValue (DateTimeOffset.UnixEpoch + TimeSpan.FromSeconds 1.0)
                 Model = models.[this.Model]
                 Tags = this.Tags |> Option.defaultValue []
                 ValueOfSortField = this.SortFieldValue
@@ -254,14 +258,19 @@ module JsonCollection =
             Models : IReadOnlyDictionary<string, JsonModel>
         }
 
-    let internal deserialise (s : string) : JsonCollection =
+    let private options =
         let opts = JsonSerializerOptions ()
         opts.Converters.Add (LeechActionJsonConverter ())
         opts.Converters.Add (NewCardDistributionJsonConverter ())
         opts.Converters.Add (NewCardOrderJsonConverter ())
         opts.Converters.Add (ModelTypeJsonConverter ())
         opts.PropertyNameCaseInsensitive <- true
-        JsonSerializer.Deserialize (s, opts)
+        opts
+
+    let internal deserialiseString (s : string) : JsonCollection = JsonSerializer.Deserialize (s, options)
+
+    let deserialise (utf8Json : Stream) : ValueTask<JsonCollection> =
+        JsonSerializer.DeserializeAsync (utf8Json, options)
 
     let toInternal (collection : JsonCollection) : SerialisedCollection * SerialisedNote list =
         let decks =

AnkiStatic.Lib/anki.schema.json

@@ -373,10 +373,8 @@
       "additionalProperties": false,
       "required": [
         "model",
-        "creationDate",
         "sortFieldValue",
-        "additionalFieldValues",
-        "tags"
+        "additionalFieldValues"
       ],
       "properties": {
         "tags": {

AnkiStatic.Test/AnkiStatic.Test.fsproj

@@ -13,6 +13,7 @@
     <Compile Include="Tests.fs" />
     <Compile Include="TestJson.fs" />
     <Compile Include="TestEndToEnd.fs" />
+    <EmbeddedResource Include="CapitalsOfTheWorld.json" />
     <EmbeddedResource Include="example1.json" />
   </ItemGroup>
 

AnkiStatic.Test/TestEndToEnd.fs

@@ -12,11 +12,13 @@ module TestEndToEnd =
         end
 
     [<TestCase "example1.json">]
+    [<TestCase "CapitalsOfTheWorld.json">]
     let ``End-to-end test of example1.json`` (fileName : string) =
         let assembly = typeof<Dummy>.Assembly
         let json = Utils.readResource assembly fileName
 
-        let collection, notes = JsonCollection.deserialise json |> JsonCollection.toInternal
+        let collection, notes =
+            JsonCollection.deserialiseString json |> JsonCollection.toInternal
 
         let outputFile =
             Path.GetTempFileName ()

AnkiStatic.Test/TestJson.fs

@@ -16,5 +16,7 @@ module TestJson =
         let assembly = typeof<Dummy>.Assembly
         let json = Utils.readResource assembly "example1.json"
 
-        let collection, notes = JsonCollection.deserialise json |> JsonCollection.toInternal
+        let collection, notes =
+            JsonCollection.deserialiseString json |> JsonCollection.toInternal
+
         ()

AnkiStatic/AnkiStatic.fsproj

@@ -7,6 +7,11 @@
 
 
     <ItemGroup>
+      <Compile Include="ArgsCrate.fs" />
+      <Compile Include="Result.fs" />
+      <Compile Include="OutputSchema.fs" />
+      <Compile Include="Render.fs" />
+      <Compile Include="Verify.fs" />
       <Compile Include="Program.fs" />
     </ItemGroup>
 
@@ -14,4 +19,9 @@
       <ProjectReference Include="..\AnkiStatic.Lib\AnkiStatic.Lib.fsproj" />
     </ItemGroup>
 
+    <ItemGroup>
+      <PackageReference Include="Argu" Version="6.1.1" />
+      <PackageReference Include="NJsonSchema" Version="10.9.0" />
+    </ItemGroup>
+
 </Project>

AnkiStatic/ArgsCrate.fs

@@ -0,0 +1,21 @@
+namespace AnkiStatic.App
+
+open System.Threading.Tasks
+open Argu
+
+type ArgsEvaluator<'ret> =
+    abstract Eval<'a, 'b when 'b :> IArgParserTemplate> :
+        (ParseResults<'b> -> Result<'a, ArguParseException list>) -> ('a -> Task<int>) -> 'ret
+
+type ArgsCrate =
+    abstract Apply<'ret> : ArgsEvaluator<'ret> -> 'ret
+
+[<RequireQualifiedAccess>]
+module ArgsCrate =
+    let make<'a, 'b when 'b :> IArgParserTemplate>
+        (ofResult : ParseResults<'b> -> Result<'a, ArguParseException list>)
+        (run : 'a -> Task<int>)
+        =
+        { new ArgsCrate with
+            member _.Apply e = e.Eval ofResult run
+        }

AnkiStatic/OutputSchema.fs

@@ -0,0 +1,49 @@
+namespace AnkiStatic.App
+
+open System.IO
+open System.Threading.Tasks
+open Argu
+open AnkiStatic
+
+type OutputSchemaArgsFragment =
+    | Output of string
+
+    interface IArgParserTemplate with
+        member s.Usage =
+            match s with
+            | Output _ -> "path to the file to be written (or overwritten, if it already exists), instead of stdout"
+
+type OutputSchemaArgs =
+    {
+        Output : FileInfo option
+    }
+
+    static member OfParse
+        (parsed : ParseResults<OutputSchemaArgsFragment>)
+        : Result<OutputSchemaArgs, ArguParseException>
+        =
+        try
+            {
+                Output = parsed.TryGetResult OutputSchemaArgsFragment.Output |> Option.map FileInfo
+            }
+            |> Ok
+        with :? ArguParseException as e ->
+            Error e
+
+[<RequireQualifiedAccess>]
+module OutputSchema =
+
+    let run (args : OutputSchemaArgs) : Task<int> =
+        task {
+            use stream = AnkiStatic.getSchema ()
+
+            match args.Output with
+            | None ->
+                let reader = new StreamReader (stream)
+                System.Console.WriteLine (reader.ReadToEnd ())
+            | Some output ->
+                use output = output.OpenWrite ()
+                stream.CopyTo output
+
+            return 0
+        }

AnkiStatic/Program.fs

@@ -1,11 +1,82 @@
-namespace AnkiStatic
+namespace AnkiStatic.App
 
-open System.IO
+open Argu
 
 module Program =
-    [<EntryPoint>]
-    let main _ =
-        let outputFile = FileInfo "/tmp/media"
+    let subcommands =
+        [|
+            "render",
+            ("Render an Anki configuration JSON file into a .apkg file", ArgsCrate.make RenderArgs.OfParse Render.run)
 
-        let database = Sqlite.createEmptyPackage outputFile |> fun t -> t.Result
-        0
+            "output-schema",
+            ("Output a schema you can use to verify the `render` config file",
+             ArgsCrate.make (OutputSchemaArgs.OfParse >> Result.mapError List.singleton) OutputSchema.run)
+
+            "verify",
+            ("Verify a `render` configuration file",
+             ArgsCrate.make (VerifyArgs.OfParse >> Result.mapError List.singleton) Verify.run)
+        |]
+        |> Map.ofArray
+
+    [<EntryPoint>]
+    let main argv =
+        // It looks like Argu doesn't really support the combination of subcommands and read-from-env-vars, so we just
+        // roll our own.
+
+        match Array.tryHead argv with
+        | None
+        | Some "--help" ->
+            subcommands.Keys
+            |> String.concat ","
+            |> eprintfn "Subcommands (try each with `--help`): %s"
+
+            127
+
+        | Some commandName ->
+
+        match Map.tryFind commandName subcommands with
+        | None ->
+            subcommands.Keys
+            |> String.concat ","
+            |> eprintfn "Unrecognised command '%s'. Subcommands (try each with `--help`): %s" commandName
+
+            127
+
+        | Some (_help, command) ->
+
+        let argv = Array.tail argv
+        let config = ConfigurationReader.FromEnvironmentVariables ()
+
+        { new ArgsEvaluator<_> with
+            member _.Eval<'a, 'b when 'b :> IArgParserTemplate>
+                (ofParseResult : ParseResults<'b> -> Result<'a, _>)
+                run
+                =
+                let parser = ArgumentParser.Create<'b> ()
+
+                let parsed =
+                    try
+                        parser.Parse (argv, config, raiseOnUsage = true) |> Some
+                    with :? ArguParseException as e ->
+                        e.Message.Replace ("AnkiStatic ", sprintf "AnkiStatic %s " commandName)
+                        |> eprintfn "%s"
+
+                        None
+
+                match parsed with
+                | None -> Error 127
+                | Some parsed ->
+
+                match ofParseResult parsed with
+                | Error errors ->
+                    for e in errors do
+                        e.Message.Replace ("AnkiStatic ", sprintf "AnkiStatic %s " commandName)
+                        |> eprintfn "%s"
+
+                    Error 127
+                | Ok args ->
+
+                run args |> Ok
+        }
+        |> command.Apply
+        |> Result.cata (fun t -> t.Result) id

AnkiStatic/Render.fs

@@ -0,0 +1,88 @@
+namespace AnkiStatic.App
+
+open System
+open System.IO
+open System.Threading.Tasks
+open Argu
+open AnkiStatic
+
+type RenderArgsFragment =
+    | [<MainCommand>] Input of string
+    | Output of string
+
+    interface IArgParserTemplate with
+        member s.Usage =
+            match s with
+            | RenderArgsFragment.Input _ ->
+                "path to the JSON file to be rendered as an Anki deck, or the literal '-' to read from stdin"
+            | RenderArgsFragment.Output _ -> "Output file path"
+
+type InputSource =
+    | File of FileInfo
+    | Stdin
+
+type RenderArgs =
+    {
+        Input : InputSource
+        Output : FileInfo
+    }
+
+    static member OfParse (parsed : ParseResults<RenderArgsFragment>) : Result<RenderArgs, ArguParseException list> =
+        let input =
+            try
+                parsed.GetResult RenderArgsFragment.Input |> Ok
+            with :? ArguParseException as e ->
+                Error e
+
+        let output =
+            try
+                parsed.GetResult RenderArgsFragment.Output |> Ok
+            with :? ArguParseException as e ->
+                Error e
+
+        match input, output with
+        | Error e, Ok _
+        | Ok _, Error e -> Error [ e ]
+        | Error e1, Error e2 -> Error [ e1 ; e2 ]
+        | Ok input, Ok output ->
+
+        let input =
+            if input = "-" then
+                InputSource.Stdin
+            else
+                InputSource.File (FileInfo input)
+
+        let output = FileInfo output
+
+        {
+            Input = input
+            Output = output
+        }
+        |> Ok
+
+module Render =
+    let run (args : RenderArgs) : Task<int> =
+        task {
+            let rng = Random ()
+
+            use s =
+                match args.Input with
+                | InputSource.Stdin -> Console.OpenStandardInput ()
+                | InputSource.File f -> f.OpenRead () :> Stream
+
+            let! json = JsonCollection.deserialise s
+            let collection, notes = json |> JsonCollection.toInternal
+
+            let outputFile =
+                Path.GetTempFileName ()
+                |> fun f -> Path.ChangeExtension (f, ".apkg")
+                |> FileInfo
+
+            let collection = SerialisedCollection.toSqlite collection
+
+            do! Sqlite.writeAll rng collection notes outputFile
+
+            outputFile.MoveTo args.Output.FullName
+
+            return 0
+        }

AnkiStatic/Result.fs

@@ -0,0 +1,9 @@
+namespace AnkiStatic.App
+
+[<RequireQualifiedAccess>]
+module Result =
+
+    let cata<'ok, 'err, 'result> onOk onError (r : Result<'ok, 'err>) : 'result =
+        match r with
+        | Ok ok -> onOk ok
+        | Error e -> onError e

AnkiStatic/Verify.fs

@@ -0,0 +1,64 @@
+namespace AnkiStatic.App
+
+open System
+open System.IO
+open System.Threading.Tasks
+open Argu
+open NJsonSchema
+open NJsonSchema.Validation
+open AnkiStatic
+
+type VerifyArgsFragment =
+    | [<MainCommand>] Input of string
+
+    interface IArgParserTemplate with
+        member s.Usage =
+            match s with
+            | Input _ -> "path to the file to be verified, or the literal '-' to read from stdin"
+
+type VerifyArgs =
+    | File of FileInfo
+    | Stdin
+
+    static member OfParse (parsed : ParseResults<VerifyArgsFragment>) : Result<VerifyArgs, ArguParseException> =
+        let input =
+            try
+                parsed.GetResult VerifyArgsFragment.Input |> Ok
+            with :? ArguParseException as e ->
+                Error e
+
+        input
+        |> Result.map (fun input ->
+            if input = "-" then
+                VerifyArgs.Stdin
+            else
+                VerifyArgs.File (FileInfo input)
+        )
+
+[<RequireQualifiedAccess>]
+module Verify =
+    let run (args : VerifyArgs) : Task<int> =
+        task {
+            let validator = JsonSchemaValidator ()
+            use schema = AnkiStatic.getSchema ()
+            let! ct = Async.CancellationToken
+            let! schema = JsonSchema.FromJsonAsync (schema, ct) |> Async.AwaitTask
+
+            use jsonStream =
+                match args with
+                | VerifyArgs.Stdin -> Console.OpenStandardInput ()
+                | VerifyArgs.File f -> f.OpenRead ()
+
+            let reader = new StreamReader (jsonStream)
+            let! json = reader.ReadToEndAsync ct |> Async.AwaitTask
+
+            let errors = validator.Validate (json, schema)
+
+            if errors.Count = 0 then
+                return 0
+            else
+                for error in errors do
+                    Console.Error.WriteLine (sprintf "Error: %+A" error)
+
+                return 1
+        }