diff --git a/Database/JSON2/HDBC.hs b/Database/JSON2/HDBC.hs new file mode 100644 --- /dev/null +++ b/Database/JSON2/HDBC.hs @@ -0,0 +1,60 @@ +{-| +This Library Contains instances class `ToJson` for `SqlValue` +and functions for manipulation `Json` . +-} + +module Database.JSON2.HDBC ( groupWithCol, groupWithNCol) +where + +import Database.HDBC.SqlValue +import Database.HDBC.Locale +import Data.JSON2 +import Data.JSON2.Instances.Time +import Data.Time +import qualified Data.Map as Map + +instance ToJson SqlValue where + toJson (SqlString x) = toJson x + toJson (SqlByteString x) = toJson x + toJson (SqlWord32 x) = toJson x + toJson (SqlWord64 x) = toJson x + toJson (SqlInt32 x) = toJson x + toJson (SqlInt64 x) = toJson x + toJson (SqlInteger x) = toJson x + toJson (SqlChar x) = toJson x + toJson (SqlBool x) = toJson x + toJson (SqlDouble x) = toJson x + toJson (SqlRational x) = toJson x + -- Data and Time Instances + toJson (SqlLocalDate x) = toJson x + toJson (SqlLocalTimeOfDay x) = toJson x + toJson (SqlZonedLocalTimeOfDay t z) = toJson (t,z) + toJson (SqlLocalTime x) = toJson x + toJson (SqlZonedTime x) = toJson x + toJson (SqlUTCTime x) = toJson x + toJson (SqlDiffTime x) = toJson x + toJson (SqlPOSIXTime x) = toJson x + -- + toJson SqlNull = JNull + +-- | Transform SQL-like JSON array of to tree-like JSON object with use column. +groupWithCol :: Json -> Json +groupWithCol (JArray xs) = mergesC $ map objHT xs where + mergesC = foldl mergeC emptyObj + mergeC (JObject x) (JObject y) = JObject $ Map.unionWith (jConcat) x y + jConcat(JArray xs) (JArray ys) = JArray (xs ++ ys) + objHT (JArray ((JString x):xs)) = x .= [xs] + objHT (JArray (x:xs)) = (toString x) .= [xs] + objHT _ = emptyObj +groupWithCol _ = emptyObj + +-- | Conversion SQL-like JSON array of to tree-like JSON object +-- with use N columns. +groupWithNCol :: Int -> Json -> Json +groupWithNCol n j | n > 0 = mapj (n - 1) (groupWithCol j) + | otherwise = j + where + mapj n j@(JObject xs) + | n > 0 = JObject ( Map.map ((mapj (n-1)) . groupWithCol) xs) + | otherwise = j + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2010, Yuriy Iskra +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The names of its contributors may not be used to endorse or + promote products derived from this software without specific prior + written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/ExampleSqlite.hs b/examples/ExampleSqlite.hs new file mode 100644 --- /dev/null +++ b/examples/ExampleSqlite.hs @@ -0,0 +1,58 @@ +module Main where +import Control.Monad (unless) +import Database.HDBC +import Database.HDBC.Sqlite3 +import Data.JSON2 +import Database.JSON2.HDBC + +dbName = "test.db" +tableName = "test" + +mkSqlTable = unlines [ + "CREATE TABLE test (", + "corporation VARCHAR(40) NOT NULL,", + "division INTEGER NOT NULL,", + "name VARCHAR(40) NOT NULL,", + "id INTEGER)" + ] +selectSql = "SELECT * from test" +insertSql = " INSERT INTO test VALUES (?, ?, ?, ?)" + +dataTable :: [(String, Int, String, Maybe Int)] +dataTable = + [("A", 1, "Pupkin", Just 1) + ,("A", 1, "Sidorov", Just 2) + ,("B", 22, "Petrov", Just 3) + ,("B", 22, "Ivanov", Nothing) + ,("B", 22, "Golubev", Nothing) + ,("B", 1, "Petrov", Nothing) + ] + +toSql4 (x1, x2, x3, x4) = [toSql x1, toSql x2, toSql x3, toSql x4] + +sqlTable = map toSql4 dataTable + +main = do + conn <- connectSqlite3 dbName + tables <- getTables conn + unless (tableName `elem` tables) $ do + run conn mkSqlTable [] + stmt <- prepare conn insertSql + executeMany stmt sqlTable + commit conn + stmtSel <- prepare conn selectSql + execute stmtSel [] + + -- Get data from db. + q <- fetchAllRows stmtSel + mapM print q + + -- Conversion SQL to Json + let json = toJson (q :: [[SqlValue]]) + pprint json + + -- Conversion JSON . + let json' = groupWithNCol 2 json + pprint json' + + disconnect conn diff --git a/json2-hdbc.cabal b/json2-hdbc.cabal new file mode 100644 --- /dev/null +++ b/json2-hdbc.cabal @@ -0,0 +1,29 @@ +Name: json2-hdbc +Version: 0.5 +Synopsis: Support JSON for SQL Database. +Category: Database, JSON +Description: Library contains instances of ToJson(JSON2) class + for SqlValue(HDBC) and functions for manipulation + JSON. +License: BSD3 +License-file: LICENSE +Author: YuriyIskra +Maintainer: YuriyIskra +Stability: Experimental +Copyright: Copyright (c) 2011 Yuriy Iskra +Build-type: Simple +Cabal-version: >= 1.6 + +extra-source-files: examples/ExampleSqlite.hs + +library + Exposed-modules: + Database.JSON2.HDBC + + Build-Depends: base >= 4 && < 5, + containers >= 0.2 && < 1, + time >= 1.1, + json2 >= 0.8, + json2-types -any, + utf8-string -any, + HDBC -any