extract test type, add useful functionality.

test/Feature/InsertSpec.hs

@@ -11,10 +11,7 @@ import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus))
 import SpecHelper
 
 import qualified Data.Aeson as JSON
-import Data.Aeson ((.:))
 import Data.Maybe (fromJust)
-import Control.Applicative ((<$>), (<*>))
-import Control.Monad (mzero)
 import qualified Data.HashMap.Strict as Hash
 import qualified Data.ByteString.Char8 as BS
 import Data.CaseInsensitive
@@ -23,23 +20,10 @@ import Text.Regex.TDFA ((=~))
 import Network.HTTP.Types.Header
 import Network.HTTP.Types.Status
 
+import TestTypes(IncPK, incStr, incNullableStr)
+
 -- }}}
 
-data IncPK = IncPK {
-  incId :: Int
-, incNullableStr :: Maybe String
-, incStr :: String
-, incInsert :: String
-} deriving (Show)
-
-instance JSON.FromJSON IncPK where
-  parseJSON (JSON.Object r) = IncPK <$>
-    r .: "id" <*>
-    r .: "nullable_string" <*>
-    r .: "non_nullable_string" <*>
-    r .: "inserted_at"
-  parseJSON _ = mzero
-
 getHeader :: CI BS.ByteString -> [Header] -> Maybe BS.ByteString
 getHeader name headers =
   Hash.lookup name $ Hash.fromList headers

test/TestTypes.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+module TestTypes (
+  IncPK(..),
+  fromList
+) where
+
+import qualified Data.Aeson as JSON
+import Data.Aeson ((.:))
+import Data.Maybe (fromJust)
+import Control.Applicative ((<$>), (<*>))
+import Control.Monad (mzero)
+
+import Database.HDBC (SqlValue, fromSql)
+
+data IncPK = IncPK {
+  incId :: Int
+, incNullableStr :: Maybe String
+, incStr :: String
+, incInsert :: String
+} deriving (Eq, Show)
+
+instance JSON.FromJSON IncPK where
+  parseJSON (JSON.Object r) = IncPK <$>
+    r .: "id" <*>
+    r .: "nullable_string" <*>
+    r .: "non_nullable_string" <*>
+    r .: "inserted_at"
+  parseJSON _ = mzero
+
+fromList :: [(String, SqlValue)] -> IncPK
+fromList row = IncPK
+  (fromSql . fromJust $ lookup "id" row)
+  (fromSql . fromJust $ lookup "nullable_string" row)
+  (fromSql . fromJust $ lookup "non_nullable_string" row)
+  (fromSql . fromJust $ lookup "inserted_at" row)