Skip to content

Instantly share code, notes, and snippets.

@coot
Last active April 22, 2018 15:01
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save coot/3120e715341dbe38b82e6dbf7a987ab7 to your computer and use it in GitHub Desktop.
Save coot/3120e715341dbe38b82e6dbf7a987ab7 to your computer and use it in GitHub Desktop.
PureScript: pick subrecords from a record.
module Main where
import Prelude
import Data.Foldable (fold, elem)
import TryPureScript
import Type.Row (class ListToRow, class RowToList, Cons, Nil, kind RowList)
import Type.Proxy (Proxy(..))
import Type.Data.Symbol (class IsSymbol, reflectSymbol)
import Data.Array (cons)
import Data.Monoid (mempty)
import Data.Symbol (SProxy(..))
import Data.StrMap (StrMap, fold, insert) as StrMap
import Unsafe.Coerce (unsafeCoerce)
class SubRow (r :: # Type) (s :: # Type)
instance subrow :: Union r t s => SubRow r s
class GetKeys (l :: RowList) where
keys
:: forall r
. RowToList r l
=> ListToRow l r
=> Proxy (Record r)
-> Array String
instance getKeysNil :: GetKeys Nil where
keys _ = []
instance getKeysCons
:: ( IsSymbol name
, GetKeys tail
, ListToRow tail row
, RowToList row tail
)
=> GetKeys (Cons name ty tail) where
keys _ = cons (reflectSymbol (SProxy :: SProxy name)) (keys (Proxy :: Proxy (Record row)))
pick
:: forall r s l
. SubRow r s
=> RowToList r l
=> ListToRow l r
=> GetKeys l
=> Proxy (Record r)
-> Record s
-> Record r
pick p s = unsafeCoerce (StrMap.fold fmap) (mempty :: StrMap.StrMap Unit) m
where
ks :: Array String
ks = keys p
m :: StrMap.StrMap Unit
m = unsafeCoerce s
fmap d name val =
if name `elem` ks
then StrMap.insert name val d
else d
r = {a: 0, b: 'a', c: "" }
s :: { a :: Int, b :: Char}
s = pick (Proxy :: Proxy {a :: Int, b :: Char}) r
main =
render $ fold
[ h1 (text "Subrecords using RowList")
, p (code $ text """
pick (Proxy :: Proxy {a :: Int, b :: Char}) {a: 0, b: 'a', c: ""} == {a: 0, b: 'a'}
""")
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment