Skip to content

Instantly share code, notes, and snippets.

@cideM
Last active Oct 20, 2020
Embed
What would you like to do?
module Main where
import Prelude
import Effect (Effect)
import Control.Monad.Except.Trans (throwError)
import Effect.Console (log)
import Control.Alt ((<|>))
import Data.Generic.Rep as GR
import Foreign (Foreign, ForeignError(..), fail)
import Foreign as Foreign
import Simple.JSON as JSON
import Type.Prelude (class IsSymbol, SProxy(..), reflectSymbol)
import Prim.RowList (class RowToList)
import Record as Record
import Data.Either (Either(..))
instance untaggedSumRepSum ::
( UntaggedSumRep a
, UntaggedSumRep b
) =>
UntaggedSumRep (GR.Sum a b) where
untaggedSumRep f =
GR.Inl <$> untaggedSumRep f
<|> GR.Inr
<$> untaggedSumRep f
instance untaggedSumRepConstructor ::
( UntaggedSumRep a
) =>
UntaggedSumRep (GR.Constructor name a) where
untaggedSumRep f = GR.Constructor <$> untaggedSumRep f
instance untaggedSumRepArgument ::
( JSON.ReadForeign a
) =>
UntaggedSumRep (GR.Argument a) where
untaggedSumRep f = GR.Argument <$> JSON.readImpl f
class UntaggedSumRep rep where
untaggedSumRep :: Foreign -> Foreign.F rep
data Foo
= FooA (Node "foo" ( some :: String ))
| FooB (Node "bar" ( other :: String ))
derive instance genericFoo :: GR.Generic Foo _
instance readForeignFoo :: JSON.ReadForeign Foo where
readImpl f = GR.to <$> untaggedSumRep f
newtype Node (jsonTagValue :: Symbol) r
= Node { nodeType :: String | r }
instance readForeignNode ::
( IsSymbol jsonTagValue
, RowToList row rowList
, JSON.ReadForeignFields rowList () row
) =>
JSON.ReadForeign (Node jsonTagValue row) where
readImpl f = do
case (JSON.read f :: JSON.E { nodeType :: String }) of
Left e -> throwError e
Right peek ->
if peek.nodeType == jsonTagValueS then do
case ( JSON.read f ::
JSON.ReadForeignFields rowList () row =>
JSON.E { | row }
) of
Left e -> throwError e
Right full -> pure $ Node $ Record.union peek full
else
fail $ ForeignError
$ "Wrong type tag "
<> peek."nodeType"
<> " where "
<> jsonTagValueS
<> " was expected."
where
jsonTagValueP = SProxy :: SProxy jsonTagValue
jsonTagValueS = reflectSymbol jsonTagValueP
main :: Effect Unit
main = case JSON.readJSON """{ "nodeType": "foo", "some": "SUCCESS" }""" of
Left e -> log $ show e
Right (r :: Foo) -> case r of
FooA (Node content) -> log content.some
FooB (Node content) -> log content.other
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment