Sequence a Record

Main.purs

module Main where

import Prelude
import Control.Monad.Eff.Console (log, logShow)
import TryPureScript (render, withConsole)

import Data.Maybe (Maybe(..), isNothing, fromJust)
import Data.Record (get, insert)
import Data.Tuple (Tuple(..))
import Global.Unsafe (unsafeStringify)
import Type.Prelude (class IsSymbol, class RowLacks, class RowToList, RLProxy(RLProxy), SProxy(SProxy), reflectSymbol)
import Type.Row (Cons, Nil, kind RowList)

class Applicative m <= SequenceRecord rl row m row'
  | rl -> row row', rl -> m
  where
    sequenceRecordImpl :: RLProxy rl -> Record row -> m (Record row')

instance sequenceRecordCons ::
  ( IsSymbol name
  , Applicative m
  , RowCons name (m ty) trash row
  , SequenceRecord tail row m tailRow'
  , RowLacks name tailRow'
  , RowCons name ty tailRow' row'
  ) => SequenceRecord (Cons name (m ty) tail) row m row' where
  sequenceRecordImpl _ a  =
       insert namep <$> val <*> rest
    where
      namep = SProxy :: SProxy name
      val = get namep a
      rest = sequenceRecordImpl (RLProxy :: RLProxy tail) a

instance sequenceRecordNil :: Applicative m => SequenceRecord Nil row m () where
  sequenceRecordImpl _ _ = pure {}

sequenceRecord :: forall row row' rl m
   . RowToList row rl
  => Applicative m
  => SequenceRecord rl row m row'
  => Record row
  -> m (Record row')
sequenceRecord a = sequenceRecordImpl (RLProxy :: RLProxy rl) a

sequencedJust = sequenceRecord {x: Just "a", y: Just 1, z: Just 3}
sequencedNothing = sequenceRecord {x: Nothing, y: Just 1, z: Just 3}

main = render =<< withConsole do
  logShow $ unsafeStringify <$> sequencedJust
  logShow $ unsafeStringify <$> sequencedNothing