handa-gdata 0.6.7 → 0.6.9.1
raw patch · 2 files changed
+64/−15 lines, 2 filesdep ~http-conduitnew-uploader
Dependency ranges changed: http-conduit
Files
- handa-gdata.cabal +5/−4
- src/Network/Google/FusionTables.hs +59/−11
handa-gdata.cabal view
@@ -1,10 +1,11 @@ name: handa-gdata-version: 0.6.7+version: 0.6.9.1 cabal-version: >=1.6 -- CHANGELOG: -- 0.6.2: Improve getCachedTokens--- +-- 0.6.8: Add FusionTables.bulkImportRows+-- 0.6.9: Add FusionTables.createColumn build-type: Simple license: MIT@@ -89,7 +90,7 @@ , filepath -any , GenericPretty >= 1.0.0 , HTTP >= 4000.2.5- , http-conduit >= 1.9.0+ , http-conduit >= 1.9.0 && < 2.0 , json >= 0.5 , old-locale -any , pretty -any@@ -130,7 +131,7 @@ , cmdargs >= 0.9.4 , GenericPretty >= 1.0.0 , HTTP >= 4000.2.5- , http-conduit >= 1.9.0+ , http-conduit >= 1.9.0 && < 2.0 , json >= 0.5 , network -any , old-locale -any
src/Network/Google/FusionTables.hs view
@@ -22,17 +22,17 @@ TableId, TableMetadata(..), ColumnMetadata(..), CellType(..) -- * One-to-one wrappers around API routines, with parsing of JSON results- , createTable+ , createTable, createColumn , listTables, listColumns -- , sqlQuery -- * Higher level interface to common SQL queries , insertRows -- , filterRows- -- bulkImportRows+ , bulkImportRows ) where -import Control.Monad (liftM)+import Control.Monad (liftM, unless) import Data.Maybe (mapMaybe) import Data.List as L import qualified Data.ByteString.Char8 as B@@ -45,7 +45,7 @@ -- TODO: Ideally this dependency wouldn't exist here and the user could select their -- own JSON parsing lib (e.g. Aeson). import Text.JSON (JSObject(..), JSValue(..), Result(Ok,Error),- decode, valFromObj, toJSObject, toJSString)+ decode, valFromObj, toJSObject, toJSString, fromJSString) import Text.JSON.Pretty (pp_value) -- For easy pretty printing:@@ -121,7 +121,24 @@ , ("type", str$ show colTy) ] str = JSString . toJSString +-- | Create a new column in a given table. Returns the metadata for the new column.+createColumn :: AccessToken -> TableId -> (FTString,CellType) -> IO ColumnMetadata+createColumn tok tab_tableId (colName,colTy) =+ do response <- doRequest req+ let Ok final = parseColumn response+ return final+ where+ req = appendHeaders [("Content-Type", "application/json")] $+ appendBody (BL.pack json)+ (makeRequest tok fusiontableApi "POST"+ (fusiontableHost, "fusiontables/v1/tables/"++tab_tableId++"/columns" ))+ json :: String+ json = render$ pp_value$ JSObject$ toJSObject$+ [ ("name",str colName)+ , ("type",str$ show colTy) ]+ str = JSString . toJSString + -- | Designed to mirror the types listed here: -- <https://developers.google.com/fusiontables/docs/v1/reference/column> data CellType = NUMBER | STRING | LOCATION | DATETIME@@ -191,7 +208,9 @@ -- | Insert one or more rows into a table. Rows are represented as lists of strings. -- The columns being written are passed in as a separate list. The length of all -- rows must match eachother and must match the list of column names.--- +--+-- NOTE: this method has a major limitation. SQL queries are encoded into the URL,+-- and it is very easy to exceed the maximum URL length accepted by Google APIs. insertRows :: AccessToken -> TableId -> [FTString] -- ^ Which columns to write. -> [[FTString]] -- ^ Rows @@ -221,19 +240,48 @@ -- | Implement a larger quantity of rows, but with the caveat that the number and order -- of columns must exactly match the schema of the fusion table on the server. -- `bulkImportRows` will perform a listing of the columns to verify this before uploading.+--+-- This function also checks that the server reports receiving the same number of+-- rows as were uploaded.+--+-- NOTE: also use this function for LONG rows, even if there is only one. Really,+-- you should almost always use this function rather thna `insertRows`. bulkImportRows :: AccessToken -> TableId -> [FTString] -- ^ Which columns to write. -> [[FTString]] -- ^ Rows -> IO () bulkImportRows tok tid cols rows = do - -- listColumns+ targetSchema <- fmap (map col_name) $ listColumns tok tid - let csv = "38"- req = appendBody (BL.pack csv)+ unless (targetSchema == cols) $ + error$ "bulkImportRows: upload schema (1) did not match server side schema (2):\n (1) "+++ show cols ++"\n (2) " ++ show targetSchema++ let csv = unlines rowlns -- (header : rowlns) -- ARGH, they don't accept the header.+ -- All sanity checking must be client side [2013.11.30].+ -- header = concat$ intersperse "," $ map show cols+ rowlns = [ concat$ intersperse "," [ "\"" ++f++"\"" | f <- row ]+ | row <- rows ]+ req = appendBody (BL.pack csv) $ (makeRequest tok fusiontableApi "POST"- (fusiontableHost, "fusiontables/v1/tables/"++tid++"/import" ))- - error "implement bulkImportRows"+ (fusiontableHost, "upload/fusiontables/v1/tables/"++tid++"/import" ))+ {+ queryString = B.pack $ H.urlEncodeVars [("isStrict", "true")]+ }+ resp <- doRequest req+ let Ok received = parseResponse resp + unless (received == length rows) $+ error$ "attempted to upload "++show (length rows)+++ " rows, but "++show received++" received by server."+ return ()++ where + parseResponse :: JSValue -> Result Int+ parseResponse (JSObject ob) = do+ -- JS allTables <- valFromObj "items" ob+-- JSString "fusiontables#import" <- valFromObj "kind" ob -- Sanity check.+ JSString num <- valFromObj "numRowsReceived" ob + return$ read$ fromJSString num -- TODO: provide some basic select functionality