module Network.Google.FusionTables (
TableId, TableMetadata(..), ColumnMetadata(..)
, listTables, listColumns
, parseTables, parseColumns
, insertRows
) 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)
import Text.JSON (JSObject(..), JSValue(..), Result(Ok,Error), decode, valFromObj)
import Text.PrettyPrint.GenericPretty (Out(doc,docPrec), Generic)
import Text.PrettyPrint.HughesPJ (text)
type FTString = String
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)
instance Out TableMetadata
instance Out ColumnMetadata
type TableId = FTString
fusiontableHost :: String
fusiontableHost = "www.googleapis.com"
fusiontableApi :: (String, String)
fusiontableApi = ("Gdata-version", "2")
listTables :: AccessToken
-> IO JSValue
listTables accessToken = doRequest req
where
req = makeRequest accessToken fusiontableApi "GET"
( fusiontableHost, "fusiontables/v1/tables" )
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
listColumns :: AccessToken
-> TableId
-> IO JSValue
listColumns accessToken tid = doRequest req
where
req = makeRequest accessToken fusiontableApi "GET"
( fusiontableHost, "fusiontables/v1/tables/"++tid++"/columns" )
parseColumns :: JSValue -> Result [ColumnMetadata]
parseColumns (JSObject ob) = do
JSArray cols <- valFromObj "items" ob
mapM parseColumn cols
sqlQuery = error "sqlQuery"
insertRows :: AccessToken -> TableId
-> [FTString]
-> [[FTString]]
-> 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++"'"
bulkImportRows = error "implement bulkImportRows"
filterRows = error "implement filterRows"