Composable Ema sites - Hacker Log

Welcome to the Functional Programming Zulip Chat Archive. You can join the chat here.

Sridhar Ratnakumar

@TheMatten I ended up dropping the type class entirely and put the encoders in the Site type

image.png

https://github.com/srid/ema/pull/81/files

I don't like the PartialIsoEnumerableWithCtx type much; it probably can be simplified ...

-- | An Iso that is not necessarily surjective; as well as takes an (unchanging)
-- context value.
type PartialIsoEnumerableWithCtx ctx s a = (ctx -> a -> s, ctx -> s -> Maybe a, ctx -> [a])

partialIsoIsLawfulForCtx :: Eq a => PartialIsoEnumerableWithCtx ctx s a -> ctx -> Bool
partialIsoIsLawfulForCtx (to, from, getas) ctx =
  all (\a -> let s = to ctx a in Just a == from ctx s) (getas ctx)

defaultEnum :: (Bounded r, Enum r) => [r]
defaultEnum = [minBound .. maxBound]
Sridhar Ratnakumar

Where I'm at ...

concatSites ::
  forall r1 r2 a1 a2.
  Site r1 a1 -> Site r2 a2 -> Site (Either r1 r2) (a1, a2)
concatSites site1 site2 = undefined

This is like Semigroup, but with polymorphic type indexes (r a).

Sridhar Ratnakumar

Working version of that function!

https://github.com/srid/ema/blob/1e7318e929e28c7444e488089ce52d87e1c187db/src/Ema/Site.hs#L78-L123

Gotta heavily refactor. Wonder if any of the existing ideas would be useful to simplify this definition and implementation?

Sridhar Ratnakumar
class PartialIsoFunctor (f :: Type -> Type -> Type -> Type) where
  pimap :: Iso a (Maybe a) b b -> Iso' c d -> (y -> x) -> f x a c -> f y b d
Sridhar Ratnakumar

I have got something that's correct ... BUT not very elegant at all. https://github.com/srid/ema/pull/81

TheMatten

Sridhar Ratnakumar said:

https://stackoverflow.com/q/71180949/55246

/cc TheMatten

Haha, I'm literally working on such typeclass right now with @Asad Saeeduddin :big_smile:
What you want is Apply part of Applicative on n-ary functor, with different monoidal categories used for every type parameter ((Hask, (,), ()) and (Hask, Either, Void) instead of just (Hask, (,), ()) used in Applicative)

Sridhar Ratnakumar

Someone suggests Data.Contravariant.Decidable in Twitter: https://twitter.com/lucasdicioccio/status/1494902322861850625

TheMatten

Sridhar Ratnakumar said:

What's Hask here?

It's this hypothetical category of Haskell types and functions between them - doesn't really matter here, basically what I'm saying is that you can combine arbitrary types wrapped in your functor by tupling:

merge :: f a -> f b -> f (a, b)

which is the same thing as

(<*>) :: f (a -> b) -> f a -> f b

just expressed differently

Similarly, in case of different functor you may combine these with sum:

merge :: f a -> f b -> f (Either a b)

which is suspiciously similar to

choose :: (a -> Either b c) -> f b -> f c -> f a

except that Decidable lives in "opposite" category of Hask, where functions go the opposite way (as in Contravariant)

TheMatten

All of this stuff doesn't really matter - instead, at some point you should be able to just implement derive some MonoidalN class on Site and specialize it's method to get siteMerge

Sridhar Ratnakumar

Getting close to getting things working (composing Emanote, and extending it, as example). Mostly works, with some edges cases (how some routes are decoded in Emanote).

Overall, there is progress in composable sites in Ema ... BUT still not happy. I can't compose the model creator/updater process easily (I can compose it, but it is a lot of leg work). I suspect the use of LVar (TMVar) is getting in the way.

I should look into continuations. Can they be composed more easily?

Sridhar Ratnakumar

Beneath the LVar abstraction, I already have something akin to continuations:

  m
    ( Change source tag,
      (Change source tag -> m ()) ->
      m Cmd
    )

https://github.com/srid/unionmount/blob/c906d32c6e8d1b849e60680fd33d2af38fde309d/src/System/UnionMount.hs#L164-L168

Sridhar Ratnakumar

m (initialValue, functionThatWillInformOfNewValues)

Sridhar Ratnakumar

Alternatively I should think of Ema model updates as streams. Then it becomes a matter of composing streams.

Sridhar Ratnakumar

Non-empty streams, more specifically (the initial value is readily available).

Sridhar Ratnakumar

Composing callback-based updates using Applicative: image.png

Sridhar Ratnakumar

I find myself going back to type class. Works well with generic composition.

Sridhar Ratnakumar

Simplest site:

data Route
  = Route_Index
  | Route_About
  deriving stock (Show, Eq, GHC.Generic)
  deriving anyclass (Generic, HasDatatypeInfo, IsRoute, HasModel)

main :: IO ()
main = void $ Ema.runSite @Route ()

instance RenderAsset Route where
  renderAsset enc () r =
    Ema.AssetGenerated Ema.Html $
      tailwindLayout (H.title "Basic site" >> H.base ! A.href "/") $
        H.div ! A.class_ "container mx-auto" $ do
          H.div ! A.class_ "mt-8 p-2 text-center" $ do
            case r of
              Route_Index -> do
                "You are on the index page. "
                routeElem Route_About "Go to About"
              Route_About -> do
                routeElem Route_Index "Go to Index"
                ". You are on the about page. "
    where
      routeElem r' w =
        H.a ! A.class_ "text-red-500 hover:underline" ! routeHref r' $ w
      routeHref r' =
        A.href (fromString . toString $ Ema.routeUrl enc () r')
Sridhar Ratnakumar

Just route type and HTML; everything else is boilerplate-free

Sridhar Ratnakumar

minimal site, no routes - but just to get a dynamic model going for use elsewhere:

data Route
  deriving stock (Show, Eq, Generic)
  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
  deriving (IsRoute) via (ConstModelRoute Model Route)

data Model = Model

instance RenderAsset Route where
  renderAsset _enc = \case

instance HasModel Route where
  runModel _ _ () = do
    pure $ pure Model -- <-- make this non-pure to update the model
Sridhar Ratnakumar

And what it looks to do the "virtual mount" on this model:

instance HasModel Route where
  runModel _ _ () = do
    let model0 = Model "zero"
        pats = [((), "*")]
        ignorePats = [".pijul", ".direnv", ".stfolder", "dist-newstyle"]
        baseDir = "./"
    fmap Dynamic $
      UM.mount baseDir pats ignorePats model0 $
        \() fp _action -> do
          pure $ \m -> m {_modelStatus = show fp}
Sridhar Ratnakumar

https://twitter.com/sridca/status/1502749766358380550