commit f11d74147db05ad3111d926664e08f21cde8e646 Author: Cale Gibbard Date: Thu Jan 22 13:39:46 2026 -0500 Initial commit, we have a basic UI that lets you edit a toy-datalog program and conjunctive query and see results live. diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..fa49107 --- /dev/null +++ b/.gitignore @@ -0,0 +1,16 @@ +.attr-cache +.cabal-sandbox +*.hi +*.o +cabal.project.local +cabal.sandbox.config +ctags +dist-newstyle/ +dist/ +ghcid-output.txt +profile/ +result +result-* +tags +TAGS +static.out diff --git a/.obelisk/impl/default.nix b/.obelisk/impl/default.nix new file mode 100644 index 0000000..2b4d4ab --- /dev/null +++ b/.obelisk/impl/default.nix @@ -0,0 +1,2 @@ +# DO NOT HAND-EDIT THIS FILE +import (import ./thunk.nix) \ No newline at end of file diff --git a/.obelisk/impl/github.json b/.obelisk/impl/github.json new file mode 100644 index 0000000..a39b896 --- /dev/null +++ b/.obelisk/impl/github.json @@ -0,0 +1,8 @@ +{ + "owner": "obsidiansystems", + "repo": "obelisk", + "branch": "develop", + "private": false, + "rev": "c0767818c990f081796cfb4017c5931d75fa4803", + "sha256": "0v16c1z09llramddq09ra8psh1mxxp7yvh62df84d1qq6qcgkmny" +} diff --git a/.obelisk/impl/thunk.nix b/.obelisk/impl/thunk.nix new file mode 100644 index 0000000..20f2d28 --- /dev/null +++ b/.obelisk/impl/thunk.nix @@ -0,0 +1,12 @@ +# DO NOT HAND-EDIT THIS FILE +let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }: + if !fetchSubmodules && !private then builtins.fetchTarball { + url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256; + } else (import (builtins.fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/3aad50c30c826430b0270fcf8264c8c41b005403.tar.gz"; + sha256 = "0xwqsf08sywd23x0xvw4c4ghq0l28w2ki22h0bdn766i16z9q2gr"; +}) {}).fetchFromGitHub { + inherit owner repo rev sha256 fetchSubmodules private; + }; + json = builtins.fromJSON (builtins.readFile ./github.json); +in fetch json \ No newline at end of file diff --git a/backend/backend.cabal b/backend/backend.cabal new file mode 100644 index 0000000..46c0548 --- /dev/null +++ b/backend/backend.cabal @@ -0,0 +1,43 @@ +name: backend +version: 0.1 +cabal-version: >= 1.8 +build-type: Simple + +library + hs-source-dirs: src + if impl(ghcjs) + buildable: False + build-depends: base + , common + , frontend + , obelisk-backend + , obelisk-route + exposed-modules: + Backend + ghc-options: -Wall -O -fno-show-valid-hole-fits + -- unsafe code + -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields + -- unneeded code + -Widentities -Wredundant-constraints + if impl(ghc >= 8.8) + ghc-options: + -Wmissing-deriving-strategies + +executable backend + main-is: main.hs + hs-source-dirs: src-bin + ghc-options: -Wall -O -fno-show-valid-hole-fits -threaded + -- unsafe code + -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields + -- unneeded code + -Widentities -Wredundant-constraints + if impl(ghc >= 8.8) + ghc-options: + -Wmissing-deriving-strategies + if impl(ghcjs) + buildable: False + build-depends: base + , backend + , common + , frontend + , obelisk-backend diff --git a/backend/frontend.jsexe b/backend/frontend.jsexe new file mode 120000 index 0000000..3a9cb6f --- /dev/null +++ b/backend/frontend.jsexe @@ -0,0 +1 @@ +../frontend-js/bin/frontend.jsexe \ No newline at end of file diff --git a/backend/frontendJs/frontend.jsexe b/backend/frontendJs/frontend.jsexe new file mode 120000 index 0000000..af9b8f4 --- /dev/null +++ b/backend/frontendJs/frontend.jsexe @@ -0,0 +1 @@ +../../frontend-js/bin/frontend.jsexe \ No newline at end of file diff --git a/backend/src-bin/main.hs b/backend/src-bin/main.hs new file mode 100644 index 0000000..00f1994 --- /dev/null +++ b/backend/src-bin/main.hs @@ -0,0 +1,6 @@ +import Backend +import Frontend +import Obelisk.Backend + +main :: IO () +main = runBackend backend frontend diff --git a/backend/src/Backend.hs b/backend/src/Backend.hs new file mode 100644 index 0000000..5842ce9 --- /dev/null +++ b/backend/src/Backend.hs @@ -0,0 +1,10 @@ +module Backend where + +import Common.Route +import Obelisk.Backend + +backend :: Backend BackendRoute FrontendRoute +backend = Backend + { _backend_run = \serve -> serve $ const $ return () + , _backend_routeEncoder = fullRouteEncoder + } diff --git a/backend/static b/backend/static new file mode 120000 index 0000000..4dab164 --- /dev/null +++ b/backend/static @@ -0,0 +1 @@ +../static \ No newline at end of file diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..fe0438b --- /dev/null +++ b/cabal.project @@ -0,0 +1,3 @@ +optional-packages: + * +write-ghc-environment-files: never diff --git a/common/common.cabal b/common/common.cabal new file mode 100644 index 0000000..931ff5d --- /dev/null +++ b/common/common.cabal @@ -0,0 +1,21 @@ +name: common +version: 0.1 +cabal-version: >= 1.2 +build-type: Simple + +library + hs-source-dirs: src + build-depends: base + , obelisk-route + , text + exposed-modules: + Common.Api + Common.Route + ghc-options: -Wall -O -fno-show-valid-hole-fits + -- unsafe code + -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields + -- unneeded code + -Widentities -Wredundant-constraints + if impl(ghc >= 8.8) + ghc-options: + -Wmissing-deriving-strategies diff --git a/common/src/Common/Api.hs b/common/src/Common/Api.hs new file mode 100644 index 0000000..1ea3df0 --- /dev/null +++ b/common/src/Common/Api.hs @@ -0,0 +1,4 @@ +module Common.Api where + +commonStuff :: String +commonStuff = "Here is a string defined in Common.Api" diff --git a/common/src/Common/Route.hs b/common/src/Common/Route.hs new file mode 100644 index 0000000..17dadae --- /dev/null +++ b/common/src/Common/Route.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module Common.Route where + +{- -- You will probably want these imports for composing Encoders. +import Prelude hiding (id, (.)) +import Control.Category +-} + +import Data.Text (Text) +import Data.Functor.Identity + +import Obelisk.Route +import Obelisk.Route.TH + +data BackendRoute :: * -> * where + -- | Used to handle unparseable routes. + BackendRoute_Missing :: BackendRoute () + -- You can define any routes that will be handled specially by the backend here. + -- i.e. These do not serve the frontend, but do something different, such as serving static files. + +data FrontendRoute :: * -> * where + FrontendRoute_Main :: FrontendRoute () + -- This type is used to define frontend routes, i.e. ones for which the backend will serve the frontend. + +fullRouteEncoder + :: Encoder (Either Text) Identity (R (FullRoute BackendRoute FrontendRoute)) PageName +fullRouteEncoder = mkFullRouteEncoder + (FullRoute_Backend BackendRoute_Missing :/ ()) + (\case + BackendRoute_Missing -> PathSegment "missing" $ unitEncoder mempty) + (\case + FrontendRoute_Main -> PathEnd $ unitEncoder mempty) + +concat <$> mapM deriveRouteComponent + [ ''BackendRoute + , ''FrontendRoute + ] diff --git a/config/common/example b/config/common/example new file mode 100644 index 0000000..e368f70 --- /dev/null +++ b/config/common/example @@ -0,0 +1 @@ +This string comes from config/common/example \ No newline at end of file diff --git a/config/common/route b/config/common/route new file mode 100644 index 0000000..99298a3 --- /dev/null +++ b/config/common/route @@ -0,0 +1 @@ +http://localhost:8000 \ No newline at end of file diff --git a/config/readme.md b/config/readme.md new file mode 100644 index 0000000..7ca5a54 --- /dev/null +++ b/config/readme.md @@ -0,0 +1,9 @@ +### Config + +Obelisk projects should contain a config folder with the following subfolders: common, frontend, and backend. + +Things that should never be transmitted to the frontend belong in backend/ (e.g., email credentials) + +Frontend-only configuration belongs in frontend/. + +Shared configuration files (e.g., the route config) belong in common/ diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..adc19fe --- /dev/null +++ b/default.nix @@ -0,0 +1,23 @@ +{ system ? builtins.currentSystem +, obelisk ? import ./.obelisk/impl { + inherit system; + iosSdkVersion = "16.1"; + + # You must accept the Android Software Development Kit License Agreement at + # https://developer.android.com/studio/terms in order to build Android apps. + # Uncomment and set this to `true` to indicate your acceptance: + # config.android_sdk.accept_license = false; + + # In order to use Let's Encrypt for HTTPS deployments you must accept + # their terms of service at https://letsencrypt.org/repository/. + # Uncomment and set this to `true` to indicate your acceptance: + # terms.security.acme.acceptTerms = false; + } +}: +with obelisk; +project ./. ({ ... }: { + android.applicationId = "systems.obsidian.obelisk.examples.minimal"; + android.displayName = "Obelisk Minimal Example"; + ios.bundleIdentifier = "systems.obsidian.obelisk.examples.minimal"; + ios.bundleName = "Obelisk Minimal Example"; +}) diff --git a/dep/toy-datalog/default.nix b/dep/toy-datalog/default.nix new file mode 100644 index 0000000..2b4d4ab --- /dev/null +++ b/dep/toy-datalog/default.nix @@ -0,0 +1,2 @@ +# DO NOT HAND-EDIT THIS FILE +import (import ./thunk.nix) \ No newline at end of file diff --git a/dep/toy-datalog/git.json b/dep/toy-datalog/git.json new file mode 100644 index 0000000..d9d472b --- /dev/null +++ b/dep/toy-datalog/git.json @@ -0,0 +1,8 @@ +{ + "url": "https://code.obsidian.systems/cale/toy-datalog.git", + "rev": "c09e07042b633c64021c10aac0258cc117d289cc", + "sha256": "1fl7b5iqk02i97sdpsfpp698mj4gp9hkmzamycv9jacvq7zq1k5y", + "private": false, + "fetchSubmodules": false, + "branch": "master" +} diff --git a/dep/toy-datalog/thunk.nix b/dep/toy-datalog/thunk.nix new file mode 100644 index 0000000..3e23b43 --- /dev/null +++ b/dep/toy-datalog/thunk.nix @@ -0,0 +1,17 @@ +# DO NOT HAND-EDIT THIS FILE +let fetch = {url, rev, branch ? null, sha256 ? null, fetchSubmodules ? false, private ? false, ...}: + let realUrl = let firstChar = builtins.substring 0 1 url; in + if firstChar == "/" then /. + url + else if firstChar == "." then ./. + url + else url; + in if !fetchSubmodules && private then builtins.fetchGit { + url = realUrl; inherit rev; + ${if branch == null then null else "ref"} = branch; + } else (import (builtins.fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/3aad50c30c826430b0270fcf8264c8c41b005403.tar.gz"; + sha256 = "0xwqsf08sywd23x0xvw4c4ghq0l28w2ki22h0bdn766i16z9q2gr"; +}) {}).fetchgit { + url = realUrl; inherit rev sha256; + }; + json = builtins.fromJSON (builtins.readFile ./git.json); +in fetch json \ No newline at end of file diff --git a/frontend/frontend.cabal b/frontend/frontend.cabal new file mode 100644 index 0000000..77112c5 --- /dev/null +++ b/frontend/frontend.cabal @@ -0,0 +1,60 @@ +name: frontend +version: 0.1 +cabal-version: >= 1.8 +build-type: Simple + +library + hs-source-dirs: src + build-depends: base + , common + , jsaddle + , lens + , obelisk-executable-config-lookup + , obelisk-frontend + , obelisk-generated-static + , obelisk-route + , reflex-dom-core + , text + , toy-datalog + exposed-modules: + Frontend + default-extensions: + ImportQualifiedPost, + OverloadedStrings, + FlexibleContexts + ghc-options: -Wall -O -fno-show-valid-hole-fits + -- unsafe code + -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields + -- unneeded code + -Widentities -Wredundant-constraints + if impl(ghc >= 8.8) + ghc-options: + -Wmissing-deriving-strategies + +executable frontend + main-is: main.hs + hs-source-dirs: src-bin + build-depends: base + , common + , frontend + , obelisk-frontend + , obelisk-route + , reflex-dom + , toy-datalog + default-extensions: + ImportQualifiedPost, + OverloadedStrings, + FlexibleContexts + ghc-options: -Wall -O -fno-show-valid-hole-fits -threaded + -- unsafe code + -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields + -- unneeded code + -Widentities -Wredundant-constraints + if impl(ghc >= 8.8) + ghc-options: + -Wmissing-deriving-strategies + if impl(ghcjs) + ghc-options: -dedupe + cpp-options: -DGHCJS_BROWSER + if os(darwin) + ghc-options: -dynamic diff --git a/frontend/src-bin/main.hs b/frontend/src-bin/main.hs new file mode 100644 index 0000000..9408dc3 --- /dev/null +++ b/frontend/src-bin/main.hs @@ -0,0 +1,10 @@ +import Frontend +import Common.Route +import Obelisk.Frontend +import Obelisk.Route.Frontend +import Reflex.Dom + +main :: IO () +main = do + let Right validFullEncoder = checkEncoder fullRouteEncoder + run $ runFrontend validFullEncoder frontend diff --git a/frontend/src/Frontend.hs b/frontend/src/Frontend.hs new file mode 100644 index 0000000..cd92338 --- /dev/null +++ b/frontend/src/Frontend.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} + +module Frontend where + +import Control.Monad +import Data.Text (Text) +import Data.Text qualified as T + +import Obelisk.Frontend +import Obelisk.Route +import Obelisk.Generated.Static + +import Reflex.Dom.Core + +import Common.Route + +import Datalog +import Text.Megaparsec qualified as P +import Data.Map (Map) +import Data.Map qualified as Map + +example :: Text +example = T.unlines + [ "odd(X,Y) :- r(X,Y)." + , "odd(X,Y) :- even(X,Z), r(Z,Y)." + , "even(X,Y) :- odd(X,Z), r(Z,Y)." + , "r(0,1)." + , "r(1,2)." + , "r(2,3)." + , "r(3,4)." + , "r(4,5)." + , "r(X,Y) :- r(Y,X)." + ] + +frontend :: Frontend (R FrontendRoute) +frontend = Frontend + { _frontend_head = do + el "title" $ text "Toy Datalog" + elAttr "script" ("type" =: "application/javascript" <> "src" =: $(static "lib.js")) blank + elAttr "link" ("href" =: $(static "main.css") <> "type" =: "text/css" <> "rel" =: "stylesheet") blank + , _frontend_body = do + el "h1" $ text "Toy Datalog" + divClass "main" $ do + tp <- divClass "program" $ textAreaElement $ def & textAreaElementConfig_initialValue .~ example + tq <- divClass "query" $ inputElement $ def & inputElementConfig_initialValue .~ "even(A,B)" + let programD = ffor (value tp) $ \p -> P.parse parseProgram "" p + queryD = ffor (value tq) $ \q -> P.parse parseQuery "" q + dyn_ . ffor2 programD queryD $ \p q -> case (p,q) of + (Left e, _) -> el "pre" $ text $ T.pack (P.errorBundlePretty e) + (_, Left e) -> el "pre" $ text $ T.pack (P.errorBundlePretty e) + (Right prog, Right query) -> case extendFixedpointDb =<< addProgram prog emptyDatabase of + Left e -> evalErrorWidget e + Right db -> case evalConjunction db query of + Left e -> evalErrorWidget e + Right bindings -> divClass "bindings" $ forM_ bindings $ \b -> do + bindingWidget b + return () + } + +evalErrorWidget :: (DomBuilder t m) => EvalError -> m () +evalErrorWidget e = divClass "eval-error" . el "pre" . text . T.unlines $ case e of + EvalError_RuleWrongArity rule wa -> + [ "Arity error in rule:" + , pretty rule + , "Relation " <> pretty (_wrongArity_relation wa) <> " has arity " <> T.pack (show (_wrongArity_expected wa)) + , "but appears with arity " <> T.pack (show (_wrongArity_got wa)) <> "." + ] + EvalError_AtomWrongArity a wa -> + [ "Arity error in atom:" + , pretty a + , "Relation " <> pretty (_wrongArity_relation wa) <> " has arity " <> T.pack (show (_wrongArity_expected wa)) + , "but appears with arity " <> T.pack (show (_wrongArity_got wa)) <> "." + ] + +bindingWidget :: (DomBuilder t m) => Map VarId ConId -> m () +bindingWidget b = do + divClass "binding" $ do + if Map.null b + then text "True" + else + el "ul" $ forM_ (Map.toList b) $ \(VarId v, ConId c) -> + el "li" $ + text (v <> " = " <> c) diff --git a/static/lib.js b/static/lib.js new file mode 100644 index 0000000..f277a46 --- /dev/null +++ b/static/lib.js @@ -0,0 +1,4 @@ +// Accessing the property via string literal prevents renaming by javascript minifiers which can cause FFI errors +window['skeleton_lib'] = { + log: txt => console.log('Received "' + txt + '" from FFI'), +}; diff --git a/static/main.css b/static/main.css new file mode 100644 index 0000000..9bdb028 --- /dev/null +++ b/static/main.css @@ -0,0 +1,63 @@ +body { + background: #220044; + color: wheat; +} + +.main { + display: flex; + flex-direction: column; +} + +.program { + display: flex; + padding: 10px; +} + +.program textarea { + background: #110022; + color: wheat; + width: 90%; + height: 30em; + border: solid 1px wheat; + border-radius: 5px; +} + +.query { + display: flex; + padding: 10px; +} + +.query input { + background: #110022; + color: wheat; + width: 90%; + border: solid 1px wheat; + border-radius: 5px; + padding: 5px; +} + +.query input :focus { + outline: none; +} + +.bindings { + display: flex; + flex-direction: row; + flex-wrap: wrap; + justify-content: flex-start; +} + +.binding { + display: flex; + flex-direction: column; + background: #330055; + margin: 10px; + padding: 10px; + border: solid 1px wheat; + border-radius: 10px; +} + +.binding ul { + margin: 0px; + padding-left: 1em; +} diff --git a/static/obelisk.jpg b/static/obelisk.jpg new file mode 100644 index 0000000..68c8682 Binary files /dev/null and b/static/obelisk.jpg differ