Skip to content

Instantly share code, notes, and snippets.

@Woody88
Last active August 27, 2020 12:16
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Woody88/27a99b84331b181ae7da38991bb995d6 to your computer and use it in GitHub Desktop.
Save Woody88/27a99b84331b181ae7da38991bb995d6 to your computer and use it in GitHub Desktop.
module Main where
import Prelude
import Data.Either (Either(..))
import Data.Symbol (class IsSymbol, SProxy(..))
import Effect (Effect)
import Effect.Class.Console as Console
import Prim.Row (class Cons, class Lacks, class Union) as Row
import Prim.RowList (class RowToList, kind RowList)
import Prim.RowList as RL
import Record (insert) as Record
import Type.Data.Row (RProxy(..))
import Type.Data.RowList (RLProxy(..))
import Type.Equality (class TypeEquals, to)
type SetA typx typc = (x :: typx, c :: typc)
class Subset (input :: # Type) (output :: # Type) -- where
-- subset :: RProxy input -> RProxy output
instance subsetimpl ::
( Row.Union output trash input
, Row.Union output t (SetA h c)
) => Subset input output -- where
-- subset _ = RProxy :: _ output
build :: forall e r proxy. BuildRec e r => proxy e -> String -> Either String (Record r)
build = buildRec
class ReadValue ty where
readValue :: String -> Either String ty
instance readValueRequired :: ReadValue String where
readValue name = pure name
class BuildRec (e :: # Type) (r :: # Type) where
buildRec :: forall proxy. proxy e -> String -> Either String (Record r)
instance buildRecImpl ::
( Subset e e'
, BuildRecFields el r
, RowToList e' el
) => BuildRec e r where
buildRec _ = buildRecFields (RLProxy :: RLProxy el)
class BuildRecFields (el :: RowList) (r :: # Type) where
buildRecFields
:: forall proxy
. proxy el
-> String
-> Either String (Record r)
instance buildRecFieldsCons ::
( IsSymbol name
, BuildRecFields elt rt
, Row.Lacks name rt
, Row.Cons name ty rt r
, ReadValue ty
) => BuildRecFields (RL.Cons name ty elt) r where
buildRecFields _ env = Record.insert nameP <$> value <*> tail
where
nameP = SProxy :: SProxy name
value = readValue env
tail = buildRecFields (RLProxy :: RLProxy elt) env
instance buildRecFieldsNil :: TypeEquals {} (Record row) => BuildRecFields RL.Nil row where
buildRecFields _ _ = pure $ to {}
x = RProxy :: _ (x :: String, y :: String)
func :: Effect Unit
func = case build x "hello" of
Left e -> Console.log e
Right r -> Console.logShow r.x
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment