Main.purs

module Main where

import Prelude

import Effect (Effect)
import Effect.Class.Console (logShow)
import Prim.Row (class Nub)
import Prim.Row as Row
import Prim.RowList as RL
import Record (get) as R
import Record as Record
import Record.Builder (Builder)
import Record.Builder as Builder
import Record.Extra (class Keys, pick)
import Type.Prelude (class IsSymbol, class Union, RLProxy(RLProxy), RProxy(RProxy), SProxy(SProxy))
import TryPureScript (h1, h2, p, text, list, indent, link, render, code)
import Data.Foldable (fold)

example = h2 <<< code <<< text <<< show

main :: Effect Unit
main =
  render $ fold
   [ example $ mapHRecord
    (RProxy :: RProxy (word :: String, anotherWord :: String))
    (_ <> " mapped")
    { x: 3, anotherWord: "anotherWord", word: "word"}

  , example $ mapHRecord
    (RProxy :: RProxy (word :: String))
    (_ <> " mapped")
    { x: 3, anotherWord: "anotherWord", word: "word"}

  , example $ mapHRecord
    (RProxy :: _ (word :: _))
    (_ <> " mapped")
    { x: 3, anotherWord: "anotherWord", word: "word"}

  , example $ mapHRecord
    (RProxy :: _ (x :: _, y :: _))
    (_ + 55)
    { x: 3, anotherWord: "anotherWord", word: "word", y: 222 }
  ] 
    






--- This should really be in a different file
mapHRecord :: forall row xs rowToTouch rowToTouchXs rowToLeave rowToLeaveXs modifiedRow modifiedRowXs a b row'
   . RL.RowToList row xs
  => RL.RowToList rowToTouch rowToTouchXs
  => Keys rowToTouchXs
  => Keys rowToLeaveXs
  => Nub row' row'
  => RL.RowToList rowToLeave rowToLeaveXs
  => RL.RowToList modifiedRow modifiedRowXs
  => Union rowToTouch rowToLeave row
  => Union modifiedRow rowToLeave row'
  => Union rowToLeave rowToTouch row
  => MapHRecord rowToTouchXs rowToTouch a b () modifiedRow
  => RProxy rowToTouch
  -> (a -> b)
  -> Record row
  -> Record row'
mapHRecord _ f r = Record.disjointUnion ((Builder.build builder {}) :: {|modifiedRow}) (pick r :: {|rowToLeave})
  where
    builder =
      mapHRecordBuilder (RLProxy :: RLProxy rowToTouchXs) f ((pick r) :: Record rowToTouch)

class MapHRecord (xs :: RL.RowList) (row :: # Type) a b (from :: # Type) (to :: # Type)
  | xs -> row a b from to where
  mapHRecordBuilder :: RLProxy xs -> (a -> b) -> Record row -> Builder { | from } { | to }

instance mapHRecordCons ::
  ( IsSymbol name
  , Row.Cons name a trash row
  , MapHRecord tail row a b from from'
  , Row.Lacks name from'
  , Row.Cons name b from' to
  ) => MapHRecord (RL.Cons name a tail) row a b from to where
  mapHRecordBuilder _ f r =
    first <<< rest
    where
      nameP = SProxy :: SProxy name
      val = f $ R.get nameP r
      rest = mapHRecordBuilder (RLProxy :: RLProxy tail) f r
      first = Builder.insert nameP val

instance mapHRecordNil :: MapHRecord RL.Nil row a b () () where
  mapHRecordBuilder _ _ _ = identity

MapHRecord.purs

module MapHRecord where

import Prelude

import Prim.Row (class Nub)
import Prim.Row as Row
import Prim.RowList as RL
import Record (get) as R
import Record as Record
import Record.Builder (Builder)
import Record.Builder as Builder
import Record.Extra (class Keys, pick)
import Type.Prelude (class IsSymbol, class Union, RLProxy(RLProxy), RProxy, SProxy(SProxy))