{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- -- Module : Network.Google.FusionTables -- Copyright : (c) 2013 Ryan Newton -- License : MIT -- -- Maintainer : Ryan Newton -- Stability : Stable -- Portability : Portable -- -- | Functions for accessing the Fusion Tables API, see -- . -- -- This provides a very limited subset of the complete (v1) API at present. ----------------------------------------------------------------------------- module Network.Google.FusionTables ( -- * Types TableId, TableMetadata(..), ColumnMetadata(..) -- * Raw API routines, returning raw JSON , listTables, listColumns -- , sqlQuery -- * Parsing result of raw API routines , parseTables, parseColumns -- * Higher level interface to common SQL queries , insertRows -- , filterRows ) 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 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) -- For easy pretty printing: import Text.PrettyPrint.GenericPretty (Out(doc,docPrec), Generic) import Text.PrettyPrint.HughesPJ (text) -------------------------------------------------------------------------------- -- Haskell Types corresponding to JSON responses -- This could include non-ASCII characters: -- TODO: Use Data.Text -- type FTString = B.ByteString type FTString = String -- | An incomplete representation of data TableMetadata = TableMetadata { tab_name :: FTString , tab_tableId :: FTString , tab_columns :: [ColumnMetadata] } deriving (Eq, Show, Read, Ord, Generic) data ColumnMetadata = ColumnMetadata { col_columnId :: Int , col_name :: FTString , col_type :: FTString } deriving (Eq, Show, Read, Ord, Generic) -- TODO: Use Data.Aeson.TH instance Out TableMetadata instance Out ColumnMetadata -- instance Out B.ByteString where docPrec _ = text . B.unpack; doc = docPrec 0 -- | ID for a specific fusion table type TableId = FTString -------------------------------------------------------------------------------- -- | The host for API access. fusiontableHost :: String -- fusiontableHost = "https://www.googleapis.com/fusiontables/v1" fusiontableHost = "www.googleapis.com" -- | 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? -- | List all tables belonging to a user. -- See . listTables :: AccessToken -- ^ The OAuth 2.0 access token. -> IO JSValue listTables accessToken = doRequest req where req = makeRequest accessToken fusiontableApi "GET" ( fusiontableHost, "fusiontables/v1/tables" ) -- | Construct a simple Haskell representation of the result of `listTables`. 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 parseColumn :: JSValue -> Result ColumnMetadata parseColumn (JSObject ob) = do col_name <- valFromObj "name" ob col_columnId <- valFromObj "columnId" ob col_type <- valFromObj "type" ob return ColumnMetadata {col_name, col_type, col_columnId} parseColumn oth = Error$ "parseColumn: Expected JSObject, got "++show oth -- | List the columns within a specific table. -- See . listColumns :: AccessToken -- ^ The OAuth 2.0 access token. -> TableId -- ^ which table -> IO JSValue listColumns accessToken tid = doRequest req where req = makeRequest accessToken fusiontableApi "GET" ( fusiontableHost, "fusiontables/v1/tables/"++tid++"/columns" ) -- | Parse the output of `listColumns`. parseColumns :: JSValue -> Result [ColumnMetadata] parseColumns (JSObject ob) = do JSArray cols <- valFromObj "items" ob mapM parseColumn cols -------------------------------------------------------------------------------- sqlQuery = error "sqlQuery" -- | 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. -- insertRows :: AccessToken -> TableId -> [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 where req = (makeRequest tok fusiontableApi "GET" (fusiontableHost, "fusiontables/v1/query" )) { method = B.pack "POST", queryString = B.pack$ H.urlEncodeVars [("sql",query)] } query = concat $ L.intersperse ";\n" $ map (("INSERT INTO "++tid++" "++ colstr ++" VALUES ")++) vals numcols = length cols colstr = parens$ concat$ L.intersperse ", " cols vals = map fn rows fn row = if length row == numcols then parens$ concat$ L.intersperse ", " $ map singQuote row else error$ "insertRows: got a row with an incorrect number of arguments, expected " ++ show numcols ++": "++ show row parens s = "(" ++ s ++ ")" singQuote x = "'"++x++"'" -- 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" filterRows = error "implement filterRows"