diff --git a/Data/Factual/Query.hs b/Data/Factual/Query.hs --- a/Data/Factual/Query.hs +++ b/Data/Factual/Query.hs @@ -4,7 +4,11 @@ -- * Query typeclass Query(..)) where --- | A member of the Query typeclass must define a toPath method which converts --- the Query into a path String. +import qualified Data.Map as M + +-- | A member of the Query typeclass must define a path function which outputs +-- the Query endpoint path, and a params function that outputs a Map of query +-- params keys and values. class Query q where - toPath :: q -> String + path :: q -> String + params :: q -> M.Map String String diff --git a/Data/Factual/Query/DiffsQuery.hs b/Data/Factual/Query/DiffsQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Query/DiffsQuery.hs @@ -0,0 +1,29 @@ +-- | This module exports the types used to create diffs queries. +module Data.Factual.Query.DiffsQuery + ( + -- * DiffsQuery type + DiffsQuery(..) + -- * Required modules + , module Data.Factual.Shared.Table + ) where + +import Data.Factual.Query +import Data.Factual.Shared.Table +import qualified Data.Map as M + +-- | The timestamps are unix epoch integers +type Timestamp = Integer + +-- | The DiffsQuery type is used to construct diffs queries. A table, start +-- timestamp and end timestamp should be specified. +data DiffsQuery = DiffsQuery { table :: Table + , start :: Timestamp + , end :: Timestamp + } deriving (Eq, Show) + +-- The DiffsQuery type is a member of the Query typeclass so it can be used to +-- make a request. +instance Query DiffsQuery where + path query = (show $ table query) ++ "/diffs" + params query = M.fromList [ ("start", show $ start query) + , ("end", show $ end query) ] diff --git a/Data/Factual/Query/FacetsQuery.hs b/Data/Factual/Query/FacetsQuery.hs --- a/Data/Factual/Query/FacetsQuery.hs +++ b/Data/Factual/Query/FacetsQuery.hs @@ -16,7 +16,7 @@ import Data.Factual.Shared.Filter import Data.Factual.Shared.Geo import Data.Factual.Utils -import Network.HTTP.Base (urlEncode) +import qualified Data.Map as M -- | The FacetsQuery type is used to construct facets queries. A table and search -- should be specified, but the rest of the query options are essentially @@ -34,17 +34,16 @@ -- The FacetsQuery type is a member of the Query typeclass so it can be used to -- make a request. instance Query FacetsQuery where - toPath query = (show $ table query) - ++ "/facets?" - ++ joinAndFilter [ searchString $ search query - , selectString $ select query - , filtersString $ filters query - , geoString $ geo query - , limitString $ limit query - , minCountString $ minCount query - , includeCountString $ includeCount query ] + path query = (show $ table query) ++ "/facets" + params query = M.fromList [ searchPair $ search query + , selectPair $ select query + , filtersPair $ filters query + , geoPair $ geo query + , limitPair $ limit query + , minCountPair $ minCount query + , includeCountPair $ includeCount query ] -- Helper functions -minCountString :: Maybe Int -> String -minCountString (Just x) = "min_count=" ++ (urlEncode $ show x) -minCountString Nothing = "" +minCountPair :: Maybe Int -> (String, String) +minCountPair (Just x) = ("min_count", show x) +minCountPair Nothing = ("min_count", "") diff --git a/Data/Factual/Query/GeocodeQuery.hs b/Data/Factual/Query/GeocodeQuery.hs --- a/Data/Factual/Query/GeocodeQuery.hs +++ b/Data/Factual/Query/GeocodeQuery.hs @@ -9,6 +9,7 @@ import Data.Factual.Query import Data.Factual.Shared.Geo +import qualified Data.Map as M -- | The GeocodeQuery type is used to construct geocode queries. A geo point -- is required. @@ -17,4 +18,5 @@ -- The GeocodeQuery type is a member of the Query typeclass so it can be used -- to make a request. instance Query GeocodeQuery where - toPath (GeocodeQuery geo) = "/places/geocode?" ++ (geoString $ Just geo) + path _ = "/places/geocode" + params (GeocodeQuery geo) = M.fromList [(geoPair $ Just geo)] diff --git a/Data/Factual/Query/GeopulseQuery.hs b/Data/Factual/Query/GeopulseQuery.hs --- a/Data/Factual/Query/GeopulseQuery.hs +++ b/Data/Factual/Query/GeopulseQuery.hs @@ -10,6 +10,7 @@ import Data.Factual.Query import Data.Factual.Utils import Data.Factual.Shared.Geo +import qualified Data.Map as M -- | The GeopulseQuery type is used to construct geopulse queries. A geo point -- is required but select values are optional (just use an empty list to @@ -21,6 +22,6 @@ -- The GeopulseQuery type is a member of the Query typeclass so it can be used -- to make a request. instance Query GeopulseQuery where - toPath query = "/places/geopulse?" - ++ joinAndFilter [ geoString $ Just $ geo query - , selectString $ select query ] + path _ = "/places/geopulse" + params query = M.fromList [ geoPair $ Just $ geo query + , selectPair $ select query ] diff --git a/Data/Factual/Query/MatchQuery.hs b/Data/Factual/Query/MatchQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Query/MatchQuery.hs @@ -0,0 +1,36 @@ +-- | This module exports the type used to create match queries. +module Data.Factual.Query.MatchQuery + ( + -- * MatchQuery type + MatchQuery(..) + -- * MatchValue type + , MatchValue(..) + ) where + +import Data.Factual.Query +import Data.Factual.Utils +import qualified Data.Map as M + +-- | A match value can either be a String or a Number (Double). The first +-- argument is the name of the field and the second argument is the input +-- value. +data MatchValue = MatchStr String String + | MatchNum String Double + deriving Eq + +-- MatchValue is a member of the Show typeclass to help generate query Strings. +instance Show MatchValue where + show (MatchStr name str) = (show name) ++ ":" ++ (show str) + show (MatchNum name num) = (show name) ++ ":" ++ (show num) + +-- | A match query is formed as an array of match values. These values will +-- be compared with Factual records to return a cleaner, more canonical row +-- of data. +data MatchQuery = MatchQuery [MatchValue] deriving Eq + +-- MatchQuery is a member of the Query typeclass so that it can be used to +-- make requests. +instance Query MatchQuery where + path _ = "/places/match" + params (MatchQuery values) = M.fromList [("values", valuesString)] + where valuesString = "{" ++ (join "," $ map show values) ++ "}" diff --git a/Data/Factual/Query/ReadQuery.hs b/Data/Factual/Query/ReadQuery.hs --- a/Data/Factual/Query/ReadQuery.hs +++ b/Data/Factual/Query/ReadQuery.hs @@ -6,6 +6,7 @@ -- * Required modules , module Data.Factual.Shared.Table , module Data.Factual.Shared.Search + , module Data.Factual.Shared.SortOrder , module Data.Factual.Shared.Filter , module Data.Factual.Shared.Geo ) where @@ -13,10 +14,11 @@ import Data.Factual.Query import Data.Factual.Shared.Table import Data.Factual.Shared.Search +import Data.Factual.Shared.SortOrder import Data.Factual.Shared.Filter import Data.Factual.Shared.Geo import Data.Factual.Utils -import Network.HTTP.Base (urlEncode) +import qualified Data.Map as M -- | The ReadQuery type is used to construct read queries. A table should be -- specified, but the rest of the query options are essentially optional @@ -31,23 +33,25 @@ , offset :: Maybe Int , filters :: [Filter] , geo :: Maybe Geo + , sort :: [SortOrder] , includeCount :: Bool } deriving (Eq, Show) + -- The ReadQuery type is a member of the Query typeclass so it can be used to -- make a request. instance Query ReadQuery where - toPath query = (show $ table query) - ++ "?" - ++ joinAndFilter [ searchString $ search query - , selectString $ select query - , limitString $ limit query - , offsetString $ offset query - , filtersString $ filters query - , geoString $ geo query - , includeCountString $ includeCount query ] + path query = show $ table query + params query = M.fromList [ searchPair $ search query + , selectPair $ select query + , limitPair $ limit query + , offsetPair $ offset query + , filtersPair $ filters query + , geoPair $ geo query + , sortPair $ sort query + , includeCountPair $ includeCount query ] -- The following helper functions are used in generating query Strings. -offsetString :: Maybe Int -> String -offsetString (Just x) = "offset=" ++ (urlEncode $ show x) -offsetString Nothing = "" +offsetPair :: Maybe Int -> (String, String) +offsetPair (Just x) = ("offset", show x) +offsetPair Nothing = ("offset", "") diff --git a/Data/Factual/Query/ResolveQuery.hs b/Data/Factual/Query/ResolveQuery.hs --- a/Data/Factual/Query/ResolveQuery.hs +++ b/Data/Factual/Query/ResolveQuery.hs @@ -9,7 +9,7 @@ import Data.Factual.Query import Data.Factual.Utils -import Network.HTTP.Base (urlEncode) +import qualified Data.Map as M -- | A resolve value can either be a String or a Number (Double). The first -- argument is the name of the field and the second argument is the input @@ -26,10 +26,14 @@ -- | A resolve query is formed as an array of resolve values. These values will -- be compared with Factual records to return a cleaner, more canonical row -- of data. -data ResolveQuery = ResolveQuery [ResolveValue] deriving Eq +data ResolveQuery = ResolveQuery { values :: [ResolveValue] + , debug :: Bool + } deriving Eq -- ResolveQuery is a member of the Query typeclass so that it can be used to -- make requests. instance Query ResolveQuery where - toPath (ResolveQuery values) = "/places/resolve?values=" - ++ urlEncode ("{" ++ (join "," $ map show values) ++ "}") + path _ = "/places/resolve" + params query = M.fromList [("values", valuesString), ("debug", debugString)] + where valuesString = "{" ++ (join "," $ map show $ values query) ++ "}" + debugString = if (debug query) then "true" else "false" diff --git a/Data/Factual/Query/SchemaQuery.hs b/Data/Factual/Query/SchemaQuery.hs --- a/Data/Factual/Query/SchemaQuery.hs +++ b/Data/Factual/Query/SchemaQuery.hs @@ -9,6 +9,7 @@ import Data.Factual.Query import Data.Factual.Shared.Table +import qualified Data.Map as M -- | A schema query is formed by simply supplying a Table to the value -- constructor. @@ -16,4 +17,5 @@ -- SchemaQuery is a member of Query typeclass so that it can generate a response. instance Query SchemaQuery where - toPath (SchemaQuery table) = (show $ table) ++ "/schema" + path (SchemaQuery table) = (show $ table) ++ "/schema" + params _ = M.empty diff --git a/Data/Factual/Response.hs b/Data/Factual/Response.hs --- a/Data/Factual/Response.hs +++ b/Data/Factual/Response.hs @@ -22,6 +22,7 @@ import qualified Data.HashMap.Lazy as L import qualified Data.Text as T import qualified Data.Vector as V +import Debug.Trace -- | A response object has a status (that will be ok if the query was successful -- and error if the query failed), a version (which should always be 3.0) and @@ -37,8 +38,8 @@ -- the API into a Response value. fromValue :: Value -> Response fromValue value - | respStatus == "error" = formErrorResponse value - | otherwise = formValidResponse value + | respStatus == "ok" = formValidResponse value + | otherwise = formErrorResponse value where respStatus = lookupString "status" value -- | This function can be used to convert an Aeson Array value into a vanilla @@ -69,7 +70,7 @@ -- The following helper functions aid the lookup functions. formErrorResponse :: Value -> Response -formErrorResponse value = Response { status = "error" +formErrorResponse value = Response { status = lookupString "status" value , version = lookupNumber "version" value , response = Null , errorMessage = Just $ lookupString "message" value @@ -81,6 +82,7 @@ , response = lookupValue "response" value , errorMessage = Nothing , errorType = Nothing } + extractString :: Value -> String extractString (String x) = T.unpack x diff --git a/Data/Factual/Shared/Filter.hs b/Data/Factual/Shared/Filter.hs --- a/Data/Factual/Shared/Filter.hs +++ b/Data/Factual/Shared/Filter.hs @@ -5,11 +5,10 @@ Field , Filter(..) -- * Helper functions - , filtersString + , filtersPair ) where import Data.Factual.Utils -import Network.HTTP.Base (urlEncode) -- | A Field is a String representation of the field name. type Field = String @@ -29,6 +28,11 @@ | NotBeginsWithAny Field [String] -- ^ A string field must not begin with any of the strings in a list. | IsBlank Field -- ^ A field must be blank. | IsNotBlank Field -- ^ A field must not be blank. + | GreaterThan Field Double -- ^ A field must be greater than the given value. + | GreaterThanOrEqualTo Field Double -- ^ A field must be greater than or equal to the given value. + | LessThan Field Double -- ^ A field must be less than the given value. + | LessThanOrEqualTo Field Double -- ^ A field must be less than or equal to the given value. + | SearchFilter Field String -- ^ A field must match of full text search with the given string. | And [Filter] -- ^ Form an AND condition with the filters in the list. | Or [Filter] -- ^ Form an OR condition with the filters in the list. deriving Eq @@ -49,13 +53,18 @@ show (NotBeginsWithAny field strs) = (show field) ++ ":{" ++ (show "$nbwin") ++ ":[" ++ (join "," $ map show strs) ++ "]}" show (IsBlank field) = (show field) ++ ":{\"$blank\":true}" show (IsNotBlank field) = (show field) ++ ":{\"$blank\":false}" + show (GreaterThan field num) = (show field) ++ ":{" ++ (show "$gt") ++ ":" ++ (show num) ++ "}" + show (GreaterThanOrEqualTo field num) = (show field) ++ ":{" ++ (show "$gte") ++ ":" ++ (show num) ++ "}" + show (LessThan field num) = (show field) ++ ":{" ++ (show "$lt") ++ ":" ++ (show num) ++ "}" + show (LessThanOrEqualTo field num) = (show field) ++ ":{" ++ (show "$lte") ++ ":" ++ (show num) ++ "}" + show (SearchFilter field str) = (show field) ++ ":{" ++ (show "$search") ++ ":" ++ (show str) ++ "}" show (And filters) = (show "$and") ++ ":[" ++ (join "," $ map showFilter filters) ++ "]" show (Or filters) = (show "$or") ++ ":[" ++ (join "," $ map showFilter filters) ++ "]" --- The following helper functions are used in generating query Strings. +-- The following helper functions are used in generating query params. showFilter :: Filter -> String showFilter filter = "{" ++ (show filter) ++ "}" -filtersString :: [Filter] -> String -filtersString [] = "" -filtersString fs = "filters=" ++ urlEncode ("{" ++ (join "," $ map show fs) ++ "}") +filtersPair :: [Filter] -> (String, String) +filtersPair [] = ("filters", "") +filtersPair fs = ("filters", "{" ++ (join "," $ map show fs) ++ "}") diff --git a/Data/Factual/Shared/Geo.hs b/Data/Factual/Shared/Geo.hs --- a/Data/Factual/Shared/Geo.hs +++ b/Data/Factual/Shared/Geo.hs @@ -7,11 +7,9 @@ , Radius , Geo(..) -- * Helper functions - , geoString + , geoPair ) where -import Network.HTTP.Base (urlEncode) - -- | A Lat is the latitude represented as a Double. type Lat = Double -- | A Long is the longitude represented as a Double. @@ -26,7 +24,7 @@ | Point Lat Long deriving Eq --- Geo is a member of Show to help generate query strings. +-- Geo is a member of Show to help generate query params. instance Show Geo where show (Circle lat long radius) = "{\"$circle\":{\"$center\":[" ++ (show lat) @@ -42,6 +40,6 @@ ++ "]}" -- Helper functions -geoString :: Maybe Geo -> String -geoString (Just g) = "geo=" ++ (urlEncode $ show g) -geoString Nothing = "" +geoPair :: Maybe Geo -> (String, String) +geoPair (Just g) = ("geo", show g) +geoPair Nothing = ("geo", "") diff --git a/Data/Factual/Shared/Search.hs b/Data/Factual/Shared/Search.hs --- a/Data/Factual/Shared/Search.hs +++ b/Data/Factual/Shared/Search.hs @@ -4,24 +4,21 @@ -- * Search type Search(..) -- * Helper functions - , searchString + , searchPair ) where import Data.Factual.Utils -import Network.HTTP.Base (urlEncode) -- | This type is used to construct an ANDed or ORed search in a query. data Search = AndSearch [String] | OrSearch [String] | NoSearch deriving Eq -- When a Search is shown it displays the string representation that will go --- into the query string. +-- into the query params. instance Show Search where show (AndSearch terms) = join " " terms show (OrSearch terms) = join "," terms show NoSearch = "" -- Helper functions -searchString :: Search -> String -searchString (AndSearch []) = "" -searchString (OrSearch []) = "" -searchString search = "q=" ++ (urlEncode $ show search) +searchPair :: Search -> (String, String) +searchPair search = ("q", show search) diff --git a/Data/Factual/Shared/SortOrder.hs b/Data/Factual/Shared/SortOrder.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Shared/SortOrder.hs @@ -0,0 +1,23 @@ +-- | This module exports the SortOrder type used to create read and facet queries. +module Data.Factual.Shared.SortOrder + ( + -- * SortOrder type + SortOrder(..) + -- * Helper functions + , sortPair + ) where + +import Data.Factual.Utils + +-- | The SortOrder type is used to represent sorting parameters +data SortOrder = Asc String | Desc String deriving Eq + +-- SortOrder is a member of Show to help generate query strings. +instance Show SortOrder where + show (Asc field) = field ++ ":asc" + show (Desc field) = field ++ ":desc" + +-- The following helper function is used in generating query params. +sortPair :: [SortOrder] -> (String, String) +sortPair [] = ("sort", "") +sortPair sorts = ("sort", join "," $ map show sorts) diff --git a/Data/Factual/Utils.hs b/Data/Factual/Utils.hs --- a/Data/Factual/Utils.hs +++ b/Data/Factual/Utils.hs @@ -3,14 +3,13 @@ ( -- * Utility methods join - , joinAndFilter - , selectString - , limitString - , includeCountString + , selectPair + , limitPair + , includeCountPair ) where import Data.List (intersperse) -import Network.HTTP.Base (urlEncode) +import qualified Data.Map as M -- | The join function joins a list of lists into a list using a separator list. -- The most common use case is for joining Strings with a common separator @@ -18,20 +17,14 @@ join :: [a] -> [[a]] -> [a] join delim xs = concat (intersperse delim xs) --- | This function filters out empty Strings from a list before joining the --- Strings with an & character. The use case is forming query path Strings. -joinAndFilter :: [String] -> String -joinAndFilter strs = join "&" $ filter ("" /=) strs - --- The following helper functions are used in generating query Strings. -selectString :: [String] -> String -selectString [] = "" -selectString selects = "select=" ++ (urlEncode $ (join "," selects)) +-- The following helper functions are used in generating query params Maps. +selectPair :: [String] -> (String, String) +selectPair selects = ("select", join "," selects) -limitString :: Maybe Int -> String -limitString (Just x) = "limit=" ++ (urlEncode $ show x) -limitString Nothing = "" +limitPair :: Maybe Int -> (String, String) +limitPair (Just x) = ("limit", show x) +limitPair Nothing = ("limit", "") -includeCountString :: Bool -> String -includeCountString True = "include_count=true" -includeCountString False = "include_count=false" +includeCountPair :: Bool -> (String, String) +includeCountPair True = ("include_count", "true") +includeCountPair False = ("include_count", "false") diff --git a/Data/Factual/Write.hs b/Data/Factual/Write.hs --- a/Data/Factual/Write.hs +++ b/Data/Factual/Write.hs @@ -1,12 +1,16 @@ -- | This module exports the definition of the Write typeclass. module Data.Factual.Write ( - -- * Query typeclass + -- * Write typeclass Write(..)) where --- | A member of the Write typeclass must define a url method which returns --- the write url as a string and a body method which returns of the body --- of the write. +import qualified Data.Map as M + +-- | A member of the Write typeclass must define a path function which returns +-- the write path as a String, a params function that outputs any addition path +-- params as a Map, and a body function which returns Map of the data passed in +-- the body of the post request. class Write w where - path :: w -> String - body :: w -> String + path :: w -> String + params :: w -> M.Map String String + body :: w -> M.Map String String diff --git a/Data/Factual/Write/Flag.hs b/Data/Factual/Write/Flag.hs --- a/Data/Factual/Write/Flag.hs +++ b/Data/Factual/Write/Flag.hs @@ -13,6 +13,7 @@ import Data.Factual.Shared.Table import Data.Maybe (fromJust) import Data.Factual.Utils +import qualified Data.Map as M -- | A Problem represents what is wrong with the row being flagged data Problem = Duplicate @@ -41,24 +42,25 @@ -- request to the API. instance Write Flag where path flag = (show $ table flag) ++ "/" ++ (factualId flag) ++ "/flag" - body flag = "problem=" ++ (show $ problem flag) ++ "&" ++ - "user=" ++ (user flag) ++ "&" ++ - joinAndFilter [ commentString flag - , debugString flag - , referenceString flag ] + params _ = M.empty + body flag = M.fromList [ ("problem", show $ problem flag) + , ("user", user flag) + , commentPair flag + , debugPair flag + , referencePair flag ] -- The following functions are helpers for the body function -commentString :: Flag -> String -commentString flag - | comment flag == Nothing = "" - | otherwise = "comment=" ++ (fromJust $ comment flag) +commentPair :: Flag -> (String, String) +commentPair flag + | comment flag == Nothing = ("comment", "") + | otherwise = ("comment", fromJust $ comment flag) -debugString :: Flag -> String -debugString flag - | debug flag == True = "debug=true" - | otherwise = "debug=false" +debugPair :: Flag -> (String, String) +debugPair flag + | debug flag == True = ("debug", "true") + | otherwise = ("debug", "false") -referenceString :: Flag -> String -referenceString flag - | reference flag == Nothing = "" - | otherwise = "reference=" ++ (fromJust $ reference flag) +referencePair :: Flag -> (String, String) +referencePair flag + | reference flag == Nothing = ("reference", "") + | otherwise = ("reference", fromJust $ reference flag) diff --git a/Data/Factual/Write/Submit.hs b/Data/Factual/Write/Submit.hs --- a/Data/Factual/Write/Submit.hs +++ b/Data/Factual/Write/Submit.hs @@ -26,9 +26,10 @@ -- The Submit type is a member of the Write typeclass so that it can be -- sent as a post request to the API. instance Write Submit where - path submit = pathString submit - body submit = "user=" ++ (user submit) ++ "&" ++ - "values=" ++ valuesString (values submit) + path submit = pathString submit + params _ = M.empty + body submit = M.fromList [ ("user", user submit) + , ("values", valuesString (values submit)) ] -- The following functions are helpers for the Write typeclass functions. pathString :: Submit -> String diff --git a/Network/Factual/API.hs b/Network/Factual/API.hs --- a/Network/Factual/API.hs +++ b/Network/Factual/API.hs @@ -1,15 +1,16 @@ --- | This module exports functions which are used to execute queries and handle +-- | This module exports functions which are used to execute requests and handle -- the OAuth authentication process. module Network.Factual.API ( -- * Authentication generateToken -- * Read functions - , makeRequest - , makeRawRequest - , makeMultiRequest + , executeQuery + , executeMultiQuery + , get -- * Write functions - , sendWrite + , executeWrite + , post -- * Debug functions , debugQuery , debugWrite @@ -26,78 +27,111 @@ import Network.OAuth.Http.CurlHttpClient (CurlClient(..)) import Data.Aeson (Value, decode) import Data.Factual.Query -import Data.Factual.Write import Data.Factual.Utils +import qualified Data.Factual.Write as W import qualified Data.Map as M import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.Factual.Response as F --- | The Key is the oauth key as a String. -type Key = String --- | The Secret is the oauth secret as a String. +-- | Key and Secret are both Strings used to create a Token +type Key = String type Secret = String +-- | Path, Params and Body are types passed to the get and post functions +type Path = String +type Params = M.Map String String +type Body = M.Map String String --- | This function takes a set of credentials and returns an OAuth token that --- can be used to make requests. +-- | This function takes a Key and Secret, and generates a Token that is passed +-- to the various methods used to make requests. generateToken :: Key -> Secret -> Token generateToken key secret = fromApplication $ Application key secret OOB --- | This function takes an OAuth token and a query (which is member of the --- Query typeclass) and returns an IO action which will fetch a response from --- the Factual API. -makeRequest :: (Query query) => Token -> query -> IO F.Response -makeRequest token query = makeRawRequest token (toPath query) - --- | This function can be used to make raw read requests for any path. You pass --- in your Token and the path of your request (e.g. \"\/t\/places?q=starbucks\") -makeRawRequest :: Token -> String -> IO F.Response -makeRawRequest token queryString = do - response <- makeRawRequest' token queryString - return $ F.fromValue $ extractJSON response - --- | This function can be used to make multi queries. You pass in a Map of Strings --- to queries and a single query is made to the API. The result is a Map of the --- same keys to regular response values. -makeMultiRequest :: (Query query) => Token -> M.Map String query -> IO (M.Map String F.Response) -makeMultiRequest token mult = do - let queryString = multiQueryString $ M.toList mult - response <- makeRawRequest' token queryString - return $ formMultiResponse response $ M.keys mult +-- | This function takes a Token and Query value and sends the query to the +-- Factual API. The resultant IO action contains a Response value which wraps +-- the resultant data. +executeQuery :: (Query query) => Token -> query -> IO F.Response +executeQuery token query = get token (path query) (params query) --- | This function takes an OAuth token and a Write and retunrs and IO action --- which sends the Write to API and returns a Response. -sendWrite :: (Write write) => Token -> write -> IO Response -sendWrite token write = do - let fullpath = basePath ++ path write - let request = generatePostRequest fullpath (body write) - makeRequest' token request +-- | This function can be used to make a Multi Query (multiple queries in a single +-- request. It takes a Token, a Map of key Strings to Queries and returns a Map +-- from the same keys to Response values. +executeMultiQuery :: (Query query) => Token -> M.Map String query -> IO (M.Map String F.Response) +executeMultiQuery token multiMap = do + let queryString = formMultiQueryString $ M.toList multiMap + response <- get'' token queryString + return $ formMultiResponse response $ M.keys multiMap --- | This function takes a query and prints out the path for debugging purposes +-- | This function can be used to debug Queries. It takes a Query value and prints +-- out the URL path generated by that query. debugQuery :: (Query query) => query -> IO () -debugQuery query = putStrLn ("Query path: " ++ basePath ++ toPath query) +debugQuery query = putStrLn $ "Query path: " ++ basePath ++ (formQueryString (path query) (params query)) --- | This function takes a write and prints out the path and body for debugging --- purposes. -debugWrite :: (Write write) => write -> IO () +-- | This function is used to execute Writes. The function takes a Token and a +-- Write value, and returns a Response value. +executeWrite :: (W.Write write) => Token -> write -> IO F.Response +executeWrite token write = post token (W.path write) (W.params write) (W.body write) + +-- | This function can be used to debug Writes. It takes a Write value and prints +-- out the URL path, and post body generated by that write. +debugWrite :: (W.Write write) => write -> IO () debugWrite write = do - putStrLn ("Write path: " ++ basePath ++ path write) + putStrLn ("Write path: " ++ basePath ++ W.path write) putStrLn "Write body:" - putStrLn $ body write + putStrLn $ formParamsString $ W.body write +-- | This function can be used to perform raw read queries to any API endpoint. +-- It takes a Token, a Path string and a Map of params (both keys and values +-- are strings). The function returns a standard Response value. +get :: Token -> Path -> Params -> IO F.Response +get token path params = get' token (formQueryString path params) + +-- | This function can be used to perform raw post queries to any API endpoint. +-- It takes a Token, a Path string, a Map of params and a body Map. Both Maps +-- have String keys and values. The function returns a standard Response value. +post :: Token -> Path -> Params -> Body -> IO F.Response +post token path params body = post' token queryString bodyString + where queryString = formQueryString path params + bodyString = formParamsString body + -- The following helper functions aid the exported API functions -makeRawRequest' :: Token -> String -> IO Response -makeRawRequest' token queryString = do - let fullpath = basePath ++ queryString - let request = generateRequest fullpath - makeRequest' token request +get' :: Token -> String -> IO F.Response +get' token queryString = do + response <- get'' token queryString + return $ F.fromValue $ extractJSON response -makeRequest' :: Token -> Request -> IO Response -makeRequest' token request = runOAuthM token $ setupOAuth request +get'' :: Token -> String -> IO Response +get'' token queryString = do + let fullPath = basePath ++ queryString + let request = generateRequest fullPath + execute token request -multiQueryString :: (Query query) => [(String, query)] -> String -multiQueryString ps = "/multi?queries=" ++ (urlEncode $ "{" ++ (join "," $ map queryPair ps) ++ "}") - where queryPair (n,q) = "\"" ++ n ++ "\":\"" ++ toPath q ++ "\"" +post' :: Token -> String -> String -> IO F.Response +post' token queryString bodyString = do + let fullPath = basePath ++ queryString + let request = generatePostRequest fullPath bodyString + response <- execute token request + return $ F.fromValue $ extractJSON response +execute :: Token -> Request -> IO Response +execute token request = runOAuthM token $ setupOAuth request + +formQueryString :: String -> M.Map String String -> String +formQueryString path params = path ++ "?" ++ (formParamsString params) + +formParamsString :: M.Map String String -> String +formParamsString params = formParamsString' $ M.toList params + +formParamsString' :: [(String, String)] -> String +formParamsString' paramList = join "&" $ map formParamParts filteredParams + where filteredParams = filter (\(k,v) -> "" /= v) paramList + +formParamParts :: (String, String) -> String +formParamParts (key, value) = key ++ "=" ++ (urlEncode value) + +formMultiQueryString :: (Query query) => [(String, query)] -> String +formMultiQueryString ps = "/multi?queries=" ++ (urlEncode $ "{" ++ (join "," $ map queryPair ps) ++ "}") + where queryPair (n,q) = "\"" ++ n ++ "\":\"" ++ (formQueryString (path q) (params q)) ++ "\"" + formMultiResponse :: Response -> [String] -> M.Map String F.Response formMultiResponse res ks = M.fromList $ map formPair ks where formPair k = (k, F.fromValue $ F.lookupValue k json) @@ -107,10 +141,11 @@ generateRequest url = (fromJust $ parseURL url) { reqHeaders = (fromList headersList) } generatePostRequest :: String -> String -> Request -generatePostRequest url body = baseRequest { reqHeaders = (fromList headersList) +generatePostRequest url body = baseRequest { reqHeaders = (fromList postHeaders) , method = POST , reqPayload = B.pack body } where baseRequest = (fromJust $ parseURL url) + postHeaders = headersList ++ [("Content-Type", "application/x-www-form-urlencoded")] setupOAuth :: Request -> OAuthMonadT IO Response setupOAuth request = do @@ -121,7 +156,7 @@ extractJSON = fromJust . decode . rspPayload headersList :: [(String, String)] -headersList = [("X-Factual-Lib", "factual-haskell-driver-0.4.0")] +headersList = [("X-Factual-Lib", "factual-haskell-driver-0.5.0")] basePath :: String basePath = "http://api.v3.factual.com" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -20,7 +20,9 @@ * Geocode Queries * Geopulse Queries * Resolve Queries +* Match Queries * Schema Queries +* Diffs Queries * Multi Queries * Raw Read Queries * Parametric Search @@ -56,16 +58,19 @@ can always run the unit tests: *Main> runUnitTests - Cases: 43 Tried: 43 Errors: 0 Failures: 0 - Counts {cases = 43, tried = 43, errors = 0, failures = 0} + Cases: 51 Tried: 51 Errors: 0 Failures: 0 + Counts {cases = 51, tried = 51, errors = 0, failures = 0} *Main> runIntegrationTests "mykey" "mysecret" - Cases: 9 Tried: 9 Errors: 0 Failures: 0 - Counts {cases = 9, tried = 9, errors = 0, failures = 0} + Cases: 10 Tried: 10 Errors: 0 Failures: 0 + Counts {cases = 10, tried = 10, errors = 0, failures = 0} # Documentation You can read library documentation by opening docs/index.html in your browser or by visiting the [Hackage page](http://hackage.haskell.org/package/factual-api). + +The [github wiki](https://github.com/rudyl313/factual-haskell-driver/wiki) also +provides thorough documentation and examples for each feature. # Examples diff --git a/examples/DiffsExample.hs b/examples/DiffsExample.hs new file mode 100644 --- /dev/null +++ b/examples/DiffsExample.hs @@ -0,0 +1,18 @@ +module Main where + +import System.Environment (getArgs) +import Network.Factual.API +import Data.Factual.Query.DiffsQuery +import Data.Factual.Response + +main :: IO() +main = do + args <- getArgs + let oauthKey = head args + let oauthSecret = last args + let token = generateToken oauthKey oauthSecret + let query = DiffsQuery { table = Custom "canada-stable", start = 1339123455775, end = 1339124455775 } + result <- executeQuery token query + putStrLn $ "Status: " ++ status result + putStrLn $ "Version: " ++ show (version result) + putStrLn $ "Data: " ++ show (response result) diff --git a/examples/FacetsExample.hs b/examples/FacetsExample.hs --- a/examples/FacetsExample.hs +++ b/examples/FacetsExample.hs @@ -19,7 +19,7 @@ , limit = Nothing , minCount = Nothing , includeCount = False } - result <- makeRequest token query + result <- executeQuery token query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/GeocodeExample.hs b/examples/GeocodeExample.hs --- a/examples/GeocodeExample.hs +++ b/examples/GeocodeExample.hs @@ -12,7 +12,7 @@ let oauthSecret = last args let token = generateToken oauthKey oauthSecret let query = GeocodeQuery $ Point 34.06021 (-118.41828) - result <- makeRequest token query + result <- executeQuery token query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/GeopulseExample.hs b/examples/GeopulseExample.hs --- a/examples/GeopulseExample.hs +++ b/examples/GeopulseExample.hs @@ -13,7 +13,7 @@ let token = generateToken oauthKey oauthSecret let query = GeopulseQuery { geo = Point 34.06021 (-118.41828) , select = ["commercial_density"] } - result <- makeRequest token query + result <- executeQuery token query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/MatchExample.hs b/examples/MatchExample.hs new file mode 100644 --- /dev/null +++ b/examples/MatchExample.hs @@ -0,0 +1,19 @@ +module Main where + +import System.Environment (getArgs) +import Network.Factual.API +import Data.Factual.Query.MatchQuery +import Data.Factual.Response + +main :: IO() +main = do + args <- getArgs + let oauthKey = head args + let oauthSecret = last args + let token = generateToken oauthKey oauthSecret + let query = MatchQuery [ MatchStr "name" "McDonalds" + , MatchStr "address" "10451 Santa Monica Blvd" ] + result <- executeQuery token query + putStrLn $ "Status: " ++ status result + putStrLn $ "Version: " ++ show (version result) + putStrLn $ "Data: " ++ show (response result) diff --git a/examples/MultiExample.hs b/examples/MultiExample.hs --- a/examples/MultiExample.hs +++ b/examples/MultiExample.hs @@ -29,7 +29,7 @@ , geo = Just (Circle 34.06021 (-118.41828) 5000.0) , filters = [EqualStr "name" "Xerox"] } let multiQuery = M.fromList [("query1", query1), ("query2", query2)] - multiResult <- makeMultiRequest token multiQuery + multiResult <- executeMultiQuery token multiQuery let result1 = multiResult M.! "query1" let result2 = multiResult M.! "query2" putStrLn "query1:" diff --git a/examples/RawReadExample.hs b/examples/RawReadExample.hs --- a/examples/RawReadExample.hs +++ b/examples/RawReadExample.hs @@ -3,6 +3,7 @@ import System.Environment (getArgs) import Network.Factual.API import Data.Factual.Response +import qualified Data.Map as M main :: IO() main = do @@ -10,7 +11,7 @@ let oauthKey = head args let oauthSecret = last args let token = generateToken oauthKey oauthSecret - result <- makeRawRequest token "/t/places?q=starbucks" + result <- get token "/t/places" $ M.fromList [("q", "starbucks")] putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/ReadExample.hs b/examples/ReadExample.hs --- a/examples/ReadExample.hs +++ b/examples/ReadExample.hs @@ -18,8 +18,9 @@ , offset = Nothing , includeCount = True , geo = Just (Circle 34.06021 (-118.41828) 5000.0) + , sort = [] , filters = [EqualStr "name" "Stand"] } - result <- makeRequest token query + result <- executeQuery token query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/ResolveExample.hs b/examples/ResolveExample.hs --- a/examples/ResolveExample.hs +++ b/examples/ResolveExample.hs @@ -11,9 +11,11 @@ let oauthKey = head args let oauthSecret = last args let token = generateToken oauthKey oauthSecret - let query = ResolveQuery [ ResolveStr "name" "McDonalds" - , ResolveStr "address" "10451 Santa Monica Blvd" ] - result <- makeRequest token query + let resolveValues = [ ResolveStr "name" "McDonalds" + , ResolveStr "address" "10451 Santa Monica Blvd" ] + let query = ResolveQuery { values = resolveValues + , debug = False } + result <- executeQuery token query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/examples/SchemaExample.hs b/examples/SchemaExample.hs --- a/examples/SchemaExample.hs +++ b/examples/SchemaExample.hs @@ -12,7 +12,7 @@ let oauthSecret = last args let token = generateToken oauthKey oauthSecret let query = SchemaQuery Places - result <- makeRequest token query + result <- executeQuery token query putStrLn $ "Status: " ++ status result putStrLn $ "Version: " ++ show (version result) putStrLn $ "Data: " ++ show (response result) diff --git a/factual-api.cabal b/factual-api.cabal --- a/factual-api.cabal +++ b/factual-api.cabal @@ -1,5 +1,5 @@ name: factual-api -version: 0.4.0 +version: 0.5.0 license: BSD3 license-file: LICENSE.txt category: API, Web @@ -27,9 +27,11 @@ exposed-modules: Network.Factual.API Data.Factual.Query + Data.Factual.Query.DiffsQuery Data.Factual.Query.FacetsQuery Data.Factual.Query.GeocodeQuery Data.Factual.Query.GeopulseQuery + Data.Factual.Query.MatchQuery Data.Factual.Query.ReadQuery Data.Factual.Query.ResolveQuery Data.Factual.Query.SchemaQuery @@ -40,6 +42,7 @@ Data.Factual.Shared.Filter Data.Factual.Shared.Geo Data.Factual.Shared.Search + Data.Factual.Shared.SortOrder Data.Factual.Shared.Table other-modules: diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,11 +1,13 @@ import Test.HUnit import Network.Factual.API -import Data.Factual.Query import Data.Factual.Query.ReadQuery import Data.Factual.Query.SchemaQuery import Data.Factual.Query.ResolveQuery import Data.Factual.Query.GeocodeQuery +import Data.Factual.Query.MatchQuery import Data.Factual.Response +import qualified Data.Factual.Query.DiffsQuery as D +import qualified Data.Factual.Query as Q import qualified Data.Map as M import qualified Data.Factual.Write as W import qualified Data.Factual.Query.FacetsQuery as F @@ -28,13 +30,13 @@ , TestLabel "Crosswalk Products table test" crosswalkProductsTablePathTest , TestLabel "Monetize table test" monetizeTablePathTest , TestLabel "Custom table test" customTablePathTest - , TestLabel "Geopulse test" geopulsePathTest - , TestLabel "Geocode test" geocodePathTest + , TestLabel "Geopulse test" geopulseTest + , TestLabel "Geocode test" geocodeTest , TestLabel "And search test" andSearchPathTest , TestLabel "Or search test" orSearchPathTest - , TestLabel "Select test" selectPathTest - , TestLabel "Limit test" limitPathTest - , TestLabel "Offset test" offsetPathTest + , TestLabel "Select test" selectTest + , TestLabel "Limit test" limitTest + , TestLabel "Offset test" offsetTest , TestLabel "Equal number filter test" equalNumFilterTest , TestLabel "Equal string filter test" equalStrFilterTest , TestLabel "Not equal number filter test" notEqualNumFilterTest @@ -49,13 +51,21 @@ , TestLabel "Not begins with any filter test" notBeginsWithAnyFilterTest , TestLabel "Is blank filter test" isBlankFilterTest , TestLabel "Is not blank filter test" isNotBlankFilterTest + , TestLabel "Greater than number filter test" greaterThanFilterTest + , TestLabel "Greater than or equal to number filter test" greaterThanOrEqualToFilterTest + , TestLabel "Less than number filter test" lessThanFilterTest + , TestLabel "Less than or equal to number filter test" lessThanOrEqualToFilterTest + , TestLabel "Search filter test" searchFilterTest , TestLabel "And filter test" andFilterTest , TestLabel "Or filter test" orFilterTest , TestLabel "Geo test" geoTest + , TestLabel "Sort test" sortTest , TestLabel "Include count test" includeCountTest , TestLabel "Schema query test" schemaQueryTest , TestLabel "Resolve query test" resolveQueryTest + , TestLabel "Match query test" matchQueryTest , TestLabel "Facets test" facetsTest + , TestLabel "Diffs test" diffsTest , TestLabel "Submit path test" submitPathTest , TestLabel "Submit body test" submitBodyTest , TestLabel "Flag path test" flagPathTest @@ -64,225 +74,312 @@ integrationTests key secret = TestList [ TestLabel "Read test" (readIntegrationTest token) , TestLabel "Schema test" (schemaIntegrationTest token) , TestLabel "Resolve test" (resolveIntegrationTest token) + , TestLabel "Match test" (matchIntegrationTest token) , TestLabel "Raw read test" (rawIntegrationTest token) , TestLabel "Facets test" (facetsIntegrationTest token) + --, TestLabel "Diffs test" (diffsIntegrationTest token) , TestLabel "Geopulse test" (geopulseIntegrationTest token) , TestLabel "Geocode test" (geocodeIntegrationTest token) , TestLabel "Multi test" (multiIntegrationTest token) + --, TestLabel "Submit test" (submitIntegrationTest token) + --, TestLabel "Flag test" (flagIntegrationTest token) , TestLabel "Error test" (errorIntegrationTest token) ] where token = generateToken key secret placeTablePathTest = TestCase (do - let expected = "/t/places?include_count=false" - let path = toPath $ blankReadQuery { table = Places } - assertEqual "Correct path for places table" expected path) + let expected = "/t/places" + let queryPath = Q.path $ blankReadQuery { table = Places } + assertEqual "Correct path for places table" expected queryPath) restaurantsTablePathTest = TestCase (do - let expected = "/t/restaurants-us?include_count=false" - let path = toPath $ blankReadQuery { table = RestaurantsUS } - assertEqual "Correct path for us restaurants table" expected path) + let expected = "/t/restaurants-us" + let queryPath = Q.path $ blankReadQuery { table = RestaurantsUS } + assertEqual "Correct path for us restaurants table" expected queryPath) hotelsTablePathTest = TestCase (do - let expected = "/t/hotels-us?include_count=false" - let path = toPath $ blankReadQuery { table = HotelsUS } - assertEqual "Correct path for us hotels table" expected path) + let expected = "/t/hotels-us" + let queryPath = Q.path $ blankReadQuery { table = HotelsUS } + assertEqual "Correct path for us hotels table" expected queryPath) globalTablePathTest = TestCase (do - let expected = "/t/global?include_count=false" - let path = toPath $ blankReadQuery { table = Global } - assertEqual "Correct path for global table" expected path) + let expected = "/t/global" + let queryPath = Q.path $ blankReadQuery { table = Global } + assertEqual "Correct path for global table" expected queryPath) crosswalkTablePathTest = TestCase (do - let expected = "/t/crosswalk?include_count=false" - let path = toPath $ blankReadQuery { table = Crosswalk } - assertEqual "Correct path for crosswalk table" expected path) + let expected = "/t/crosswalk" + let queryPath = Q.path $ blankReadQuery { table = Crosswalk } + assertEqual "Correct path for crosswalk table" expected queryPath) healthcareTablePathTest = TestCase (do - let expected = "/t/health-care-providers-us?include_count=false" - let path = toPath $ blankReadQuery { table = HealthCareProviders } - assertEqual "Correct path for health care providers table" expected path) + let expected = "/t/health-care-providers-us" + let queryPath = Q.path $ blankReadQuery { table = HealthCareProviders } + assertEqual "Correct path for health care providers table" expected queryPath) worldGeographiesTablePathTest = TestCase (do - let expected = "/t/world-geographies?include_count=false" - let path = toPath $ blankReadQuery { table = WorldGeographies } - assertEqual "Correct path for world geographies table" expected path) + let expected = "/t/world-geographies" + let queryPath = Q.path $ blankReadQuery { table = WorldGeographies } + assertEqual "Correct path for world geographies table" expected queryPath) cpgTablePathTest = TestCase (do - let expected = "/t/products-cpg?include_count=false" - let path = toPath $ blankReadQuery { table = ProductsCPG } - assertEqual "Correct path for products CPG table" expected path) + let expected = "/t/products-cpg" + let queryPath = Q.path $ blankReadQuery { table = ProductsCPG } + assertEqual "Correct path for products CPG table" expected queryPath) crosswalkProductsTablePathTest = TestCase (do - let expected = "/t/products-crosswalk?include_count=false" - let path = toPath $ blankReadQuery { table = ProductsCrosswalk } - assertEqual "Correct path for products crosswalk table" expected path) + let expected = "/t/products-crosswalk" + let queryPath = Q.path $ blankReadQuery { table = ProductsCrosswalk } + assertEqual "Correct path for products crosswalk table" expected queryPath) monetizeTablePathTest = TestCase (do - let expected = "/places/monetize?include_count=false" - let path = toPath $ blankReadQuery { table = Monetize } - assertEqual "Correct path for monetize table" expected path) + let expected = "/places/monetize" + let queryPath = Q.path $ blankReadQuery { table = Monetize } + assertEqual "Correct path for monetize table" expected queryPath) customTablePathTest = TestCase (do - let expected = "/t/foo?include_count=false" - let path = toPath $ blankReadQuery { table = Custom "foo" } - assertEqual "Correct path for custom table" expected path) + let expected = "/t/foo" + let queryPath = Q.path $ blankReadQuery { table = Custom "foo" } + assertEqual "Correct path for custom table" expected queryPath) -geopulsePathTest = TestCase (do - let expected = "/places/geopulse?geo=%7B%22%24point%22%3A%5B34.06021%2C-118.41828%5D%7D&select=commercial_density" - let path = toPath $ G.GeopulseQuery { G.geo = Point 34.06021 (-118.41828) , G.select = ["commercial_density"] } - assertEqual "Correct path for geopulse" expected path) +geopulseTest = TestCase (do + let query = G.GeopulseQuery { G.geo = Point 34.06021 (-118.41828) , G.select = ["commercial_density"] } + let queryPath = Q.path query + let queryParams = Q.params query + assertEqual "Correct path for geopulse" queryPath "/places/geopulse" + assertEqual "Correct geo param" (queryParams M.! "geo") "{\"$point\":[34.06021,-118.41828]}" + assertEqual "Correct select param" (queryParams M.! "select") "commercial_density") -geocodePathTest = TestCase (do - let expected = "/places/geocode?geo=%7B%22%24point%22%3A%5B34.06021%2C-118.41828%5D%7D" - let path = toPath $ GeocodeQuery $ Point 34.06021 (-118.41828) - assertEqual "Correct path for geocode" expected path) +geocodeTest = TestCase (do + let query = GeocodeQuery $ Point 34.06021 (-118.41828) + let queryPath = Q.path query + let queryParams = Q.params query + assertEqual "Correct path for geocode" queryPath "/places/geocode" + assertEqual "Correct geo param" (queryParams M.! "geo") "{\"$point\":[34.06021,-118.41828]}") andSearchPathTest = TestCase (do - let expected = "/t/places?q=foo%20bar&include_count=false" - let path = toPath $ blankReadQuery { search = AndSearch ["foo", "bar"] } - assertEqual "Correct path for ANDed search" expected path) + let query = blankReadQuery { search = AndSearch ["foo", "bar"] } + let queryParams = Q.params query + assertEqual "Correct query value" (queryParams M.! "q") "foo bar") orSearchPathTest = TestCase (do - let expected = "/t/places?q=foo%2Cbar&include_count=false" - let path = toPath $ blankReadQuery { search = OrSearch ["foo", "bar"] } - assertEqual "Correct path for ANDed search" expected path) + let query = blankReadQuery { search = OrSearch ["foo", "bar"] } + let queryParams = Q.params query + assertEqual "Correct query value" (queryParams M.! "q") "foo,bar") -selectPathTest = TestCase (do - let expected = "/t/places?select=foo%2Cbar&include_count=false" - let path = toPath $ blankReadQuery { select = ["foo", "bar"] } - assertEqual "Correct path for select terms" expected path) +selectTest = TestCase (do + let query = blankReadQuery { select = ["foo", "bar"] } + let queryParams = Q.params query + assertEqual "Correct select value" (queryParams M.! "select") "foo,bar") -limitPathTest = TestCase (do - let expected = "/t/places?limit=321&include_count=false" - let path = toPath $ blankReadQuery { limit = Just 321 } - assertEqual "Correct path for limit" expected path) +limitTest = TestCase (do + let query = blankReadQuery { limit = Just 321 } + let queryParams = Q.params query + assertEqual "Correct limit value" (queryParams M.! "limit") "321") -offsetPathTest = TestCase (do - let expected = "/t/places?offset=321&include_count=false" - let path = toPath $ blankReadQuery { offset = Just 321 } - assertEqual "Correct path for offset" expected path) +offsetTest = TestCase (do + let query = blankReadQuery { offset = Just 321 } + let queryParams = Q.params query + assertEqual "Correct offset value" (queryParams M.! "offset") "321") equalNumFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A123.4%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [EqualNum "field" 123.4] } - assertEqual "Correct path for equal number filter" expected path) + let query = blankReadQuery { filters = [EqualNum "field" 123.4] } + let queryParams = Q.params query + assertEqual "Correct filters value" (queryParams M.! "filters") "{\"field\":123.4}") equalStrFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%22value%22%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [EqualStr "field" "value"] } - assertEqual "Correct path for equal string filter" expected path) + let query = blankReadQuery { filters = [EqualStr "field" "value"] } + let queryParams = Q.params query + assertEqual "Correct filters value" (queryParams M.! "filters") "{\"field\":\"value\"}") notEqualNumFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24neq%22%3A123.4%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [NotEqualNum "field" 123.4] } - assertEqual "Correct path for not equal number filter" expected path) + let query = blankReadQuery { filters = [NotEqualNum "field" 123.4] } + let queryParams = Q.params query + assertEqual "Correct filters value" (queryParams M.! "filters") "{\"field\":{\"$neq\":123.4}}") notEqualStrFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24neq%22%3A%22value%22%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [NotEqualStr "field" "value"] } - assertEqual "Correct path for not equal string filter" expected path) + let query = blankReadQuery { filters = [NotEqualStr "field" "value"] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$neq\":\"value\"}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) inNumListFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24in%22%3A%5B123.4%2C5432.1%5D%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [InNumList "field" [123.4, 5432.1]] } - assertEqual "Correct path for in number list filter" expected path) + let query = blankReadQuery { filters = [InNumList "field" [123.4, 5432.1]] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$in\":[123.4,5432.1]}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) inStrListFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24in%22%3A%5B%22value%22%2C%22other%22%5D%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [InStrList "field" ["value","other"]] } - assertEqual "Correct path for in string list filter" expected path) + let query = blankReadQuery { filters = [InStrList "field" ["value","other"]] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$in\":[\"value\",\"other\"]}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) notInNumListFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24nin%22%3A%5B123.4%2C5432.1%5D%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [NotInNumList "field" [123.4, 5432.1]] } - assertEqual "Correct path for not in number list filter" expected path) + let query = blankReadQuery { filters = [NotInNumList "field" [123.4, 5432.1]] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$nin\":[123.4,5432.1]}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) notInStrListFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24nin%22%3A%5B%22value%22%2C%22other%22%5D%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [NotInStrList "field" ["value","other"]] } - assertEqual "Correct path for not in string list filter" expected path) + let query = blankReadQuery { filters = [NotInStrList "field" ["value","other"]] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$nin\":[\"value\",\"other\"]}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) beginsWithFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24bw%22%3A%22val%22%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [BeginsWith "field" "val"] } - assertEqual "Correct path for begins with filter" expected path) + let query = blankReadQuery { filters = [BeginsWith "field" "val"] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$bw\":\"val\"}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) notBeginsWithFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24nbw%22%3A%22val%22%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [NotBeginsWith "field" "val"] } - assertEqual "Correct path for not begins with filter" expected path) + let query = blankReadQuery { filters = [NotBeginsWith "field" "val"] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$nbw\":\"val\"}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) beginsWithAnyFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24bwin%22%3A%5B%22val%22%2C%22ot%22%5D%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [BeginsWithAny "field" ["val","ot"]] } - assertEqual "Correct path for begins with any filter" expected path) + let query = blankReadQuery { filters = [BeginsWithAny "field" ["val","ot"]] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$bwin\":[\"val\",\"ot\"]}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) notBeginsWithAnyFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24nbwin%22%3A%5B%22val%22%2C%22ot%22%5D%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [NotBeginsWithAny "field" ["val","ot"]] } - assertEqual "Correct path for not begins with any filter" expected path) + let query = blankReadQuery { filters = [NotBeginsWithAny "field" ["val","ot"]] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$nbwin\":[\"val\",\"ot\"]}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) isBlankFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24blank%22%3Atrue%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [IsBlank "field"] } - assertEqual "Correct path for is blank filter" expected path) + let query = blankReadQuery { filters = [IsBlank "field"] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$blank\":true}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) isNotBlankFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22field%22%3A%7B%22%24blank%22%3Afalse%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [IsNotBlank "field"] } - assertEqual "Correct path for is not blank filter" expected path) + let query = blankReadQuery { filters = [IsNotBlank "field"] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$blank\":false}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) +greaterThanFilterTest = TestCase (do + let query = blankReadQuery { filters = [GreaterThan "field" 10.0] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$gt\":10.0}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) + +greaterThanOrEqualToFilterTest = TestCase (do + let query = blankReadQuery { filters = [GreaterThanOrEqualTo "field" 10.0] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$gte\":10.0}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) + +lessThanFilterTest = TestCase (do + let query = blankReadQuery { filters = [LessThan "field" 10.0] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$lt\":10.0}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) + +lessThanOrEqualToFilterTest = TestCase (do + let query = blankReadQuery { filters = [LessThanOrEqualTo "field" 10.0] } + let queryParams = Q.params query + let expected = "{\"field\":{\"$lte\":10.0}}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) + +searchFilterTest = TestCase (do + let query = blankReadQuery { filters = [SearchFilter "field" "value"] } + let queryParams = Q.params query + assertEqual "Correct filters value" (queryParams M.! "filters") "{\"field\":{\"$search\":\"value\"}}") + andFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22%24and%22%3A%5B%7B%22field1%22%3A%7B%22%24blank%22%3Atrue%7D%7D%2C%7B%22field2%22%3A%7B%22%24blank%22%3Afalse%7D%7D%5D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [And [IsBlank "field1", IsNotBlank "field2"]] } - assertEqual "Correct path for and filter" expected path) + let query = blankReadQuery { filters = [And [IsBlank "field1", IsNotBlank "field2"]] } + let queryParams = Q.params query + let expected = "{\"$and\":[{\"field1\":{\"$blank\":true}},{\"field2\":{\"$blank\":false}}]}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) orFilterTest = TestCase (do - let expected = "/t/places?filters=%7B%22%24or%22%3A%5B%7B%22field1%22%3A%7B%22%24blank%22%3Atrue%7D%7D%2C%7B%22field2%22%3A%7B%22%24blank%22%3Afalse%7D%7D%5D%7D&include_count=false" - let path = toPath $ blankReadQuery { filters = [Or [IsBlank "field1", IsNotBlank "field2"]] } - assertEqual "Correct path for or filter" expected path) + let query = blankReadQuery { filters = [Or [IsBlank "field1", IsNotBlank "field2"]] } + let queryParams = Q.params query + let expected = "{\"$or\":[{\"field1\":{\"$blank\":true}},{\"field2\":{\"$blank\":false}}]}" + assertEqual "Correct filters value" (queryParams M.! "filters") expected) geoTest = TestCase (do - let expected = "/t/places?geo=%7B%22%24circle%22%3A%7B%22%24center%22%3A%5B300.1%2C%20200.3%5D%2C%22%24meters%22%3A100.5%7D%7D&include_count=false" - let path = toPath $ blankReadQuery { geo = Just (Circle 300.1 200.3 100.5) } - assertEqual "Correct path for geo" expected path) + let query = blankReadQuery { geo = Just (Circle 300.1 200.3 100.5) } + let queryParams = Q.params query + let expected = "{\"$circle\":{\"$center\":[300.1, 200.3],\"$meters\":100.5}}" + assertEqual "Correct geo value" (queryParams M.! "geo") expected) +sortTest = TestCase (do + let query = blankReadQuery { sort = [Asc "name", Desc "country"] } + let queryParams = Q.params query + let expected = "name:asc,country:desc" + assertEqual "Correct sort value" (queryParams M.! "sort") expected) + includeCountTest = TestCase (do - let expected = "/t/places?include_count=true" - let path = toPath $ blankReadQuery { includeCount = True } - assertEqual "Correct path for include count" expected path) + let query = blankReadQuery { includeCount = True } + let queryParams = Q.params query + assertEqual "Correct include_count value" (queryParams M.! "include_count") "true") schemaQueryTest = TestCase (do + let queryPath = Q.path $ SchemaQuery Places let expected = "/t/places/schema" - let path = toPath $ SchemaQuery Places - assertEqual "Correct path for a schema query" expected path) + assertEqual "Correct path for a schema query" queryPath expected) resolveQueryTest = TestCase (do - let expected = "/places/resolve?values=%7B%22field1%22%3A%22value1%22%2C%22field2%22%3A32.1%7D" - let path = toPath $ ResolveQuery [ResolveStr "field1" "value1", ResolveNum "field2" 32.1] - assertEqual "Correct path for a resolve query" expected path) + let query = ResolveQuery { values = [ResolveStr "field1" "value1", ResolveNum "field2" 32.1], + debug = False } + let queryPath = Q.path query + let queryParams = Q.params query + let expectedValues = "{\"field1\":\"value1\",\"field2\":32.1}" + assertEqual "Correct path" queryPath "/places/resolve" + assertEqual "Correct values" (queryParams M.! "values") expectedValues + assertEqual "Correct debug" (queryParams M.! "debug") "false") +matchQueryTest = TestCase (do + let query = MatchQuery [MatchStr "field1" "value1", MatchNum "field2" 32.1] + let queryPath = Q.path query + let queryParams = Q.params query + let expectedValues = "{\"field1\":\"value1\",\"field2\":32.1}" + assertEqual "Correct path" queryPath "/places/match" + assertEqual "Correct values" (queryParams M.! "values") expectedValues) + facetsTest = TestCase (do - let expected = "/t/places/facets?q=starbucks&select=locality%2Cregion&filters=%7B%22country%22%3A%22US%22%7D&limit=10&min_count=2&include_count=false" - let path = toPath $ F.FacetsQuery { F.table = Places - , F.search = AndSearch ["starbucks"] - , F.select = ["locality", "region"] - , F.filters = [EqualStr "country" "US"] - , F.geo = Nothing - , F.limit = Just 10 - , F.minCount = Just 2 - , F.includeCount = False } - assertEqual "Correct path for a facets query" expected path) + let query = F.FacetsQuery { F.table = Places + , F.search = AndSearch ["starbucks"] + , F.select = ["locality", "region"] + , F.filters = [EqualStr "country" "US"] + , F.geo = Nothing + , F.limit = Just 10 + , F.minCount = Just 2 + , F.includeCount = False } + let queryPath = Q.path query + let queryParams = Q.params query + assertEqual "Correct path for a facets query" queryPath "/t/places/facets" + assertEqual "Correct q" (queryParams M.! "q") "starbucks" + assertEqual "Correct select" (queryParams M.! "select") "locality,region" + assertEqual "Correct filters" (queryParams M.! "filters") "{\"country\":\"US\"}" + assertEqual "Correct limit" (queryParams M.! "limit") "10" + assertEqual "Correct min count" (queryParams M.! "min_count") "2" + assertEqual "Correct include count" (queryParams M.! "include_count") "false") +diffsTest = TestCase (do + let query = D.DiffsQuery { D.table = Places, D.start = 1318890505254, D.end = 1318890516892 } + let queryPath = Q.path query + let queryParams = Q.params query + assertEqual "Correct path for a diffs query" queryPath "/t/places/diffs" + assertEqual "Correct start" (queryParams M.! "start") "1318890505254" + assertEqual "Correct end" (queryParams M.! "end") "1318890516892") + submitPathTest = TestCase (do let expected = "/t/places/foobar/submit" - let path = W.path submitWrite - assertEqual "Correct path for submit" expected path) + let writePath = W.path submitWrite + assertEqual "Correct path for submit" expected writePath) submitBodyTest = TestCase (do let expected = "user=user123&values={\"key\":\"val\"}" - let body = W.body submitWrite - assertEqual "Correct body for submit" expected body) + let bodyParams = W.body submitWrite + assertEqual "Correct user" (bodyParams M.! "user") "user123" + assertEqual "Correct values" (bodyParams M.! "values") "{\"key\":\"val\"}") flagPathTest = TestCase (do let expected = "/t/places/foobar/flag" @@ -291,9 +388,13 @@ flagBodyTest = TestCase (do let expected = "problem=Duplicate&user=user123&comment=There was a problem&debug=false" - let body = W.body flagWrite - assertEqual "Correct body for flag" expected body) + let bodyParams = W.body flagWrite + assertEqual "Correct problem" (bodyParams M.! "problem") "Duplicate" + assertEqual "Correct user" (bodyParams M.! "user") "user123" + assertEqual "Correct comment" (bodyParams M.! "comment") "There was a problem" + assertEqual "Correct debug" (bodyParams M.! "debug") "false") + readIntegrationTest :: Token -> Test readIntegrationTest token = TestCase (do let query = ReadQuery { table = Places @@ -303,25 +404,33 @@ , offset = Just 10 , includeCount = True , geo = Just (Circle 34.06021 (-118.41828) 5000.0) + , sort = [] , filters = [EqualStr "name" "Stand"] } - result <- makeRequest token query + result <- executeQuery token query assertEqual "Valid read query" "ok" (status result)) schemaIntegrationTest :: Token -> Test schemaIntegrationTest token = TestCase (do let query = SchemaQuery Places - result <- makeRequest token query + result <- executeQuery token query assertEqual "Valid schema query" "ok" (status result)) resolveIntegrationTest :: Token -> Test resolveIntegrationTest token = TestCase (do - let query = ResolveQuery [ResolveStr "name" "McDonalds"] - result <- makeRequest token query + let query = ResolveQuery { values = [ResolveStr "name" "McDonalds"], + debug = False } + result <- executeQuery token query assertEqual "Valid resolve query" "ok" (status result)) +matchIntegrationTest :: Token -> Test +matchIntegrationTest token = TestCase (do + let query = MatchQuery [MatchStr "name" "McDonalds"] + result <- executeQuery token query + assertEqual "Valid match query" "ok" (status result)) + rawIntegrationTest :: Token -> Test rawIntegrationTest token = TestCase (do - result <- makeRawRequest token "/t/places?q=starbucks" + result <- get token "/t/places" (M.fromList [("q", "starbucks")]) assertEqual "Valid read query" "ok" (status result)) facetsIntegrationTest token = TestCase (do @@ -333,18 +442,23 @@ , F.limit = Just 100 , F.minCount = Just 1 , F.includeCount = False } - result <- makeRequest token query + result <- executeQuery token query assertEqual "Valid facets query" "ok" (status result)) +diffsIntegrationTest token = TestCase (do + let query = D.DiffsQuery { D.table = Custom "canada-stable", D.start = 1339123455775, D.end = 1339124455775 } + result <- executeQuery token query + assertEqual "Valid diffs query" "ok" (status result)) + geopulseIntegrationTest token = TestCase (do let query = G.GeopulseQuery { G.geo = Point 34.06021 (-118.41828) , G.select = [] } - result <- makeRequest token query + result <- executeQuery token query assertEqual "Valid geopulse query" "ok" (status result)) geocodeIntegrationTest token = TestCase (do let query = GeocodeQuery $ Point 34.06021 (-118.41828) - result <- makeRequest token query + result <- executeQuery token query assertEqual "Valid geopulse query" "ok" (status result)) @@ -357,16 +471,42 @@ , offset = Just 10 , includeCount = True , geo = Just (Circle 34.06021 (-118.41828) 5000.0) + , sort = [] , filters = [EqualStr "name" "Stand"] } let query2 = query1 { filters = [EqualStr "name" "Xerox"] } - results <- makeMultiRequest token $ M.fromList [("query1", query1), ("query2", query2)] + results <- executeMultiQuery token $ M.fromList [("query1", query1), ("query2", query2)] let result1 = results M.! "query1" let result2 = results M.! "query2" assertEqual "Valid multi query" ["ok","ok"] [status result1, status result2]) +submitIntegrationTest :: Token -> Test +submitIntegrationTest token = TestCase (do + let newValues = M.fromList [ ("name","Factual") + , ("address","1801 Avenue of the Stars, Suite 1450") + , ("country","USA") + , ("locality","Los Angeles") ] + let write = S.Submit { S.table = Custom "canada-edge" + , S.user = "drivertest" + , S.factualId = Nothing + , S.values = newValues } + result <- executeWrite token write + assertEqual "Valid submit" "ok" (status result)) + +flagIntegrationTest :: Token -> Test +flagIntegrationTest token = TestCase (do + let write = L.Flag { L.table = Custom "canada-edge" + , L.user = "drivertest" + , L.factualId = "f33527e0-a8b4-4808-a820-2686f18cb00c" + , L.problem = L.Inaccurate + , L.comment = Nothing + , L.debug = False + , L.reference = Nothing } + result <- executeWrite token write + assertEqual "Valid flag" "ok" (status result)) + errorIntegrationTest :: Token -> Test errorIntegrationTest token = TestCase (do - result <- makeRawRequest token "/t/foobarbaz" + result <- get token "/t/foobarbaz" (M.empty) assertEqual "Invalud read query" "error" (status result)) blankReadQuery :: ReadQuery @@ -377,6 +517,7 @@ , offset = Nothing , filters = [] , geo = Nothing + , sort = [] , includeCount = False } submitWrite :: S.Submit