Guest User

Untitled

a guest
Aug 25th, 2019
79
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