feat: add codec for basic schema types

Author: mstream

.gitignore

@@ -0,0 +1,3 @@
+.psc-ide-port
+.spago
+output

.tidyrc.json

@@ -0,0 +1,11 @@
+{
+  "importSort": "ide",
+  "importWrap": "auto",
+  "indent": 2,
+  "operatorsFile": null,
+  "ribbon": 1,
+  "typeArrowPlacement": "first",
+  "unicode": "always",
+  "width": 72
+}
+

flake.lock

@@ -0,0 +1,86 @@
+{
+  description = "Logo language interpreter";
+
+  inputs = {
+    easy-purescript-nix.url = "github:justinwoo/easy-purescript-nix/master";
+    flake-utils.url = "github:numtide/flake-utils/main";
+    nixpkgs.url = "github:nixos/nixpkgs/nixos-23.05";
+  };
+
+  outputs =
+    { easy-purescript-nix
+    , flake-utils
+    , nixpkgs
+    , ...
+    }:
+    let
+      name = "purescript-json-schema";
+
+      supportedSystems = [
+        "aarch64-darwin"
+        "x86_64-linux"
+      ];
+
+    in
+    flake-utils.lib.eachSystem supportedSystems (system:
+    let
+      pkgs = import nixpkgs {
+        inherit system;
+      };
+
+      easy-ps = import easy-purescript-nix { inherit pkgs; };
+
+      format-check = pkgs.stdenvNoCC.mkDerivation {
+        checkPhase = ''
+          purs-tidy check {src,test}
+        '';
+        doCheck = true;
+        dontBuild = true;
+        installPhase = ''
+          mkdir "$out"
+        '';
+        name = "format-check";
+        nativeBuildInputs = with easy-ps; [ purs-tidy ];
+        src = ./.;
+      };
+
+      devShellInputs = {
+        easy-ps = with easy-ps; [
+          psa
+          purs
+          purs-backend-es
+          purs-tidy
+          spago
+        ];
+
+        node-packages = with pkgs.nodePackages; [
+          markdownlint-cli
+        ];
+
+        pkgs = with pkgs; [
+          act
+          docker
+          esbuild
+          gh
+          git
+          imagemagick
+          nodejs
+        ];
+      };
+    in
+    {
+      checks = { inherit format-check; };
+      devShell = pkgs.mkShell {
+        inherit name;
+        buildInputs =
+          devShellInputs.easy-ps ++
+          devShellInputs.node-packages ++
+          devShellInputs.pkgs;
+        PLAYWRIGHT_BROWSERS_PATH = "${pkgs.playwright-driver.browsers}";
+        shellHook = ''
+          PS1="\[\e[33m\][\[\e[m\]\[\e[34;40m\]${name}:\[\e[m\]\[\e[36m\]\w\[\e[m\]\[\e[33m\]]\[\e[m\]\[\e[32m\]\\$\[\e[m\] "
+        '';
+      };
+    }
+    );
+}

flake.nix

@@ -0,0 +1,5 @@
+let upstream =
+      https://github.com/purescript/package-sets/releases/download/psc-0.15.9-20230629/packages.dhall
+        sha256:f91d36c7e4793fe4d7e042c57fef362ff3f9e9ba88454cd38686701e30bf545a
+
+in  upstream

packages.dhall

@@ -0,0 +1,27 @@
+{ name = "mlogo"
+, dependencies =
+  [ "aff"
+  , "argonaut-core"
+  , "arrays"
+  , "control"
+  , "effect"
+  , "either"
+  , "exceptions"
+  , "foldable-traversable"
+  , "foreign-object"
+  , "gen"
+  , "lists"
+  , "maybe"
+  , "node-process"
+  , "nonempty"
+  , "ordered-collections"
+  , "prelude"
+  , "quickcheck"
+  , "spec"
+  , "strings"
+  , "tailrec"
+  , "tuples"
+  ]
+, packages = ./packages.dhall
+, sources = [ "src/purs/**/*.purs", "test/unit/**/*.purs" ]
+}

spago.dhall

