diff --git a/handa-gdata.cabal b/handa-gdata.cabal --- a/handa-gdata.cabal +++ b/handa-gdata.cabal @@ -1,11 +1,11 @@ name: handa-gdata -version: 0.6.0 +version: 0.6.1 cabal-version: >=1.6 build-type: Simple license: MIT license-file: LICENSE -copyright: (c) 2012-13 Brian W Bush -maintainer: Brian W Bush +copyright: (c) 2012-13 Brian W Bush, Ryan Newton +maintainer: Brian W Bush , Ryan Newton stability: Stable homepage: http://code.google.com/p/hgdata package-url: http://code.google.com/p/hgdata/downloads/list @@ -66,7 +66,7 @@ . * Listing photos in an album category: Network -author: Brian W Bush +author: Brian W Bush , Ryan Newton data-dir: "" source-repository head diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -161,7 +161,7 @@ , gshead , gssync ] - &= summary "hgData v0.6.0, (c) 2012-13 Brian W. Bush , MIT license." + &= summary "hgData v0.6.1, (c) 2012-13 Brian W. Bush , MIT license." &= program "hgdata" &= help "Command-line utility for accessing Google services and APIs. Send bug reports and feature requests to ." diff --git a/src/Network/Google/FusionTables.hs b/src/Network/Google/FusionTables.hs --- a/src/Network/Google/FusionTables.hs +++ b/src/Network/Google/FusionTables.hs @@ -19,36 +19,39 @@ module Network.Google.FusionTables ( -- * Types - TableId, TableMetadata(..), ColumnMetadata(..) + TableId, TableMetadata(..), ColumnMetadata(..), CellType(..) - -- * Raw API routines, returning raw JSON + -- * One-to-one wrappers around API routines, with parsing of JSON results + , createTable , listTables, listColumns -- , sqlQuery - - -- * Parsing result of raw API routines - , parseTables, parseColumns -- * Higher level interface to common SQL queries , insertRows - -- , filterRows + -- , filterRows + -- bulkImportRows ) where import Control.Monad (liftM) import Data.Maybe (mapMaybe) import Data.List as L import qualified Data.ByteString.Char8 as B -import Network.Google (AccessToken, ProjectId, doRequest, makeRequest) -import Network.HTTP.Conduit (Request(..)) +import qualified Data.ByteString.Lazy.Char8 as BL +import Network.Google (AccessToken, ProjectId, doRequest, makeRequest, appendBody, appendHeaders) +import Network.HTTP.Conduit (Request(..), RequestBody(..),parseUrl) import qualified Network.HTTP as H import Text.XML.Light (Element(elContent), QName(..), filterChildrenName, findChild, strContent) -- 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) +import Text.JSON (JSObject(..), JSValue(..), Result(Ok,Error), + decode, valFromObj, toJSObject, toJSString) +import Text.JSON.Pretty (pp_value) -- For easy pretty printing: import Text.PrettyPrint.GenericPretty (Out(doc,docPrec), Generic) -import Text.PrettyPrint.HughesPJ (text) +import Text.PrettyPrint.HughesPJ (text, render) +import Text.Printf (printf) -------------------------------------------------------------------------------- -- Haskell Types corresponding to JSON responses @@ -91,18 +94,50 @@ -- | The API version used here. fusiontableApi :: (String, String) -fusiontableApi = ("Gdata-version", "2") --- RRN: Is there documentation for what this means? It seems like "Gdata" might be --- deprecated with the new google APIs? +-- FIXME: This is meaningless because we're using the new discovery-based API, *NOT* +-- the old GData APIs. +fusiontableApi = ("Gdata-version", "999") +-- | Create an (exportable) table with a given name and list of columns. +createTable :: AccessToken -> String -> [(FTString,CellType)] -> IO TableMetadata +createTable tok name cols = + do response <- doRequest req + let Ok final = parseTable response + return final + where + req = appendHeaders [("Content-Type", "application/json")] $ + appendBody (BL.pack json) + (makeRequest tok fusiontableApi "POST" + (fusiontableHost, "fusiontables/v1/tables" )) + json :: String + json = render$ pp_value$ JSObject$ toJSObject$ + [ ("name",str name) + , ("isExportable", JSBool True) + , ("columns", colsJS) ] + colsJS = JSArray (map fn cols) + fn (colName, colTy) = JSObject$ + toJSObject [ ("name", str colName) + , ("kind", str "fusiontables#column") + , ("type", str$ show colTy) ] + str = JSString . toJSString + +-- | Designed to mirror the types listed here: +-- +data CellType = NUMBER | STRING | LOCATION | DATETIME + deriving (Show,Eq,Ord,Read) + -- | List all tables belonging to a user. -- See . listTables :: AccessToken -- ^ The OAuth 2.0 access token. - -> IO JSValue -listTables accessToken = doRequest req + -> IO [TableMetadata] +listTables accessToken = + do resp <- doRequest req + case parseTables resp of + Ok x -> return x + Error err -> error$ "listTables: failed to parse JSON response:\n"++err where - req = makeRequest accessToken fusiontableApi "GET" + req = makeRequest accessToken fusiontableApi "GET" ( fusiontableHost, "fusiontables/v1/tables" ) @@ -110,15 +145,15 @@ parseTables :: JSValue -> Result [TableMetadata] parseTables (JSObject ob) = do JSArray allTables <- valFromObj "items" ob - mapM parseTab allTables - where - parseTab :: JSValue -> Result TableMetadata - parseTab (JSObject ob) = do - tab_name <- valFromObj "name" ob - tab_tableId <- valFromObj "tableId" ob - tab_columns <- mapM parseColumn =<< valFromObj "columns" ob - return TableMetadata {tab_name, tab_tableId, tab_columns} - parseTab oth = Error$ "parseTable: Expected JSObject, got "++show oth + mapM parseTable allTables + +parseTable :: JSValue -> Result TableMetadata +parseTable (JSObject ob) = do + tab_name <- valFromObj "name" ob + tab_tableId <- valFromObj "tableId" ob + tab_columns <- mapM parseColumn =<< valFromObj "columns" ob + return TableMetadata {tab_name, tab_tableId, tab_columns} +parseTable oth = Error$ "parseTable: Expected JSObject, got "++show oth parseColumn :: JSValue -> Result ColumnMetadata parseColumn (JSObject ob) = do @@ -132,8 +167,12 @@ -- See . listColumns :: AccessToken -- ^ The OAuth 2.0 access token. -> TableId -- ^ which table - -> IO JSValue -listColumns accessToken tid = doRequest req + -> IO [ColumnMetadata] +listColumns accessToken tid = + do resp <- doRequest req + case parseColumns resp of + Ok x -> return x + Error err -> error$ "listColumns: failed to parse JSON response:\n"++err where req = makeRequest accessToken fusiontableApi "GET" ( fusiontableHost, "fusiontables/v1/tables/"++tid++"/columns" ) @@ -156,15 +195,11 @@ -> [FTString] -- ^ Which columns to write. -> [[FTString]] -- ^ Rows -> IO () -insertRows tok tid cols rows = - do putStrLn$"DOING REQUEST "++show req - putStrLn$ "VALS before encode "++ show vals - doRequest req +insertRows tok tid cols rows = doRequest req where - req = (makeRequest tok fusiontableApi "GET" + req = (makeRequest tok fusiontableApi "POST" (fusiontableHost, "fusiontables/v1/query" )) { - method = B.pack "POST", queryString = B.pack$ H.urlEncodeVars [("sql",query)] } query = concat $ L.intersperse ";\n" $ @@ -182,8 +217,23 @@ singQuote x = "'"++x++"'" --- Implement a larger quantity of rows, but with the caveat that the number and order +-- | 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 = error "implement bulkImportRows" +-- `bulkImportRows` will perform a listing of the columns to verify this before uploading. +bulkImportRows :: AccessToken -> TableId + -> [FTString] -- ^ Which columns to write. + -> [[FTString]] -- ^ Rows + -> IO () +bulkImportRows tok tid cols rows = do + -- listColumns + let csv = "38" + req = appendBody (BL.pack csv) + (makeRequest tok fusiontableApi "POST" + (fusiontableHost, "fusiontables/v1/tables/"++tid++"/import" )) + + error "implement bulkImportRows" + + +-- TODO: provide some basic select functionality filterRows = error "implement filterRows" diff --git a/src/Network/Google/OAuth2.hs b/src/Network/Google/OAuth2.hs --- a/src/Network/Google/OAuth2.hs +++ b/src/Network/Google/OAuth2.hs @@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- -- Module : Network.Google.OAuth2 --- Copyright : (c) 2012-13 Brian W Bush +-- Copyright : (c) 2012-13 Brian W Bush, Ryan Newton -- License : MIT -- --- Maintainer : Brian W Bush +-- Maintainer : Brian W Bush , Ryan Newton -- Stability : Stable -- Portability : Portable -- @@ -311,13 +311,18 @@ toks <- fmap read (readFile tokenF) -- Our policy is to *always* refresh: toks2 <- refreshTokens client toks - atomicWriteFile tokenF (show toks2) - return toks2 + toks3 <- timestamp toks2 + atomicWriteFile tokenF (show toks3) + return toks3 else do toks <- askUser atomicWriteFile tokenF (show toks) return toks - where + where + -- TODO: Convert relative time to absolute UTF time for the tokens: + timestamp toks = + return toks + -- This is the part where we require user interaction: askUser = do putStrLn$ "Load this URL: "++show permissionUrl