Operations.purs

module Data.Record.Operations where

import Data.Functor.Variant (SProxy(..))
import Data.Monoid (class Monoid)
import Prim.RowList (Cons, Nil, kind RowList)
import Type.Data.Boolean (True, False, kind Boolean)
import Type.Data.Symbol (class Equals)
import Type.Prelude (class ListToRow, class RowToList)
import Unsafe.Coerce (unsafeCoerce)

class Lacks (k :: Symbol) (r :: RowList) (b :: Boolean) | k r -> b

instance lacksNil ::
  Lacks k Nil True

instance lacksCons1 ::
  Lacks k (Cons k v r) False
else
instance lacksCons2 ::
  Lacks k r b =>
  Lacks k (Cons l v r) b

class Values (k :: Symbol) (r :: RowList) (s :: RowList) | k r -> s

instance valuesNil ::
  Values k Nil Nil

class ValuesCase (b :: Boolean) (k :: Symbol) (l :: Symbol) (v :: Type) (r :: RowList) (s :: RowList) | b k l v r -> s

instance valuesCase1 ::
  Values k r s =>
  ValuesCase False k l v r s

instance valuesCase2 ::
  Values k r s =>
  ValuesCase True k l v r (Cons l v s)

instance valuesCons ::
  (Equals k l b, ValuesCase b k l v r s) =>
  Values k (Cons l v r) s

values ::
  forall k r s r' s'.
  RowToList r r' =>
  Values k r' s' =>
  ListToRow s' s =>
  SProxy k -> { | r } -> { | s }
values = unsafeCoerce

get ::
  forall k r v r'.
  RowToList r r' =>
  Values k r' (Cons k v Nil) =>
  SProxy k -> { | r } -> v
get = unsafeCoerce

a :: String
a = get (SProxy :: _ "bar") { foo: 1, bar: "test", baz: "xyz" }

class Remove (k :: Symbol) (r :: RowList) (s :: RowList) | k r -> s

instance removeNil ::
  Remove k Nil Nil

class RemoveCase (b :: Boolean) (k :: Symbol) (l :: Symbol) (v :: Type) (r :: RowList) (s :: RowList) | b l k v r -> s

instance removeCase1 ::
  Remove k r s =>
  RemoveCase False k l v r (Cons l v s)

instance removeCase2 ::
  Remove k r s =>
  RemoveCase True k l v r s

instance removeCons ::
  (Equals k l b, RemoveCase b k l v r s) =>
  Remove k (Cons l v r) s

remove ::
  forall k r s r' s'.
  RowToList r r' =>
  Remove k r' s' =>
  ListToRow s' s =>
  SProxy k -> { | r } -> { | s }
remove = unsafeCoerce

b :: { baz :: Int }
b = remove (SProxy :: _ "foo") { foo: "bar", baz: 1 }

class Homogeneous (v :: Type) (vs :: RowList)

instance homogeneousNil ::
  Homogeneous v Nil

instance homogeneousCons ::
  Homogeneous v r =>
  Homogeneous v (Cons k v r)

toArray ::
  forall r v r'.
  RowToList r r' =>
  Homogeneous v r' =>
  { | r } -> Array v
toArray = unsafeCoerce

c :: Array Int
c = toArray { foo: 1, bar: 2, baz: 3 }

class Append (r :: RowList) (s :: RowList) (t :: RowList) | r s -> t

instance appendNil ::
  Append Nil r r

class AppendCase (b :: Boolean) (k :: Symbol) (v :: Type) (r :: RowList) (s :: RowList) (t :: RowList) | b k v r s -> t

instance appendCase1 ::
  Append r s t =>
  AppendCase True k v r s (Cons k v t)

instance appendCase2 ::
  ( Monoid v
  , Values k r vr
  , Values k s vs
  , Homogeneous v vr
  , Homogeneous v vs
  , Remove k r r'
  , Remove k s s'
  , Append r' s' t
  ) =>
  AppendCase False k v r s (Cons k v t)

instance appendCons ::
  (Lacks k s b, AppendCase b k v r s t) =>
  Append (Cons k v r) s t

append ::
  forall r s t r' s' t'.
  RowToList r r' =>
  RowToList s s' =>
  Append r' s' t' =>
  ListToRow t' t =>
  { | r } -> { | s } -> { | t }
append = unsafeCoerce

d :: { foo :: String, bar :: Int }
d = append { foo: "Hello" } { bar: 1, foo: ", World" }

e = append { onMouseLeave: "foo", onMouseEnter: "bar" } { baz: 1 }