Add type names

TokTok · Dec 20, 2016 · d21902d · d21902d
1 parent bc208b2
commit d21902d
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 13 deletions.
diff --git a/src/Data/Schema.hs b/src/Data/Schema.hs
@@ -7,7 +7,7 @@ import           Data.Proxy (Proxy)
 
 data Field = Field
   { fieldName :: String
-  , fieldType :: Schema
+  , fieldType :: Type
   }
   deriving (Eq, Show, Read)
 
@@ -19,15 +19,22 @@ data Schema
   deriving (Eq, Show, Read)
 
 
+data Type = Type
+  { typeName   :: String
+  , typeSchema :: Schema
+  }
+  deriving (Eq, Show, Read)
+
+
 class HasSchema a where
-  schema :: Proxy a -> Schema
+  schema :: Proxy a -> Type
 
 
 instance HasSchema Int where
-  schema _ = SchemaInt
+  schema _ = Type "Int" SchemaInt
 
 instance HasSchema Double where
-  schema _ = SchemaDouble
+  schema _ = Type "Double" SchemaDouble
 
 instance HasSchema String where
-  schema _ = SchemaString
+  schema _ = Type "String" SchemaString
diff --git a/test/Data/SchemaSpec.hs b/test/Data/SchemaSpec.hs
@@ -8,24 +8,27 @@ import           Test.QuickCheck
 import           Data.Schema
 
 
-data Record = Record
+data MyRecord = MyRecord
   { recordField1 :: Int
   , recordField2 :: Double
   , recordField3 :: String
   }
   deriving (Eq, Show, Read)
 
 
-instance HasSchema Record where
-  schema p = SchemaRecord
-    [ Field "recordField1" $ schema $ recordField1 <$> p
-    , Field "recordField2" $ schema $ recordField2 <$> p
-    , Field "recordField3" $ schema $ recordField3 <$> p
-    ]
+instance HasSchema MyRecord where
+  schema p = Type
+    { typeName = "MyRecord"
+    , typeSchema = SchemaRecord
+        [ Field "recordField1" $ schema $ recordField1 <$> p
+        , Field "recordField2" $ schema $ recordField2 <$> p
+        , Field "recordField3" $ schema $ recordField3 <$> p
+        ]
+    }
 
 
 spec :: Spec
 spec = do
   describe "schemas" $ do
     it "can be printed to stdout" $
-      print (schema (Proxy :: Proxy Record))
+      print (schema (Proxy :: Proxy MyRecord))