Generics in purescript (updated to version 7)

Generic.purs

module Generic where

import Prelude
import Data.Maybe
import Data.Traversable
import Data.Array

data GenericSpine = SProd String (Array (Unit -> GenericSpine))
                  | SRecord (Array {recLabel :: String, recValue :: Unit -> GenericSpine})
                  | SNumber Number
                  | SString String
                  | SArray (Array (Unit -> GenericSpine))

data GenericSignature = SigProd (Array {sigConstructor :: String, sigValues :: Array (Unit -> GenericSignature)})
                      | SigRecord (Array {recLabel :: String, recValue :: Unit -> GenericSignature})
                      | SigNumber | SigString | SigArray (Unit -> GenericSignature)

data Proxy a = Proxy

anyProxy :: forall a. Proxy a
anyProxy = Proxy

class Generic a where
    toSpine :: a -> GenericSpine
    toSignature :: Proxy a -> GenericSignature
    fromSpine :: GenericSpine -> Maybe a

instance genericNumber :: Generic Number where
    toSpine x = SNumber x
    toSignature _ = SigNumber
    fromSpine (SNumber n) = Just n
    fromSpine _ = Nothing

instance genericString :: Generic String where
    toSpine x = SString x
    toSignature _ = SigString
    fromSpine (SString s) = Just s
    fromSpine _ = Nothing

instance genericArray :: (Generic a) => Generic (Array a) where
    toSpine xs = SArray ((\x y -> toSpine x) <$> xs)
    toSignature x = SigArray (\unit -> toSignature (lowerProxy x))
        where lowerProxy :: Proxy (Array a) -> Proxy a
              lowerProxy (Proxy) = (anyProxy :: Proxy a)

    fromSpine (SArray x) = traverse (fromSpine <<< ($ unit)) x

Test.purs

module Test where

import Prelude
import Data.Maybe
import Generic
import Data.Array
import Console

data Foo = Foo Number String | Bar Number | Quux (Array String) | Baz {a :: String, bq :: Number} String

data IntList = IntList Number IntList | NilIntList

instance genericFoo :: Generic Foo

instance genericIntList :: Generic IntList

genericShow :: GenericSpine -> String
genericShow (SProd s arr) =
    if null arr
    then s
    else s <> " " <> go (map (\x -> genericShow (x unit)) arr)
  where
    go x = case uncons x of
             Nothing -> ""
             Just uc -> uc.head <> " " <> go uc.tail

genericShow (SRecord xs) = "{" <> go xs <> "}"
    where
      go x =
          case uncons x of
            Nothing -> ""
            Just uc -> uc.head.recLabel <> ": " <> genericShow (uc.head.recValue unit) <> ", " <> go uc.tail

genericShow (SNumber x) = show x
genericShow (SString x) = show x
genericShow (SArray xs) = "[" <> go xs <> "]"
    where
      go x = case uncons x of
               Nothing -> ""
               Just uc -> genericShow (uc.head unit) <> ", " <> go uc.tail

gShow :: forall a. (Generic a) => a -> String
gShow = genericShow <<< toSpine

instance showFoo :: Show Foo where
    show = gShow

instance showIntList :: Show IntList where
    show = gShow

newtype MyNewInt = MyNewInt String

instance genericNew :: Generic MyNewInt

instance showNewInt :: Show MyNewInt where
    show = gShow

toFrom :: forall a. (Generic a) => a -> Maybe a
toFrom x = fromSpine (toSpine x)

-- main1 = print $ show $ toFrom [Foo 12 "Hello", Quux ["Hi","Dere"], Baz {a : "yo", bq : 22} "oy"]

-- main2 = print $ show $ toFrom (IntList 12 (IntList 23 (IntList 45 NilIntList)))

main = print $ show $ toFrom $ MyNewInt "Hello"