purescript Solution of exercise 5 from "Purescript by example", chapter 10.19

Tree.purs

module Tree where

import Prelude
import Data.Either
import Data.Foreign
import Data.Foreign.Class

data Tree a = Leaf a | Branch (Tree a) (Tree a)

newtype STree = STree
  { t :: String
  , v :: Foreign }

toSTree :: forall a. Tree a -> STree
toSTree (Leaf a) = STree { t: "leaf"
                         , v: toForeign a }
toSTree (Branch a b) = STree { t: "branch"
                             , v: toForeign { a: toSTree a
                                            , b: toSTree b } }

instance treeIsForeign :: IsForeign a => IsForeign (Tree a) where
  read value = do
    tag <- readProp "t" value
    case tag of
      "leaf" -> do
        a <- readProp "v" value :: F a
        return $ Leaf a
      "branch" -> do
        v <- readProp "v" value
        a <- readProp "a" v :: F (Tree a)
        b <- readProp "b" v :: F (Tree a)
        return $ Branch a b
      otherwise -> Left $ ErrorAtProperty "t" $ JSONError $ "expected \"leaf\" or \"branch\", got " ++ show tag


---- Testing stuff

instance showTree :: Show a => Show (Tree a) where
  show (Leaf a) = show a
  show (Branch a b) = "(" ++ show a ++ "," ++ show b ++ ")"

instance showSTree :: Show STree where
  show t = Data.JSON.stringify (toForeign t)

l1 :: Tree Int
l1 = Leaf 1
l2 = Leaf 2
l3 = Leaf 3
l4 = Leaf 4
l5 = Leaf 5

t1 :: Tree Int
t1 = Branch l2 l3
t2 = Branch l4 l5
t3 = Branch t1 t2
t4 = Branch l1 t3

---- Now you can do in PSCI:

-- > toSTree t1
-- {"t":"branch","v":{"a":{"t":"leaf","v":2},"b":{"t":"leaf","v":3}}}
-- > let s = stringify <<< toForeign $ toSTree t4
-- > readJSON s :: F (Tree Int)
-- Right ((1,((2,3),(4,5))))