lawspec 0.8.0 → 0.10.0

package/examples/native-payments/typescript/lawspec.json

@@ -0,0 +1,149 @@
+{
+  "version": 1,
+  "sources": [
+    "laws"
+  ],
+  "machineBits": 64,
+  "targets": [
+    {
+      "language": "typescript",
+      "root": ".",
+      "nativeBindings": {
+        "types": [
+          {
+            "type": "example.payments::type::Currency",
+            "native": [
+              "payments_domain",
+              "CurrencyCode"
+            ],
+            "constructors": [
+              {
+                "constructor": "USD",
+                "native": [
+                  "payments_domain",
+                  "Dollars"
+                ],
+                "style": "unit",
+                "fields": []
+              },
+              {
+                "constructor": "EUR",
+                "native": [
+                  "payments_domain",
+                  "Euros"
+                ],
+                "style": "unit",
+                "fields": []
+              },
+              {
+                "constructor": "GBP",
+                "native": [
+                  "payments_domain",
+                  "Pounds"
+                ],
+                "style": "unit",
+                "fields": []
+              }
+            ]
+          },
+          {
+            "type": "example.payments::type::Money",
+            "native": [
+              "payments_domain",
+              "Price"
+            ],
+            "constructors": [
+              {
+                "constructor": "Money",
+                "native": [
+                  "payments_domain",
+                  "Price"
+                ],
+                "style": "record",
+                "fields": [
+                  {
+                    "field": "amount",
+                    "native": "major"
+                  },
+                  {
+                    "field": "currency",
+                    "native": "unit"
+                  }
+                ]
+              }
+            ]
+          },
+          {
+            "type": "example.payments::type::Payment",
+            "native": [
+              "payments_domain",
+              "PaymentStatus"
+            ],
+            "constructors": [
+              {
+                "constructor": "Paid",
+                "native": [
+                  "payments_domain",
+                  "Settled"
+                ],
+                "style": "variant",
+                "fields": [
+                  {
+                    "field": "value",
+                    "native": "price"
+                  }
+                ]
+              },
+              {
+                "constructor": "Declined",
+                "native": [
+                  "payments_domain",
+                  "Rejected"
+                ],
+                "style": "variant",
+                "fields": [
+                  {
+                    "field": "reason",
+                    "native": "explanation"
+                  }
+                ]
+              }
+            ]
+          }
+        ],
+        "functions": [
+          {
+            "declaration": "example.payments::addFee",
+            "native": [
+              "payments_domain",
+              "apply_fee"
+            ]
+          },
+          {
+            "declaration": "example.payments::roundTrip",
+            "native": [
+              "payments_domain",
+              "restore"
+            ]
+          },
+          {
+            "declaration": "example.payments::archive",
+            "native": [
+              "payments_domain",
+              "store"
+            ]
+          }
+        ],
+        "generators": [
+          {
+            "type": "example.payments::type::Money",
+            "factory": [
+              "lawspec_generators",
+              "prices"
+            ]
+          }
+        ]
+      }
+    }
+  ]
+}

package/examples/native-payments/typescript/src/payments_domain.ts

@@ -0,0 +1,42 @@
+// Application-owned domain types; no generated domain declarations.
+import * as ls from './lawspec_runtime.js';
+
+export class CurrencyCode {}
+export class Dollars extends CurrencyCode {}
+export class Euros extends CurrencyCode {}
+export class Pounds extends CurrencyCode {}
+
+export class Price {
+  major: ls.Decimal;
+  unit: CurrencyCode;
+  constructor({unit, major}: {unit: CurrencyCode; major: ls.Decimal}) {
+    this.unit = unit;
+    this.major = major;
+  }
+}
+export class PaymentStatus {}
+export class Settled extends PaymentStatus {
+  price: Price;
+  constructor({price}: {price: Price}) {
+    super();
+    this.price = price;
+  }
+}
+export class Rejected extends PaymentStatus {
+  explanation: string;
+  constructor({explanation}: {explanation: string}) {
+    super();
+    this.explanation = explanation;
+  }
+}
+export function apply_fee(price: Price): Price {
+  const major = ls.binary('+', price.major, new ls.Decimal(2n, -1n),
+    'Decimal', 'Decimal') as ls.Decimal;
+  return new Price({major, unit: price.unit});
+}
+export function restore<T>(payment: T): T {
+  return payment;
+}
+export function store<T>(payments: T[]): T[] {
+  return payments;
+}

