recordApply

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.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 Applyable fs rf xs rx ry | -> ry where
  recordApply' :: RLProxy fs -> Record rf -> RLProxy xs -> Record rx -> Record ry
 
instance applyNil 
  :: Applyable RL.Nil rf RL.Nil ry ry where
  recordApply' _ _ _ rec = rec
  
instance applyCons ::
  ( IsSymbol k
  , Applyable fst rft xst rxt ryt
  , Cons k xtyp rxt rx
  , Lacks k rxt
  , Cons k (xtyp -> ytyp) rft rf
  , Lacks k rft
  , Cons k ytyp ryt ry
  , Lacks k ryt
  ) => Applyable (RL.Cons k (xtyp -> ytyp) fst) rf 
                 (RL.Cons k xtyp xst) rx ry where
  recordApply' fs recf xs recx =
    let nextf = delete (__ :: _ k) recf :: Record rft
        nextx = delete (__ :: _ k) recx :: Record rxt
        itr = recordApply' (RLProxy :: RLProxy fst) nextf 
                           (RLProxy :: RLProxy xst) nextx :: Record ryt
    in insert (__ :: _ k) 
              (get (__ :: _ k) recf $ get (__ :: _ k) recx) itr :: Record ry

recordApply
  :: forall fs rf xs rx ry 
   . Applyable fs rf xs rx ry 
   => RL.RowToList rf fs
   => RL.RowToList rx xs
   => Record rf -> Record rx -> Record ry
recordApply recf recx = recordApply' (RLProxy :: RLProxy fs) recf 
                                     (RLProxy :: RLProxy xs) recx

main :: Effect Unit
main =
  let r0 = { a: "z", b: 4, ab : true }
  in render $ fold
      [ h1 (text $ show r0)
      , h1 (text $ show $ 
        recordApply { a: (_ <> "oo")
                    , ab: (not :: Boolean -> Boolean)
                    , b: (_ * 3)} r0)
      ]