2f:T47e,# Purescript incremental relational lenses 3/n Understanding and implementing incremental relational lenses in purescript. - [Part 1](https://observablehq.com/d/67f10b2878554077) - [Part 2](https://observablehq.com/d/c893cda26d4f49bf) - Part 3 In the previous part we've setup some type level facilities for implementing lenses, and in this part we'll aim at getting started on implementing the key primitives for classic relational lenses before going into incrementality. Hopefully we'll also settle on an approach for incremental view maintenance, and a way to modularise the update lenses to allow using them directly, or as part of an effect system. ## Sources - https://www.youtube.com/watch?v=e0JST9vmhFc&t=896s - https://github.com/rudihorn/haskell-lenses - Language integrated relational lenses https://era.ed.ac.uk/handle/1842/39676 This is a great visual summary of what this is all about from [the paper](https://arxiv.org/pdf/1807.01948.pdf) Horn, Rudi et al. “Incremental relational lenses.” Proceedings of the ACM on Programming Languages 2 (2018): 1 - 30. ![image@1.png](${await FileAttachment("image@1.png").url()}) 30:T42f,### Minimal example > For example, given F = {A → B} and M = {{A = 1, B = 2}, {A = 2, B = 3}} and N = {{A = 1, B = 42}}, the result of revising M to be consistent with N and F is {{A = 1, B = 42}, {A = 2, B = 3}}. That's a good minimal example to workshop on top of. Let's try to write it in the haskell-lens way: ```haskell type U = '[ '("A", Int), '("B", Int)] m :: U m = rows @U [ ("A", 1), ("B", 2) ] type F = '[ ["A"] --> '["B"]] -- n is the modification to the view, which should allow us -- to infer m' the modified source of the view. n :: U n = rows @U [ ("A", 1), ("B", 42) ] -- it's implied that we have an identity lens here, but with the fundep F -- we also imagine we have a table `u` in the DB l = prim @"u" @U F -- the put assumes a db connection... feels like it would be good to have a pure version too... -- maybe a good case for purescript-run. At least returning the result of the lens! -- as `IO U` or something. revision :: IO () revision = test_put l n -- some IO modification of n which modifies a previously inserted m into m' ```31:T81e,### Classic relational lenses Anyhow, the work horse is in `3.3.2`: - If m and some n have the same value for X in the fundep (in our example `("A", 1)`) - we return a copy of m whose Y attributes have been updated with those from `n[Y]` (in our example `42`). This in the haskell-lens code [for the simple select case](https://github.com/rudihorn/haskell-lenses/blob/master/Lens/Put/Classic.hs#L76C55-L76C55) ```haskell put_classic_select c (HPred p) (l :: Lens s) _ n = do m <- get c l let unsat = SR.filter (DP.not p) m let m0 = merge @(TopologicalSort (Fds s)) unsat n return m0 ``` Right then `merge` [is implemented in terms of `revise`](https://github.com/rudihorn/haskell-lenses/blob/master/Lens/Record/Sorted.hs#L106-L107) (the names seems to indicate we're on the right track. Yes, then revise iterates on the fundeps and for each of them [it does](https://github.com/rudihorn/haskell-lenses/blob/master/Lens/Record/Sorted.hs#L106-L107): ```haskell revise_fd :: forall (fd :: FunDep) rt rt'. (RevisableFd fd rt rt') => RecordsSet rt -> RecordsSet rt' -> RecordsSet rt revise_fd m n = Set.map update m where map = Map.fromList $ Set.toList $ Set.map f_row n f_row r = (R.project @(Left fd) r, R.project @(AdjustOrder (Right fd) (VarsEnv rt)) r) update r = case Map.lookup (R.project @(Left fd) r) map of Nothing -> r Just s -> R.revise r s ``` Which maps an update function over the incoming record, which: - checks that the projection of the left hand side of the fun dep exists in the `map` - which is the projection of the fundep lhs of the updated row n. - such that after the lookup, `Just s` is a "small" projected row of n over all the non root values I think. So in our example `[("B", 42)]` - if it does it calls `R.revise` [in Lens.Record.Base](https://github.com/rudihorn/haskell-lenses/blob/master/Lens/Record/Base.hs#L203-L204) - which is called with each source row r and overwrites it with the value s of the "non-root" fields. ![image@2.png](${await FileAttachment("image@2.png").url()})32:T9ec,### Lens expressions Something I'll need from haskell-lenses is the data type used for a lens expression type which will allow to interpret lenses in terms of other lenses and make them lens combinators. How is that going to play with regular profunctor lenses though? I suppose we have an algebra `Relational (Lens s t a b) -> Lens s t a b`? It might have some impact with regards to how "normal" lenses can and cannot interact with relational lenses... Hmm, just realised there was a bigger paper for the haskell implementation https://era.ed.ac.uk/handle/1842/39676 The `Lens` expression type is parameterised by a sort, which is all the type checking info. And then also lenses combine like so: ``` ::= prim @ @ @ | select | join | dropl @ @ ``` > The sort is a tuple of the used tables, the view’s record type, a static predicate restriction and a collection of functional dependencies. So these things are in theory orthogonal, but in the haskell implementation they are "coupled" in the `Lens` data type. So let's focus on the expression side of things, and see if we can collocate all the type level "sort" info in the `Database` type level data. I'm tempted to go the extensible route with variant (like https://discourse.purescript.org/t/exploring-mutually-recursive-variants/424 but without the mutual recursion concerns), but it's not clear how costly that will be on my brain when it comes to the type level shenanigans, so let's be a bit more "conservative" here. Ok I think to implement the GADT constraints I'll need the sigma encoding (I realised I've used this in the past here https://github.com/jmatsushita/purescript-set-monad/blob/master/src/Data/Set/Monad.purs). Actually rather than: ```haskell runRel :: Rel (Lens' s a) -> Lens' s a ``` Do I want ```haskell runRel :: Rel s a -> Lens' s a -- i.e. runRel :: Rel db tbl -> Lens' db tbl ``` I think the paper means the second one. But I suppose the first one could be an improvement because it would allow to combine relational lenses with regular lenses with maybe a `Raw` or even `Lens` constructor. Maybe it doesn't hurt to think in terms of the first even if we don't implement the machinery for it? It might hurt my brain though tbh. 😭 Let's keep it "simpler". Realised I've been using the type variable rows for what is really a Row type of columns, the rows (in the database sense) is the term level data. The column type (of kind Row Type) is the shape of these rows. 33:Tb0a,### Database types and terms Seems that we'll want to make the database and table values mostly handles with sophisticated types. However the getting and setting will be interpreted in terms of operations in an effect. Such that `table :: Table fds cols -> Run (DB + r )` reusing the effects we defined in part 1. Are we going to need something like `Lens.Action` from Haskell to deal with effects? Hmmm that seems to be only for monadic getters and folds. Seems that there might be problems with well behavedness and compositionality... Ah but there is `modifying` in ``` modifying :: forall m b a s. MonadState s m => Setter s s a b -> (a -> b) -> m Unit ``` Hmmm. Why doesn't this return a `b`? Oh I suppose it should return an s, but we're already "in one" with `MonadState s m`. Right, and that's [what we have](https://pursuit.purescript.org/packages/purescript-run-profunctor-lenses/0.1.0/docs/Run.Lenses) in `purescript-run-profunctor-lenses` ``` modifying :: forall r b a s. Setter s s a b -> (a -> b) -> Run (state :: STATE s | r) Unit ``` I have to remember that the lenses are pure, but they will be called by pure or effectful getters and setters (taking the pure lens as a parameter). So I think I'll need a setter in our DB effect. I think that: - `view` form the lens ecosystem is `get` in the paper. - `assign` is `put`. Later (when I figure out modules in observableHQ with purescript) or when I publish a library, we can import these qualified like `State.view` and `DB.view`. For now we can use `view'` and `view`. I'm very tempted to try and connect the sqlite3 backend of selda with a wasm sqlite... I should probably try this in a separate notebook. If it works then I can bring the results here and see how to create extensible effects for it. I started working on a notebook for this https://observablehq.com/d/e86a669f88f1dfa4 Reporting back with a yack in the process of being shaved: - There isn't a sqlite3 in the browser option in purescript. so that's needed to continue forward. - In selda [`genericInsert_` does the heavy lifting](https://github.com/Kamirus/purescript-selda/blob/a81f47f9054e9ea893d5ef79586be70068462249/src/Selda/Query/Class.purs#L52-L66) using [`HFoldl` from `purescript-heterogeneous`](https://github.com/natefaubion/purescript-heterogeneous/blob/master/src/Heterogeneous/Folding.purs). Very good that it's implemented with the library from the purescript ecosystem ❤️ I've now published a low level wrapping for sqlite in wasm in purescript with some browser tests. https://github.com/jmatsushita/purescript-wasm-sqlite I'll work on integrating this here, but since the package isn't in the registry (yet? I should probably publish it) I might work in a separate observableHQ notebook so that this one can be ran without a custom compiler backend. 34:T1b29,### Schema at the type level Ok, I'm happy with another stab at the type level representation of the schema (for now without the extra fundeps info) ```haskell -- let's try again with how we represent the database info we want at the type level -- we need it for relational lenses, to play a similar role to Sort which carries table names -- fundeps and other type level data. But maybe with purescript's row type we can give this -- an easier interface. -- myDB :: Database -- ( -- (tableA :: Table () ( colA :: Int, colB :: String, ... ) -- (tableB :: Table (colA :: (colB :: Unit)) ( ... ) ) -- ) -- With `Table ` -- data Table (fds :: Row (Row Type)) (cols :: Row Type) -- It might be preferable to use a type level list instead of the inner row for FDs? -- IIUC, fundeps are declared when defining a `prim` lens like here https://github.com/rudihorn/haskell-lenses/blob/master/Scratch.hs#L69-L70 -- then when for instance definine a `join` lens, the Sort will include multiple tables and fundeps -- from these multiple tables. But there isn't really a type for the whole database. -- we need machinery in this module to convert the schema type into a concrete record type. -- so we can construct a value such as -- { -- tableA: [ { colA: 1, colB: "hello" } ], -- tableB: [ { colA: 1, colB: "hello" } ] -- } -- the type of this would be -- Record -- ( tableA :: Array { colA :: Int, colB :: String } -- , tableB :: Array { colA :: Int, colB :: String } -- ) newtype MapDB schema = MapDB (forall r. (forall tables. Show (Record tables) => Tables schema tables => Record tables -> r) -> r) instance Show (MapDB schema) where show (MapDB f) = f show mkDbMap :: forall schema tables. Show (Record tables) => Tables schema tables => Record tables -> MapDB schema mkDbMap rec = MapDB (\f -> f rec) -- This type class is used to convert the schema type into a concrete record type. -- e.g. -- -- type MySchema = -- ( tableA :: (colA :: Int, colB :: String) -- , tableB :: (colA :: Int, colB :: String) -- ) -- -- type MyTables = Record -- ( tableA :: Array (Record (colA :: Int, colB :: String)) -- , tableB :: Array (Record (colA :: Int, colB :: String)) -- ) class Tables :: Row (Row Type) -> Row Type -> Constraint class Tables schema tables | schema -> tables instance (RowToList schema schemaRL, TablesRL schemaRL schema tables) => Tables schema tables class TablesRL :: RowList (Row Type) -> Row (Row Type) -> Row Type -> Constraint class TablesRL schemaRL schTables tables | schemaRL schTables -> tables -- adapting https://jordanmartinez.github.io/purescript-jordans-reference-site/content/21-Hello-World/06-Type-Level-Programming/src/22-RowList/02-Advanced-ps.html -- to our Row (Row List) structure instance TablesRL RL.Nil emptyTables () instance -- 1. Use Row.Cons to get the rest of the table column types ( Row.Cons tableName trs remainingSchTablesRows schTables -- 2. Cons (Array (Record cols)) to get the transformation we want , Row.Cons tableName (Array (Record trs)) remainingTableRows tables -- 3. Recurse , TablesRL remainingSchemaRowList remainingSchTablesRows remainingTableRows -- In our case trs is a (Row Type) that we need to wrap in Array (Record trs) ) => TablesRL (RL.Cons tableName trs remainingSchemaRowList) schTables tables type MySchema = ( tableA :: (colA :: Int, colB :: String) , tableB :: (colA :: Int, colB :: String) ) type MyTables = Record ( tableA :: Array (Record (colA :: Int, colB :: String)) , tableB :: Array (Record (colA :: Int, colB :: String)) ) db :: MapDB MySchema db = mkDbMap { tableA: [ { colA: 1, colB: "hello" } ], tableB: [ { colA: 1, colB: "hello" } ] } ``` I've extended this with a selda db type and a raw wasqlite type and I'm pleased with the terseness and the use of VTAs ```haskell data Database schema = InMem (forall r. (forall tables. Show (Record tables) => Tables schema tables => Record tables -> r) -> r) | SeldaDB (forall r. (forall tables. SeldaTables schema tables => Record tables -> r) -> r) | WASQLite (forall r. (forall tables. WASqliteTables schema tables => Proxy tables -> r) -> r) class SeldaTables :: Row (Row Type) -> Row Type -> Constraint class SeldaTables schema tables | schema -> tables instance (RowToList schema schemaRL, SeldaTablesRL schemaRL schema tables) => SeldaTables schema tables class SeldaTablesRL :: RowList (Row Type) -> Row (Row Type) -> Row Type -> Constraint class SeldaTablesRL schemaRL schTables tables | schemaRL schTables -> tables instance SeldaTablesRL RL.Nil emptyTables () instance -- 1. Use Row.Cons to get the rest of the table column types ( Row.Cons tableName trs remainingSchTablesRows schTables -- 2. Cons (Array (Record cols)) to get the transformation we want , Row.Cons tableName (Selda.Table trs) remainingTableRows tables -- 3. Recurse , SeldaTablesRL remainingSchemaRowList remainingSchTablesRows remainingTableRows -- In our case trs is a (Row Type) that we need to wrap in Array (Record trs) ) => SeldaTablesRL (RL.Cons tableName trs remainingSchemaRowList) schTables tables mkDbSelda :: forall schema tables. SeldaTables schema tables => Record tables -> Database schema mkDbSelda rec = SeldaDB (\f -> f rec) dbSelda :: Database MySchema dbSelda = mkDbSelda { tableA: Selda.Table { name: "tableA" }, tableB: Selda.Table { name: "tableB" } } -- with the Selda approach the names are term level, whereas in haskell-lenses they are -- reflected from the type level (with `recover`) -- before we implement the lens machinery and the wasqlite backend for selda let's follow -- the same approach as haskell-lenses using a Proxy tables class WASqliteTables :: Row (Row Type) -> Row Type -> Constraint class WASqliteTables schema tables | schema -> tables instance (RowToList schema schemaRL, WASqliteTablesRL schemaRL schema tables) => WASqliteTables schema tables class WASqliteTablesRL :: RowList (Row Type) -> Row (Row Type) -> Row Type -> Constraint class WASqliteTablesRL schemaRL schTables tables | schemaRL schTables -> tables instance WASqliteTablesRL RL.Nil emptyTables () instance -- 1. Use Row.Cons to get the rest of the table column types ( Row.Cons tableName trs remainingSchTablesRows schTables -- 2. Cons (Array (Record cols)) to get the transformation we want , Row.Cons tableName (Selda.Table trs) remainingTableRows tables -- 3. Recurse , WASqliteTablesRL remainingSchemaRowList remainingSchTablesRows remainingTableRows -- In our case trs is a (Row Type) that we need to wrap in Array (Record trs) ) => WASqliteTablesRL (RL.Cons tableName trs remainingSchemaRowList) schTables tables mkDbWaSqlite :: forall @schema tables. WASqliteTables schema tables => Database schema mkDbWaSqlite = WASQLite (\f -> f (Proxy :: Proxy tables)) db :: Database MySchema db = mkDbWaSqlite @MySchema ```35:T40a,renderCompilationStatus = (source, warnings, errors) => { const renderedWarnings = warnings && warnings.length >0 ? htl.html`