package/examples/native-payments/typescript/test/lawspec_generators.ts

@@ -0,0 +1,8 @@
+import * as fc from 'fast-check';
+import * as ls from '../src/lawspec_runtime.js';
+import {Price, Euros} from '../src/payments_domain.js';
+
+export function prices(): fc.Arbitrary<Price> {
+  return fc.integer({min:100, max:200}).map(cents =>
+    new Price({major:new ls.Decimal(BigInt(cents), -2n), unit:new Euros()}));
+}

package/examples/specs/collections.lawspec

@@ -0,0 +1,67 @@
+unit example.collections
+
+reverse :: List Int32 -> List Int32
+sort :: List Int32 -> List Int32
+sorted :: List Int32 -> Bool
+permutation :: List Int32 -> List Int32 -> Bool
+echoMaybe :: Maybe (Maybe Bool) -> Maybe (Maybe Bool)
+echoEither :: Either (List Int32) (Maybe Bool) -> Either (List Int32) (Maybe Bool)
+echoNested :: List (Maybe (Either CodeUnit16 Bytes)) -> List (Maybe (Either CodeUnit16 Bytes))
+
+law `list involution` (f :: List a -> List a) requires Eq a is
+  definition is `involution` f end
+end
+
+law `reverse twice restores the list` is
+  definition is `list involution` reverse end
+  example `ordered input` is
+    x = [3, 1, 2]
+    expect reverse x = [2, 1, 3]
+  end
+  example `empty input` is x = [] expect reverse x = [] end
+end
+
+law `sorting is idempotent` is
+  definition is `idempotent` sort end
+  example `duplicates` is x = [3, 1, 3] expect sort x = [1, 3, 3] end
+end
+
+law `sort produces sorted output` is
+  definition is `for all` (xs :: List Int32) . sorted (sort xs) end
+end
+
+law `sort preserves length` is
+  definition is `for all` (xs :: List Int32) . prelude.length (sort xs) = prelude.length xs end
+end
+
+law `sort preserves elements` is
+  definition is `for all` (xs :: List Int32) . permutation (sort xs) xs end
+end
+
+law `nonempty reversal preserves length` is
+  definition is
+    `for all` (xs :: List Int32 where prelude.length xs > 0) .
+      prelude.length (reverse xs) = prelude.length xs
+  end
+end
+
+law `Maybe preserves nested absence` is
+  definition is `for all` (x :: Maybe (Maybe Bool)) . echoMaybe x = x end
+  example `outer absence` is x = Nothing expect echoMaybe x = Nothing end
+  example `inner absence` is x = Just Nothing expect echoMaybe x = Just Nothing end
+  example `present` is x = Just (Just true) expect echoMaybe x = Just (Just true) end
+end
+
+law `Either preserves branches` is
+  definition is `for all` (x :: Either (List Int32) (Maybe Bool)) . echoEither x = x end
+  example `left list` is x = Left [3, 1, 3] expect echoEither x = Left [3, 1, 3] end
+  example `right absence` is x = Right Nothing expect echoEither x = Right Nothing end
+end
+
+law `nested raw values survive` is
+  definition is `for all` (xs :: List (Maybe (Either CodeUnit16 Bytes))) . echoNested xs = xs end
+  example `surrogate and octets` is
+    xs = [Nothing, Just (Left codeUnit16(55296)), Just (Right bytes([0, 255]))]
+    expect echoNested xs = [Nothing, Just (Left codeUnit16(55296)), Just (Right bytes([0, 255]))]
+  end
+end

package/examples/specs/data_types.lawspec

@@ -0,0 +1,66 @@
+unit example.data_types
+
+type Pair (a :: Type) (b :: Type) is
+  Pair
+    first :: a
+    second :: b
+end
+
+type Tree (a :: Type) is
+  Leaf value :: a
+  Branch children :: List (Tree a)
+end
+
+law `products preserve every field` is
+  definition is
+    `for all` (pair :: Pair Int8 Bool) .
+      (match pair with
+        | Pair first second -> Pair first second
+      end) = pair
+  end
+  example `maximum integer and false` is
+    pair = Pair 127 false
+    expect pair = Pair 127 false
+  end
+end
+
+law `sums preserve constructor identity and payloads` is
+  definition is
+    `for all` (tree :: Tree Int8) .
+      (match tree with
+        | Leaf value -> Leaf value
+        | Branch children -> Branch children
+      end) = tree
+  end
+  example `nested branches` is
+    tree = Branch [Leaf 127, Branch [], Leaf -128]
+    expect tree = Branch [Leaf 127, Branch [], Leaf -128]
+  end
+end
+
+
+-- A refined type argument constrains the corresponding stored fields. This
+-- predicate becomes a scoped Core traversal, shared by all eight backends.
+refinement Positive is (value :: Int8 where value > 0) end
+
+definition positivePair (value :: Positive) :: Pair Positive Bool is
+  Pair value true
+end
+
+definition reciprocalFirst (pair :: Pair Positive Bool) :: Rational is
+  match pair with
+    | Pair first second -> 1 / first
+  end
+end
+
+law `named payload contracts justify exact division` is
+  definition is
+    `for all` (value :: Positive) .
+      reciprocalFirst (positivePair value) = 1 / value
+  end
+  example `one half` is
+    value = 2
+    expect positivePair value = Pair 2 true
+    expect reciprocalFirst (positivePair value) = rational(1, 2)
+  end
+end

package/examples/specs/finite_data.lawspec

@@ -0,0 +1,37 @@
+unit example.finite_data
+
+type Choice is Yes | No end
+
+type Pair (a :: Type) (b :: Type) is
+  Pair first :: a second :: b
+end
+
+law `sum constructors remain distinct` is
+  definition is
+    `for all` (choice :: Choice) .
+      (match choice with
+        | Yes -> Yes
+        | No -> No
+      end) = choice
+  end
+  example `yes` is choice = Yes expect choice = Yes end
+end
+
+law `products preserve both fields` is
+  definition is
+    `for all` (pair :: Pair Bool Bool) .
+      (match pair with
+        | Pair first second -> Pair first second
+      end) = pair
+  end
+  example `different fields` is
+    pair = Pair true false
+    expect pair = Pair true false
+  end
+end
+
+law `nested optional products keep presence states` is
+  definition is
+    `for all` (value :: Maybe (Pair Choice (Nullable Bool))) . value = value
+  end
+end

package/examples/specs/list_contracts.lawspec