@@ -0,0 +1,113 @@
+module JsonSchema
+  ( JsonArraySchemaSpec
+  , JsonIntegerSchemaSpec
+  , JsonNumberSchemaSpec
+  , JsonObjectSchemaSpec
+  , JsonSchemaObjectProperty
+  , JsonSchema(..)
+  , JsonStringSchemaSpec
+  , genSchema
+  ) where
+
+import Prelude
+
+import Control.Lazy (class Lazy)
+import Control.Lazy as Lazy
+import Control.Monad.Gen (class MonadGen)
+import Control.Monad.Gen as Gen
+import Control.Monad.Gen.Common as GenCommon
+import Data.Generic.Rep (class Generic)
+import Data.List as List
+import Data.Map (Map)
+import Data.Map as Map
+import Data.Maybe (Maybe)
+import Data.NonEmpty ((:|))
+import Data.Show.Generic (genericShow)
+
+data JsonSchema
+  = JsonArraySchema JsonArraySchemaSpec
+  | JsonBooleanSchema
+  | JsonEmptySchema
+  | JsonIntegerSchema JsonIntegerSchemaSpec
+  | JsonNullSchema
+  | JsonNumberSchema JsonNumberSchemaSpec
+  | JsonObjectSchema JsonObjectSchemaSpec
+  | JsonStringSchema JsonStringSchemaSpec
+
+derive instance Generic JsonSchema _
+derive instance Eq JsonSchema
+
+instance Show JsonSchema where
+  show schema = genericShow schema
+
+type JsonArraySchemaSpec =
+  { itemsSchema ∷ Maybe JsonSchema
+  , uniqueItems ∷ Boolean
+  }
+
+type JsonBooleanSchemaSpec = {}
+
+type JsonIntegerSchemaSpec = {}
+
+type JsonNumberSchemaSpec = {}
+
+type JsonStringSchemaSpec = {}
+
+type JsonObjectSchemaSpec =
+  { properties ∷ Map String JsonSchemaObjectProperty
+  }
+
+type JsonSchemaObjectProperty =
+  { isRequired ∷ Boolean
+  , schema ∷ JsonSchema
+  }
+
+genSchema ∷ ∀ m. Lazy (m JsonSchema) ⇒ MonadGen m ⇒ m JsonSchema
+genSchema = Lazy.defer \_ → Gen.oneOf $ genBooleanSchema :|
+  [ genArraySchema
+  , genEmptySchema
+  , genIntegerSchema
+  , genNullSchema
+  , genNumberSchema
+  , genObjectSchema
+  , genStringSchema
+  ]
+
+genArraySchema ∷ ∀ m. Lazy (m JsonSchema) ⇒ MonadGen m ⇒ m JsonSchema
+genArraySchema = do
+  itemsSchema ← GenCommon.genMaybe genSchema
+  uniqueItems ← Gen.chooseBool
+  pure $ JsonArraySchema { itemsSchema, uniqueItems }
+
+genBooleanSchema ∷ ∀ m. MonadGen m ⇒ m JsonSchema
+genBooleanSchema = pure JsonBooleanSchema
+
+genEmptySchema ∷ ∀ m. MonadGen m ⇒ m JsonSchema
+genEmptySchema = pure JsonEmptySchema
+
+genIntegerSchema ∷ ∀ m. MonadGen m ⇒ m JsonSchema
+genIntegerSchema = pure $ JsonIntegerSchema {}
+
+genNullSchema ∷ ∀ m. MonadGen m ⇒ m JsonSchema
+genNullSchema = pure JsonNullSchema
+
+genNumberSchema ∷ ∀ m. MonadGen m ⇒ m JsonSchema
+genNumberSchema = pure $ JsonNumberSchema {}
+
+genObjectSchema ∷ ∀ m. Lazy (m JsonSchema) ⇒ MonadGen m ⇒ m JsonSchema
+genObjectSchema = do
+  properties ← genProperties
+  pure $ JsonObjectSchema { properties }
+  where
+  genProperties ∷ m (Map String JsonSchemaObjectProperty)
+  genProperties = (Map.fromFoldable <<< List.singleton)
+    <$> GenCommon.genTuple (pure "prop") genProperty
+
+  genProperty ∷ m JsonSchemaObjectProperty
+  genProperty = do
+    isRequired ← Gen.chooseBool
+    schema ← genSchema
+    pure { isRequired, schema }
+
+genStringSchema ∷ ∀ m. MonadGen m ⇒ m JsonSchema
+genStringSchema = pure $ JsonStringSchema {}