27:null 28:["$","title",null,{"children":"Purescript incremental relational lenses 2/n | Jun Matsushita | Observable"}] 2d: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' ```2e: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()})2f:T11bb,### How about the incremental version That's a good moment too [look at how `put_delta`](https://github.com/rudihorn/haskell-lenses/blob/master/Lens/Put/Incremental.hs#L191-L205) does it! ```haskell put_delta c (Select (HPred p) l) delta_n wif = do unsat <- Set.fromList <$> query_ex @c @(Rt s) Proxy c tbls cols pred let delta_m0 = ((Delta.fromSet $ merge @(TopologicalSort (Fds s)) unsat (positive delta_n)) #- Delta.fromSet unsat) #- (Delta.fromSet $ negative delta_n) let delta_nh = (SR.filter p $ positive delta_m0, SR.filter p $ negative delta_m0) #- delta_n put_delta c l (delta_m0 #- delta_nh) wif where pred = DP.conjunction [affected @(Fds s) $ Delta.positive delta_n, query_predicate l, DP.not $ p] cols = column_map l tbls = recover_tables @(Ts s) Proxy ``` More involved as expected 🤓 Oh at first I kind of liked the indentation style, but now it totally confused me. But all good. So `unsat` is the application of the select, so we ignore that (UPDATE: nevermind, it's actually quite important, part of an optimisation and described in more details below). The main things are: - delta_m0, which also does the `merge @(TopologicalSort (Fds s)) unsat` we saw in the classic version. which is applied to `positive delta_n` so probably additions. But where does `delta_n` come from Ah yes, the main `put` first computes a delta and passes it to `put_delta` ```haskell put :: forall c s. LensPut c s => c -> Lens s -> RecordsSet (Rt s) -> IO () put c l rs = do unchanged <- query c l let delta = Delta.fromSet rs #- Delta.fromList unchanged put_delta c l delta False ``` I guess that's were we'd want a pure version. the query gets `m` and the `put_delta` does the `m'` modification hidden as implicit state inside `IO ()`. Ah so `#-` seems to be a difference operator that yields deltas between records. [Right](https://github.com/rudihorn/haskell-lenses/blob/master/Delta.hs#L31-L32) it's the `merge` (different merge) of a delta with the negation of another delta. using `Data.Set` union and `\\` difference. Interesting that rows are converted to deltas and the difference is on the deltas... Worth thinking about more later. Particularly if we need to hook this into a reactive/streaming abstraction. Oh the `Delta` datatype is a pair of positive and negatives. So pretty much exactly an ORSet... That's food for thought for future CRDT integration. Also since one of the one paper I saw on CRDTs and semantic web used a modification on ORSet to deal with tuple merging. That's the paper https://inria.hal.science/hal-00686484/document > Luis Daniel Ibáñez, Hala Skaf-Molli, Pascal Molli, Olivier Corby. Synchronizing Semantic Stores with Commutative Replicated Data Types. SWCS - Semantic Web Collaborative Spaces Workshop - 2012, Apr 2012, Lyon, France. pp.1091-1096, ff10.1145/2187980.2188246ff. ffhal-00686484f Hmm. It's only extending ORSet to SUSet because of the delete-insert atomic operation. Ah, I see. In RDF that could be a simple "row" update but span a lot of triples, and since we don't have "tables", the update could be large. Hence their comment > We could modify the operations to send the relevant set of triples to affect one by one, but that could flood the network with traffic considering the potential size of an RDF-Graph. Anyway, that's for later, but interesting to consider. Ok so back to `delta_m0` - It's doing the merge of these positive deltas (which are the changed rows). - then removes the non selected (`unsat`) rows - and removes the negative deltas (i.e. these rows that where deleted from the view). There is then `delta_nh`. Let's take a look at the paper. I think this is the juicy bit. Oh man, that looks so much like differentiation... wonder if there are results from AD or Zippers that could apply here. Also thinking about conflicts and transactions is going to be tough and interesting. ![image@3.png](${await FileAttachment("image@3.png").url()}) Ok so we're looking at the optimised version. - Q is unsat (running a query with `pred` which select affected rows, which are the ones that are "touched" in the view, i.e. present in delta_n). It feels like building this for but also on top of `purescript-selda` is going to make some code much more pleasant. Ok so delta_nh is about rows which didn't satisfy the select predicate before the udpate, but do after. That's fine. I trust it. Ok so of course that's a lot of code, but I think I get the gist of it.30:Ta2c,### What next? So I guess before I break here, let's see what we have. - I don't see a problem in defining the fundeps in the schema. That's going to be a dependency of lenses anyway, so it shouldn't be an issue. - To be honest though, maybe starting with fundeps in the lenses will make integration with selda easier? And should be easier to code by following along the haskell code too... There's going to be tons of difficulties there anyway with type level stuff, so maybe a good way to break things into chunks. - Do we want to tackle the effect/interpreter side of things early? Maybe by implementing all this first as pure functions. The moment then when we wire the database will be a good moment to add this flexibility (probably with purescript-run). - Starting pure also means we don't have to deal with Effect in lenses, which I'm not sure are a thing in purescript. Oh there is https://github.com/sigilion/purescript-run-profunctor-lenses/blob/master/src/Run/Lenses.purs (oh interesting other repo https://github.com/brownplt/B2T2 about typechecker usability for databases, I wonder how haskell and purescript seldas would fare). Very tempting... - It would make sense to go in this order: - start with the classic lenses - start with the prim lens - then the select lens - then decide where to go. Ok let's just lay down some shapes before breaking. Oh sad. Run.Lenses is not in the default package set. I don't want to move to a local try purescript compiler yet though. So let's continue without it but with Run and with Data.Lens. It also feels like I could implement a version without the sophisticated type checking. And gradually implement it. Ok leaving it in this state for the next session 👋 ```haskell -- 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) derive instance functorDb :: Functor (Db s) type DB s r = (db :: Db s | r) _db :: Proxy "db" _db = Proxy 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 s. Predicate a -> Lens' s a -> Lens' s a select pred _ = lens getSelect putSelect where getSelect :: s -> s getSelect s = s putSelect :: s -> s -> s 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) runDBPure :: forall s a. s -> Run (DB + r) a -> Run r s runDBPure = unsafeCrashWith "todo" ``` 31:Td94,### Hooking this into extensible effects I should probably try and build on top of STATE and EFFECT. This is a good thread to look at: - https://discourse.purescript.org/t/about-using-purescript-run-for-evented-things-requiring-callbacks/451/3 - Oof. Transactions seem hard. I think that's sort off emulating an indexed monad (like the hamburger dsl with a state machine in the types) with `PG Inside` and `PG Outside`. Though [given the note here](https://github.com/purescript-webrow/webrow/blob/master/src/WebRow/PostgreSQL/Internal.purs#L18-L23) I'm not sure it's as robust as intended. - Having a [RESOURCE](https://github.com/purescript-webrow/webrow/blob/master/src/WebRow/Resource.purs) effect is great I think I'm conflating 2 things: - Having a DB effect and having a way to interpret it purely (which means probably that there is a runDbPure that wraps runAccumPure and models the DB with a record backend. - Having a pure lens that operates on in-memory records rather than the DB. That version would be the one used by the runDbPure. The question is, does DB include EFFECT or not? Ok I think the idea is:: - `handleDb :: forall s r. DbF s ~> Run (EFFECT + r)` for the effectful handling - `handleDbPure ::: forall s. DbF s -> Tuple s` for the pure handling oh. Maybe then instead: ```haskell handleDb :: forall s r. DbF s ~> Run (EFFECT + r) -- and/or RESOURCE. handleDbPure ::: forall s r. DbF s ~> Run (STATE s + r) ``` I think that's the right shape. Though there's also another possible shape where we use runAccumPure to interpret DB, but I like to make DB build on STATE instead. Oh except there's a trickiness with STATE which doesn't have a pattern/base functor so doesn't have a handle function. So I probably shouldn't model my `Db` type on `State` and instead have a pattern functor. Ok this feels right for now. ```haskell 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 = interpret (on _db handleDbPure send) -- runDbPure s r = runState s (i r) -- where -- i :: forall r. Run (DB s + r) a -> Run (STATE s + r) a -- i = interpret (on _db handleDbPure send) -- runDbPure :: forall s r a. s -> Run (DB s + r) a -> Run r (Tuple s a) -- runDbPure s = runState s <<< interpret (on _db handleDbPure send) -- evalDbPure :: forall s r a. s -> Run (DB s + r) a -> Run r a -- evalDbPure s = map snd <<< runDbPure s -- runDb will require EFFECT -- evalDb :: forall s r a. s -> Run (DB s + EFFECT + r) a -> Run r a -- evalDb s = map snd <<< runDbPureAt _db s -- let's add initialise with the minimal example type Row = ( a :: Int, b :: Int ) type Table = RecordSet Row initDb :: Run (DB Table + ()) Unit initDb = do put $ rows [ { a: 1, b: 2 }, { a: 2, b: 3 } ] main :: Effect Unit main = do log $ "Run.State: " <> (show $ extract $ runState (rows []) $ runDbPure initDb) -- Run.State: (Tuple (fromFoldable [{ a: 1, b: 2 },{ a: 2, b: 3 }]) unit) ```32:Td70,### Back to lenses I'm not sure whether I need the `prim` lens constructor. Seems that it's used to help carry the fundep info and other type level info. For now let's try and just build select and just pass the fundep info at the term level. I want a select lens such that ```haskell log $ put (select (\{ a } -> a >= 2)) [{ a: 2, b: 4}, { a: 3, b: 4 }] [{ a: 1, b: 2 }, { a: 2, b: 3 }] -- [{ a: 1, b: 2 },{ a: 2, b: 4 }, { a: 3, b: 4 }] ``` I'm realising I don't have a good sense of how to use lenses with containers. Here `put` is an insertion. Maybe we should start with a single record insert? Oh hold on, in the paper `put` takes the whole record set... ``` var albums = get albumsLens; var newAlbums = albums ++ [(album='Disintegration', quantity=1)] put albumsLens with newAlbums; ``` Ok I suppose it makes sense to have a `table` lens (the `prim` lens), since it is focusing on a single table within the whole database. So let's focus on this first. ```haskell -- with an initialised db with [{ a: 1, b: 2 }, { a: 2, b: 3 }] -- and a table lens (with some way to express fundeps at the type level) table = prim @RowAB @FDs abs <- get table; put table $ abs <> [{ a: 2, b: 4}, { a: 3, b: 4 }] -- [{ a: 1, b: 2 },{ a: 2, b: 4 }, { a: 3, b: 4 }] ``` Ok let's rename RecordSet to Table. We don't have a schema for the whole database in selda, only per table. I suppose we can consider that a database is a name and a set of tables. Actually it might be more correct to put the name of the table as a key in a map... Or maybe just a record Let's follow what selda does for tables ```haskell data Database : Row Type -> Type data Database r = Database String databaseAB :: Database ( tableAB: TableAB ) databaseAB = Database "sample" ``` That makes sense as then the type of the lens means something again for me. (and calling it table instead of prim makes sense for now) ```haskell table :: forall @rows @fds. Lens (Database tables) (Table rows) ``` So if we added fundeps to the table type ``` table :: forall @tables @rows @fds. Lens (Database tables) (Table rows fds) ``` Maybe let's start by adding them also as a phantom type. After reading a bit more the paper, I think there's not really an automatic mapping between fundeps and key constraints. So let's let the fundeps be a type level annotation that doesn't correspond to anything at the type level, while the key constraint will data. The fundeps should be some kind of type level map. There's an old one lying around https://github.com/LiamGoodacre/purescript-type-map/blob/master/src/Type/Map.purs it's pretty involved. Could we do a Row of Row? Seems to work actually! And got a nice type error when I wrote: ```haskell databaseAB :: Database ( tableAB :: TableAB ) databaseAB = Database "sample" {} -- Could not match type () with type ( tableAB :: Table ( a :: Int , b :: Int ) () ) while trying to match type Database t0 with type Database ( tableAB :: Table ( a :: Int , b :: Int ) (() @...) ) while checking that expression (Database "sample") {} has type Database ( tableAB :: Table ( a :: Int , b :: Int ) (() @...) ) in value declaration databaseAB where t0 is an unknown type ``` Also it's clear now that my DB effect with a Get and Put was only for one table... It's tempting to adapt it to store the database and have Get and Put take VTAs, but let's just leave that aside for now to continue focusing on lenses. 🎉 Got it to compile33:T1019,### table lens (aka prim) types ```haskell table :: forall @tables @rows @fds. Lens' (Database tables) (Table rows fds) table = unsafeCrashWith "TODO" ``` Ok so here comes the first type level fireworks. We need to pass a `@table` VTA and establish a relationship between `tables` and `rows` type variables, such that the `table` we select is one of the rows in `tables`. I think that's fine but I'm going to struggle if I don't also have a Symbol for the table name in the lens output... Oh, but if the `tables` kind is this `Row (Row Type)` then we have the `rows` information in there. So we might be able to match on this... If the whole schema is only in the `Database` type (and only a Symbol in the Table, then I need to have the Database type everywhere. But, that might be what makes most sense applied to the real world. So maybe it's something like this: ```haskell table :: forall @schema @table @fds. Lens' (Database schema) (Table schema table fds) ``` So the `schema` carries the whole database schema info, and we consider the table only within that. It couples the part to the whole... Well if I remove the `schema type variable from the `Table` then the lens needs to know about the schema, which is ok, but if we have a table with the right rows, we can move it for instance to another database with a different schema. So that's an argument for going back to the initial type (renaming the type variable `tables` to `schema` is good though I think: ```haskell table :: forall @schema @rows @fds. Lens' (Database schema) (Table rows fds) ``` Ok so we'll need to try and pattern match on the right hand side of the Row of Rows. Let's try. I suppose we need some `Rows schema rows` constraint. Oh hold on. The table lens will be called with a table symbol. So we can have `Rows schema table rows` which makes more sense. 👍 Ok I have something that probably exists in a library elsewhere and typechecks. ```haskell table :: forall @table schema list rows @fds . RL.RowToList schema list => Rows list table rows => Lens' (Database schema) (Table rows fds) table = unsafeCrashWith "TODO" class Rows :: RL.RowList Type -> Symbol -> Row Type -> Constraint class Rows list table rows | list table -> rows instance Rows RL.Nil table () -- In a database with an empty schema, passing any label return an empty row. instance ( Symbol.Equals table t True ) => Rows (RL.Cons t rowlist rest) table rows ``` How do we test this? Let's write a use of the table lens with a VTA and a type signature and see if it makes sense. Tried this ```haskell shouldTypeCheck :: TableAB shouldTypeCheck = view table @tableAB databaseAB ``` And got a pretty wat error message: ``` CannotApplyExpressionOfTypeOnType An expression of monomorphic type: t320 -> t322 cannot be applied to: tableAB while inferring the type of (view table) in value declaration shouldTypeCheck ``` It should have been ```haskell shouldTypeCheck :: TableAB shouldTypeCheck = view (table @"tableAB") databaseAB ``` And indeed it type checks 🎉 Let's try a failing one. Hmmm. Spoke quite a bit too soon 😅 I wasn't even recursing in my instance ha ha. Also there were lots of kinds to fix. And I also had the base case wrong. ```haskell table :: forall @table schema list rows fds . RL.RowToList schema list => Rows list table rows => Lens' (Database schema) (Table rows fds) table = unsafeCrashWith "TODO" class Rows :: RL.RowList (Row Type) -> Symbol -> Row Type -> Constraint class Rows list table rows | list table -> rows instance Rows RL.Nil table rows -- In a database with an empty schema, passing any label return an empty row. instance ( Symbol.Equals table t True , Rows rest table rows ) => Rows (RL.Cons t rows rest) table rows 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 ) ``` Neat! Good progress today. Merry christmas 🎄 34:T1837,part2 = `module Main where import Prelude import Data.Lens (Lens, Lens', lens, view, set) 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 Record (get, insert) as R import Partial.Unsafe (unsafeCrashWith) import Prim.Boolean (True) import Prim.Row (class Cons, class Lacks) import Prim.Row as Row import Prim.RowList as RL import Type.Data.Symbol (class Equals) as Symbol import Type.Proxy (Proxy(..)) import Type.Row (type (+)) -- import Run (Run, extract, interpret, on, send) -- import Run (lift) as Run -- import Run.State (STATE, runState) -- import Run.State as State -- 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 Type -> Row (Row Type) -> Type data Table rows fds = Table (Set (Record rows)) instance Show (Record rows) => Show (Table rows fds) where show (Table s) = show s data Database :: Row (Row Type) -> Type data Database tbls = Database String -- 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 => Cons l a r' r => Record r -> a fetch = view (prop (Proxy @l) :: Lens (Record r) (Record r) a a) update :: forall @l a r r' . IsSymbol l => Cons l a r' r => a -> Record r -> Record r update = 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 => Lacks l r1 => 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 => Cons l a r' r1 => 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 rows fds. Foldable f => Ord (Record rows) => f (Record rows) -> Table rows fds rows = Table <<< 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 => Cons l a r' r => Cons l a () s => Ord (Record r) => Ord (Record s) => Table r fds -> Table s fds projects (Table rs) = Table $ S.map (project @l) rs -- 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 = interpret (on _db handleDbPure send) -- runDb will require EFFECT -- evalDb :: forall s r a. s -> Run (DB s + EFFECT + r) a -> Run r a -- evalDb s = map snd <<< runDbPureAt _db s -- let's initialise with the minimal example type RowAB = ( a :: Int, b :: Int ) type TableAB = Table RowAB () databaseAB :: Database ( tableAB :: RowAB ) databaseAB = Database "sample" -- initDb :: Run (DB Table + ()) Unit -- initDb = do -- put $ rows [ { a: 1, b: 2 }, { a: 2, b: 3 } ] type Predicate a = a -> Boolean -- I want a prim lens such that -- table = prim @RowAB @FDs -- abs <- get table; -- put table $ abs <> [{ a: 2, b: 4}, { a: 3, b: 4 }] table :: forall @table schema list rows fds . RL.RowToList schema list => Rows list table rows => Lens' (Database schema) (Table rows fds) table = unsafeCrashWith "TODO" class Rows :: RL.RowList (Row Type) -> Symbol -> Row Type -> Constraint class Rows list table rows | list table -> rows instance Rows RL.Nil table rows -- In a database with an empty schema, passing any label return an empty row. instance ( Symbol.Equals table t True , Rows rest table rows ) => Rows (RL.Cons t rows rest) table rows 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 ) -- we're not changing the shape of things with a select -- in RA it's only a filter, projection is separate select :: forall row fds. Predicate (Record row) -> Lens' (Table row fds) (Table row fds) select _pred = lens getSelect putSelect where getSelect :: Table row fds -> Table row fds getSelect s = s putSelect :: Table row fds -> Table row fds -> Table row fds 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) -- 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 ] 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 -- , "Run.State: " <> (show $ extract $ runState (rows []) $ runDbPure initDb) , show $ set (select (\\ { a } -> a >= 2)) (rows [{ a: 2, b: 4}, { a: 3, b: 4 }]) (rows [{ a: 1, b: 2 }, { a: 2, b: 3 }]) ] `35:[{"id":"9874c835503942a39b84b1a9855f88ccaca3d35d6b3b778c098e09cb36ea78073b92be809087f3a9c73fbdb526674d17d5922e943ba2e3170067452f73d9d460","href":"https://static.observableusercontent.com/files/9874c835503942a39b84b1a9855f88ccaca3d35d6b3b778c098e09cb36ea78073b92be809087f3a9c73fbdb526674d17d5922e943ba2e3170067452f73d9d460","name":"image@1.png","type":"image/png","lastModified":1703414790728.111,"size":177777},{"id":"e35027122bccc6670d55c77b18f4c4ec2f8ea5bd3f1002c0d3a5fe2f82f7123d4068966959c435c5002cbe4fd9d49cd4e49c996239554da3b178cb0a2df92941","href":"https://static.observableusercontent.com/files/e35027122bccc6670d55c77b18f4c4ec2f8ea5bd3f1002c0d3a5fe2f82f7123d4068966959c435c5002cbe4fd9d49cd4e49c996239554da3b178cb0a2df92941","name":"image@2.png","type":"image/png","lastModified":1703414790728.111,"size":49592},{"id":"2de0c5733d3a0cb9ff3050fca8dfaba9c7408a0a1863536d04747fdbad357dca196ecfd7b47f60b8c97bd9bba261fa235a8bbffd4a1fa8af0a0207c6369d7129","href":"https://static.observableusercontent.com/files/2de0c5733d3a0cb9ff3050fca8dfaba9c7408a0a1863536d04747fdbad357dca196ecfd7b47f60b8c97bd9bba261fa235a8bbffd4a1fa8af0a0207c6369d7129","name":"image@3.png","type":"image/png","lastModified":1703414790728.111,"size":121114}] 2b:{"id":"c893cda26d4f49bf","slug":null,"title":"Purescript incremental relational lenses 2/n","thumbnail":"17e0b8fed12a6ea50f9360cffa01273e6026b55b177782e2fc4b0991d13ab589","access_level":"public","create_time":"$D2023-12-24T10:46:30.728Z","update_time":"$D2023-12-29T17:57:47.736Z","view_time":null,"first_public_time":"$D2023-12-24T10:46:30.728Z","has_unpublished_edits":null,"fork":{"id":"67f10b2878554077","slug":null,"title":"Purescript incremental relational lenses 1/n","owner":{"id":"885522aee82e9dc7","login":"jmatsushita","name":"Jun Matsushita"}},"stars":0,"starred":false,"owner":{"type":"team","id":"885522aee82e9dc7","login":"jmatsushita","name":"Jun Matsushita","avatar_url":"https://avatars-next.observableusercontent.com/baf5b0dbf3fcd28799fdd31db44e9a029fea0c5048021a805ee2de732fcc15aa","tier":"starter_2024"},"version":1040,"publish_version":null,"role":null,"authored":false,"authors":[{"type":"individual","id":"a93138a291b16572","login":"jmatsushita","name":"Jun Matsushita","avatar_url":"https://avatars-next.observableusercontent.com/baf5b0dbf3fcd28799fdd31db44e9a029fea0c5048021a805ee2de732fcc15aa","tier":null}],"members":[{"type":"individual","id":"a93138a291b16572","login":"jmatsushita","name":"Jun Matsushita","avatar_url":"https://avatars-next.observableusercontent.com/baf5b0dbf3fcd28799fdd31db44e9a029fea0c5048021a805ee2de732fcc15aa","tier":null,"role":"editor"}],"comments":[],"custom_thumbnail":false,"trashed":false,"lapsed":null,"subscribed":null,"forks":1,"collection":null,"type":"notebook","body":{"title":"Purescript incremental relational lenses 2/n","cells":[{"id":0,"value":"# Purescript incremental relational lenses 2/n\n\nUnderstanding and implementing incremental relational lenses in purescript.\n\n- [First part](https://observablehq.com/d/67f10b2878554077) \n\nIn this part we'll aim at continuing to read the paper, work out how to design the API so that lenses can be interpreted purely and with a database backend, and setup type level machinery to deal with the database schema. \n\nWe'll also look at database APIs with strong types, and particularly selda (in both haskell and purescript).\n\n## Sources\n\n - https://www.youtube.com/watch?v=e0JST9vmhFc&t=896s\n - https://github.com/rudihorn/haskell-lenses\n\nThis 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. \n\n![image@1.png](${await FileAttachment(\"image@1.png\").url()})\n","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":890,"value":"mdPlus`## TODO\n\n- [x] carry over relevant notes and code from part 1.\n- [x] do a little code review with comments\n- [x] work out how to interpret lenses purely vs with a DB (look at extensible effects)\n- [x] decide on encoding of schema properties (fundeps <-> unique not null)\n`","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":960,"value":"$2d","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":997,"value":"$2e","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":969,"value":"$2f","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":979,"value":"$30","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":1004,"value":"$31","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":1013,"value":"$32","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":1026,"value":"$33","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":85,"value":"## Source code","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"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","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":801,"value":"Inputs.button([\n [\"Compile\", () => viewof editor.dispatchEvent(new Event('input', {bubbles: true}))],\n])","pinned":false,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":647,"value":"||\n|---|---|---|\n|Compilation status|","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":842,"value":"$${renderCompilationStatus(source, warnings, errors)}","pinned":false,"hidden":false,"mode":"html","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":566,"value":"||\n| --- |--- | --- |\n|Displaying the `render` value as html|","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":504,"value":"html = unsafe_html`${module.render}`","pinned":false,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":684,"value":"||\n| --- |--- | --- |\n|Output `val`|","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":685,"value":"module.val","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":686,"value":"||\n| --- |--- | --- |\n|Run the `greet` function|","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":687,"value":"module.greet(\"me\")","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":690,"value":"||\n| --- |--- | --- |\n|Run `main`, a console effect, check your devtools.|","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":689,"value":"module.main()","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"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","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":91,"value":"## Internals\n","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":364,"value":"### Import the module\n","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":618,"value":"ps = await Purescript(source)","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":621,"value":"// module = ps.module\nmodule = ps.module","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":623,"value":"errors = ps.errors","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":635,"value":"warnings = ps.warnings","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":274,"value":"renderCompilationStatus = (source, warnings, errors) => {\n const renderedWarnings = warnings && warnings.length >0 ? \nhtl.html`

Compiler warnings

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

${col}
${cell}

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

Compiler errors

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

${col}
${cell}

\n` : htl.html`No errors`\n return htl.html`${renderedWarnings}${renderedErrors}`\n}","pinned":false,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":571,"value":"import { Purescript } from '@jmatsushita/purescript'","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":576,"value":"Purescript","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":168,"value":"And there we have it. A compiled module that's accessible from the notebook 🎉","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":366,"value":"### Use an embedded code editor with Haskell syntax highlighting","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":192,"value":"Reuse https://observablehq.com/@cmudig/editor, an inline code editor with syntax highlighting","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":176,"value":"// import {Editor} from '@jmatsushita/editor'\nimport {CodeMirror, myDefaultTheme} from '@jmatsushita/codemirror'","pinned":false,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"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","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":457,"value":"### Support persistence in local storage","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":379,"value":"import {localStorageView} from '@tomlarkworthy/local-storage-view'","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":462,"value":"If the local storage key doesn't exist, use this example as a default value.","pinned":false,"hidden":false,"mode":"md","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":406,"value":"$34","pinned":false,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":445,"value":"viewof source = localStorageView(\"part2\", { defaultValue: part2 })","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"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","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":726,"value":"Inputs.bind(viewof editor, viewof source)","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"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","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"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","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"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","author":"$undefined","summary":"$undefined","output":"","database":"$undefined"},{"id":195,"value":"toTable = (array, source) => array ? array.map(row => objectFilter(objectMap(row, toReadableRow(source)), hideColumns)) : []","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":290,"value":"hideColumns = k => k !== \"allSpans\" && k !== \"moduleName\" && k !== \"filename\" && k !== \"errorLink\"","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":205,"value":"toColumns = array => array && array[0] ? Object.keys(array[0]).filter(hideColumns) : []","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"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","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":221,"value":"toTable(warnings, source)","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":210,"value":"toColumns(warnings)","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":200,"value":"warnings","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":263,"value":"errors.contents","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":285,"value":"toColumns(errors.contents)","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":287,"value":"toTable(errors.contents, source)","pinned":true,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"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","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":295,"value":"objectFilter = (obj, fn) => Object.fromEntries(Object.entries(obj).\n filter(([key, val]) => fn(key)));","pinned":false,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"id":667,"value":"import {mdPlus} from \"@tmcw/bonus-markdown-flavor\"","pinned":false,"hidden":false,"mode":"ojs","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"},{"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","author":"$undefined","summary":"$undefined","output":"$undefined","database":"$undefined"}],"files":"$W35","stdlib":"1","titling":"auto"}} 2c:"$2b:body"