@@ -0,0 +1,136 @@
+unit example.list_contracts
+
+definition keep (xs :: List (value :: Int8 where value > 0))
+  :: List (value :: Int8 where value > 0)
+is xs end
+
+definition stronger (xs :: List (value :: Int8 where value > 10)) :: List Int8 is
+  keep (copypositive xs)
+end
+
+definition positive (value :: a) :: Bool requires Integer a is value > 0 end
+
+definition keephelper (xs :: List (value :: a where positive value))
+  :: List a requires Integer a
+is xs end
+
+definition reuse (xs :: List (value :: Int8 where positive value)) :: List Int8 is
+  keephelper xs
+end
+
+definition empty (value :: Int8) :: List (element :: Int8 where false) is [] end
+
+definition singleton (value :: Int8 where value > 0)
+  :: List (element :: Int8 where element > 0)
+is [value] end
+
+
+law `stronger domains satisfy the callee` is
+  definition is `for all` (xs :: List (value :: Int8 where value > 10)) .
+    stronger xs = xs
+  end
+  example `positive input` is xs = [11, 127] expect stronger xs = [11, 127] end
+end
+
+law `generic predicates keep their scope` is
+  definition is `for all` (xs :: List (value :: Int8 where value > 0)) .
+    reuse xs = xs
+  end
+  example `empty` is xs = [] expect reuse xs = [] end
+  example `nonempty` is xs = [1, 2] expect reuse xs = [1, 2] end
+end
+
+law `empty output satisfies an impossible element domain` is
+  definition is `for all` (value :: Int8) . empty value = [] end
+  example `zero` is value = 0 expect empty value = [] end
+end
+
+law `constructed output satisfies its contract` is
+  definition is `for all` (value :: Int8 where value > 0) . singleton value = [value] end
+  example `maximum` is value = 127 expect singleton value = [127] end
+end
+
+
+definition sumreciprocal (xs :: List (value :: Int8 where value != 0)) :: Rational is
+  match xs with
+  | Nil -> 0
+  | Cons first rest -> unwrapnonzero (wrapnonzero (nonzero first)) + sumreciprocal rest
+  end
+end
+
+definition sumrows (rows :: List (List (value :: Int8 where value != 0))) :: Rational is
+  match rows with
+  | Nil -> 0
+  | Cons first rest -> sumreciprocal first + sumrows rest
+  end
+end
+
+definition positivetail (xs :: List (value :: Int8 where value > 0))
+  :: List (value :: Int8 where value > 0)
+is
+  match xs with | Nil -> [] | Cons first rest -> rest end
+end
+
+definition positivefirst (xs :: List (value :: Int8 where value > 0))
+  :: (result :: Int8 where result > 0)
+is
+  match xs with | Nil -> 1 | Cons first rest -> first end
+end
+
+
+law `reciprocal sum uses each nonzero head` is
+  definition is `for all` (value :: Int8 where value != 0) .
+    sumreciprocal [value] = 1 / value
+  end
+  example `half` is value = 2 expect sumreciprocal [value] = rational(1, 2) end
+end
+
+law `nested membership keeps row contracts` is
+  definition is `for all` (value :: Int8 where value != 0) .
+    sumrows [[], [value]] = 1 / value
+  end
+  example `negative half` is value = -2 expect sumrows [[], [value]] = rational(-1, 2) end
+end
+
+law `tail preserves its positive elements` is
+  definition is `for all` (first :: Int8 where first > 0)
+    (second :: Int8 where second > 0) . positivetail [first, second] = [second]
+  end
+  example `two values` is first = 1 second = 2 expect positivetail [first, second] = [2] end
+end
+
+-- Recursive calls supply their verified result contract by structural induction.
+definition copypositive (xs :: List (value :: Int8 where value > 0))
+  :: List (value :: Int8 where value > 0)
+is
+  match xs with
+  | Nil -> []
+  | Cons first rest -> Cons first (copypositive rest)
+  end
+end
+
+definition nonzero (value :: Int8 where value != 0)
+  :: (result :: Int8 where result != 0)
+is value end
+
+definition wrapnonzero (value :: Int8 where value != 0)
+  :: Maybe (result :: Int8 where result != 0)
+is Just value end
+
+definition unwrapnonzero (value :: Maybe (element :: Int8 where element != 0))
+  :: Rational
+is
+  match value with
+  | Nothing -> 0
+  | Just element -> selectnonzero (Left element)
+  end
+end
+
+definition selectnonzero (value :: Either (element :: Int8 where element != 0) Bool)
+  :: Rational
+is
+  match value with
+  | Left element -> 1 / element
+  | Right ignored -> 0
+  end
+end

package/examples/specs/list_refinements.lawspec

@@ -0,0 +1,51 @@
+unit example.list_refinements
+
+definition above (floor :: Int8) (xs :: List Int8) :: Bool is
+  match xs with
+  | Nil -> true
+  | Cons first rest -> first > floor && above floor rest
+  end
+end
+
+definition positiveRows (rows :: List (List Int8)) :: Bool is
+  match rows with
+  | Nil -> true
+  | Cons first rest -> above 0 first && positiveRows rest
+  end
+end
+
+law `each element is positive` is
+  definition is `for all` (xs :: List (value :: Int8 where value > 0)) .
+    above 0 xs = true
+  end
+  example `empty` is xs = [] expect above 0 xs = true end
+  example `positive values` is xs = [1, 127] expect above 0 xs = true end
+end
+
+law `nested element domains` is
+  definition is `for all` (rows :: List (List (value :: Int8 where value > 0))) .
+    positiveRows rows = true
+  end
+  example `empty rows` is rows = [[], [1, 2]] expect positiveRows rows = true end
+end
+
+law `dependent elements` is
+  definition is `for all` (lawspecElement :: Int8)
+    (xs :: List (value :: Int8 where value > lawspecElement)) .
+    above lawspecElement xs = true
+  end
+  example `maximum prefix still permits empty` is
+    lawspecElement = 127 xs = [] expect above lawspecElement xs = true
+  end
+  example `nonempty continuation` is
+    lawspecElement = 0 xs = [1, 2] expect above lawspecElement xs = true
+  end
+end
+
+law `division stays behind its guard` is
+  definition is `for all`
+    (xs :: List (value :: Int8 where value != 0 && 1 / value > 0)) .
+    above 0 xs = true
+  end
+  example `positive denominator` is xs = [1] expect above 0 xs = true end
+end

