extract test type, add useful functionality.

2014-09-04 01:00:48 -07:00
parent e3bf277bca
commit e7344bf16f
2 changed files with 37 additions and 18 deletions
@@ -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)