Compiler warnings

${toColumns(warnings).map(col => htl.html``)} ${toTable(warnings, source).map(row => htl.html` ${Object.values(row).map(cell => htl.html``)} `)}

${col}
${cell}

` : htl.html`No warnings
` const renderedErrors = errors ? htl.html`

Compiler errors

${toColumns(errors).map(col => htl.html``)} ${toTable(errors, source).map(row => htl.html` ${Object.values(row).map(cell => htl.html``)} `)}

${col}
${cell}

` : htl.html`No errors` return htl.html`${renderedWarnings}${renderedErrors}` }36:T2d15,part3 = `module Main where import Prelude import Data.Lens (Lens, Lens', Setter, Setter', lens) import Data.Lens as Lens import Data.Lens.Record (prop) import Data.Foldable (class Foldable, intercalate) import Data.Set (Set) import Data.Set (fromFoldable, map) as S import Data.Symbol (class IsSymbol) import Data.Tuple (snd) import Record (get, insert) as R import Partial.Unsafe (unsafeCrashWith) -- import Prim.Row (class Cons, class Lacks) import Prim.Row as Row import Prim.RowList (class RowToList, Cons, Nil, RowList) import Prim.TypeError (class Fail, class Warn, Text, Beside, Quote, Doc, Above) import Type.Data.Symbol (class Equals) as Symbol import Type.Data.Boolean (True, False, class Or) import Type.Equality (class TypeEquals) import Type.Proxy (Proxy(..)) import Type.Row (type (+)) import Run (Run, EFFECT) import Run as Run import Run.State (STATE) import Run.State as State --------------------------------------------------------------------------------------- -- -- type level definitions -- -- data Table (fds :: Row (Row Type)) (cols :: Row Type) = TableDB String | TableInMemory (Set (Record cols)) instance Show (Record cols) => Show (Table fds cols) where show (TableDB s) = "TableDB: " <> s show (TableInMemory s) = "TableInMemory: " <> show s -- I think this ends up being the Sort kind. data Database :: Row Type -- row of tables (including their fundeps and col info) -> Type data Database schema = Database String instance Show (Database schema) where show (Database name) = name database :: forall @schema tbls . IsValidSchema schema => String -> Database schema database name = Database @schema name class IsValidSchema :: Row Type -> Constraint class IsValidSchema schema instance (RowToList schema schemaRL, IsValidSchemaRL schemaRL False res (Text "init")) => IsValidSchema schema else instance Fail (Text "invalid schema") => IsValidSchema schema class IsValidSchemaRL :: RowList Type -> Boolean -> Boolean -> Doc -> Constraint class IsValidSchemaRL schemaRL acc res info | schemaRL -> res instance ( Warn (info) -- , Symbol.Equals tblKey "tableC" a , IsTable tblVal a , Or acc a newAcc , IsValidSchemaRL rest newAcc res (Above (Beside (Text tblKey) (Quote newAcc)) info) ) => IsValidSchemaRL (Cons tblKey tblVal rest) acc res info else instance ( Warn (Above (Text "Found the table! Cons True True info") (info)) ) => IsValidSchemaRL (Cons tblKey tblVal rest) True res info else instance ( Warn (Above (Text "done! Nil acc True info") (info)) ) => IsValidSchemaRL Nil True res info else instance Fail (Above (Text "IsValidSchemaRL Nil False res info") info) => IsValidSchemaRL Nil False res info class IsTable :: Type -> Boolean -> Constraint class IsTable tbl res | tbl -> res instance IsTable (Table a b) True else instance Fail (Text "Is not a Table") => IsTable x False -- -- relational lens expressions -- data Rel :: Row (Row Type) -> Type -- data Rel sort -- = Prim -- (forall r fds. -- (forall (tbls :: Row (Row Type)) (cols :: Row Type) -- . Tableable tbls cols -- => Database tbls -- -> Table fds cols -- hmm, we don't need the table data here? -- -> r) -- -> r) -- -- | Join (forall r. (forall f. Joinable db tbl1 fds1 tbl2 fds2 => Rel db tbl1 -> Rel db tbl2 -> r) -> r) -- -- Maybe an external join could allow to join over 2 databases? -- class Tableable tbls cols | tbls -> cols -- instance -- ( RowToList tbls list -- , Columns list table cols -- ) => Tableable tbls cols -- -- we should not need to carry data here at the term level for the DB version. -- mkRel :: forall a s fds. Tableable tbls cols => Database tbls -> Table fds cols -> Rel s -- mkRel db tbl = Prim unit -> tbl -- runRel :: Rel s a -> Lens' s a -- runRel -- I want a prim lens such that -- table = prim @RowAB @FDs -- rows <- get table; -- put table $ rows <> [{ a: 2, b: 4}, { a: 3, b: 4 }] table :: forall @tableName schema tables cols fds . Columns tables tableName cols => Lens' (Database schema) (Table fds cols) table tbl = unsafeCrashWith "TODO" class Tables :: Type -> RowList (Row Type) -> Constraint class Tables db tbls | db -> tbls instance IsValidSchema schema => Tables (Database schema) tbls class Columns :: Row (Row Type) -> Symbol -> Row Type -> Constraint class Columns tables tableName cols instance (RowToList tables tablesRL, ColumnsRL tablesRL tableName cols) => Columns tables tableName cols class ColumnsRL :: RowList (Row Type) -> Symbol -> Row Type -> Constraint class ColumnsRL tablesRL tableName cols | tablesRL tableName -> cols instance ColumnsRL Nil table cols -- In a database with an empty schema, passing any label return an empty row. instance ( Symbol.Equals tableName name True , ColumnsRL rest tableName cols ) => ColumnsRL (Cons name cols rest) tableName cols type Predicate a = a -> Boolean -- -- we're not changing the shape of things with a select -- -- in RA it's only a filter, projection is separate select :: forall fds cols. Predicate (Record cols) -> Lens' (Table fds cols) (Table fds cols) select _pred = lens getSelect putSelect where getSelect :: Table fds cols -> Table fds cols getSelect s = s putSelect :: Table fds cols -> Table fds cols -> Table fds cols putSelect _ s = s -- get :: forall s a r. Lens' s a -> Run (db :: DB s | r) ~> Run (db :: DB s | r) -- put :: forall s a r. Lens' s a -> Run (db :: DB s | r) ~> Run (db :: DB s | r) --------------------------------------------------------------------------------------- -- -- extensible effects -- -- -- TODO: change state to Database -- program' :: Run (STATE ( Table () ( a :: Int, b :: Int ) ) + ()) Unit -- program' = do -- put $ rows [ { a: 1, b: 2 }, { a: 2, b: 3 } ] -- we'll want some DB effect and the ability to interpret lenses in it. -- let's start from STATE -- data Db s a = Db (s -> s) (s -> a) data DbF s a = Put s a -- or should we use \`Modify (s -> s) a\` ? | Get (s -> a) derive instance functorDbF :: Functor (DbF s) type DB s r = (db :: DbF s | STATE s + r) _db :: Proxy "db" _db = Proxy get :: forall s r. Run (DB s + r) s get = Run.lift _db $ Get identity put :: forall s r. s -> Run (DB s + r) Unit put s = Run.lift _db $ Put s unit handleDbPure :: forall s r. DbF s ~> Run (STATE s + r) handleDbPure = case _ of Put s next -> do State.put s pure next Get reply -> do s <- State.get pure (reply s) runDbPure :: forall s r. Run (DB s + r) ~> Run (STATE s + r) runDbPure = Run.interpret (Run.on _db handleDbPure Run.send) -- TODO runDb/evalDB will require EFFECT -- evalDb :: forall s r a. s -> Run (DB s + EFFECT + r) a -> Run r a -- evalDb s = map snd <<< runDbPure s --------------------------------------------------------------------------------------- -- -- getter and setter for pure and effectful contexts -- -- -- | Set the foci of a Setter in a monadic state to a constant value. assign' :: forall s a b r. Setter s s a b -> b -> Run (STATE s + r) Unit assign' p b = State.modify (Lens.set p b) --------------------------------------------------------------------------------------- -- -- record field primitives -- -- -- might not be worth it to introduce fetch and update, probably best inlining view and set -- with prop once the VTA PR is merged. fetch :: forall @l a r r' . IsSymbol l => Row.Cons l a r' r => Record r -> a fetch = Lens.view (prop (Proxy @l) :: Lens (Record r) (Record r) a a) update :: forall @l a r r' . IsSymbol l => Row.Cons l a r' r => a -> Record r -> Record r update = Lens.set (prop (Proxy @l) :: Lens (Record r) (Record r) a a) -- TODO: how to merge update' with update? Needs GADT? update' :: forall @l b r1 r2. IsSymbol l => Row.Lacks l r1 => Row.Cons l b r1 r2 => b -> Record r1 -> Record r2 update' = R.insert (Proxy @l) -- creates a fresh record with only the chosen label/value pair. project :: forall @l a r' r1 r2. IsSymbol l => Row.Cons l a r' r1 => Row.Cons l a () r2 => Record r1 -> Record r2 project (r :: Record r1) = R.insert (Proxy @l) (R.get (Proxy @l) r) {} -- review the cost benefit of introducing a new name later rows :: forall f cols fds. Foldable f => Ord (Record cols) => f (Record cols) -> Table fds cols rows = TableInMemory <<< S.fromFoldable -- let's do the same for building the map of tables for now -- I think I need to do something clevel for tbls at the type level -- tables :: forall f rows fds tbls. Foldable f => Ord (Table rows fds) => f (Table rows fds) -> Database tbls -- tables = Data S.fromFoldable -- this was in a different module in haskell-lenses projects :: forall @l r r' a s fds. IsSymbol l => Row.Cons l a r' r => Row.Cons l a () s => Ord (Record r) => Ord (Record s) => Table fds r -> Table fds s projects (TableInMemory rs) = TableInMemory $ S.map (project @l) rs projects _ = unsafeCrashWith "TODO" -- Maybe there's a type level table "lens" that goes from e.g. -- Database ( tbl1 :: ( col1 :: Int), tbl2 :: (colA :: String) ) -- to -- Table ( col1 :: Int ) -- it would be a lens if renaming columns in the table would properly update the database... -- in memory table and database for a start -- when interpreted against a database we don't need to carry the actual data. -- data Table -- :: Row (Row Type) -- functional dependencies -- -> Row Type -- table columns information -- -> Type --------------------------------------------------------------------------------------- -- -- examples and tests -- -- -- -- type level tests -- shouldTypeCheck :: TableAB -- shouldTypeCheck = view (table @"tableAB") databaseAB -- shouldNotTypeCheck :: Table (a :: Int) () -- shouldNotTypeCheck = view (table @"tableAB") databaseAB -- Could not match type ( b :: Int ... ) with type ( ... ) while solving -- type class constraint Main.Rows t4 "tableAB" ( a :: Int ) type SchemaTest = ( tableA :: Table ( colA :: () ) ( colA :: Int ) , tableB :: Table () ( colA :: Int, colB :: String ) ) dbTest :: Database SchemaTest dbTest = database "test" -- dbInvalid :: Database ( tableA :: Int, tableB :: Table () ColsAB ) -- dbInvalid = database "test" -- -- Custom error: -- Is not a Table dbValid :: Database ( tableA :: Table () (), tableB :: Table () ColsAB ) dbValid = database "test" -- initDb :: Run (DB Table + ()) Unit -- initDb = do -- put $ rows [ { a: 1, b: 2 }, { a: 2, b: 3 } ] -- scratchpad type R = { "A" :: String, "B" :: String } rec :: R rec = { "A": "hello", "B": "world" } rws :: Table () ( "A" :: String, "B" :: String) rws = rows [ rec, rec, update @"A" "test" rec ] -- let's initialise with the minimal example type ColsAB = ( a :: Int, b :: Int ) type TableAB = Table () ColsAB databaseAB :: Database ( tableAB :: TableAB ) databaseAB = Database "sample" -- Now we should load rows into there via the lenses. val :: String val = intercalate "\n" [ fetch @"A" rec , show $ update @"A" "test" rec , show $ update' @"C" "test" rec , show $ project @"A" rec , show $ rws , show $ projects @"A" rws -- , show $ set (select ({ a } -> a >= 2)) (rows [{ a: 2, b: 4}, { a: 3, b: 4 }]) (rows [{ a: 1, b: 2 }, { a: 2, b: 3 }]) -- this doesn't type check because we haven't yet linked the type of the Database with the type of the Table. -- , show $ set (table @"tableAB") (rows [{ a: 1, b: 2 }, { a: 2, b: 3 }]) $ databaseAB ] `37:[{"id":"9874c835503942a39b84b1a9855f88ccaca3d35d6b3b778c098e09cb36ea78073b92be809087f3a9c73fbdb526674d17d5922e943ba2e3170067452f73d9d460","href":"https://static.observableusercontent.com/files/9874c835503942a39b84b1a9855f88ccaca3d35d6b3b778c098e09cb36ea78073b92be809087f3a9c73fbdb526674d17d5922e943ba2e3170067452f73d9d460","name":"image@1.png","type":"image/png","lastModified":1703502380086.968,"size":177777},{"id":"e35027122bccc6670d55c77b18f4c4ec2f8ea5bd3f1002c0d3a5fe2f82f7123d4068966959c435c5002cbe4fd9d49cd4e49c996239554da3b178cb0a2df92941","href":"https://static.observableusercontent.com/files/e35027122bccc6670d55c77b18f4c4ec2f8ea5bd3f1002c0d3a5fe2f82f7123d4068966959c435c5002cbe4fd9d49cd4e49c996239554da3b178cb0a2df92941","name":"image@2.png","type":"image/png","lastModified":1703502380086.968,"size":49592},{"id":"2de0c5733d3a0cb9ff3050fca8dfaba9c7408a0a1863536d04747fdbad357dca196ecfd7b47f60b8c97bd9bba261fa235a8bbffd4a1fa8af0a0207c6369d7129","href":"https://static.observableusercontent.com/files/2de0c5733d3a0cb9ff3050fca8dfaba9c7408a0a1863536d04747fdbad357dca196ecfd7b47f60b8c97bd9bba261fa235a8bbffd4a1fa8af0a0207c6369d7129","name":"image@3.png","type":"image/png","lastModified":1703502380086.968,"size":121114},{"id":"44680f702b17d2cf2f4fbb209c25904b03653e9e42caa3a2a2d1c2b3b198afa7646718376febebcd3cfa20901dd8eb42c6bc12fb8ca856453b15b003c5d21331","href":"https://static.observableusercontent.com/files/44680f702b17d2cf2f4fbb209c25904b03653e9e42caa3a2a2d1c2b3b198afa7646718376febebcd3cfa20901dd8eb42c6bc12fb8ca856453b15b003c5d21331","name":"image.png","type":"image/png","lastModified":1703938859846.304,"size":54146}] 2d:{"title":"Purescript incremental relational lenses 3/n","cells":[{"id":0,"value":"$2f","pinned":false,"hidden":false,"mode":"md"},{"id":890,"value":"mdPlus`## TODO\n\n- [x] carry over relevant notes and code from part 2.\n- [x] do a little code review with comments\n- [ ] decide on encoding of schema properties (fundeps <-> unique not null)\n- [ ] implement select lens\n- [ ] find out how to deal with view maintenance\n- [ ] API checkout other approaches:\n - [ ] https://www.haskellforall.com/2014/12/a-very-general-api-for-relational-joins.html \n`","pinned":true,"hidden":false,"mode":"ojs"},{"id":960,"value":"$30","pinned":false,"hidden":false,"mode":"md"},{"id":997,"value":"$31","pinned":false,"hidden":false,"mode":"md"},{"id":1043,"value":"$32","pinned":false,"hidden":false,"mode":"md"},{"id":1074,"value":"$33","pinned":false,"hidden":false,"mode":"md"},{"id":1087,"value":"### Adding effects back\n\nTo test the approach to allow pure in memory values, or effectful database values (which will also be possibly in memory or with OPFS) I'm adding back the extensibe effect toolkit. And to allow to work on the API for this, without the sqlite backend (yet) I'll use `purescript-web-storage` to just store raw values in the Web Storage API to get the patterns right.\n\nHmm... ok, the friction caused by the lack of modules is starting to accumulate (to define shorthand name for get and put operation for each effect like DB or WebStorage, I would need to \"simulate\" that by using prefixes for instance, but it's starting to cost. ","pinned":false,"hidden":false,"mode":"md"},{"id":1092,"value":"### Going dark\n\nSo I've made a big post on the purescript discord, asking for advice on what's a good path forward, which makes me feel better about leaving this notebook and going to code in VSCode for a bit.\n\nOk got it to build and put the DB and WebStorage effect code in modules.\n\n![image.png](${await FileAttachment(\"image.png\").url()})\n\nOh I just came across https://pursuit.purescript.org/packages/purescript-run-external-state/1.0.0/docs/Run.State.External which seems to have the same idea of swapping between pure state and what they call external state (in this case, based on a ref). It also has lenses. It helps to have another point in the design space. Not in the package set unfortunately.\n","pinned":false,"hidden":false,"mode":"md"},{"id":1097,"value":"$34","pinned":false,"hidden":false,"mode":"md"},{"id":85,"value":"## Source code","pinned":false,"hidden":false,"mode":"md"},{"id":7,"value":"viewof editor = PurescriptEditor('', \n // [myDefaultTheme]\n)\n// codeJar\n// viewof editor = Editor({ \n// language: 'haskell',\n// debounced: 2000\n// })\n// viewof source = Inputs.textarea()","pinned":false,"hidden":false,"mode":"ojs"},{"id":801,"value":"Inputs.button([\n [\"Compile\", () => viewof editor.dispatchEvent(new Event('input', {bubbles: true}))],\n])","pinned":false,"hidden":false,"mode":"ojs"},{"id":647,"value":"||\n|---|---|---|\n|Compilation status|","pinned":false,"hidden":false,"mode":"md"},{"id":842,"value":"$${renderCompilationStatus(source, warnings, errors)} ","pinned":false,"hidden":false,"mode":"html"},{"id":566,"value":"||\n| --- |--- | --- |\n|Displaying the `render` value as html|","pinned":false,"hidden":false,"mode":"md"},{"id":504,"value":"html = unsafe_html`${module.render}`","pinned":false,"hidden":false,"mode":"ojs"},{"id":684,"value":"||\n| --- |--- | --- |\n|Output `val`|","pinned":false,"hidden":false,"mode":"md"},{"id":685,"value":"module.val","pinned":true,"hidden":false,"mode":"ojs"},{"id":686,"value":"||\n| --- |--- | --- |\n|Run the `greet` function|","pinned":false,"hidden":false,"mode":"md"},{"id":687,"value":"module.greet(\"me\")","pinned":true,"hidden":false,"mode":"ojs"},{"id":690,"value":"||\n| --- |--- | --- |\n|Run `main`, a console effect, check your devtools.|","pinned":false,"hidden":false,"mode":"md"},{"id":689,"value":"module.main()","pinned":true,"hidden":false,"mode":"ojs"},{"id":155,"value":"mdPlus`## Todo\n\nReach out on the [purescript discord](https://purescript.org/chat) if you have ideas or want to help!\n\n- [x] Improve warnings and errors rendering\n- [x] Added a version of the original try purescript code sample.\n- [x] Make this notebook into a nicely importable notebook. https://observablehq.com/@jmatsushita/purescript\n- [x] Add syntax highlighting.\n- [ ] How would multiple modules work?\n- [ ] Display spinner while compiling`","pinned":false,"hidden":false,"mode":"ojs"},{"id":91,"value":"## Internals\n","pinned":false,"hidden":false,"mode":"md"},{"id":364,"value":"### Import the module\n","pinned":false,"hidden":false,"mode":"md"},{"id":618,"value":"ps = await Purescript(source)","pinned":true,"hidden":false,"mode":"ojs"},{"id":621,"value":"// module = ps.module\nmodule = ps.module","pinned":true,"hidden":false,"mode":"ojs"},{"id":623,"value":"errors = ps.errors","pinned":true,"hidden":false,"mode":"ojs"},{"id":635,"value":"warnings = ps.warnings","pinned":true,"hidden":false,"mode":"ojs"},{"id":274,"value":"$35","pinned":true,"hidden":false,"mode":"ojs"},{"id":571,"value":"import { Purescript } from '@jmatsushita/purescript'","pinned":true,"hidden":false,"mode":"ojs"},{"id":576,"value":"Purescript","pinned":true,"hidden":false,"mode":"ojs"},{"id":168,"value":"And there we have it. A compiled module that's accessible from the notebook 🎉","pinned":false,"hidden":false,"mode":"md"},{"id":366,"value":"### Use an embedded code editor with Haskell syntax highlighting","pinned":false,"hidden":false,"mode":"md"},{"id":192,"value":"Reuse https://observablehq.com/@cmudig/editor, an inline code editor with syntax highlighting","pinned":false,"hidden":false,"mode":"md"},{"id":176,"value":"// import {Editor} from '@jmatsushita/editor'\nimport {CodeMirror, myDefaultTheme} from '@jmatsushita/codemirror'","pinned":false,"hidden":false,"mode":"ojs"},{"id":824,"value":"PurescriptEditor = async (doc = '', extensions = []) => {\n const {StreamLanguage} = await import(`https://jspm.dev/@codemirror/language@6.9.3`)\n const { haskell } = await import(`https://jspm.dev/@codemirror/legacy-modes/mode/haskell`);\n return CodeMirror(doc, {\n extensions: [myDefaultTheme, StreamLanguage.define(haskell), ...extensions]\n });\n}","pinned":true,"hidden":false,"mode":"ojs"},{"id":457,"value":"### Support persistence in local storage","pinned":false,"hidden":false,"mode":"md"},{"id":379,"value":"import {localStorageView} from '@tomlarkworthy/local-storage-view'","pinned":true,"hidden":false,"mode":"ojs"},{"id":462,"value":"If the local storage key doesn't exist, use this example as a default value.","pinned":false,"hidden":false,"mode":"md"},{"id":406,"value":"$36","pinned":false,"hidden":false,"mode":"ojs"},{"id":445,"value":"viewof source = localStorageView(\"part3\", { defaultValue: part3 })","pinned":true,"hidden":false,"mode":"ojs"},{"id":717,"value":"// creating a fake source to subscribe from, together with a bound localStorageView didn't work.\n// Uncaught TypeError: e.closest is not a function\n// at inputs.min.js:40:1444\n// viewof source = Inputs.input()\n// viewof sourceStorage = localStorageView(\"sourceStorage\")\n// Inputs.bind(viewof source, viewof sourceStorage)\n// See reproducer here https://observablehq.com/d/f7e7508476855e8b#cell-264","pinned":true,"hidden":false,"mode":"ojs"},{"id":726,"value":"Inputs.bind(viewof editor, viewof source)","pinned":true,"hidden":false,"mode":"ojs"},{"id":382,"value":"// Note you need to get these the right way round to have the page load work correctly\n// Inputs.bind(viewof source, viewof sourceStorage)","pinned":true,"hidden":false,"mode":"ojs"},{"id":438,"value":"// set helper\nfunction set(input, value) {\n input.value = value;\n input.dispatchEvent(new Event(\"input\", {bubbles: true}));\n}","pinned":true,"hidden":false,"mode":"ojs"},{"id":371,"value":"### Make warnings and errors readable\n\nUse a bunch of utility functions to render the warnings and errors in an html table (using the built-in `Inputs.table` didn't seem to allow multiline cells)","pinned":false,"hidden":false,"mode":"md"},{"id":195,"value":"toTable = (array, source) => array ? array.map(row => objectFilter(objectMap(row, toReadableRow(source)), hideColumns)) : []","pinned":true,"hidden":false,"mode":"ojs"},{"id":290,"value":"hideColumns = k => k !== \"allSpans\" && k !== \"moduleName\" && k !== \"filename\" && k !== \"errorLink\"","pinned":true,"hidden":false,"mode":"ojs"},{"id":205,"value":"toColumns = array => array && array[0] ? Object.keys(array[0]).filter(hideColumns) : []","pinned":true,"hidden":false,"mode":"ojs"},{"id":237,"value":"toReadableRow = source => (v,k) => {\n switch(k) {\n case \"allSpans\": \n return JSON.stringify(v)\n\n case \"position\":\n // console.log(source.split(\"\\n\"))\n // console.log(source.split(\"\\n\").slice(v.startLine - 1, v.endLine))\n return source.split(\"\\n\").slice(v.startLine - 1, v.endLine).join(\"\\n\")\n \n default:\n return v;\n }\n}","pinned":true,"hidden":false,"mode":"ojs"},{"id":221,"value":"toTable(warnings, source)","pinned":true,"hidden":false,"mode":"ojs"},{"id":210,"value":"toColumns(warnings)","pinned":true,"hidden":false,"mode":"ojs"},{"id":200,"value":"warnings","pinned":true,"hidden":false,"mode":"ojs"},{"id":263,"value":"errors.contents","pinned":true,"hidden":false,"mode":"ojs"},{"id":285,"value":"toColumns(errors.contents)","pinned":true,"hidden":false,"mode":"ojs"},{"id":287,"value":"toTable(errors.contents, source)","pinned":true,"hidden":false,"mode":"ojs"},{"id":231,"value":"objectMap = (obj, fn) =>\n Object.fromEntries(\n Object.entries(obj).map(\n ([k, v], i) => [k, fn(v, k, i)]\n )\n )\n ","pinned":false,"hidden":false,"mode":"ojs"},{"id":295,"value":"objectFilter = (obj, fn) => Object.fromEntries(Object.entries(obj).\n filter(([key, val]) => fn(key)));","pinned":false,"hidden":false,"mode":"ojs"},{"id":667,"value":"import {mdPlus} from \"@tmcw/bonus-markdown-flavor\"","pinned":false,"hidden":false,"mode":"ojs"},{"id":521,"value":"function unsafe_html() {\n const span = document.createElement(\"span\");\n span.innerHTML = String.raw.apply(this, arguments);\n return span;\n}","pinned":true,"hidden":false,"mode":"ojs"}],"files":"$W37","stdlib":"1","titling":"auto"}