Array builder

Main.purs

module Main where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (logShow)
import Control.Monad.ST (ST,  pureST)
import Data.Foreign (Foreign, toForeign)
import Data.StrMap as StrMap
import Data.StrMap.ST as STStrMap
import Data.Array.ST as STArray
import Type.Row (class ListToRow, kind RowList, Nil, Cons)
import Type.Prelude (class IsSymbol, SProxy(..), reflectSymbol)
import TryPureScript (render, withConsole)
import Unsafe.Coerce (unsafeCoerce)

-- Type-safe API for building records incrementally

class BuilderRep (b :: RowList -> Type) where
  nil :: b Nil
  cons :: forall r l a. IsSymbol l => SProxy l -> a -> b r -> b (Cons l a r)
  
-- A builder for a `Record r`.
type Builder r = forall b. BuilderRep b => b r

-- Build a record in place.
build :: forall r rl. ListToRow rl r => Builder rl -> Record r
build b = getImpl b

buildArray :: forall r rl. ListToRow rl r => Builder rl -> Array String
buildArray b = getArrayImpl b

-- In practice, we'd use this to build things inside type class
-- instances, but here's a simple example.
example = build (cons (SProxy :: SProxy "foo") 42 
                $ cons (SProxy :: SProxy "bar") "testing"
                $ cons (SProxy :: SProxy "baz") 'ℕ' nil)

labels :: Array String
labels = buildArray (cons (SProxy :: SProxy "foo") 42 
                $ cons (SProxy :: SProxy "bar") "testing"
                $ cons (SProxy :: SProxy "baz") 'ℕ' nil)

main = render =<< withConsole do
  logShow example.foo
  logShow example.bar
  logShow example.baz
  logShow labels
  
-- implementation details

newtype Impl h e (rl :: RowList) = Impl (STStrMap.STStrMap h Foreign -> Eff (st :: ST h | e) Unit)

getImpl :: forall r rl. ListToRow rl r => (forall h e. Impl h e rl) -> Record r
getImpl (Impl f) = unsafeCoerce $ StrMap.pureST do
  m <- STStrMap.new
  f m
  pure m

instance builderImpl :: BuilderRep (Impl h e) where
  nil = Impl \_ -> pure unit
  cons l a (Impl f) = Impl \m -> do
    _ <- STStrMap.poke m (reflectSymbol l) (toForeign a)
    f m
    
newtype ArrayImpl h e a (rl :: RowList) = ArrayImpl (STArray.STArray h a -> Eff (st :: ST h | e) Unit)

getArrayImpl :: forall a r rl. ListToRow rl r => (forall h e. ArrayImpl h e a rl) -> Array a
getArrayImpl (ArrayImpl f) = pureST do
  m <- STArray.emptySTArray
  f m
  STArray.unsafeFreeze m
  
instance builderArrayImpl :: BuilderRep (ArrayImpl h e String) where
  nil = ArrayImpl \_ -> pure unit
  cons l a (ArrayImpl f) = ArrayImpl \m -> do
    _ <- STArray.pushSTArray m (reflectSymbol l)
    f m