Mark Eibes
2020-07-07T11:01:07Z

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))
|