diff --git a/schema.cabal b/schema.cabal
--- a/schema.cabal
+++ b/schema.cabal
@@ -1,12 +1,12 @@
 name:                 schema
-version:              0.0.2
+version:              0.0.3
 synopsis:             Encoding-independent schemas for Haskell data types.
 homepage:             https://toktok.github.io/
 license:              GPL-3
 license-file:         LICENSE
 author:               Iphigenia Df <iphydf@gmail.com>
 maintainer:           Iphigenia Df <iphydf@gmail.com>
-copyright:            Copyright (c) 2016-2018, Iphigenia Df
+copyright:            Copyright (c) 2016-2021, Iphigenia Df
 category:             Data
 stability:            Experimental
 cabal-version:        >= 1.10
@@ -26,8 +26,18 @@
       -Wall
   exposed-modules:
       Data.Schema
+      Data.Schema.Builder
+      Data.Schema.C
+      Data.Schema.Deinline
+      Data.Schema.Pretty
+      Data.Schema.Type
   build-depends:
       base < 5
+    , ansi-wl-pprint
+    , casing
+    , data-fix
+    , split
+    , transformers-compat
 
 test-suite testsuite
   type: exitcode-stdio-1.0
@@ -35,14 +45,15 @@
   hs-source-dirs: test
   main-is: testsuite.hs
   other-modules:
-      Data.SchemaSpec
+      Data.Schema.PrettySpec
   ghc-options:
       -Wall
-      -fno-warn-unused-imports
+  build-tool-depends:
+      hspec-discover:hspec-discover
   build-depends:
       base < 5
     , QuickCheck
-    , msgpack-binary
+    , bytestring
     , groom
     , hspec
     , schema
