suffixed symbols

Main.purs

module Main where

import Prelude

import Effect (Effect)
import Data.Foldable (fold)
import TryPureScript (h1, text, render)

import Data.Symbol (class IsSymbol, SProxy (..))
import Prim.Symbol (class Append)
import Prim.Row (class Cons, class Lacks)
import Prim.RowList (kind RowList, class RowToList, Nil, Cons) as RL
import Record (insert, get, delete)

__ :: forall sym. SProxy sym
__ = SProxy

data RLProxy (rowlist :: RL.RowList) = RLProxy

class Suffixable ns suf row alt | -> alt where
  addSuffixes' :: RLProxy ns -> SProxy suf -> Record row -> Record alt
  
instance sufNil :: Suffixable RL.Nil suf row row where
  addSuffixes' _ _ rec = rec

-- | rec :: { cur :: typ, next1 :: typ1, next2 :: typ2 ...}
-- | row :: ( cur :: typ, next1 :: typ1, next2 :: typ2 ...)
-- |
-- | nxt :: { next1 :: typ1, next2 :: typ2 ...}
-- | now :: ( next1 :: typ1, next2 :: typ2 ...)
-- | ns ::  [ next1 :: typ1, next2 :: typ2 ...]
-- |
-- | itr :: { next1suf :: typ1, next2suf :: typ2 ...}
-- | iow :: ( next1suf :: typ1, next2suf :: typ2 ...)
-- |
-- | alt :: (cursuf :: typ, next1suf :: typ1, next2suf :: typ2 ...)

instance sufCons :: 
  ( Append cur suf cursuf
  , IsSymbol cur
  , IsSymbol cursuf
  , Cons cursuf typ iow alt 
  , Lacks cursuf iow
  , Suffixable ns suf now iow
  , Cons cur typ now row
  , Lacks cur now
  ) 
  => Suffixable (RL.Cons cur typ ns) suf row alt where
  addSuffixes' _ psuf rec =
    let nxt = delete (__ :: _ cur) rec :: Record now
        itr = addSuffixes' (RLProxy :: RLProxy ns) psuf nxt :: Record iow
      in insert (__ :: _ cursuf) (get (__ :: _ cur) rec) itr :: Record alt  

addSuffixes 
  :: forall xs suf row alt
   . Suffixable xs suf row alt
  => RL.RowToList row xs
  => SProxy suf -> Record row -> Record alt
addSuffixes psuf rec =
  addSuffixes' (RLProxy :: RLProxy xs) psuf rec

main :: Effect Unit
main =
  let r0 = { a: "z", b: 4, ab : true }
  in render $ fold
      [ h1 (text $ show r0)
      , h1 (text $ show $ addSuffixes  (__ :: _ "c") r0)
      , h1 (text $ show $ addSuffixes (__ :: _ "de") $ addSuffixes  (__ :: _ "c") r0)
      ]