Record smooshing

Data.Record.Operations.purs

module Data.Record.Operations where

import Prelude

import Data.Functor.Variant (SProxy(..))
import Data.Variant.Internal (RLProxy(..))
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

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

instance lacksCase1 ::
  LacksCase True k l v r False

instance lacksCase2 ::
  Lacks k r b =>
  LacksCase False k l v r b

instance lacksCons ::
  (Equals k l b, LacksCase b k l v r o) =>
  Lacks k (Cons l v r) o

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 ::
  forall t' s' t s b.
  RowToList s s' =>
  Lacks "bar" s' b =>
  AppendCase b "bar" String (Cons "foo" String Nil) s' t' =>
  ListToRow t' t =>
  Record s -> Record t
e = append { foo: "foo", bar: "bar" }

f :: { foo :: String, bar :: String, baz :: Int }
f = e { baz: 1 }