57 lines
2.0 KiB
Haskell
57 lines
2.0 KiB
Haskell
module Types(SqlRow(SqlRow), getRow) where
|
|
|
|
import Database.HDBC (toSql, SqlValue(..))
|
|
|
|
import qualified Data.Aeson as JSON
|
|
import Data.Aeson.Types (Parser)
|
|
|
|
import Data.Scientific (toRealFloat)
|
|
import Data.HashMap.Strict (foldlWithKey')
|
|
import Data.Text (Text)
|
|
import Data.Text.Encoding (decodeUtf8)
|
|
import Data.Time.Calendar (showGregorian)
|
|
|
|
import Control.Monad(mzero)
|
|
|
|
instance JSON.FromJSON SqlValue where
|
|
parseJSON (JSON.String s) = return $ toSql s
|
|
parseJSON (JSON.Number n) = return $ toSql (toRealFloat n::Double)
|
|
parseJSON (JSON.Bool b) = return $ toSql b
|
|
parseJSON JSON.Null = return SqlNull
|
|
parseJSON (JSON.Object o) = return . toSql $ JSON.encode o
|
|
parseJSON (JSON.Array a) = return . toSql $ JSON.encode a
|
|
|
|
instance JSON.ToJSON SqlValue where
|
|
toJSON (SqlString s) = JSON.toJSON s
|
|
toJSON (SqlByteString s) = JSON.toJSON $ decodeUtf8 s
|
|
toJSON (SqlWord32 w) = JSON.toJSON w
|
|
toJSON (SqlWord64 w) = JSON.toJSON w
|
|
toJSON (SqlInt32 i) = JSON.toJSON i
|
|
toJSON (SqlInt64 i) = JSON.toJSON i
|
|
toJSON (SqlInteger i) = JSON.toJSON i
|
|
toJSON (SqlChar c) = JSON.toJSON c
|
|
toJSON (SqlBool b) = JSON.toJSON b
|
|
toJSON (SqlDouble n) = JSON.toJSON n
|
|
toJSON (SqlRational n) = JSON.toJSON n
|
|
toJSON (SqlLocalDate d) = JSON.toJSON $ showGregorian d
|
|
toJSON (SqlLocalTimeOfDay t) = JSON.toJSON $ show t
|
|
toJSON (SqlLocalTime t) = JSON.toJSON $ show t
|
|
toJSON SqlNull = JSON.Null
|
|
{-toJSON (SqlZonedLocalTimeOfDay t tz)-}
|
|
{-toJSON (SqlZonedTime t)-}
|
|
{-toJSON (SqlDiffTime t)-}
|
|
{-toJSON (SqlPOSIXTime t)-}
|
|
toJSON x = JSON.toJSON $ show x
|
|
|
|
|
|
newtype SqlRow = SqlRow {getRow :: [(Text, SqlValue)] }
|
|
instance JSON.FromJSON SqlRow where
|
|
parseJSON (JSON.Object m) = foldlWithKey' add (return $ SqlRow []) m
|
|
where
|
|
add :: Parser SqlRow -> Text -> JSON.Value -> Parser SqlRow
|
|
add parser k v = do
|
|
SqlRow l <- parser
|
|
sqlV <- JSON.parseJSON v
|
|
return . SqlRow $ (k, sqlV) : l
|
|
parseJSON _ = mzero
|