1module Main where 2 3import Prelude 4import Prim.Row 5import Effect 6import Effect.Console 7 8data Proxy a = Proxy 9 10solve :: forall l r u. Union l r u => Proxy r -> Proxy u -> Proxy l 11solve _ _ = Proxy 12 13solveUnionBackwardsNil :: Proxy _ 14solveUnionBackwardsNil = solve (Proxy :: Proxy ()) (Proxy :: Proxy ()) 15 16solveUnionBackwardsCons :: Proxy _ 17solveUnionBackwardsCons = solve (Proxy :: Proxy ( a :: Int )) (Proxy :: Proxy ( a :: Int, b :: String )) 18 19solveUnionBackwardsDblCons :: Proxy _ 20solveUnionBackwardsDblCons = solve (Proxy :: Proxy ( a :: Int, a :: String )) (Proxy :: Proxy ( a :: Boolean, a :: Int, a :: String )) 21 22foreign import merge 23 :: forall r1 r2 r3 24 . Union r1 r2 r3 25 => Record r1 26 -> Record r2 27 -> Record r3 28 29test1 = merge { x: 1 } { y: true } 30 31test2 = merge { x: 1 } { x: true } 32 33mergeWithExtras 34 :: forall r1 r2 r3 35 . Union r1 (y :: Boolean | r2) (y :: Boolean | r3) 36 => { x :: Int | r1 } 37 -> { y :: Boolean | r2 } 38 -> { x :: Int, y :: Boolean | r3} 39mergeWithExtras = merge 40 41test3 x = merge { x: 1 } x 42test3' x = merge x { x: 1 } 43 44type Mandatory r = (x :: Int | r) 45type Optional r = (x :: Int, y :: Int, z :: Int | r) 46 47withDefaults 48 :: forall r s 49 . Union r (y :: Int, z :: Int) (y :: Int, z :: Int | s) 50 => Record (Mandatory r) 51 -> Record (Optional s) 52withDefaults p = merge p { y: 1, z: 1 } 53 54withDefaultsClosed 55 :: forall r s 56 . Union r (y :: Int, z :: Int) (y :: Int, z :: Int | s) 57 => Subrow s (y :: Int, z :: Int) 58 => Record (Mandatory r) 59 -> Record (Optional s) 60withDefaultsClosed p = merge p { y: 1, z: 1 } 61 62test4 = withDefaults { x: 1, y: 2 } 63 64-- r is a subrow of s if Union r t s for some t. 65class Subrow (r :: # Type) (s :: # Type) 66instance subrow :: Union r t s => Subrow r s 67 68main :: Effect Unit 69main = do 70 logShow test1.x 71 logShow test1.y 72 logShow (test1.x == 1) 73 logShow (mergeWithExtras { x: 1 } { x: 0, y: true, z: 42.0 }).x 74 logShow (withDefaults { x: 1 }).x 75 logShow (withDefaults { x: 1 }).y 76 logShow (withDefaults { x: 1 }).z 77 logShow (withDefaults { x: 1, y: 2 }).x 78 logShow (withDefaults { x: 1, y: 2 }).y 79 logShow (withDefaults { x: 1, y: 2 }).z 80 logShow (withDefaultsClosed { x: 1, y: 2 }).x 81 logShow (withDefaultsClosed { x: 1, y: 2 }).y 82 logShow (withDefaultsClosed { x: 1, y: 2 }).z 83 log "Done" 84