package/examples/specs/matching.lawspec

@@ -0,0 +1,49 @@
+unit example.matching
+
+-- Rebuilding values checks both constructor identity and every payload field.
+law `list patterns preserve the head and tail` is
+  definition is
+    `for all` (xs :: List Int8) .
+      (match xs with
+        | Nil -> []
+        | Cons head tail -> Cons head tail
+      end) = xs
+  end
+end
+
+law `nested Maybe patterns preserve each absence state` is
+  definition is
+    `for all` (value :: Maybe (Maybe Bool)) .
+      (match value with
+        | Nothing -> Nothing
+        | Just inner -> Just (match inner with
+            | Nothing -> Nothing
+            | Just payload -> Just payload
+          end)
+      end) = value
+  end
+end
+
+law `Either patterns preserve their constructor` is
+  definition is
+    `for all` (value :: Either (List Int8) (Maybe Bool)) .
+      (match value with
+        | Left items -> Left items
+        | Right optional -> Right optional
+      end) = value
+  end
+end
+
+-- The annotation gives the empty-case literal the same primitive type as head.
+law `matching can provide a default value` is
+  definition is
+    `for all` (value :: Maybe Int8) .
+      ((match value with
+        | Nothing -> 0
+        | Just payload -> payload
+      end) :: Int8) = ((match value with
+        | Just payload -> payload
+        | Nothing -> 0
+      end) :: Int8)
+  end
+end

package/examples/specs/payments.lawspec

@@ -0,0 +1,76 @@
+unit example.payments
+
+-- The executable acceptance model for native domain bindings in 0.10.
+-- Applications may call Money "Price", amount "major", and currency "unit";
+-- those representation choices must not alter these laws.
+type Currency is USD | EUR | GBP end
+
+type Money is
+  Money amount :: Decimal currency :: Currency
+end
+
+type Payment is
+  Paid value :: Money
+  Declined reason :: Text
+end
+
+-- These are adapter functions supplied by the application.
+addFee :: Money -> Money
+roundTrip :: Payment -> Payment
+archive :: List (Maybe Payment) -> List (Maybe Payment)
+
+-- The model is exact, independent of host decimal rounding settings.
+definition feeModel (money :: Money) :: Money is
+  match money with
+    | Money amount currency -> Money (amount + 0.2) currency
+  end
+end
+
+law `fees preserve currency and exact decimal value` is
+  definition is
+    `for all` (money :: Money) . addFee money = feeModel money
+  end
+  example `decimal tenths` is
+    money = Money 0.1 USD
+    expect addFee money = Money 0.3 USD
+  end
+  example `small amount is not rounded away` is
+    money = Money 0.000000000000000000000000000001 EUR
+    expect addFee money = Money 0.200000000000000000000000000001 EUR
+  end
+  example `beyond binary floating precision` is
+    money = Money 9007199254740993.1 GBP
+    expect addFee money = Money 9007199254740993.3 GBP
+  end
+end
+
+law `payment variants and payloads survive native conversion` is
+  definition is
+    `for all` (payment :: Payment) . roundTrip payment = payment
+  end
+  example `successful payment` is
+    payment = Paid (Money 12.34 EUR)
+    expect roundTrip payment = Paid (Money 12.34 EUR)
+  end
+  example `declined payment` is
+    payment = Declined "card declined"
+    expect roundTrip payment = Declined "card declined"
+  end
+end
+
+law `archives preserve order duplicates and absence` is
+  definition is
+    `for all` (payments :: List (Maybe Payment)) . archive payments = payments
+  end
+  example `empty archive` is
+    payments = []
+    expect archive payments = []
+  end
+  example `missing is different from a declined payment` is
+    payments = [Nothing, Just (Declined ""), Just (Paid (Money 0.1 USD)),
+                Just (Paid (Money 0.1 USD))]
+    expect archive payments = [Nothing, Just (Declined ""),
+                              Just (Paid (Money 0.1 USD)),
+                              Just (Paid (Money 0.1 USD))]
+  end
+end