recordMap

Main.purs

module Main where

import Prelude

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

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)

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

__ :: forall sym. SProxy sym
__ = SProxy

class Mappable f xs rx ry | -> ry where
  recordMap' ::  (forall a. a -> f a) -> RLProxy xs -> Record rx -> Record ry
 
instance mapNil 
  :: Mappable f RL.Nil ry ry where
  recordMap' _ _ rec = rec
  
instance mapCons
  :: ( IsSymbol k
     , Mappable f xst rxt ryt
     , Cons k xtyp rxt rx
     , Lacks k rxt
     , Cons k (f xtyp) ryt ry
     , Lacks k ryt
     ) => Mappable f (RL.Cons k xtyp xst) rx ry where
  recordMap' f xs recx =
    let next = delete (__ :: _ k) recx :: Record rxt
        itr = recordMap' f (RLProxy :: RLProxy xst) next :: Record ryt
    in insert (__ :: _ k) (f $ get (__ :: _ k) recx) itr :: Record ry

recordMap
  :: forall xs rx ry f
   . Mappable f xs rx ry 
   => RL.RowToList rx xs
   => (forall a. a -> f a) -> Record rx -> Record ry
recordMap f recx = recordMap' f (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 $ recordMap (\x -> [x,x]) r0)
      , h1 (text $ show $ recordMap Just r0)
      ]