First implementation of (deriving IsYamlObject) seems working.

diff --git a/Derive.hs b/Derive.hs
index 2259d62..58a3749 100644
--- a/Derive.hs
+++ b/Derive.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell, TypeSynonymInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Derive where

 import Language.Haskell.TH
@@ -7,6 +8,7 @@ import Data.Maybe
 import Data.Default
 import Data.Object
 import Data.Object.Yaml
+import qualified Data.ByteString.Char8 as BS

 import YAML
 import YAMLInstances
@@ -21,7 +23,10 @@ getNameBase :: Name -> Name
 getNameBase name = mkName $ nameBase name

 stringOfName :: Name -> ExpQ
-stringOfName n = stringE $ nameBase n
+stringOfName n = sigE (stringE $ nameBase n) [t| BS.ByteString |]
+
+nameE :: Name -> ExpQ
+nameE name = varE $ getNameBase name

 consClause :: Con -> ClauseQ
 consClause (NormalC name fields) =  do
@@ -32,7 +37,7 @@ consClause (NormalC name fields) =  do
     (pats,vars) <- genPE (length fields)

     clause [conP name pats]                                 -- (A x1 x2)
-           (normalB [| Mapping [(toYamlScalar constructorName, Mapping $(mkList vars))] |]) []
+           (normalB [| Mapping [(toYamlScalar (BS.pack constructorName), Mapping $(mkList vars))] |]) []

 consClause (RecC name fields) = do
     -- Name of constructor, i.e. "A". Will become string literal in generated code
@@ -40,7 +45,7 @@ consClause (RecC name fields) = do
         names = [getNameBase name | (name, _, _) <- fields]
         pats = map varP names
     clause [conP name pats]                                 -- (A x1 x2)
-           (normalB [| Mapping [(toYamlScalar constructorName, Mapping $(mkList names))] |]) []
+           (normalB [| Mapping [(toYamlScalar (BS.pack constructorName), Mapping $(mkList names))] |]) []

 consClause x = report True (show x) >> return undefined

@@ -50,23 +55,45 @@ fromClause (RecC name fields) = do
         names = [getNameBase name | (name, _, _) <- fields]
         pats = map varP names
     obj <- newName "obj"
+    let guard = [| getFirstKey $(varE obj) == (BS.pack constructorName) |]
+        body = foldl appE (conE $ mkName constructorName) $ map (getAttr' constructorName obj) $ map getNameBase names
     clause [varP obj]
-        (normalB $ foldl appE (varE name) $ map (getAttr' obj) $ map getNameBase names) []
+        (guardedB [normalGE guard body]) []
   where
-    getAttr' obj n = [| fromMaybe def $ getScalarAttr $(stringOfName n) $(varE obj) |]
-
+    getAttr' c obj n = [| fromMaybe def $ getSubKey (BS.pack c) $(stringOfName n) $(varE obj) |]

+deriveToYamlObject :: Name -> Q [Dec]
 deriveToYamlObject t = do
   -- Get list of constructors for type t
   TyConI (DataD _ _ _ constructors _)  <-  reify t
   convbody <- mapM consClause constructors
-  return $ InstanceD [] (ConT ''ConvertSuccess `AppT` ConT t `AppT` ConT ''YamlObject) [FunD 'convertSuccess convbody]
+  return [InstanceD [] (ConT ''ConvertSuccess `AppT` ConT t `AppT` ConT ''YamlObject) [FunD 'convertSuccess convbody]]

+deriveFromYamlObject :: Name -> Q [Dec]
 deriveFromYamlObject t = do
   TyConI (DataD _ _ _ constructors _)  <-  reify t
   body <- mapM fromClause constructors
-  return $ InstanceD [] (ConT ''ConvertSuccess `AppT` ConT ''YamlObject `AppT` ConT t) [FunD 'convertSuccess body]
-
+  return [InstanceD [] (ConT ''ConvertSuccess `AppT` ConT ''YamlObject `AppT` ConT t) [FunD 'convertSuccess body]]
+
+deriveIsYamlObject :: Name -> Q [Dec]
+deriveIsYamlObject t = do
+  [i1] <- deriveToYamlObject t
+  [i2] <- deriveFromYamlObject t
+  let i3 = InstanceD [] (ConT ''IsYamlObject `AppT` ConT t) []
+  return [i1,i2,i3]
+
+defaultClause :: Con -> ClauseQ
+defaultClause (RecC name fields) = do
+  let defs = replicate (length fields) (varE $ mkName "def")
+      names = [getNameBase name | (name, _, _) <- fields]
+      body = foldl appE (conE name) defs
+  clause [] (normalB body) []
+
+deriveDefault :: Name -> Q [Dec]
+deriveDefault t = do
+  TyConI (DataD _ _ _ constructors _)  <-  reify t
+  body <- defaultClause (head constructors)
+  return [InstanceD [] (ConT ''Default `AppT` ConT t) [FunD 'def [body]]]

 -- | Generate n unique variables and return them in form of patterns and expressions
 genPE ::  Int -> Q ([PatQ], [Name])
diff --git a/TestDerive.hs b/TestDerive.hs
index 6854b9c..0571cde 100644
--- a/TestDerive.hs
+++ b/TestDerive.hs
@@ -1,19 +1,32 @@
 {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeSynonymInstances #-}
+{-# LANGUAGE OverloadedStrings #-}

+import Data.Default
 import Data.Convertible.Base
 import Data.Object.Yaml
+import qualified Data.ByteString.Char8 as BS

 import YAML
 import Derive

 data Test = Test {getX :: Int, getY :: Int}
+          | Another {getA :: Double}
+  deriving(Show)

-$(deriveToYamlObject ''Test)
+$(deriveDefault ''Test)
+
+$(deriveIsYamlObject ''Test)

 t1 = Test 3 5
+t2 = Another 7.5

-t2 :: YamlObject
-t2 = cs t1
+test :: Test -> IO ()
+test t = do
+  let s = serialize t
+  BS.putStrLn s
+  print (unserialize s :: Maybe Test)

-main = print t2
+main = do
+  test t1
+  test t2

diff --git a/YAML.hs b/YAML.hs
index 38ebab6..4e26d2e 100644
--- a/YAML.hs
+++ b/YAML.hs
@@ -31,12 +31,21 @@ getList _              = []
 getScalarAttr :: (IsYamlScalar a) => BS.ByteString -> YamlObject -> Maybe a
 getScalarAttr key obj = getScalar =<< getAttr key obj

+getSubKey :: (IsYamlScalar a) => BS.ByteString -> BS.ByteString -> YamlObject -> Maybe a
+getSubKey key subkey obj = do
+  attr <- getAttr key obj
+  r <- getAttr subkey attr
+  getScalar r
+
 getListAttr :: BS.ByteString -> YamlObject -> [YamlObject]
 getListAttr key obj =
   case getAttr key obj of
     Just x -> getList x
     Nothing -> []

+getFirstKey :: YamlObject -> BS.ByteString
+getFirstKey (Mapping pairs) = fromYamlScalar $ fst $ head pairs
+
 instance IsYamlScalar Double where
   fromYamlScalar (YamlScalar v _ _) = read $ BS.unpack v
   toYamlScalar x = YamlScalar (BS.pack $ show x) NoTag Any