From fe064dcf1d8d201486feda732d890fa13e66af5c Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm@sourcephile.fr>
Date: Sun, 23 Jul 2023 00:14:55 +0200
Subject: [PATCH 1/1] init
---
.chglog/CHANGELOG.tpl.md | 37 +++
.chglog/config.yml | 37 +++
.envrc | 1 +
.hlint.yaml | 28 ++
.reuse/dep5 | 13 +
Makefile | 111 ++++++++
flake.lock | 121 +++++++++
flake.nix | 60 +++++
fourmolu.yaml | 8 +
src/ForallSem.hs | 547 +++++++++++++++++++++++++++++++++++++++
symantic.cabal | 249 ++++++++++++++++++
11 files changed, 1212 insertions(+)
create mode 100755 .chglog/CHANGELOG.tpl.md
create mode 100755 .chglog/config.yml
create mode 100644 .envrc
create mode 100644 .hlint.yaml
create mode 100644 .reuse/dep5
create mode 100644 Makefile
create mode 100644 flake.lock
create mode 100644 flake.nix
create mode 100644 fourmolu.yaml
create mode 100644 src/ForallSem.hs
create mode 100644 symantic.cabal
diff --git a/.chglog/CHANGELOG.tpl.md b/.chglog/CHANGELOG.tpl.md
new file mode 100755
index 0000000..07711aa
--- /dev/null
+++ b/.chglog/CHANGELOG.tpl.md
@@ -0,0 +1,37 @@
+{{ range .Versions }}
+## {{ .Tag.Name }} ({{ datetime "2006-01-02" .Tag.Date }})
+
+{{ range .CommitGroups -}}
+### {{ .Title }}
+
+{{ range .Commits -}}
+* {{ upperFirst .Type }}{{ if .Subject }} {{ .Subject }}{{ end }}.
+{{ end }}
+{{ end -}}
+
+{{- if .RevertCommits -}}
+### Reverts
+
+{{ range .RevertCommits -}}
+* {{ .Revert.Header }}
+{{ end }}
+{{ end -}}
+
+{{- if .MergeCommits -}}
+### Merges
+
+{{ range .MergeCommits -}}
+* {{ .Header }}
+{{ end }}
+{{ end -}}
+
+{{- if .NoteGroups -}}
+{{ range .NoteGroups -}}
+### {{ .Title }}
+
+{{ range .Notes }}
+{{ .Body }}
+{{ end }}
+{{ end -}}
+{{ end -}}
+{{ end -}}
diff --git a/.chglog/config.yml b/.chglog/config.yml
new file mode 100755
index 0000000..2e25049
--- /dev/null
+++ b/.chglog/config.yml
@@ -0,0 +1,37 @@
+style: none
+template: CHANGELOG.tpl.md
+info:
+ title: ChangeLog
+ repository_url: "https://git.sourcephile.fr/haskell/literate-web"
+options:
+ sort: "date"
+
+ commits:
+ sort_by: Type
+
+ commit_groups:
+ group_by: Scope
+ sort_by: Custom
+ title_order:
+ - iface
+ - doc
+ - impl
+ - tests
+ - build
+ title_maps:
+ build: Build
+ doc: Documentation
+ iface: Interface
+ impl: Implementation
+ tests: Tests
+
+ header:
+ pattern: "^([\\w\\$\\.\\-\\*\\s]*)\\:\\s(\\w*)\\s*(.*)$"
+ pattern_maps:
+ - Scope
+ - Type
+ - Subject
+
+ notes:
+ keywords:
+ - BREAKING CHANGE
diff --git a/.envrc b/.envrc
new file mode 100644
index 0000000..3550a30
--- /dev/null
+++ b/.envrc
@@ -0,0 +1 @@
+use flake
diff --git a/.hlint.yaml b/.hlint.yaml
new file mode 100644
index 0000000..f95c6ca
--- /dev/null
+++ b/.hlint.yaml
@@ -0,0 +1,28 @@
+- extensions:
+ - name: Haskell2010
+ - name: NoCPP
+ - name: TypeApplications
+
+- ignore: {name: Move brackets to avoid $}
+- ignore: {name: Reduce duplication}
+- ignore: {name: Redundant $}
+- ignore: {name: Redundant bracket}
+- ignore: {name: Redundant do}
+- ignore: {name: Redundant lambda}
+- ignore: {name: Use camelCase}
+- ignore: {name: Use const}
+- ignore: {name: Use fmap}
+- ignore: {name: Use if}
+- ignore: {name: Use import/export shortcut}
+- ignore: {name: Use intercalate}
+- ignore: {name: Use list literal pattern}
+- ignore: {name: Use list literal}
+- ignore: {name: Use newtype instead of data}
+- ignore: {name: Use null}
+- ignore: {name: Use span}
+- ignore: {name: Use unless}
+- ignore: {name: Use ++}
+
+# BEGIN: generated hints
+- fixity: "infixr 4 </>"
+# END: generated hints
diff --git a/.reuse/dep5 b/.reuse/dep5
new file mode 100644
index 0000000..4db55a9
--- /dev/null
+++ b/.reuse/dep5
@@ -0,0 +1,13 @@
+Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
+Upstream-Name: literate-web
+Upstream-Contact: Julien Moutinho <julm+literate-web@sourcephile.fr>
+Source: https://git.sourcephile.fr/haskell/literate-web
+
+Files: *.lock cabal.project* *.cabal *.md .chglog/* .envrc
+ .gitignore .gitmodules .git-blame-ignore-revs *.yaml
+Copyright: Julien Moutinho <julm+literate-web@sourcephile.fr>
+License: CC0-1.0
+
+Files: src/* tests/* Makefile *.nix
+Copyright: Julien Moutinho <julm+literate-web@sourcephile.fr>
+License: AGPL-3.0-or-later
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..41fbb85
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,111 @@
+cabal := $(wildcard *.cabal)
+package := $(notdir ./$(cabal:.cabal=))
+version := $(shell sed -ne 's/^version: *\(.*\)/\1/p' $(cabal))
+project := $(patsubst %.cabal,%,$(cabal))
+cabal_builddir ?= dist-newstyle
+
+override REPL_OPTIONS += -ignore-dot-ghci
+override TEST_OPTIONS += --color=always
+override GHCID_OPTIONS += --no-height-limit --reverse-errors --color=always --warnings --restart $(cabal)
+
+all: build
+build:
+ cabal build $(CABAL_BUILD_FLAGS)
+clean c:
+ cabal clean
+repl:
+ cabal repl $(CABAL_REPL_FLAGS) $(project)
+ghcid:
+ ghcid $(GHCID_OPTIONS) --command 'cabal repl -fno-code $(CABAL_REPL_FLAGS) $(project) $(addprefix --repl-options ,$(REPL_OPTIONS))'
+
+.PHONY: tests
+t tests:
+ cabal test $(CABAL_TEST_FLAGS) \
+ --test-show-details always --test-options "$(TEST_OPTIONS)"
+tests/prof-time: $(project)-tests.eventlog.json
+tests/prof-heap: $(project)-tests.eventlog.html
+.PHONY: $(project)-test.eventlog
+$(project)-test.eventlog $(project)-test.prof:
+ cabal test $(CABAL_TEST_FLAGS) \
+ --test-show-details always --test-options "$(TEST_OPTIONS) +RTS $(RTS_OPTIONS)" \
+ --enable-profiling $(addprefix --ghc-options ,$(GHC_PROF_OPTIONS)) || true
+t/repl tests/repl:
+ cabal repl $(CABAL_REPL_FLAGS) $(CABAL_TEST_FLAGS) --enable-tests $(project)-tests
+t/ghcid tests/ghcid:
+ ghcid $(GHCID_OPTIONS) --command 'cabal repl $(CABAL_REPL_FLAGS) $(project) $(addprefix --repl-options ,$(REPL_OPTIONS))' \
+ --run=':! ghcid $(GHCID_OPTIONS) --command "cabal repl $(CABAL_REPL_FLAGS) $(CABAL_TEST_FLAGS) $(project):tests" --test ":main $(TEST_OPTIONS)"'
+
+.PHONY: benchmarks/time
+bt benchmarks/time:
+ cabal bench $(CABAL_BENCH_FLAGS) time \
+ --benchmark-options "$(BENCHMARKS_TIME_OPTIONS)"
+.PHONY: benchmarks/weigh
+bw benchmarks/weigh:
+ cabal bench $(CABAL_BENCH_FLAGS) weigh \
+ --benchmark-options "$(BENCHMARKS_WEIGH_OPTIONS)"
+benchmarks/weigh/ghcid:
+ ghcid $(GHCID_OPTIONS) --target=relactive --run=':! ghcid $(GHCID_OPTIONS) --target=weigh --run'
+
+executables/async/ghcid:
+ ghcid $(GHCID_OPTIONS) --target=relactive --run=':! ghcid $(GHCID_OPTIONS) --target=async --run'
+executables/fsnotify/ghcid:
+ ghcid $(GHCID_OPTIONS) --target=relactive --run=':! ghcid $(GHCID_OPTIONS) --target=fsnotify --run'
+
+
+%/accept: TEST_OPTIONS += --accept
+%/accept: %
+
+%/cover: CABAL_TEST_FLAGS += --enable-coverage
+%/cover: %
+
+%.eventlog.html: RTS_OPTIONS += -hy -l-au
+%.eventlog.html: %.eventlog
+ eventlog2html $<
+%.eventlog.json: RTS_OPTIONS += -p -l-au
+%.eventlog.json: %.eventlog
+ hs-speedscope $<
+
+doc:
+ cabal haddock --haddock-css ocean --haddock-hyperlink-source
+
+.PHONY: ChangeLog.md
+ChangeLog.md:
+ ! git tag --merged | grep -Fqx $(package)-$(version)
+ git diff --exit-code
+ git tag -f $(package)-$(version)
+ git-chglog --output $@.new --tag-filter-pattern '$(package)-.*' $(package)-$(version)
+ touch $@
+ cat $@ >>$@.new
+ mv -f $@.new $@
+ git tag -d $(package)-$(version)
+ git add '$@'
+ git commit -m 'doc: update `$@`'
+tag: build ChangeLog.md
+ git tag -s -m $(package)-$(version) $(package)-$(version)
+
+tar:
+ git diff --exit-code
+ reuse lint
+ cabal sdist
+ cabal haddock --haddock-for-hackage --enable-doc
+upload: LANG=C
+upload: tar
+ git tag --merged | grep -Fqx $(package)-$(version)
+ git push --follow-tags $(GIT_PUSH_FLAGS)
+ cabal upload $(CABAL_UPLOAD_FLAGS) "$(cabal_builddir)"/sdist/$(package)-$(version).tar.gz
+ cabal upload $(CABAL_UPLOAD_FLAGS) --documentation "$(cabal_builddir)"/$(package)-$(version)-docs.tar.gz
+%/publish: CABAL_UPLOAD_FLAGS+=--publish
+%/publish: %
+
+publish: upload/publish
+
+.PHONY: .hlint.yaml
+.hlint.yaml: $(shell find src -name '*.hs' -not -name 'HLint.hs')
+ sed -i -e '/^# BEGIN: generated hints/,/^# END: generated hints/d' $@
+ echo >>$@ '# BEGIN: generated hints'
+ hlint --find . | grep -- '- fixity:' | sort -u >>$@
+ echo >>$@ '# END: generated hints'
+lint: .hlint.yaml
+ if hlint --quiet --report=hlint.html -XNoCPP $(HLINT_FLAGS) .; \
+ then rm -f hlint.html; \
+ else sensible-browser ./hlint.html & fi
diff --git a/flake.lock b/flake.lock
new file mode 100644
index 0000000..aa62899
--- /dev/null
+++ b/flake.lock
@@ -0,0 +1,121 @@
+{
+ "nodes": {
+ "flake-utils": {
+ "locked": {
+ "lastModified": 1667077288,
+ "narHash": "sha256-bdC8sFNDpT0HK74u9fUkpbf1MEzVYJ+ka7NXCdgBoaA=",
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "rev": "6ee9ebb6b1ee695d2cacc4faa053a7b9baa76817",
+ "type": "github"
+ },
+ "original": {
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "type": "github"
+ }
+ },
+ "flake-utils_2": {
+ "locked": {
+ "lastModified": 1667077288,
+ "narHash": "sha256-bdC8sFNDpT0HK74u9fUkpbf1MEzVYJ+ka7NXCdgBoaA=",
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "rev": "6ee9ebb6b1ee695d2cacc4faa053a7b9baa76817",
+ "type": "github"
+ },
+ "original": {
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "type": "github"
+ }
+ },
+ "nixpkgs": {
+ "locked": {
+ "lastModified": 1686237827,
+ "narHash": "sha256-fAZB+Zkcmc+qlauiFnIH9+2qgwM0NO/ru5pWEw3tDow=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "81ed90058a851eb73be835c770e062c6938c8a9e",
+ "type": "github"
+ },
+ "original": {
+ "id": "nixpkgs",
+ "type": "indirect"
+ }
+ },
+ "pre-commit-hooks": {
+ "inputs": {
+ "flake-utils": "flake-utils",
+ "nixpkgs": [
+ "nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1667992213,
+ "narHash": "sha256-8Ens8ozllvlaFMCZBxg6S7oUyynYx2v7yleC5M0jJsE=",
+ "owner": "cachix",
+ "repo": "pre-commit-hooks.nix",
+ "rev": "ebcbfe09d2bd6d15f68de3a0ebb1e4dcb5cd324b",
+ "type": "github"
+ },
+ "original": {
+ "owner": "cachix",
+ "repo": "pre-commit-hooks.nix",
+ "type": "github"
+ }
+ },
+ "pre-commit-hooks_2": {
+ "inputs": {
+ "flake-utils": "flake-utils_2",
+ "nixpkgs": [
+ "symantic-base",
+ "nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1667992213,
+ "narHash": "sha256-8Ens8ozllvlaFMCZBxg6S7oUyynYx2v7yleC5M0jJsE=",
+ "owner": "cachix",
+ "repo": "pre-commit-hooks.nix",
+ "rev": "ebcbfe09d2bd6d15f68de3a0ebb1e4dcb5cd324b",
+ "type": "github"
+ },
+ "original": {
+ "owner": "cachix",
+ "repo": "pre-commit-hooks.nix",
+ "type": "github"
+ }
+ },
+ "root": {
+ "inputs": {
+ "nixpkgs": "nixpkgs",
+ "pre-commit-hooks": "pre-commit-hooks",
+ "symantic-base": "symantic-base"
+ }
+ },
+ "symantic-base": {
+ "inputs": {
+ "nixpkgs": [
+ "nixpkgs"
+ ],
+ "pre-commit-hooks": "pre-commit-hooks_2"
+ },
+ "locked": {
+ "lastModified": 1689629067,
+ "narHash": "sha256-JJmKWWemB+6J73IwQqqN61o+z4B+XL5Z4d0q2DcKNVk=",
+ "ref": "refs/heads/main",
+ "rev": "f928eacc54007508ed00235b2ba7e065e17f5f66",
+ "revCount": 90,
+ "type": "git",
+ "url": "git://git.sourcephile.fr/haskell/symantic-base"
+ },
+ "original": {
+ "type": "git",
+ "url": "git://git.sourcephile.fr/haskell/symantic-base"
+ }
+ }
+ },
+ "root": "root",
+ "version": 7
+}
diff --git a/flake.nix b/flake.nix
new file mode 100644
index 0000000..6fbe0ea
--- /dev/null
+++ b/flake.nix
@@ -0,0 +1,60 @@
+{
+ inputs = {
+ nixpkgs.url = "flake:nixpkgs";
+ pre-commit-hooks.url = "github:cachix/pre-commit-hooks.nix";
+ pre-commit-hooks.inputs.nixpkgs.follows = "nixpkgs";
+ symantic-base.url = "git://git.sourcephile.fr/haskell/symantic-base";
+ symantic-base.inputs.nixpkgs.follows = "nixpkgs";
+ };
+ outputs = inputs:
+ let
+ pkg = "symantic";
+ lib = inputs.nixpkgs.lib;
+ forAllSystems = f: lib.genAttrs lib.systems.flakeExposed (system: f rec {
+ inherit system;
+ pkgs = inputs.nixpkgs.legacyPackages.${system};
+ haskellPackages = pkgs.haskellPackages.extend (with pkgs.haskell.lib; hfinal: hsuper: {
+ ${pkg} = doBenchmark (buildFromSdist (hfinal.callCabal2nix pkg ./. { }));
+ symantic-base = buildFromSdist (hfinal.callCabal2nix "symantic-base" inputs.symantic-base { });
+ });
+ });
+ in
+ rec {
+ # nix -L build
+ defaultPackage = forAllSystems ({ haskellPackages, ... }: haskellPackages.${pkg});
+ # nix -L develop or direnv allow
+ devShell = forAllSystems ({ pkgs, haskellPackages, system, ... }:
+ haskellPackages.shellFor {
+ packages = ps: [ ps.${pkg} ];
+ nativeBuildInputs = [
+ haskellPackages.cabal-install
+ haskellPackages.ghcid
+ haskellPackages.haskell-language-server
+ haskellPackages.hlint
+ #haskellPackages.stan
+ pkgs.git-chglog
+ pkgs.reuse
+ ];
+ withHoogle = false;
+ doBenchmark = true;
+ inherit (checks.${system}.pre-commit-check) shellHook;
+ });
+ # nix flake check
+ checks = forAllSystems (args: with args; {
+ pre-commit-check = inputs.pre-commit-hooks.lib.${system}.run {
+ src = ./.;
+ #settings.ormolu.cabalDefaultExtensions = true;
+ settings.ormolu.defaultExtensions = [
+ "ImportQualifiedPost"
+ "TypeApplications"
+ ];
+ hooks = {
+ hlint.enable = true;
+ nixpkgs-fmt.enable = true;
+ fourmolu.enable = true;
+ cabal-fmt.enable = true;
+ };
+ };
+ });
+ };
+}
diff --git a/fourmolu.yaml b/fourmolu.yaml
new file mode 100644
index 0000000..1fc42af
--- /dev/null
+++ b/fourmolu.yaml
@@ -0,0 +1,8 @@
+comma-style: leading
+diff-friendly-import-export: true
+haddock-style: single-line
+indent-wheres: true
+indentation: 2
+newlines-between-decls: 1
+record-brace-space: false
+respectful: true
diff --git a/src/ForallSem.hs b/src/ForallSem.hs
new file mode 100644
index 0000000..342f22b
--- /dev/null
+++ b/src/ForallSem.hs
@@ -0,0 +1,547 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module ForallSem where
+
+import Data.Functor (Functor(..), (<$>))
+import Data.Functor.Constant (Constant(..))
+import Control.Applicative (Applicative(..))
+import Control.Monad (Monad(..))
+import Data.Kind (Type, Constraint)
+import Data.Function (($), (.), id)
+import Data.String (String)
+import Data.Semigroup (Semigroup(..))
+import Data.Maybe (Maybe(..), isJust)
+import Text.Read (Read(..), reads)
+import Data.Bool (otherwise)
+import Text.Show (Show(..))
+import Data.Eq (Eq(..))
+import Data.Either (Either(..))
+import Data.Int (Int)
+import Prelude (error)
+import Control.Monad.Trans.Except qualified as MT
+import Control.Monad.Trans.Reader qualified as MT
+import Control.Monad.Trans.State qualified as MT
+import Type.Reflection
+import Unsafe.Coerce (unsafeCoerce)
+import Data.Proxy (Proxy(..))
+import Prelude qualified
+import GHC.Types
+
+type Semantic = Type -> Type
+type Syntax = Semantic -> Constraint
+class Syn0 (sem::Semantic) where
+ syn0 :: sem ()
+class Syn1 (sem::Semantic) where
+ syn1 :: sem ()
+class Syn2 (sem::Semantic) where
+ syn2 :: sem () -> sem () -> sem ()
+
+p0 :: (forall sem. syn sem => Syn0 sem) => ForallSem syn ()
+p0 = ForallSem syn0
+
+p1 :: (forall sem. syn sem => Syn1 sem) => ForallSem syn ()
+p1 = ForallSem syn1
+
+p3 :: forall syn.
+ ( forall sem. syn sem => Syn0 sem
+ , forall sem. syn sem => Syn1 sem
+ , forall sem. syn sem => Syn2 sem
+ ) => ForallSem syn ()
+p3 = ForallSem $ syn2 (unForallSem @syn p0) (unForallSem @syn p1)
+
+
+
+
+
+
+
+data ForallSem (syn::Syntax) (a::Type)
+ = ForallSem { unForallSem :: forall sem. syn sem => sem a }
+
+instance ( forall sem. syn sem => Functor sem
+ ) => Functor (ForallSem syn) where
+ fmap f (ForallSem sem) = ForallSem (fmap f sem)
+ a <$ (ForallSem sem) = ForallSem (a <$ sem)
+instance ( forall sem. syn sem => Applicative sem
+ , Functor (ForallSem syn)
+ ) => Applicative (ForallSem syn) where
+ pure a = ForallSem (pure a)
+ liftA2 f (ForallSem a) (ForallSem b) = ForallSem (liftA2 f a b)
+ (<*>) (ForallSem f) (ForallSem a) = ForallSem ((<*>) f a)
+ (<*) (ForallSem f) (ForallSem a) = ForallSem ((<*) f a)
+ (*>) (ForallSem f) (ForallSem a) = ForallSem ((*>) f a)
+instance ( forall sem. syn sem => Monad sem
+ , Applicative (ForallSem syn)
+ ) => Monad (ForallSem syn) where
+ (>>=) (ForallSem sa) f = ForallSem (sa >>= \a -> case f a of ForallSem sb -> sb)
+ return = pure
+ (>>) = (*>)
+
+-- * Interpreter 'Parser'
+data TermVT syn = forall vs a. TermVT
+ { typeTermVT :: Ty vs a
+ , unTermVT :: ForallSem syn a
+ }
+
+-- instance Eq (TyVT) where
+-- TyVT x == TyVT y =
+-- let (x', y') = appendVars x y in
+-- isJust $ eqTypeKi x' y'
+
+-- * Type family @(++)@
+type family (++) xs ys where
+ '[] ++ ys = ys
+ -- xs ++ '[] = xs
+ (x ': xs) ++ ys = x ': xs ++ ys
+infixr 5 ++
+
+-- * Type 'Len'
+data Len (xs::[k]) where
+ LenZ :: Len '[]
+ LenS :: Len xs -> Len (x ': xs)
+
+instance Show (Len vs) where
+ showsPrec _p = showsPrec 10 . intLen
+
+addLen :: Len a -> Len b -> Len (a ++ b)
+addLen LenZ b = b
+addLen (LenS a) b = LenS $ addLen a b
+
+shiftLen :: forall t b a. Len a -> Len (a ++ b) -> Len (a ++ t ': b)
+shiftLen LenZ b = LenS b
+shiftLen (LenS a) (LenS b) = LenS $ shiftLen @t @b a b
+
+intLen :: Len xs -> Int
+intLen = go 0
+ where
+ go :: Int -> Len xs -> Int
+ go i LenZ = i
+ go i (LenS l) = go (1 Prelude.+ i) l
+
+-- ** Class 'LenInj'
+class LenInj (vs::[k]) where
+ lenInj :: Len vs
+instance LenInj '[] where
+ lenInj = LenZ
+instance LenInj as => LenInj (a ': as) where
+ lenInj = LenS lenInj
+
+type Name = String
+-- Use a CUSK, because it's a polymorphically recursive type,
+-- See https://ryanglscott.github.io/2020/01/05/five-benefits-to-using-standalonekindsignatures/
+data Ty :: forall aK. [Type] -> aK -> Type where
+ TyConst :: Len vs -> TypeRep a -> Ty vs a
+ TyVar :: Name -> Var vs a -> Ty vs a
+ TyApp :: Ty vs f -> Ty vs a -> Ty vs (f a)
+infixl 9 `TyApp`
+deriving instance Show (Ty vs a)
+instance AllocVars Ty where
+ allocVarsL len (TyConst l c) = TyConst (addLen len l) c
+ allocVarsL len (TyApp f a) = TyApp (allocVarsL len f) (allocVarsL len a)
+ allocVarsL len (TyVar n v) = TyVar n (allocVarsL len v)
+ --allocVarsL len (TyFam l f as) = TyFam (addLen len l) f $ allocVarsL len `mapTys` as
+
+ allocVarsR len (TyConst l c) = TyConst (addLen l len) c
+ allocVarsR len (TyApp f a) = TyApp (allocVarsR len f) (allocVarsR len a)
+ allocVarsR len (TyVar n v) = TyVar n (allocVarsR len v)
+ --allocVarsR len (TyFam l f as) = TyFam (addLen l len) f $ allocVarsR len `mapTys` as
+
+data TyVT = forall vs a. TyVT (Ty vs a)
+deriving instance Show TyVT
+instance Eq TyVT where
+ TyVT x == TyVT y = isJust (eqTyKi x' y')
+ where (x', y') = appendVars x y
+
+-- | /Heterogeneous type equality/:
+-- return two proofs when two 'Type's are equals:
+-- one for the type and one for the kind.
+eqTyKi :: Ty vs (x::xK) -> Ty vs (y::yK) -> Maybe (x:~~:y)
+eqTyKi (TyConst _lx x) (TyConst _ly y) = eqTypeRep x y
+eqTyKi (TyVar _nx x) (TyVar _ny y) = eqVarKi x y
+eqTyKi (TyApp fx ax) (TyApp fy ay)
+ | Just HRefl <- eqTyKi fx fy
+ , Just HRefl <- eqTyKi ax ay
+ = Just HRefl
+-- eqTyKi (TyFam _ _lx fx ax) (TyFam _ _ly fy ay)
+-- | Just HRefl <- eqTypeRep fx fy
+-- , Just HRefl <- eqTypes ax ay
+-- = Just HRefl
+-- -- NOTE: 'TyFam' is expanded as much as possible.
+-- eqTyKi x@TyFam{} y = eqTyKi (expandFam x) y
+-- eqTyKi x y@TyFam{} = eqTyKi x (expandFam y)
+eqTyKi _x _y = Nothing
+
+-- data Some :: (Type -> Type) -> Type where
+-- Some :: TypeRep a -> t a -> Some t
+--
+-- mapSome :: (forall a. s a -> t a) -> Some s -> Some t
+-- mapSome f (Some a t) = Some a (f t)
+--
+-- type SomeTy = Some (Constant ())
+
+-- pattern SomeTy :: TypeRep a -> SomeTy
+-- pattern SomeTy a = Some a (Constant ())
+-- {-# COMPLETE SomeTy #-}
+
+-- someType :: TypeRep a -> SomeTy
+-- someType a = Some a (Constant ())
+
+--infer :: Vars vs -> TermVT syn -> Maybe (TermVT syn)
+--infer ctx te = case te of
+--Lit i -> return $ Some TTyInt (embed (CInt i))
+
+
+data Parser syn = Parser
+ { unParser ::
+ --MT.State (TokenTerm a)
+ (Either ErrMsg (TermVT syn))
+ }
+
+{-
+instance ( forall sem. syn sem => Functor sem
+ ) => Functor (Parser syn) where
+ fmap f (Parser esa) = Parser $
+ case esa of
+ Left e -> Left e
+ Right (ForallSem sem) -> Right (ForallSem (f <$> sem))
+ a <$ Parser esa = Parser $
+ case esa of
+ Left e -> Left e
+ Right (ForallSem sem) -> Right (ForallSem (a <$ sem))
+instance ( forall sem. syn sem => Applicative sem
+ , Applicative (ForallSem syn)
+ , forall err. syn (Either err)
+ , syn (Parser syn) -- FIXME: what constraint is still missing to still require that?
+ ) => Applicative (Parser syn) where
+ pure a = Parser (Right (ForallSem (pure a)))
+ liftA2 f (Parser a) (Parser b) = Parser (liftA2 (liftA2 f) a b)
+ (<*>) (Parser f) (Parser a) = Parser (liftA2 (<*>) f a)
+ (*>) (Parser f) (Parser a) = Parser (liftA2 (*>) f a)
+ (<*) (Parser f) (Parser a) = Parser (liftA2 (<*) f a)
+instance ( forall sem. syn sem => Monad sem
+ , forall err. syn (Either err)
+ , syn (Parser syn) -- FIXME: what constraint is still missing to still require that?
+ ) => Monad (Parser syn) where
+ (>>=) (Parser efsa) f = Parser (efsa >>= \(ForallSem sa) -> sa >>= unParser . f)
+-}
+
+-- * Type 'BinTree'
+-- | /Binary Tree/.
+data BinTree a
+ = BinTree0 a
+ | BinTree2 (BinTree a) (BinTree a)
+ deriving (Eq, Show)
+
+type TermAST = BinTree TokenTerm
+data TokenTerm
+ = TokenTermAtom String
+ | TokenTermAbst String TyVT TermAST
+ deriving (Show)
+
+tree0 = add (lit 8) (neg (add (lit 1) (lit 2)))
+tree1 = mul (add (lit 8) (neg (add (lit 1) (lit 2)))) (lit 2)
+tree2 = lam (\(x::sem Int) -> mul (lit 0) (add (lit 1) (lit 2)))
+tree0Print = print tree0
+tree1Print = print tree1
+tree2Print = print tree2
+
+type ErrMsg = String
+
+safeRead :: Read a => String -> Either ErrMsg a
+safeRead s = case reads s of
+ [(x,"")] -> Right x
+ _ -> Left $ "Read error: " <> s
+
+instance (forall sem. syn sem => Addable sem) => Addable (ForallSem syn) where
+ lit n = ForallSem (lit n)
+ neg (ForallSem a) = ForallSem (neg a)
+ add (ForallSem a) (ForallSem b) = ForallSem (add a b)
+instance (forall sem. syn sem => Mulable sem) => Mulable (ForallSem syn) where
+ mul (ForallSem a) (ForallSem b) = ForallSem (mul a b)
+instance ( forall sem. syn sem => Abstractable sem
+ --, forall sem. syn sem => Typeable sem -- user instance not accepted
+ --, forall s1 s2. (syn s1, syn s2) => s1 ~ s2 -- crazy...
+ ) => Abstractable (ForallSem syn) where
+ ForallSem a2b .@ ForallSem a = ForallSem (a2b .@ a)
+ lam f = ForallSem (lam (\a -> let ForallSem b = f (forallSem a) in b))
+ where
+ -- Safe here because a :: sem a and b :: sem b share the same 'sem'.
+ forallSem :: sem a -> ForallSem syn a
+ forallSem a = ForallSem (unsafeCoerce a)
+
+
+
+parseAddable ::
+ ( forall sem. syn sem => Addable sem
+ , syn (ForallSem syn)
+ ) =>
+ (TermAST -> Parser syn) -> TermAST -> Parser syn
+parseAddable _final (BinTree0 (TokenTermAtom s))
+ | Right (i::Int) <- safeRead s
+ = Parser $ Right $ TermVT (TyConst LenZ typeRep) $ ForallSem @_ @Int $ lit i
+parseAddable final (BinTree2 (BinTree0 (TokenTermAtom "Neg")) aT) = Parser $
+ case final aT of
+ Parser aE -> do
+ TermVT aTy (ForallSem a :: ForallSem syn a) <- aE
+ case eqTyKi aTy (TyConst (lenVars aTy) (typeRep @Int)) of
+ Nothing -> Left "TypeError"
+ Just HRefl -> do
+ Right $ TermVT aTy $ neg a
+parseAddable final (BinTree2 (BinTree2 (BinTree0 (TokenTermAtom "Add")) aT) bT) =
+ Parser $ do
+ TermVT aTy (ForallSem a :: ForallSem syn a) <- unParser (final aT)
+ case eqTyKi aTy (TyConst (lenVars aTy) (typeRep @Int)) of
+ Nothing -> Left "TypeError"
+ Just HRefl -> do
+ TermVT bTy (ForallSem b :: ForallSem syn b) <- unParser (final bT)
+ case eqTyKi bTy (TyConst (lenVars bTy) (typeRep @Int)) of
+ Nothing -> Left "TypeError"
+ Just HRefl -> do
+ Right $ TermVT aTy $ ForallSem @_ @Int $ add a b
+parseAddable _final e = Parser $ Left $ "Invalid tree: " <> show e
+
+--tree0Parser :: (forall sem. syn sem => Addable sem, syn (ForallSem syn)) => Either ErrMsg (ForallSem syn Int)
+--tree0Parser = unParser $ parse tree0Print
+
+class (Addable sem, Mulable sem, Abstractable sem) => FinalSyntaxes sem
+instance (Addable sem, Mulable sem, Abstractable sem) => FinalSyntaxes sem
+
+parseMulable ::
+ ( forall sem. syn sem => Mulable sem
+ , forall sem. syn sem => Addable sem
+ , syn (ForallSem syn)
+ ) =>
+ (TermAST -> Parser syn) -> TermAST -> Parser syn
+parseMulable final (BinTree2 (BinTree2 (BinTree0 (TokenTermAtom "Mul")) aT) bT) =
+ Parser $ do
+ case (final aT, final bT) of
+ (Parser aE, Parser bE) -> do
+ TermVT aTy (ForallSem a :: ForallSem syn a) <- aE
+ case eqTyKi aTy (TyConst (lenVars aTy) (typeRep @Int)) of
+ Nothing -> Left "TypeError"
+ Just HRefl -> do
+ TermVT bTy (ForallSem b :: ForallSem syn b) <- bE
+ case eqTyKi bTy (TyConst (lenVars bTy) (typeRep @Int)) of
+ Nothing -> Left "TypeError"
+ Just HRefl -> do
+ Right $ TermVT aTy (ForallSem @_ @a $ mul a b)
+parseMulable final t = parseAddable final t
+
+parseAbstractable ::
+ ( forall sem. syn sem => Mulable sem
+ , forall sem. syn sem => Addable sem
+ , forall sem. syn sem => Abstractable sem
+ , syn (ForallSem syn)
+ ) =>
+ a ~ Int =>
+ (TermAST -> Parser syn) -> TermAST -> Parser syn
+-- TODO: parse variables
+parseAbstractable final (BinTree0 (TokenTermAbst n (TyVT (aTy::Ty vs a)) bT)) =
+ Parser $
+ case final bT of
+ Parser bE -> do
+ TermVT abTy (abF :: ForallSem syn ab) <- bE
+ case eqTyKi (TyConst (lenVars aTy) (typeRep @Type)) aTy of
+ Nothing -> Left "TypeError"
+ Just HRefl -> do
+ case abTy of
+ FUN iTy bTy ->
+ case eqTyKi (TyConst (lenVars bTy) (typeRep @Type)) bTy of
+ Nothing -> Left "TypeError"
+ Just HRefl -> do
+ -- FIXME: appendVars
+ case eqTyKi aTy iTy of
+ Nothing -> Left "TypeError"
+ Just HRefl -> do
+ case abF of
+ ForallSem ab ->
+ Right $ TermVT abTy $ ForallSem @_ @ab $
+ -- FIXME: Tyable
+ lam (ab .@)
+ _ -> Left "TypeError"
+parseAbstractable final t = parseMulable final t
+
+pattern FUN :: forall k (fun :: k) vs. ()
+ => forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
+ (arg :: TYPE r1) (res :: TYPE r2).
+ (k ~ Type, fun ~~ (arg -> res))
+ => Ty vs arg
+ -> Ty vs res
+ -> Ty vs fun
+pattern FUN arg res <- (TyConst _len (eqTypeRep (typeRep @(->)) -> Just HRefl) `TyApp` arg) `TyApp` res
+ where FUN arg res = (TyConst (lenVars arg) (typeRep @(->)) `TyApp` arg) `TyApp` res
+
+-- * Class 'LenVars'
+-- | Return the 'Len' of the 'Var' context.
+class LenVars a where
+ lenVars :: a -> Len (VarsOf a)
+
+type instance VarsOf (Ty vs a) = vs
+instance LenVars (Ty vs a) where
+ lenVars (TyConst len _c) = len
+ lenVars (TyApp f _a) = lenVars f
+ lenVars (TyVar _n v) = lenVars v
+ -- lenVars (TyFam l _f _as) = l
+
+-- * Type family 'VarsOf'
+-- | Return the 'Var' context of something.
+type family VarsOf a :: [Type]
+type instance VarsOf (Var vs v) = vs
+--type instance VarsOf (UsedVars src vs vs') = vs'
+
+
+
+-- * Class 'AllocVars'
+-- | Allocate 'Var's in a 'Var' context,
+-- either to the left or to the right.
+class AllocVars (a::[Type] -> k -> Type) where
+ allocVarsL :: Len len -> a vs x -> a (len ++ vs) x
+ allocVarsR :: Len len -> a vs x -> a (vs ++ len) x
+
+appendVars ::
+ AllocVars a =>
+ AllocVars b =>
+ LenVars (a vs_x x) =>
+ LenVars (b vs_y y) =>
+ VarsOf (a vs_x x) ~ vs_x =>
+ VarsOf (b vs_y y) ~ vs_y =>
+ a vs_x (x::kx) ->
+ b vs_y (y::ky) ->
+ ( a (vs_x ++ vs_y) x
+ , b (vs_x ++ vs_y) y )
+appendVars x y =
+ ( allocVarsR (lenVars y) x
+ , allocVarsL (lenVars x) y
+ )
+
+
+
+-- Var
+data Var (vs::[Type]) (v::vK) :: Type where
+ VarZ :: TypeRep vk -> Len (Proxy (v::vK) ': vs) -> Var (Proxy (v::vK) ': vs) v
+ VarS :: Var vs v -> Var (not_v ': vs) v
+instance AllocVars Var where
+ allocVarsL LenZ v = v
+ allocVarsL (LenS len) v = VarS (allocVarsL len v)
+
+ allocVarsR len (VarZ k l) = VarZ k (addLen l len)
+ allocVarsR len (VarS v) = VarS (allocVarsR len v)
+
+data VarV vs = forall v. VarV (Var vs v)
+instance LenVars (Var vs v) where
+ lenVars (VarZ _k l) = l
+ lenVars (VarS v) = LenS (lenVars v)
+
+deriving instance Show (Var vs v)
+
+eqVarKi :: Var vs x -> Var vs y -> Maybe ((x::kx) :~~: (y::ky))
+eqVarKi VarZ{} VarZ{} = Just HRefl
+eqVarKi (VarS x) (VarS y) = eqVarKi x y
+eqVarKi _ _ = Nothing
+
+-- Vars
+data Vars (vs::[Type]) :: Type where
+ -- VarsZ represents an empty context.
+ VarsZ :: Vars '[]
+ -- A cons stores a variable name and its type,
+ -- and then the rest of the context.
+ VarsS :: String -> TypeRep vK -> Vars vs -> Vars (Proxy (v::vK) ': vs)
+type instance VarsOf (Vars vs) = vs
+instance LenVars (Vars vs) where
+ lenVars VarsZ = LenZ
+ lenVars (VarsS _n _kv vs) = LenS $ lenVars vs
+
+
+-- Vars
+data Env :: [Type] -> Type where
+ ENil :: Env '[]
+ ECons :: v -> Env vs -> Env (v ': vs)
+
+-- (!) :: Env vs -> Var vs v -> v
+-- (ECons x _) ! VarZ = x
+-- (ECons _ e) ! (VarS x) = e ! x
+-- ENil ! _ = error "GHC can't tell this is impossible"
+
+lookupVars :: String -> Vars vs -> Maybe (VarV vs)
+lookupVars _ VarsZ = Nothing
+lookupVars n (VarsS vN vK vs)
+ | n == vN = Just (VarV (VarZ vK (LenS (lenVars vs))))
+ | otherwise = (\(VarV v) -> VarV (VarS v)) <$> lookupVars n vs
+
+
+fix :: (a -> a) -> a
+fix f = f (fix f)
+
+parse ::
+ ( forall sem. syn sem => Addable sem
+ , forall sem. syn sem => Mulable sem
+ , forall sem. syn sem => Abstractable sem
+ , syn (ForallSem syn)
+ ) =>
+ TermAST -> Parser syn
+parse = fix parseAbstractable
+
+tree0ParsePrint :: TermAST
+tree0ParsePrint = case parse @FinalSyntaxes tree0Print of
+ Parser (Left e) -> error e
+ Parser (Right (TermVT _ty (ForallSem sem))) -> print sem
+
+tree1ParsePrint :: TermAST
+tree1ParsePrint = case parse @FinalSyntaxes tree1Print of
+ Parser (Left e) -> error e
+ Parser (Right (TermVT _ty (ForallSem sem))) -> print sem
+
+tree2ParsePrint :: TermAST
+tree2ParsePrint = case parse @FinalSyntaxes tree2Print of
+ Parser (Left e) -> error e
+ Parser (Right (TermVT _ty (ForallSem sem))) -> print sem
+
+class Addable sem where
+ lit :: Int -> sem Int
+ neg :: sem Int -> sem Int
+ add :: sem Int -> sem Int -> sem Int
+class Mulable sem where
+ mul :: sem Int -> sem Int -> sem Int
+class Abstractable sem where
+ -- | Lambda term abstraction, in HOAS (Higher-Order Abstract Syntax) style.
+ lam :: Typeable a => (sem a -> sem b) -> sem (a -> b)
+ -- | Application, aka. unabstract.
+ (.@) :: sem (a -> b) -> sem a -> sem b
+
+
+-- * Interpreter 'Printer'
+newtype Printer a = Printer { unPrinter :: TermAST }
+print :: Printer a -> TermAST
+print = unPrinter
+print2 :: String -> Printer a1 -> Printer a2 -> Printer a3
+print2 n (Printer aT) (Printer bT) = Printer $ BinTree2 (BinTree2 (BinTree0 (TokenTermAtom n)) aT) bT
+instance Addable Printer where
+ lit n = Printer $ BinTree0 (TokenTermAtom (show n))
+ neg (Printer aT) = Printer $ BinTree2 (BinTree0 (TokenTermAtom "Neg")) aT
+ add = print2 "Add"
+instance Mulable Printer where
+ mul = print2 "Mul"
+instance Abstractable Printer where
+ Printer f .@ Printer a = Printer $ BinTree2 f a
+ lam (f::Printer a -> Printer b) = Printer $
+ -- FIXME: Tyable? instead of Typeable?
+ BinTree0 (TokenTermAbst "x" (TyVT (TyConst (lenInj @_ @'[]) (typeRep @a)))
+ (unPrinter (f (Printer (BinTree0 (TokenTermAtom "x"))))))
diff --git a/symantic.cabal b/symantic.cabal
new file mode 100644
index 0000000..4c0004d
--- /dev/null
+++ b/symantic.cabal
@@ -0,0 +1,249 @@
+cabal-version: 3.0
+name: literate-web
+maintainer: mailto:literate-web@sourcephile.fr
+bug-reports: https://mails.sourcephile.fr/inbox/literate-web
+homepage: https://git.sourcephile.fr/literate-web.git
+author: Julien Moutinho <julm+literate-web@sourcephile.fr>
+copyright: Julien Moutinho <julm+literate-web@sourcephile.fr>
+license: AGPL-3.0-or-later
+license-file: LICENSES/AGPL-3.0-or-later.txt
+
+-- PVP: +-+------- breaking API changes
+-- | | +----- non-breaking API additions
+-- | | | +--- code changes with no API change
+version: 0.0.0.20221117
+stability: experimental
+category: Web
+synopsis: Haskell-website compiler
+description:
+ Exploring the design space of compile-time website generator
+ by using a domain-specific language (DSL)
+ embedded into the Haskell language.
+ .
+ Alternatives:
+ .
+ * <https://hackage.haskell.org/package/ema ema>
+
+build-type: Simple
+tested-with: GHC ==9.2.4
+extra-doc-files: ChangeLog.md
+extra-source-files:
+ .envrc
+ cabal.project
+ flake.lock
+ flake.nix
+
+extra-tmp-files:
+
+source-repository head
+ type: git
+ location: git://git.sourcephile.fr/haskell/literate-web.git
+
+common boilerplate
+ default-language: Haskell2010
+ default-extensions:
+ NoImplicitPrelude
+ BlockArguments
+ DataKinds
+ DefaultSignatures
+ DeriveDataTypeable
+ DeriveGeneric
+ DerivingVia
+ FlexibleContexts
+ FlexibleInstances
+ GADTs
+ ImportQualifiedPost
+ LambdaCase
+ MultiParamTypeClasses
+ NamedFieldPuns
+ NumericUnderscores
+ OverloadedStrings
+ RecordWildCards
+ ScopedTypeVariables
+ TupleSections
+ TypeApplications
+ TypeFamilies
+ TypeOperators
+
+ ghc-options:
+ -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns
+ -Wmonomorphism-restriction -Wpartial-fields
+ -fprint-potential-instances
+
+-- -dshow-passes
+-- -ddump-to-file
+-- -ddump-simpl
+-- -dsuppress-coercions
+-- -dsuppress-module-prefixes
+-- -dsuppress-type-applications
+-- -O0
+-- -fmax-simplifier-iterations=0
+
+common library-deps
+ build-depends:
+ , async >=2.2
+ , base >=4.6 && <5
+ , bytestring >=0.10
+ , containers >=0.5
+ , directory >=1.3
+ , filepath >=1.4
+ , filepattern >=0.1
+ , hashable
+ , http-client >=0.6
+ , http-media >=0.7
+ , monad-classes
+ , peano
+ , reflection
+ , symantic-base >=0.5
+ , template-haskell
+ , text
+ , transformers >=0.5
+ , unicode-transforms >=0.2
+ , unordered-containers
+ , uri-encode >=1.5
+ , wai
+ , wai-middleware-static
+ , wai-websockets
+ , warp
+ , websockets >=0.12
+ , pipes
+ , pipes-safe
+ , pipes-concurrency
+ , pipes-parse
+ , pipes-group
+ , mvc
+ , mvc-updates
+ , ghc-prim
+
+library
+ import: boilerplate, library-deps
+ hs-source-dirs: src
+ exposed-modules:
+ ForallSem
+ Literate.Web
+ Literate.Web.Semantics.Compiler
+ Literate.Web.Semantics.Addresser
+ Literate.Web.Syntaxes
+ Literate.Web.Types.MIME
+ Literate.Web.Types.URL
+
+library relactive
+ import: boilerplate, library-deps
+ hs-source-dirs: src
+ build-depends:
+ , async
+ , contravariant >=1.5
+ , stm
+ , monad-classes
+
+ exposed-modules:
+ Control.Reactive
+ Control.Reactive.IORef
+ Control.Reactive.MVar
+ Control.Reactive.Relation
+ Control.Reactive.STRef
+ Control.Reactive.TVar
+ Control.Reactive.Value
+
+-- Literate.Web.Semantics.Server
+-- Literate.Web.Semantics.Client
+--Literate.Web.Decoder
+--Literate.Web.Encoder
+--Literate.Web.Generator
+--Literate.Web.MIME
+
+--Literate.Web.Decoder
+test-suite literate-web-tests
+ -- library-deps is only to have ghcid reloaded on changes in src
+ import: boilerplate, library-deps
+ type: exitcode-stdio-1.0
+ hs-source-dirs: tests
+ main-is: Main.hs
+ other-modules:
+ Examples.Ex01
+ Examples.Ex02
+ Examples.Ex03
+ Examples.Ex04
+ Examples.Ex05
+ Goldens
+ Paths_literate_web
+ Utils
+ autogen-modules: Paths_literate_web
+ build-depends:
+ , base >=4.6 && <5
+ , containers >=0.5
+ , literate-web
+ , monad-classes
+ , relude
+ , symantic-base >=0.5
+ , tasty >=0.11
+ , tasty-golden >=2.3
+ , tasty-hunit >=0.9
+ , text >=1.2
+ , transformers >=0.5
+ , relactive
+
+-- , relude >=1 && <2
+benchmark time
+ import: boilerplate, library-deps
+ type: exitcode-stdio-1.0
+ hs-source-dirs: benchmarks/time
+ main-is: Main.hs
+ build-depends:
+ , base >=4.6 && <5
+ , relactive
+ , tasty
+ , tasty-bench
+
+ -- , relude >= 1
+ -- Set a larger allocation area (nursery)
+ -- to remove some noisiness of the garbage collection.
+ ghc-options: -with-rtsopts=-A32m
+
+benchmark weigh
+ import: boilerplate, library-deps
+ type: exitcode-stdio-1.0
+ hs-source-dirs: benchmarks/weigh src
+ build-depends:
+ , async
+ , contravariant >=1.5
+ , stm
+
+ main-is: Main.hs
+ build-depends:
+ , base >=4.6 && <5
+ , relude >=1
+ , weigh
+
+--, relactive
+executable async
+ import: boilerplate, library-deps
+ hs-source-dirs: executables/async
+ main-is: Main.hs
+ build-depends:
+ , async
+ , base >=4.6 && <5
+ , relactive
+ , relude
+ , symantic-base
+ , tasty
+ , tasty-bench
+
+-- , relude >= 1
+
+executable fsnotify
+ import: boilerplate, library-deps
+ hs-source-dirs: executables/fsnotify
+ main-is: Main.hs
+ build-depends:
+ , async
+ , base >=4.6 && <5
+ , directory
+ , filepath
+ , fsnotify
+ , relactive
+ , relude >=1
+ , symantic-base
+ , tasty
+ , tasty-bench
+ , time
--
2.47.0