diff --git a/Justfile b/Justfile index bb34ada..08deacd 100644 --- a/Justfile +++ b/Justfile @@ -7,6 +7,13 @@ import? "contractile.just" default: @just --list +# Run the Idris2 test suite (estate port 6/11; partial — core.test.ts only). +# Requires idris2 0.8.0+ on PATH. +test-core: + @export IDRIS2_PREFIX="$(dirname "$(dirname "$(command -v idris2)")")" && \ + idris2 --build ubicity-tests.ipkg && \ + ./build/exec/ubicity-tests + # Setup development environment setup: @echo "🔧 Setting up UbiCity development environment..." diff --git a/tests/core.test.ts b/tests/core.test.ts deleted file mode 100644 index dd94ad5..0000000 --- a/tests/core.test.ts +++ /dev/null @@ -1,95 +0,0 @@ -/** - * Core functionality tests for UbiCity - * Tests the fundamental learning experience capture and storage - */ - -import { assertEquals, assertExists } from '@std/assert'; -import { join } from '@std/path'; -import { ensureDir, exists } from '@std/fs'; - -const TEST_DATA_DIR = './test-data-tmp'; - -Deno.test('Core - LearningExperience validation', () => { - const validExperience = { - id: 'test-001', - timestamp: new Date().toISOString(), - learner: { - id: 'learner-123', - name: 'Test Learner', - }, - context: { - location: { - name: 'Test Makerspace', - type: 'makerspace', - }, - }, - experience: { - type: 'workshop', - domain: ['electronics', 'art'], - description: 'Built a light-up sculpture', - }, - }; - - assertExists(validExperience.id); - assertExists(validExperience.learner); - assertExists(validExperience.context.location); - assertEquals(validExperience.experience.domain.length, 2); -}); - -Deno.test('Core - Data persistence', async () => { - await ensureDir(TEST_DATA_DIR); - - const testFile = join(TEST_DATA_DIR, 'test-experience.json'); - const testData = { id: 'test', data: 'value' }; - - await Deno.writeTextFile(testFile, JSON.stringify(testData, null, 2)); - - const fileExists = await exists(testFile); - assertEquals(fileExists, true); - - const content = await Deno.readTextFile(testFile); - const parsed = JSON.parse(content); - assertEquals(parsed.id, 'test'); - - // Cleanup - await Deno.remove(TEST_DATA_DIR, { recursive: true }); -}); - -Deno.test('Core - ID generation uniqueness', () => { - const ids = new Set(); - for (let i = 0; i < 1000; i++) { - const id = crypto.randomUUID(); - ids.add(id); - } - assertEquals(ids.size, 1000, 'All IDs should be unique'); -}); - -Deno.test('Core - Timestamp validation', () => { - const now = new Date(); - const iso = now.toISOString(); - - // Valid ISO 8601 - assertEquals(typeof iso, 'string'); - assertEquals(iso.includes('T'), true); - assertEquals(iso.includes('Z'), true); - - // Parseable - const parsed = new Date(iso); - assertEquals(isNaN(parsed.getTime()), false); -}); - -Deno.test('Core - Domain array handling', () => { - const domains = ['electronics', 'art', 'sculpture']; - - // Deduplication - const unique = [...new Set(domains)]; - assertEquals(unique.length, 3); - - // Case normalization - const normalized = domains.map((d) => d.toLowerCase()); - assertEquals(normalized[0], 'electronics'); - - // Filtering - const filtered = domains.filter((d) => d.startsWith('e')); - assertEquals(filtered.length, 1); -}); diff --git a/tests/idris2/CoreTest.idr b/tests/idris2/CoreTest.idr new file mode 100644 index 0000000..53ecb41 --- /dev/null +++ b/tests/idris2/CoreTest.idr @@ -0,0 +1,122 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +-- Port of tests/core.test.ts to Idris2, estate-rollout port 6/11. +-- PARTIAL: 1 of 4 TS test files in ubicity. The other 3 (privacy, +-- mapper, export) await strategy review per ESTATE-ROLLOUT.adoc +-- "unit-logic strategy" section. +-- +-- 3 of 5 original tests ported here. The other 2 deferred: +-- +-- • "Core - Data persistence" — needs JSON parse + temp-file write. +-- Idris2 base stdlib lacks JSON. Would need either a JSON +-- dependency or a custom parser. Deferred. +-- +-- • "Core - ID generation uniqueness" — needs crypto.randomUUID(). +-- Idris2 base lacks crypto. Would need either a crypto dep or +-- a deterministic-RNG mock (which defeats the uniqueness check). +-- Deferred. + +module CoreTest + +import Test.Spec +import Data.String +import Data.List + +%default covering + +-- == LearningExperience record type == +-- Mirrors the TS interface implicitly assumed by core.test.ts. Fields +-- match the literal object the TS test constructs. + +record Location where + constructor MkLocation + name : String + ltype : String + +record Learner where + constructor MkLearner + id : String + name : String + +record Experience where + constructor MkExperience + etype : String + domain : List String + description : String + +record LearningExperience where + constructor MkLearningExperience + id : String + timestamp : String + learner : Learner + context_location : Location + experience : Experience + +-- Sample valid experience matching the TS literal object. +sampleExperience : LearningExperience +sampleExperience = MkLearningExperience + { id = "test-001" + , timestamp = "2026-05-20T00:00:00Z" + , learner = MkLearner + { id = "learner-123" + , name = "Test Learner" + } + , context_location = MkLocation + { name = "Test Makerspace" + , ltype = "makerspace" + } + , experience = MkExperience + { etype = "workshop" + , domain = ["electronics", "art"] + , description = "Built a light-up sculpture" + } + } + +-- == ISO 8601 timestamp shape helpers == + +isoLooksValid : String -> Bool +isoLooksValid s = isInfixOf "T" s && isInfixOf "Z" s + +-- == List dedup helper == + +dedupList : Eq a => List a -> List a +dedupList = nub + +-- == Tests == + +public export +allSuites : List TestCase +allSuites = + [ test "Core - LearningExperience validation (field presence)" $ do + let e = sampleExperience + allPass + [ assertTrue "id non-empty" (length e.id > 0) + , assertTrue "learner id non-empty" (length e.learner.id > 0) + , assertTrue "location name non-empty" (length e.context_location.name > 0) + , assertTrue "domain has exactly 2 entries" (length e.experience.domain == 2) + ] + + , test "Core - Timestamp ISO 8601 shape (T + Z)" $ do + let s = "2026-05-20T10:30:00Z" + let parseable = length s >= 20 + allPass + [ assertTrue "contains T" (isInfixOf "T" s) + , assertTrue "contains Z" (isInfixOf "Z" s) + , assertTrue "length >= 20" parseable + ] + + , test "Core - Domain array dedup/normalize/filter" $ do + let domains = ["electronics", "art", "sculpture"] + let unique = dedupList domains + let normalized = map toLower domains + let filtered = filter (isPrefixOf "e") domains + let first_normalized = case normalized of + (x :: _) => x + [] => "" + allPass + [ assertTrue "dedup keeps all 3" (length unique == 3) + , assertTrue "normalize keeps electronics" (length normalized == 3 && first_normalized == "electronics") + , assertTrue "filter on e-prefix returns 1" (length filtered == 1) + ] + ] diff --git a/tests/idris2/Main.idr b/tests/idris2/Main.idr new file mode 100644 index 0000000..4af9f35 --- /dev/null +++ b/tests/idris2/Main.idr @@ -0,0 +1,23 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) + +module Main + +import Test.Spec +import CoreTest +import MapperTest +import System + +%default covering + +main : IO () +main = do + (p1, f1) <- runTestSuite "CoreTest" CoreTest.allSuites + (p2, f2) <- runTestSuite "MapperTest" MapperTest.allSuites + let totalPassed = p1 + p2 + let totalFailed = f1 + f2 + putStrLn "" + putStrLn $ "=== Total: " ++ show totalPassed ++ " passed, " ++ show totalFailed ++ " failed ===" + if totalFailed > 0 + then exitWith (ExitFailure 1) + else pure () diff --git a/tests/idris2/MapperTest.idr b/tests/idris2/MapperTest.idr new file mode 100644 index 0000000..a7f4c44 --- /dev/null +++ b/tests/idris2/MapperTest.idr @@ -0,0 +1,186 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +-- Port of tests/mapper.test.ts to Idris2, estate-rollout port 6/11. +-- 5 of 5 tests ported. All tests exercise pure data-manipulation logic +-- (group-by, adjacency, filter, sort, set-uniqueness). The TS suite +-- builds its inline data fresh in each test, so the Idris2 port needs +-- no SUT bindings either. + +module MapperTest + +import Test.Spec +import Data.String +import Data.List + +%default covering + +-- == Lightweight experience record == +-- Single shared shape covering all 5 tests. Unused fields per test are +-- defaulted to "" or [] when building test fixtures. + +record MExp where + constructor MkMExp + expId : String + locationName : String + domains : List String + timestamp : String + learnerId : String + expType : String + +-- == Helpers == + +locCount : String -> List MExp -> Nat +locCount loc xs = length (filter (\e => e.locationName == loc) xs) + +uniqueDomains : List MExp -> List String +uniqueDomains xs = nub (concatMap (\e => e.domains) xs) + +sortPair : Ord a => (a, a) -> (a, a) +sortPair (a, b) = if a <= b then (a, b) else (b, a) + +-- All unordered pairs from a list, each sorted (smaller first). +pairsOf : Ord a => List a -> List (a, a) +pairsOf [] = [] +pairsOf (x :: xs) = map (\y => sortPair (x, y)) xs ++ pairsOf xs + +isInterdisciplinary : MExp -> Bool +isInterdisciplinary e = length e.domains >= 2 + +-- ASCII-only separator (PATTERNS.adoc ascii-only-string-literals-idris2). +domainPairStr : (String, String) -> String +domainPairStr (a, b) = a ++ "->" ++ b + +allInterdisciplinaryPairs : List MExp -> List String +allInterdisciplinaryPairs xs = + concatMap (\e => map domainPairStr (pairsOf e.domains)) + (filter isInterdisciplinary xs) + +-- Learner journey: filter by id, sort by timestamp (ISO strings are +-- lexicographically sortable, so a string compare suffices). +journeyOf : String -> List MExp -> List MExp +journeyOf lid xs = + sortBy (\a, b => compare a.timestamp b.timestamp) + (filter (\e => e.learnerId == lid) xs) + +-- == Test fixtures == + +hotspotData : List MExp +hotspotData = + [ MkMExp "1" "Makerspace A" ["electronics"] "" "" "" + , MkMExp "2" "Makerspace A" ["woodworking"] "" "" "" + , MkMExp "3" "Garden B" ["gardening"] "" "" "" + ] + +networkData : List MExp +networkData = + [ MkMExp "1" "" ["electronics", "art"] "" "" "" + , MkMExp "2" "" ["art", "sculpture"] "" "" "" + , MkMExp "3" "" ["electronics", "robotics"] "" "" "" + ] + +journeyData : List MExp +journeyData = + [ MkMExp "1" "" [] "2025-01-01T10:00:00Z" "alice" "workshop" + , MkMExp "2" "" [] "2025-01-05T14:00:00Z" "alice" "project" + , MkMExp "3" "" [] "2025-01-03T12:00:00Z" "alice" "mentorship" + ] + +interdisciplinaryData : List MExp +interdisciplinaryData = + [ MkMExp "1" "" ["electronics", "art"] "" "alice" "" + , MkMExp "2" "" ["gardening", "food-justice"] "" "bob" "" + ] + +highDiversityData : List MExp +highDiversityData = + [ MkMExp "" "" ["electronics"] "" "" "" + , MkMExp "" "" ["woodworking"] "" "" "" + , MkMExp "" "" ["textiles"] "" "" "" + , MkMExp "" "" ["sculpture"] "" "" "" + ] + +lowDiversityData : List MExp +lowDiversityData = + [ MkMExp "" "" ["electronics"] "" "" "" + , MkMExp "" "" ["electronics"] "" "" "" + , MkMExp "" "" ["electronics"] "" "" "" + ] + +-- == Tests == + +public export +allSuites : List TestCase +allSuites = + [ test "Mapper - Hotspot detection" $ do + let mkrA = locCount "Makerspace A" hotspotData + let gdnB = locCount "Garden B" hotspotData + let uniqLocs = nub (map (\e => e.locationName) hotspotData) + let hotspotsList = filter (\l => locCount l hotspotData >= 2) uniqLocs + let firstHotspot = case hotspotsList of + (h :: _) => h + [] => "" + allPass + [ assertTrue "Makerspace A has 2" (mkrA == 2) + , assertTrue "Garden B has 1" (gdnB == 1) + , assertTrue "2 unique locations" (length uniqLocs == 2) + , assertTrue "exactly 1 hotspot at threshold 2" (length hotspotsList == 1) + , assertEq firstHotspot "Makerspace A" + ] + + , test "Mapper - Domain network generation" $ do + let allPairs = concatMap (\e => pairsOf e.domains) networkData + let artPartners = nub (mapMaybe (\(a, b) => if a == "art" then Just b else Nothing) allPairs) + allPass + [ assertTrue "art-electronics edge present" (elem ("art", "electronics") allPairs) + , assertTrue "art-sculpture edge present" (elem ("art", "sculpture") allPairs) + , assertTrue "electronics-robotics edge present" (elem ("electronics", "robotics") allPairs) + , assertTrue "art has exactly 2 distinct partners" (length artPartners == 2) + ] + + , test "Mapper - Learner journey tracking" $ do + let journey = journeyOf "alice" journeyData + let t0 = case journey of + (h :: _) => h.expType + [] => "" + let t1 = case (drop 1 journey) of + (h :: _) => h.expType + [] => "" + let t2 = case (drop 2 journey) of + (h :: _) => h.expType + [] => "" + allPass + [ assertTrue "journey length 3" (length journey == 3) + , assertEq t0 "workshop" + , assertEq t1 "mentorship" + , assertEq t2 "project" + ] + + , test "Mapper - Interdisciplinary connections" $ do + let interdisc = filter isInterdisciplinary interdisciplinaryData + let pairs = allInterdisciplinaryPairs interdisciplinaryData + allPass + [ assertTrue "2 interdisciplinary entries" (length interdisc == 2) + , assertTrue "2 unique pair strings" (length pairs == 2) + , assertTrue "art->electronics present" (elem "art->electronics" pairs) + , assertTrue "food-justice->gardening present" (elem "food-justice->gardening" pairs) + ] + + , test "Mapper - Diversity score calculation" $ do + let uniqHigh = uniqueDomains highDiversityData + let uniqLow = uniqueDomains lowDiversityData + let hiNum = length uniqHigh + let loNum = length uniqLow + let highTotal = length highDiversityData + let lowTotal = length lowDiversityData + -- Compare ratios via cross-multiplication to stay in Nat: + -- (hiNum / highTotal) > (loNum / lowTotal) + -- iff hiNum * lowTotal > loNum * highTotal + let lhs = hiNum * lowTotal + let rhs = loNum * highTotal + allPass + [ assertTrue "high has 4 unique domains" (hiNum == 4) + , assertTrue "low has 1 unique domain" (loNum == 1) + , assertTrue "high diversity ratio > low diversity ratio" (lhs > rhs) + ] + ] diff --git a/tests/idris2/Test/Spec.idr b/tests/idris2/Test/Spec.idr new file mode 100644 index 0000000..ff6a493 --- /dev/null +++ b/tests/idris2/Test/Spec.idr @@ -0,0 +1,112 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- Copyright (c) 2026 Jonathan D.A. Jewell (hyperpolymath) +-- +||| Minimal Idris2 test harness for the Gossamer ABI test suite. +||| +||| Mirrors the Deno.test interface used by the previous TypeScript suite: +||| each test is a named IO action returning Bool (True = pass, False = fail). +||| The runner reports per-test status and exits non-zero on any failure so +||| Justfile / CI can detect breakage. + +module Test.Spec + +import Data.IORef +import Data.List +import System + +%default total + +public export +record TestCase where + constructor MkTest + name : String + body : IO Bool + +public export +test : String -> IO Bool -> TestCase +test = MkTest + +||| Assert that two showable, comparable values are equal. +||| Prints expected/actual on mismatch. +public export +assertEq : (Show a, Eq a) => a -> a -> IO Bool +assertEq actual expected = + if actual == expected + then pure True + else do + putStrLn "" + putStrLn $ " expected: " ++ show expected + putStrLn $ " actual: " ++ show actual + pure False + +||| Assert that two values are not equal. +public export +assertNotEq : (Show a, Eq a) => a -> a -> IO Bool +assertNotEq actual notExpected = + if actual /= notExpected + then pure True + else do + putStrLn "" + putStrLn $ " did not expect: " ++ show notExpected + pure False + +||| Assert that a Bool is True; print the supplied message on failure. +public export +assertTrue : String -> Bool -> IO Bool +assertTrue msg b = + if b + then pure True + else do + putStrLn "" + putStrLn $ " assertion failed: " ++ msg + pure False + +||| Combine a list of sub-assertions; all must pass. +||| Use in a do-block to compose multiple checks in one test case. +public export +allPass : List (IO Bool) -> IO Bool +allPass [] = pure True +allPass (x :: xs) = do + r <- x + if r then allPass xs else pure False + +runOne : TestCase -> IO Bool +runOne (MkTest name body) = do + putStr $ " " ++ name ++ " ... " + result <- body + if result + then putStrLn "PASS" + else putStrLn "FAIL" + pure result + +runAll : List TestCase -> Nat -> Nat -> IO (Nat, Nat) +runAll [] p f = pure (p, f) +runAll (t :: ts) p f = do + ok <- runOne t + if ok + then runAll ts (S p) f + else runAll ts p (S f) + +||| Run a list of test cases. Reports a summary and exits non-zero +||| if any test failed. Use for single-suite executables. +public export +runTests : List TestCase -> IO () +runTests cases = do + (p, f) <- runAll cases 0 0 + putStrLn "" + putStrLn $ show p ++ " passed, " ++ show f ++ " failed" + if f > 0 + then exitWith (ExitFailure 1) + else pure () + +||| Run a named suite without exiting. Returns (passed, failed) so a parent +||| aggregator (e.g. Main) can accumulate across multiple suites and only +||| exit at the end. +public export +runTestSuite : String -> List TestCase -> IO (Nat, Nat) +runTestSuite name cases = do + putStrLn $ "=== " ++ name ++ " ===" + (p, f) <- runAll cases 0 0 + putStrLn $ show p ++ " passed, " ++ show f ++ " failed" + putStrLn "" + pure (p, f) diff --git a/ubicity-tests.ipkg b/ubicity-tests.ipkg new file mode 100644 index 0000000..c3d16d1 --- /dev/null +++ b/ubicity-tests.ipkg @@ -0,0 +1,18 @@ +-- SPDX-License-Identifier: PMPL-1.0-or-later +-- ubicity Idris2 test suite. Estate port 6/11 (partial — core.test.ts + +-- mapper.test.ts; privacy + export await strategy review). + +package ubicity-tests + +sourcedir = "tests/idris2" + +depends = base + +modules = Test.Spec + , CoreTest + , MapperTest + , Main + +main = Main + +executable = "ubicity-tests"