diff --git a/src/Data/Schema.hs b/src/Data/Schema.hs
--- a/src/Data/Schema.hs
+++ b/src/Data/Schema.hs
@@ -1,43 +1,10 @@
-{-# LANGUAGE FlexibleInstances #-}
-module Data.Schema where
-
-import           Data.Proxy (Proxy)
-
-
-data Field = Field
-  { fieldName :: String
-  , fieldType :: Type
-  }
-  deriving (Eq, Show, Read)
-
-data Schema
-  = SchemaRecord [Field]
-  | SchemaInt
-  | SchemaDouble
-  | SchemaString
-  deriving (Eq, Show, Read)
-
-
-data Type = Type
-  { typeName   :: String
-  , typeSchema :: Schema
-  }
-  deriving (Eq, Show, Read)
-
-
-class HasSchema a where
-  schema :: Proxy a -> Type
-
-
-instance HasSchema Schema where
-  schema = error "TODO(robinlinden): define schema for Schema"
-
-
-instance HasSchema Int where
-  schema _ = Type "Int" SchemaInt
-
-instance HasSchema Double where
-  schema _ = Type "Double" SchemaDouble
+module Data.Schema
+    ( SchemaF (..)
+    , Schema
+    , Type (..)
+    , Builder (..)
+    , ToSchema (..)
+    ) where
 
-instance HasSchema String where
-  schema _ = Type "String" SchemaString
+import           Data.Schema.Builder (Builder (..), ToSchema (..))
+import           Data.Schema.Type    (Schema, SchemaF (..), Type (..))
diff --git a/src/Data/Schema/Builder.hs b/src/Data/Schema/Builder.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Schema/Builder.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE DefaultSignatures   #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE IncoherentInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators       #-}
+module Data.Schema.Builder
+    ( Builder (..)
+    , ToSchema (..)
+    , atom
+    ) where
+
+import           Control.Applicative (liftA2)
+import           Data.Fix            (Fix (..))
+import           Data.Schema.Type    (Schema, SchemaF (..), Type (..), prodType)
+import           GHC.Generics
+
+
+data Builder a = Builder
+    { zero      :: a
+    , getSchema :: Schema
+    }
+    deriving (Read, Show)
+
+atom :: Type -> a -> Builder a
+atom ty z = Builder z (Fix (Atom ty))
+
+instance Semigroup (Builder a) where
+    Builder x l <> Builder _ r = Builder x (l <> r)
+instance Functor Builder where
+    fmap f (Builder x s) = Builder (f x) s
+instance Applicative Builder where
+    pure x = Builder x (Fix Empty)
+    Builder f l <*> Builder x r = Builder (f x) (prodType l r)
+
+
+class GToSchema f where
+    gToSchema :: Builder (f a)
+
+
+class ToSchema a where
+    toSchema :: Builder a
+
+    default toSchema :: (Generic a, GToSchema (Rep a)) => Builder a
+    toSchema = to <$> gToSchema
+
+instance ToSchema a => ToSchema [a] where
+    toSchema = Builder [v] (Fix (List s))
+      where
+        Builder v s = toSchema
+
+instance GToSchema U1 where
+    gToSchema = Builder U1 (Fix Empty)
+
+instance (GToSchema a, GToSchema b) => GToSchema (a :*: b) where
+    gToSchema = liftA2 (:*:) gToSchema gToSchema
+
+instance (GToSchema a, GToSchema b) => GToSchema (a :+: b) where
+    gToSchema = (L1 <$> gToSchema) <> (R1 <$> gToSchema)
+
+instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
+    gToSchema =
+        M1 <$> addDatatypeName
+            (moduleName (undefined :: D1 d f a))
+            (datatypeName (undefined :: D1 d f a))
+            gToSchema
+      where
+        addDatatypeName :: String -> String -> Builder a -> Builder a
+        addDatatypeName mName dName (Builder x (Fix (Sum Nothing cs))) =
+            Builder x . Fix . Sum (Just (mName, dName)) $ cs
+        addDatatypeName _ _ s = s
+
+instance (Constructor c, GToSchema f) => GToSchema (C1 c f) where
+    gToSchema = M1 <$> addConName (conName (undefined :: C1 c f a)) gToSchema
+      where
+        addConName :: String -> Builder a -> Builder a
+        addConName name (Builder x (Fix Empty)) =
+            Builder x . Fix . Atom . TyName $ name
+        addConName name (Builder x s) =
+            Builder x . Fix . Sum Nothing . (:[]) . Fix . Con name $ s
+
+instance (Selector s, GToSchema f) => GToSchema (S1 s f) where
+    gToSchema = M1 <$> addSelName (selName (undefined :: S1 s f a)) gToSchema
+      where
+        addSelName :: String -> Builder a -> Builder a
+        addSelName "" b               = b
+        addSelName name (Builder x s) = Builder x . Fix . Field name $ s
+
+instance GToSchema a => GToSchema (M1 t c a) where
+    gToSchema = M1 <$> gToSchema
+
+instance ToSchema a => GToSchema (K1 i a) where
+    gToSchema = K1 <$> toSchema
diff --git a/src/Data/Schema/C.hs b/src/Data/Schema/C.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Schema/C.hs
@@ -0,0 +1,197 @@
+{-# LANGUAGE LambdaCase #-}
+module Data.Schema.C where
+
+import           Control.Arrow                ((&&&))
+import qualified Data.Char                    as Char
+import           Data.Fix                     (Fix (..), foldFix)
+import           Data.List.Split              as List
+import           Data.Schema                  (Schema, SchemaF (..), Type (..))
+import           Prelude                      hiding ((<$>))
+import qualified Text.Casing                  as Casing
+import           Text.PrettyPrint.ANSI.Leijen
+
+genC :: Schema -> Doc
+genC (Fix (Sum (Just (mName, dName)) cons)) =
+    vsep
+    . punctuate line
+    . map (uncurry genDatatype . flattenFields ns prefix)
+    $ cons
+  where
+    ns = namespaceFor (List.splitOn "." mName)
+    prefix = dName <> "_"
+genC s = error $ show s
+
+namespaceFor :: [String] -> String
+namespaceFor []               = ""
+namespaceFor [ns, "Types", _] = ns <> "_"
+namespaceFor (_:parts)        = namespaceFor parts
+
+data StructField = StructField
+    { sfField :: Doc
+    , sfType  :: Type
+    }
+    deriving (Show)
+
+data StructName = StructName
+    { snType :: Doc
+    , snFun  :: Doc
+    }
+    deriving (Show)
+
+flattenFields :: String -> String -> Schema -> (StructName, [StructField])
+flattenFields ns prefix = conName . unFix &&& foldFix go
+  where
+    go (Atom ty)              = [StructField empty ty]
+    go (Sum (Just (_, ty)) _) = [StructField empty $ tyName ns ty]
+
+    go (Field name tys)       = map (\ty -> ty{sfField = fieldName name}) tys
+    go (Con _ tys)            = tys
+    go (Prod fields)          = concat fields
+    go (Sum Nothing _)        = []
+    go Empty                  = []
+    go Module{}               = []
+    go Schema{}               = []
+    go List{}                 = []
+
+    conName (Con name _) = StructName
+        { snType = text $ toCName name
+        , snFun = text $ map Char.toLower $ toCName name <> "_"
+        }
+    conName _ = StructName empty empty
+
+    -- | @TypeName -> Namespace_Prefix_Type_Name@
+    toCName :: String -> String
+    toCName name = ns <> prefix <> toCamelSnake name
+
+genDatatype :: StructName -> [StructField] -> Doc
+genDatatype sName fields =
+    genHeader sName fields </> line <>
+    genSource sName fields
+
+genHeader :: StructName -> [StructField] -> Doc
+genHeader sName fields =
+    text "// events.h" </>
+    genTypedef sName </>
+    genGetterDecls sName fields
+
+genSource :: StructName -> [StructField] -> Doc
+genSource sName fields =
+    text "// events.c" </>
+    genStruct sName fields </> line <>
+    (vcat . punctuate line . map (\field ->
+        genGetterDefn sName field </>
+        genSetterDefn sName field) $ fields)
+
+genTypedef :: StructName -> Doc
+genTypedef (StructName sName _) =
+    text "typedef struct" <+> sName <+> sName <> semi
+
+-- | Generate the C struct definition.
+genStruct :: StructName -> [StructField] -> Doc
+genStruct (StructName sName _) fields =
+    text "struct" <+> sName <+> braces (line <>
+        indent 4 (vcat (map ((<> semi) . go) fields))
+        <> line) <> semi
+  where
+    go (StructField f TyBool)     = text "bool"     <+> f
+    go (StructField f TyWord8)    = text "uint8_t"  <+> f
+    go (StructField f TyWord16)   = text "uint16_t" <+> f
+    go (StructField f TyWord32)   = text "uint32_t" <+> f
+    go (StructField f TyWord64)   = text "uint64_t" <+> f
+    go (StructField f (TyName s)) = text s <+> f
+    go (StructField f (TyFixedBin s)) =
+        text "uint8_t" <+> f <> brackets (int s)
+    go (StructField f TyBin) =
+        text "uint8_t *" <> f <> semi </>
+        text "uint32_t " <> f <> text "_size"
+
+eventParam :: Doc -> Doc -> Doc -> Doc
+eventParam qual sName params =
+    parens (line <> indent 4 (qual <> sName <+> text "*event" <> params))
+
+getterDecl :: Doc -> Doc -> String -> Doc -> Doc
+getterDecl sName fName ty f =
+    text ty <> fName <> text "get_" <> f <> eventParam (text "const ") sName empty
+
+setterDecl :: Doc -> Doc -> String -> Doc -> Doc -> Doc
+setterDecl sName fName ty f params =
+    text "static void" <+> fName <> text "set_" <> f <> eventParam empty sName (text (", " <> ty <> "value") <> params)
+
+getterDeclFor :: (String -> Doc -> Doc) -> StructField -> Doc
+getterDeclFor decl = \case
+    (StructField f TyBool)       -> decl "bool "     f
+    (StructField f TyWord8)      -> decl "uint8_t "  f
+    (StructField f TyWord16)     -> decl "uint16_t " f
+    (StructField f TyWord32)     -> decl "uint32_t " f
+    (StructField f TyWord64)     -> decl "uint64_t " f
+    (StructField f (TyName s))   -> decl (s <> " ")  f
+    (StructField f TyFixedBin{}) -> decl "const uint8_t *" f
+    (StructField f TyBin) ->
+        decl "const uint8_t *" f <> semi </>
+        decl "uint32_t " (f <> text "_size")
+
+genGetterDecls :: StructName -> [StructField] -> Doc
+genGetterDecls (StructName sName fName) fields =
+    vcat (map ((<> semi) . getterDeclFor decl) fields)
+  where
+    decl = getterDecl sName fName
+
+genGetterDefn :: StructName -> StructField -> Doc
+genGetterDefn (StructName sName fName) = getterDeclFor defn
+  where
+    defn ty f = getterDecl sName fName ty f </> braces
+        (line <> indent 4 (text "return event->" <> f <> semi) <> line)
+
+genSetterDefn :: StructName -> StructField -> Doc
+genSetterDefn (StructName sName fName) = go
+  where
+    defn params body ty field = setterDecl sName fName ty field params </> braces
+        (line <> indent 4 (body field) <> line)
+
+    setValue field = text "event->" <> field <> text " = value" <> semi
+    simpleDefn = defn empty setValue
+
+    setFixedBin n field =
+        text "memcpy" <> parens (text "event->" <> field <> text ", value, " <> int n) <> semi
+    setBin field =
+        text "assert(event != nullptr);" </>
+        line </>
+        text "if (event->" <> field <> text " != nullptr)" <+> braces (line <>
+            indent 4 (
+                text "free(event->" <> field <> text ");" </>
+                text "event->" <> field <> text " = nullptr;" </>
+                text "event->" <> field <> text "_size = 0;"
+            ) <> line) </>
+        line </>
+        text "event->" <> field <> text " = (uint8_t *)malloc(size);" </>
+        line <>
+        text "if (event->" <> field <> text " == nullptr)" <+> braces (line <>
+            indent 4 (
+                text "return false;"
+            ) <> line) </>
+        line </>
+        text "memcpy" <> parens (text "event->" <> field <> text ", value, size") <> semi </>
+        text "event->" <> field <> text "_size = size;" </>
+        text "return true;"
+
+    go (StructField field TyBool)       = simpleDefn "bool "     field
+    go (StructField field TyWord8)      = simpleDefn "uint8_t "  field
+    go (StructField field TyWord16)     = simpleDefn "uint16_t " field
+    go (StructField field TyWord32)     = simpleDefn "uint32_t " field
+    go (StructField field TyWord64)     = simpleDefn "uint64_t " field
+    go (StructField field (TyName s))   = simpleDefn (s <> " ")  field
+    go (StructField field (TyFixedBin n)) =
+        defn empty (setFixedBin n) "const uint8_t *" field
+    go (StructField field TyBin) =
+        defn (text ", uint32_t size") setBin "const uint8_t *" field
+
+-- | @fieldName' -> field_name@
+fieldName :: String -> Doc
+fieldName = text . filter (/= '\'') . Casing.toQuietSnake . Casing.fromHumps
+
+tyName :: String -> String -> Type
+tyName ns = TyName . (ns <>) . toCamelSnake
+
+-- | @TypeName -> Type_Name@
+toCamelSnake :: String -> String
+toCamelSnake = Casing.toSnake . Casing.fromHumps
diff --git a/src/Data/Schema/Deinline.hs b/src/Data/Schema/Deinline.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Schema/Deinline.hs
@@ -0,0 +1,19 @@
+module Data.Schema.Deinline (deinline) where
+
+import           Control.Arrow (first)
+import           Data.Fix      (Fix (..), foldFix)
+import           Data.List     (nub)
+import           Data.Schema   (Schema, SchemaF (..), Type (..))
+
+deinline :: Schema -> Schema
+deinline = fst . foldFix getTypes
+
+getTypes :: SchemaF (Schema, [Schema]) -> (Schema, [Schema])
+getTypes (Atom ty)                    = (Fix . Atom $ ty, [])
+getTypes (Sum dt@(Just (_, ty)) cons) = (Fix . Atom . TyName $ ty, Fix (Sum dt (map fst cons)) : concatMap snd cons)
+getTypes (Prod fields)                = (Fix . Prod . map fst $ fields, concatMap snd fields)
+getTypes (Field name ty)              = first (Fix . Field name) ty
+getTypes (Con name ty)                = first (Fix . Con name) ty
+getTypes (List ty)                    = first (Fix . List) ty
+getTypes (Schema mods)                = (Fix . Schema . nub . concatMap snd $ mods, [])
+getTypes x                            = error $ "unhandled: " <> show x
diff --git a/src/Data/Schema/Pretty.hs b/src/Data/Schema/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Schema/Pretty.hs
@@ -0,0 +1,24 @@
+module Data.Schema.Pretty (ppSchema) where
+
+import           Data.Fix                     (foldFix)
+import           Data.Schema                  (Schema, SchemaF (..))
+import           Prelude                      hiding ((<$>))
+import           Text.PrettyPrint.ANSI.Leijen
+
+ppSchema :: Schema -> Doc
+ppSchema = (<> line) . foldFix go
+
+go :: SchemaF Doc -> Doc
+go (Atom ty)                 = text $ show ty
+go (Field name ty)           = text name <+> text "::" <+> ty
+go (List ty)                 = text "repeated" <+> ty
+go (Con name ty)             = text name <+> equals <+> ty
+go (Prod fields)             = braces (line <> indent 2 (vcat fields) <> line)
+go (Sum Nothing cons)        = vcat cons
+go (Sum (Just (m, ty)) cons) =
+    text ("type " <> m <> "." <> ty) <+> braces (
+        line <> indent 2 (vcat cons)
+        <> line)
+go (Module name ss)          = text "module" <+> text name <$> vcat ss
+go (Schema mods)             = text "schema 1.0;" <$> line <> vcat (punctuate line mods)
+go Empty                     = text "<empty>"
diff --git a/src/Data/Schema/Type.hs b/src/Data/Schema/Type.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Schema/Type.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE DeriveFoldable     #-}
+{-# LANGUAGE DeriveFunctor      #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE DeriveTraversable  #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia        #-}
+{-# LANGUAGE FlexibleInstances  #-}
+module Data.Schema.Type
+    ( SchemaF (..)
+    , Schema
+    , Type (..)
+    , sumType
+    , prodType
+    ) where
+
+import           Control.Applicative          ((<|>))
+import           Data.Fix                     (Fix (..))
+import           Data.Functor.Classes         (Eq1, Read1, Show1)
+import           Data.Functor.Classes.Generic (FunctorClassesDefault (..))
+import           GHC.Generics                 (Generic, Generic1)
+
+
+data Type
+    = TyBool
+    | TyWord8
+    | TyWord16
+    | TyWord32
+    | TyWord64
+    | TyBin
+    | TyFixedBin Int
+    | TyName String
+    deriving (Show, Read, Eq)
+
+type DatatypeName = (String, String)
+
+data SchemaF a
+    = Empty
+    | Atom Type
+    | List a
+
+    | Prod [a]
+    | Field String a
+
+    | Sum (Maybe DatatypeName) [a]
+    | Con String a
+
+    | Module String [a]
+    | Schema [a]
+    deriving (Show, Read, Eq, Generic, Generic1, Functor, Foldable, Traversable)
+    deriving (Show1, Read1, Eq1) via FunctorClassesDefault SchemaF
+
+type Schema = Fix SchemaF
+
+instance Semigroup Schema where
+    (<>) = sumType
+
+sumType :: Schema -> Schema -> Schema
+sumType (Fix (Sum da a)) (Fix (Sum db b)) = Fix $ Sum (da <|> db) (a ++ b)
+sumType (Fix (Sum da a)) b                = Fix $ Sum da (a ++ [b])
+sumType a (Fix (Sum db b))                = Fix $ Sum db (a : b)
+sumType a b                               = Fix $ Sum Nothing [a, b]
+
+prodType :: Schema -> Schema -> Schema
+prodType (Fix (Prod a)) (Fix (Prod b)) = Fix $ Prod (a ++ b)
+prodType (Fix (Prod a)) b              = Fix $ Prod (a ++ [b])
+prodType a (Fix (Prod b))              = Fix $ Prod (a : b)
+prodType a b                           = Fix $ Prod [a, b]
diff --git a/test/Data/Schema/PrettySpec.hs b/test/Data/Schema/PrettySpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Data/Schema/PrettySpec.hs
@@ -0,0 +1,80 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE KindSignatures       #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE StrictData           #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+module Data.Schema.PrettySpec where
+
+import           GHC.Generics        (Generic)
+import           Test.Hspec
+
+import qualified Data.ByteString     as BS
+import           Data.Proxy          (Proxy (..))
+import           Data.Schema
+import           Data.Schema.Builder (atom)
+import           Data.Schema.Pretty  (ppSchema)
+import           Data.Word           (Word16, Word32, Word64)
+import           GHC.TypeNats        (KnownNat, Nat, natVal)
+
+
+newtype FixedByteString (size :: Nat) = FixedByteString BS.ByteString
+    deriving (Ord, Eq, Read, Show, Generic)
+instance KnownNat size => ToSchema (FixedByteString (size :: Nat)) where
+    toSchema = atom (TyFixedBin (fromIntegral $ natVal (Proxy :: Proxy size))) (FixedByteString BS.empty)
+
+instance ToSchema BS.ByteString where
+    toSchema = atom TyBin BS.empty
+instance ToSchema Word16 where
+    toSchema = atom TyWord16 0
+instance ToSchema Word32 where
+    toSchema = atom TyWord32 0
+instance ToSchema Word64 where
+    toSchema = atom TyWord64 0
+instance ToSchema Bool where
+    toSchema = atom TyBool False
+
+instance ToSchema Int where
+    toSchema = atom TyWord32 0
+instance ToSchema Double where
+    toSchema = atom (TyName "double") 0
+instance ToSchema String where
+    toSchema = atom (TyName "string") ""
+
+--------------------------------------------------------------------------------
+-- Version 1 of the protocol.
+--
+data MyRecordV1 = MyRecordV1
+  { recordField1V1 :: Int
+  , recordField2V1 :: Double
+  , recordField3V1 :: String
+  , someWord32V1   :: Word32
+  , publicKeyV1    :: FixedByteString 32
+  , messageV1      :: BS.ByteString
+  }
+  deriving (Eq, Show, Read, Generic)
+
+instance ToSchema MyRecordV1
+
+myRecordV1 :: Schema
+myRecordV1 = getSchema (toSchema :: Builder MyRecordV1)
+
+
+spec :: Spec
+spec =
+    describe "ppSchema" $ do
+        it "prints a human-readable form" $ do
+            show (ppSchema myRecordV1) `shouldBe` unlines
+                [ "type Data.Schema.PrettySpec.MyRecordV1 {"
+                , "  MyRecordV1 = {"
+                , "    recordField1V1 :: TyWord32"
+                , "    recordField2V1 :: TyName \"double\""
+                , "    recordField3V1 :: TyName \"string\""
+                , "    someWord32V1 :: TyWord32"
+                , "    publicKeyV1 :: TyFixedBin 32"
+                , "    messageV1 :: TyBin"
+                , "  }"
+                , "}"
+                ]
diff --git a/test/Data/SchemaSpec.hs b/test/Data/SchemaSpec.hs
deleted file mode 100644
--- a/test/Data/SchemaSpec.hs
+++ /dev/null
@@ -1,107 +0,0 @@
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module Data.SchemaSpec (spec) where
-
-import           Control.Applicative ((<$>), (<*>))
-import           Control.Monad       (when)
-import           Data.Proxy          (Proxy (..))
-import           Debug.Trace         (trace)
-import           GHC.Generics        (Generic)
-import           Test.Hspec
-import           Test.QuickCheck
-import           Text.Groom          (groom)
-
-import           Data.MessagePack    (MessagePack (..), Object (..))
-import           Data.Schema
-
---------------------------------------------------------------------------------
--- Version 1 of the protocol.
---
-data MyRecordV1 = MyRecordV1
-  { recordField1V1 :: Int
-  , recordField2V1 :: Double
-  , recordField3V1 :: String
-  }
-  deriving (Eq, Show, Read, Generic)
-
-instance MessagePack MyRecordV1
-instance Arbitrary MyRecordV1 where
-  arbitrary = MyRecordV1
-    <$> arbitrary
-    <*> arbitrary
-    <*> arbitrary
-
-
-instance HasSchema MyRecordV1 where
-  schema p = Type
-    { typeName = "MyRecord"
-    , typeSchema = SchemaRecord
-        [ Field "recordField1" $ schema $ recordField1V1 <$> p
-        , Field "recordField2" $ schema $ recordField2V1 <$> p
-        , Field "recordField3" $ schema $ recordField3V1 <$> p
-        ]
-    }
-
-
---------------------------------------------------------------------------------
--- Version 2 of the protocol.
---
--- This version has reordered the second and third field.
---
-data MyRecordV2 = MyRecordV2
-  { recordField1V2 :: Int
-  , recordField3V2 :: String
-  , recordField2V2 :: Double
-  }
-  deriving (Eq, Show, Read, Generic)
-
-instance MessagePack MyRecordV2
-instance Arbitrary MyRecordV2 where
-  arbitrary = MyRecordV2
-    <$> arbitrary
-    <*> arbitrary
-    <*> arbitrary
-
-
-instance HasSchema MyRecordV2 where
-  schema p = Type
-    { typeName = "MyRecord"
-    , typeSchema = SchemaRecord
-        [ Field "recordField1" $ schema $ recordField1V2 <$> p
-        -- Also reordered here so we know the order in the schema.
-        , Field "recordField3" $ schema $ recordField3V2 <$> p
-        , Field "recordField2" $ schema $ recordField2V2 <$> p
-        ]
-    }
-
-
---------------------------------------------------------------------------------
--- Implementation of schema loading goes here:
---
-fromObjectWithSchema :: (MessagePack a, HasSchema a) => Type -> Type -> Object -> a
-fromObjectWithSchema srcType tgtType obj =
-  trace ("Loading object: " ++ groom obj) $
-  trace ("Source schema: " ++ groom srcType) $
-  trace ("Target schema: " ++ groom tgtType) $
-  error "unimplemented: fromObjectWithSchema"
-
-
-spec :: Spec
-spec =
-  describe "msgpack formats" $
-    it "can be translated from v1 to v2 and back" $
-      property $ \(v1 :: MyRecordV1) ->
-        let
-          -- Forward:
-          obj1 = toObject v1
-          scm1 = schema (Proxy :: Proxy MyRecordV1)
-          v2 :: MyRecordV2
-          v2 = fromObjectWithSchema scm1 scm2 obj1
-          -- And back:
-          obj2 = toObject v2
-          scm2 = schema (Proxy :: Proxy MyRecordV2)
-          v1' :: MyRecordV1
-          v1' = fromObjectWithSchema scm2 scm1 obj2
-        in
-        when False $
-          v1' `shouldBe` v1
