json2-hdbc (empty) → 0.5
raw patch · 5 files changed
+180/−0 lines, 5 filesdep +HDBCdep +basedep +containerssetup-changed
Dependencies added: HDBC, base, containers, json2, json2-types, time, utf8-string
Files
- Database/JSON2/HDBC.hs +60/−0
- LICENSE +31/−0
- Setup.hs +2/−0
- examples/ExampleSqlite.hs +58/−0
- json2-hdbc.cabal +29/−0
+ Database/JSON2/HDBC.hs view
@@ -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 +
+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/ExampleSqlite.hs view
@@ -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
+ json2-hdbc.cabal view
@@ -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 <iskra.yw@gmail.com>+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