SHARE
TWEET

Untitled

a guest Aug 25th, 2019 75 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module Data.Record.Operations where
  2.  
  3. import Data.Functor.Variant (SProxy(..))
  4. import Data.Monoid (class Monoid)
  5. import Prim.RowList (Cons, Nil, kind RowList)
  6. import Type.Data.Boolean (True, False, kind Boolean)
  7. import Type.Data.Symbol (class Equals)
  8. import Type.Prelude (class ListToRow, class RowToList)
  9. import Unsafe.Coerce (unsafeCoerce)
  10.  
  11. class Lacks (k :: Symbol) (r :: RowList) (b :: Boolean) | k r -> b
  12.  
  13. instance lacksNil ::
  14.   Lacks k Nil True
  15.  
  16. instance lacksCons1 ::
  17.   Lacks k (Cons k v r) False
  18. else
  19. instance lacksCons2 ::
  20.   Lacks k r b =>
  21.   Lacks k (Cons l v r) b
  22.  
  23. class Values (k :: Symbol) (r :: RowList) (s :: RowList) | k r -> s
  24.  
  25. instance valuesNil ::
  26.   Values k Nil Nil
  27.  
  28. class ValuesCase (b :: Boolean) (k :: Symbol) (l :: Symbol) (v :: Type) (r :: RowList) (s :: RowList) | b k l v r -> s
  29.  
  30. instance valuesCase1 ::
  31.   Values k r s =>
  32.   ValuesCase False k l v r s
  33.  
  34. instance valuesCase2 ::
  35.   Values k r s =>
  36.   ValuesCase True k l v r (Cons l v s)
  37.  
  38. instance valuesCons ::
  39.   (Equals k l b, ValuesCase b k l v r s) =>
  40.   Values k (Cons l v r) s
  41.  
  42. values ::
  43.   forall k r s r' s'.
  44.   RowToList r r' =>
  45.   Values k r' s' =>
  46.   ListToRow s' s =>
  47.   SProxy k -> { | r } -> { | s }
  48. values = unsafeCoerce
  49.  
  50. get ::
  51.   forall k r v r'.
  52.   RowToList r r' =>
  53.   Values k r' (Cons k v Nil) =>
  54.   SProxy k -> { | r } -> v
  55. get = unsafeCoerce
  56.  
  57. a :: String
  58. a = get (SProxy :: _ "bar") { foo: 1, bar: "test", baz: "xyz" }
  59.  
  60. class Remove (k :: Symbol) (r :: RowList) (s :: RowList) | k r -> s
  61.  
  62. instance removeNil ::
  63.   Remove k Nil Nil
  64.  
  65. class RemoveCase (b :: Boolean) (k :: Symbol) (l :: Symbol) (v :: Type) (r :: RowList) (s :: RowList) | b l k v r -> s
  66.  
  67. instance removeCase1 ::
  68.   Remove k r s =>
  69.   RemoveCase False k l v r (Cons l v s)
  70.  
  71. instance removeCase2 ::
  72.   Remove k r s =>
  73.   RemoveCase True k l v r s
  74.  
  75. instance removeCons ::
  76.   (Equals k l b, RemoveCase b k l v r s) =>
  77.   Remove k (Cons l v r) s
  78.  
  79. remove ::
  80.   forall k r s r' s'.
  81.   RowToList r r' =>
  82.   Remove k r' s' =>
  83.   ListToRow s' s =>
  84.   SProxy k -> { | r } -> { | s }
  85. remove = unsafeCoerce
  86.  
  87. b :: { baz :: Int }
  88. b = remove (SProxy :: _ "foo") { foo: "bar", baz: 1 }
  89.  
  90. class Homogeneous (v :: Type) (vs :: RowList)
  91.  
  92. instance homogeneousNil ::
  93.   Homogeneous v Nil
  94.  
  95. instance homogeneousCons ::
  96.   Homogeneous v r =>
  97.   Homogeneous v (Cons k v r)
  98.  
  99. toArray ::
  100.   forall r v r'.
  101.   RowToList r r' =>
  102.   Homogeneous v r' =>
  103.   { | r } -> Array v
  104. toArray = unsafeCoerce
  105.  
  106. c :: Array Int
  107. c = toArray { foo: 1, bar: 2, baz: 3 }
  108.  
  109. class Append (r :: RowList) (s :: RowList) (t :: RowList) | r s -> t
  110.  
  111. instance appendNil ::
  112.   Append Nil r r
  113.  
  114. class AppendCase (b :: Boolean) (k :: Symbol) (v :: Type) (r :: RowList) (s :: RowList) (t :: RowList) | b k v r s -> t
  115.  
  116. instance appendCase1 ::
  117.   Append r s t =>
  118.   AppendCase True k v r s (Cons k v t)
  119.  
  120. instance appendCase2 ::
  121.   ( Monoid v
  122.   , Values k r vr
  123.   , Values k s vs
  124.   , Homogeneous v vr
  125.   , Homogeneous v vs
  126.   , Remove k r r'
  127.   , Remove k s s'
  128.   , Append r' s' t
  129.   ) =>
  130.   AppendCase False k v r s (Cons k v t)
  131.  
  132. instance appendCons ::
  133.   (Lacks k s b, AppendCase b k v r s t) =>
  134.   Append (Cons k v r) s t
  135.  
  136. append ::
  137.   forall r s t r' s' t'.
  138.   RowToList r r' =>
  139.   RowToList s s' =>
  140.   Append r' s' t' =>
  141.   ListToRow t' t =>
  142.   { | r } -> { | s } -> { | t }
  143. append = unsafeCoerce
  144.  
  145. d :: { foo :: String, bar :: Int }
  146. d = append { foo: "Hello" } { bar: 1, foo: ", World" }
  147.  
  148. e = append { onMouseLeave: "foo", onMouseEnter: "bar" } { baz: 1 }
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top