module Network.Google.FusionTables (
TableId, TableMetadata(..), ColumnMetadata(..), CellType(..)
, createTable
, listTables, listColumns
, insertRows
) where
import Control.Monad (liftM)
import Data.Maybe (mapMaybe)
import Data.List as L
import qualified Data.ByteString.Char8 as B
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)
import Text.JSON (JSObject(..), JSValue(..), Result(Ok,Error),
decode, valFromObj, toJSObject, toJSString)
import Text.JSON.Pretty (pp_value)
import Text.PrettyPrint.GenericPretty (Out(doc,docPrec), Generic)
import Text.PrettyPrint.HughesPJ (text, render)
import Text.Printf (printf)
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", "999")
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
data CellType = NUMBER | STRING | LOCATION | DATETIME
deriving (Show,Eq,Ord,Read)
listTables :: AccessToken
-> 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, error was:\n "
++err++"\nJSON response was:\n "++show resp
where
req = makeRequest accessToken fusiontableApi "GET"
( fusiontableHost, "fusiontables/v1/tables" )
parseTables :: JSValue -> Result [TableMetadata]
parseTables (JSObject ob) = do
JSArray allTables <- valFromObj "items" ob
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
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 [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" )
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 = doRequest req
where
req = (makeRequest tok fusiontableApi "POST"
(fusiontableHost, "fusiontables/v1/query" ))
{
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 :: AccessToken -> TableId
-> [FTString]
-> [[FTString]]
-> IO ()
bulkImportRows tok tid cols rows = do
let csv = "38"
req = appendBody (BL.pack csv)
(makeRequest tok fusiontableApi "POST"
(fusiontableHost, "fusiontables/v1/tables/"++tid++"/import" ))
error "implement bulkImportRows"
filterRows = error "implement filterRows"