diff --git a/Data/Factual/Credentials.hs b/Data/Factual/Credentials.hs deleted file mode 100644 --- a/Data/Factual/Credentials.hs +++ /dev/null @@ -1,18 +0,0 @@ --- | This module contains a simple definition of the credentials type which is --- used to perform submit queries to the Factual API. - -module Data.Factual.Credentials - ( - -- * Credentials type - Credentials(..) - , Key - , Secret - ) where - --- | The Key is the oauth key as a String. -type Key = String --- | The Secret is the oauth secret as a String. -type Secret = String - --- | A Credentials value is used to generate a Token. -data Credentials = Credentials Key Secret diff --git a/Data/Factual/CrosswalkQuery.hs b/Data/Factual/CrosswalkQuery.hs deleted file mode 100644 --- a/Data/Factual/CrosswalkQuery.hs +++ /dev/null @@ -1,52 +0,0 @@ --- | This module exports the type used to create crosswalk queries. -module Data.Factual.CrosswalkQuery - ( - -- * CrosswalkQuery type - CrosswalkQuery(..) - ) where - -import Data.Factual.Query -import Data.Factual.Utils - --- | A crosswalk query can be formed by specifying a factual id and --- (optionally) a list of namespaces to only include when attempting to find --- the ids for various namespaces, or by specifying a namespace and namespace --- id in order to find the factual id. An optional limit can be set as well. -data CrosswalkQuery = CrosswalkQuery { factualId :: Maybe String - , limit :: Maybe Int - , namespace :: Maybe String - , namespaceId :: Maybe String - , only :: [String] - } deriving (Eq, Show) - --- A crosswalk query is a member of the Query typeclass so it can generate a --- path to be queried. -instance Query CrosswalkQuery where - toPath query = "/places/crosswalk?" - ++ joinAndFilter [ factualIdString $ factualId query - , limitString $ limit query - , namespaceString $ namespace query - , namespaceIdString $ namespaceId query - , onlyString $ only query ] - --- The following helper functions are used to generate the separate parts of --- the query path. -factualIdString :: Maybe String -> String -factualIdString (Just id) = "factual_id=" ++ id -factualIdString Nothing = "" - -limitString :: Maybe Int -> String -limitString (Just lim) = "limit=" ++ (show lim) -limitString Nothing = "" - -namespaceString :: Maybe String -> String -namespaceString (Just namespace) = "namespace=" ++ namespace -namespaceString Nothing = "" - -namespaceIdString :: Maybe String -> String -namespaceIdString (Just id) = "namespace_id=" ++ id -namespaceIdString Nothing = "" - -onlyString :: [String] -> String -onlyString [] = "" -onlyString strs = "only=" ++ (join "," strs) diff --git a/Data/Factual/Query/CrosswalkQuery.hs b/Data/Factual/Query/CrosswalkQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Query/CrosswalkQuery.hs @@ -0,0 +1,48 @@ +-- | This module exports the type used to create crosswalk queries. +module Data.Factual.Query.CrosswalkQuery + ( + -- * CrosswalkQuery type + CrosswalkQuery(..) + ) where + +import Data.Factual.Query +import Data.Factual.Utils + +-- | A crosswalk query can be formed by specifying a factual id and +-- (optionally) a list of namespaces to only include when attempting to find +-- the ids for various namespaces, or by specifying a namespace and namespace +-- id in order to find the factual id. An optional limit can be set as well. +data CrosswalkQuery = CrosswalkQuery { factualId :: Maybe String + , limit :: Maybe Int + , namespace :: Maybe String + , namespaceId :: Maybe String + , only :: [String] + } deriving (Eq, Show) + +-- A crosswalk query is a member of the Query typeclass so it can generate a +-- path to be queried. +instance Query CrosswalkQuery where + toPath query = "/places/crosswalk?" + ++ joinAndFilter [ factualIdString $ factualId query + , limitString $ limit query + , namespaceString $ namespace query + , namespaceIdString $ namespaceId query + , onlyString $ only query ] + +-- The following helper functions are used to generate the separate parts of +-- the query path. +factualIdString :: Maybe String -> String +factualIdString (Just id) = "factual_id=" ++ id +factualIdString Nothing = "" + +namespaceString :: Maybe String -> String +namespaceString (Just namespace) = "namespace=" ++ namespace +namespaceString Nothing = "" + +namespaceIdString :: Maybe String -> String +namespaceIdString (Just id) = "namespace_id=" ++ id +namespaceIdString Nothing = "" + +onlyString :: [String] -> String +onlyString [] = "" +onlyString strs = "only=" ++ (join "," strs) diff --git a/Data/Factual/Query/FacetsQuery.hs b/Data/Factual/Query/FacetsQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Query/FacetsQuery.hs @@ -0,0 +1,49 @@ +-- | This module exports the types used to create facets queries. +module Data.Factual.Query.FacetsQuery + ( + -- * FacetsQuery type + FacetsQuery(..) + -- * Required modules + , module Data.Factual.Shared.Table + , module Data.Factual.Shared.Search + , module Data.Factual.Shared.Filter + , module Data.Factual.Shared.Geo + ) where + +import Data.Factual.Query +import Data.Factual.Shared.Table +import Data.Factual.Shared.Search +import Data.Factual.Shared.Filter +import Data.Factual.Shared.Geo +import Data.Factual.Utils + +-- | 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 +-- optional. +data FacetsQuery = FacetsQuery { table :: Table + , search :: Search + , select :: [String] + , filters :: [Filter] + , geo :: Maybe Geo + , limit :: Maybe Int + , minCount :: Maybe Int + , includeCount :: Bool + } deriving (Eq, Show) + +-- 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 ] + +-- Helper functions +minCountString :: Maybe Int -> String +minCountString (Just x) = "min_count=" ++ show x +minCountString Nothing = "" diff --git a/Data/Factual/Query/GeocodeQuery.hs b/Data/Factual/Query/GeocodeQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Query/GeocodeQuery.hs @@ -0,0 +1,20 @@ +-- | This module exports the type used to create geopulse queries. +module Data.Factual.Query.GeocodeQuery + ( + -- * ResolveQuery type + GeocodeQuery(..) + -- * Required modules + , module Data.Factual.Shared.Geo + ) where + +import Data.Factual.Query +import Data.Factual.Shared.Geo + +-- | The GeocodeQuery type is used to construct geocode queries. A geo point +-- is required. +data GeocodeQuery = GeocodeQuery Geo deriving (Eq, Show) + +-- 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) diff --git a/Data/Factual/Query/GeopulseQuery.hs b/Data/Factual/Query/GeopulseQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Query/GeopulseQuery.hs @@ -0,0 +1,26 @@ +-- | This module exports the type used to create geopulse queries. +module Data.Factual.Query.GeopulseQuery + ( + -- * ResolveQuery type + GeopulseQuery(..) + -- * Required modules + , module Data.Factual.Shared.Geo + ) where + +import Data.Factual.Query +import Data.Factual.Utils +import Data.Factual.Shared.Geo + +-- | 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 +-- denote selecting all pulses). +data GeopulseQuery = GeopulseQuery { geo :: Geo + , select :: [String] + } deriving (Eq, Show) + +-- 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 ] diff --git a/Data/Factual/Query/ReadQuery.hs b/Data/Factual/Query/ReadQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Query/ReadQuery.hs @@ -0,0 +1,52 @@ +-- | This module exports the types used to create read queries. +module Data.Factual.Query.ReadQuery + ( + -- * ReadQuery type + ReadQuery(..) + -- * Required modules + , module Data.Factual.Shared.Table + , module Data.Factual.Shared.Search + , module Data.Factual.Shared.Filter + , module Data.Factual.Shared.Geo + ) where + +import Data.Factual.Query +import Data.Factual.Shared.Table +import Data.Factual.Shared.Search +import Data.Factual.Shared.Filter +import Data.Factual.Shared.Geo +import Data.Factual.Utils + +-- | The ReadQuery type is used to construct read queries. A table should be +-- specified, but the rest of the query options are essentially optional +-- (you opt out using Nothing or an empty List for the value). The select is +-- a list of field names to include in the results. The limit and offset are +-- used to request a specific range of rows and includeCount will include the +-- count of returned rows if it is set to True. +data ReadQuery = ReadQuery { table :: Table + , search :: Search + , select :: [String] + , limit :: Maybe Int + , offset :: Maybe Int + , filters :: [Filter] + , geo :: Maybe Geo + , 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) + ++ "read?" + ++ joinAndFilter [ searchString $ search query + , selectString $ select query + , limitString $ limit query + , offsetString $ offset query + , filtersString $ filters query + , geoString $ geo query + , includeCountString $ includeCount query ] + +-- The following helper functions are used in generating query Strings. +offsetString :: Maybe Int -> String +offsetString (Just x) = "offset=" ++ show x +offsetString Nothing = "" diff --git a/Data/Factual/Query/ResolveQuery.hs b/Data/Factual/Query/ResolveQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Query/ResolveQuery.hs @@ -0,0 +1,35 @@ +-- | This module exports the type used to create resolve queries. +module Data.Factual.Query.ResolveQuery + ( + -- * ResolveQuery type + ResolveQuery(..) + -- * ResolveValue type + , ResolveValue(..) + ) where + +import Data.Factual.Query +import Data.Factual.Utils + +-- | 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 +-- value. +data ResolveValue = ResolveStr String String + | ResolveNum String Double + deriving Eq + +-- ResolveValue is a member of the Show typeclass to help generate query Strings. +instance Show ResolveValue where + show (ResolveStr name str) = (show name) ++ ":" ++ (show str) + show (ResolveNum name num) = (show name) ++ ":" ++ (show num) + +-- | 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 + +-- 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={" + ++ (join "," $ map show values) + ++ "}" diff --git a/Data/Factual/Query/SchemaQuery.hs b/Data/Factual/Query/SchemaQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Query/SchemaQuery.hs @@ -0,0 +1,19 @@ +-- | This module exports the type used to create schema queries. +module Data.Factual.Query.SchemaQuery + ( + -- * SchemaQuery type + SchemaQuery(..) + -- * Required modules + , module Data.Factual.Shared.Table + ) where + +import Data.Factual.Query +import Data.Factual.Shared.Table + +-- | A schema query is formed by simply supplying a Table to the value +-- constructor. +data SchemaQuery = SchemaQuery Table deriving (Eq, Show) + +-- SchemaQuery is a member of Query typeclass so that it can generate a response. +instance Query SchemaQuery where + toPath (SchemaQuery table) = (show $ table) ++ "schema" diff --git a/Data/Factual/ReadQuery.hs b/Data/Factual/ReadQuery.hs deleted file mode 100644 --- a/Data/Factual/ReadQuery.hs +++ /dev/null @@ -1,153 +0,0 @@ --- | This module exports the types used to create read queries. -module Data.Factual.ReadQuery - ( - -- * ReadQuery type - ReadQuery(..) - -- * Search type - , Search(..) - -- * Filter type - , Field - , Filter(..) - -- * Geo type - , Lat - , Long - , Radius - , Geo(..) - ) where - -import Data.Factual.Query -import Data.Factual.Table -import Data.Factual.Utils - --- | A Field is a String representation of the field name. -type Field = String --- | A Lat is the latitude represented as a Double. -type Lat = Double --- | A Long is the longitude represented as a Double. -type Long = Double --- | A Radius is the radius of the circle as a Double in meters. -type Radius = Double - --- | This type is used to construct an ANDed or ORed search in a read query. -data Search = AndSearch [String] | OrSearch [String] deriving Eq - --- When a Search is shown it displays the string representation that will go --- into the query string. -instance Show Search where - show (AndSearch terms) = join " " terms - show (OrSearch terms) = join "," terms - --- | The Filter type is used to represent various filters in a read query. -data Filter = EqualNum Field Double -- ^ A numeric field has to match a number exactly. - | EqualStr Field String -- ^ A string field has to match a string exactly. - | NotEqualNum Field Double -- ^ A numeric field must equal a specific number. - | NotEqualStr Field String -- ^ A string field must equal a specific string. - | InNumList Field [Double] -- ^ A numeric field must be equal to any of the numbers in a list. - | InStrList Field [String] -- ^ A string field must be equal to any of the strings in a list. - | NotInNumList Field [Double] -- ^ A numeric field must not be equal to any of the numbers in a list. - | NotInStrList Field [String] -- ^ A string field must not be equal to any of the strings in a list. - | BeginsWith Field String -- ^ A string field must begin with a specific string. - | NotBeginsWith Field String -- ^ A string field must not begin with a specific string. - | BeginsWithAny Field [String] -- ^ A string field must begin with any of the strings in a list. - | 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. - | 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 - --- Filter is a member of Show to help generate query strings. -instance Show Filter where - show (EqualNum field num) = (show field) ++ ":" ++ (show num) - show (EqualStr field str) = (show field) ++ ":" ++ (show str) - show (NotEqualNum field num) = (show field) ++ ":{" ++ (show "$neq") ++ ":" ++ (show num) ++ "}" - show (NotEqualStr field str) = (show field) ++ ":{" ++ (show "$neq") ++ ":" ++ (show str) ++ "}" - show (InNumList field nums) = (show field) ++ ":{" ++ (show "$in") ++ ":[" ++ (join "," $ map show nums) ++ "]}" - show (InStrList field strs) = (show field) ++ ":{" ++ (show "$in") ++ ":[" ++ (join "," $ map show strs) ++ "]}" - show (NotInNumList field nums) = (show field) ++ ":{" ++ (show "$nin") ++ ":[" ++ (join "," $ map show nums) ++ "]}" - show (NotInStrList field strs) = (show field) ++ ":{" ++ (show "$nin") ++ ":[" ++ (join "," $ map show strs) ++ "]}" - show (BeginsWith field str) = (show field) ++ ":{" ++ (show "$bw") ++ ":" ++ (show str) ++ "}" - show (NotBeginsWith field str) = (show field) ++ ":{" ++ (show "$nbw") ++ ":" ++ (show str) ++ "}" - show (BeginsWithAny field strs) = (show field) ++ ":{" ++ (show "$bwin") ++ ":[" ++ (join "," $ map show strs) ++ "]}" - 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 (And filters) = (show "$and") ++ ":[" ++ (join "," $ map showFilter filters) ++ "]" - show (Or filters) = (show "$or") ++ ":[" ++ (join "," $ map showFilter filters) ++ "]" - --- | The Geo type is used to limit the search to specific geograph location. --- Currently, only circles are supported. Supply a latitude, longitude and --- radius in meters for the circle. -data Geo = Circle Lat Long Radius deriving Eq - --- Geo is a member of Show to help generate query strings. -instance Show Geo where - show (Circle lat long radius) = "{\"$circle\":{\"$center\":[" - ++ (show lat) - ++ ", " - ++ (show long) - ++ "],\"$meters\":" - ++ (show radius) - ++ "}}" - --- | The ReadQuery type is used to construct read queries. A table should be --- specified, but the rest of the query options are essentially optional --- (you opt out using Nothing or an empty List for the value). The select is --- a list of field names to include in the results. The limit and offset are --- used to request a specific range of rows and includeCount will include the --- count of returned rows if it is set to True. -data ReadQuery = ReadQuery { table :: Table - , search :: Search - , select :: [String] - , limit :: Maybe Int - , offset :: Maybe Int - , filters :: [Filter] - , geo :: Maybe Geo - , 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) - ++ "read?" - ++ joinAndFilter [ searchString $ search query - , selectString $ select query - , limitString $ limit query - , offsetString $ offset query - , filtersString $ filters query - , geoString $ geo query - , includeCountString $ includeCount query ] - --- The following helper functions are used in generating query Strings. -showFilter :: Filter -> String -showFilter filter = "{" ++ (show filter) ++ "}" - -searchString :: Search -> String -searchString (AndSearch []) = "" -searchString (OrSearch []) = "" -searchString search = "q=" ++ show search - -selectString :: [String] -> String -selectString [] = "" -selectString selects = "select=" ++ (join "," selects) - -limitString :: Maybe Int -> String -limitString (Just x) = "limit=" ++ show x -limitString Nothing = "" - -offsetString :: Maybe Int -> String -offsetString (Just x) = "offset=" ++ show x -offsetString Nothing = "" - -filtersString :: [Filter] -> String -filtersString [] = "" -filtersString fs = "filters={" ++ (join "," $ map show fs) ++ "}" - -geoString :: Maybe Geo -> String -geoString (Just c) = "geo=" ++ show c -geoString Nothing = "" - -includeCountString :: Bool -> String -includeCountString True = "include_count=true" -includeCountString False = "include_count=false" diff --git a/Data/Factual/ResolveQuery.hs b/Data/Factual/ResolveQuery.hs deleted file mode 100644 --- a/Data/Factual/ResolveQuery.hs +++ /dev/null @@ -1,35 +0,0 @@ --- | This module exports the type used to create resolve queries. -module Data.Factual.ResolveQuery - ( - -- * ResolveQuery type - ResolveQuery(..) - -- * ResolveValue type - , ResolveValue(..) - ) where - -import Data.Factual.Query -import Data.Factual.Utils - --- | 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 --- value. -data ResolveValue = ResolveStr String String - | ResolveNum String Double - deriving Eq - --- ResolveValue is a member of the Show typeclass to help generate query Strings. -instance Show ResolveValue where - show (ResolveStr name str) = (show name) ++ ":" ++ (show str) - show (ResolveNum name num) = (show name) ++ ":" ++ (show num) - --- | 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 - --- 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={" - ++ (join "," $ map show values) - ++ "}" diff --git a/Data/Factual/SchemaQuery.hs b/Data/Factual/SchemaQuery.hs deleted file mode 100644 --- a/Data/Factual/SchemaQuery.hs +++ /dev/null @@ -1,17 +0,0 @@ --- | This module exports the type used to create schema queries. -module Data.Factual.SchemaQuery - ( - -- * SchemaQuery type - SchemaQuery(..) - ) where - -import Data.Factual.Query -import Data.Factual.Table - --- | A schema query is formed by simply supplying a Table to the value --- constructor. -data SchemaQuery = SchemaQuery Table deriving (Eq, Show) - --- SchemaQuery is a member of Query typeclass so that it can generate a response. -instance Query SchemaQuery where - toPath (SchemaQuery table) = (show $ table) ++ "schema" diff --git a/Data/Factual/Shared/Filter.hs b/Data/Factual/Shared/Filter.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Shared/Filter.hs @@ -0,0 +1,60 @@ +-- | This module exports the Filter type used to create read and facet queries. +module Data.Factual.Shared.Filter + ( + -- * Filter type + Field + , Filter(..) + -- * Helper functions + , filtersString + ) where + +import Data.Factual.Utils + +-- | A Field is a String representation of the field name. +type Field = String + +-- | The Filter type is used to represent various filters in a read or facets query. +data Filter = EqualNum Field Double -- ^ A numeric field has to match a number exactly. + | EqualStr Field String -- ^ A string field has to match a string exactly. + | NotEqualNum Field Double -- ^ A numeric field must equal a specific number. + | NotEqualStr Field String -- ^ A string field must equal a specific string. + | InNumList Field [Double] -- ^ A numeric field must be equal to any of the numbers in a list. + | InStrList Field [String] -- ^ A string field must be equal to any of the strings in a list. + | NotInNumList Field [Double] -- ^ A numeric field must not be equal to any of the numbers in a list. + | NotInStrList Field [String] -- ^ A string field must not be equal to any of the strings in a list. + | BeginsWith Field String -- ^ A string field must begin with a specific string. + | NotBeginsWith Field String -- ^ A string field must not begin with a specific string. + | BeginsWithAny Field [String] -- ^ A string field must begin with any of the strings in a list. + | 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. + | 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 + +-- Filter is a member of Show to help generate query strings. +instance Show Filter where + show (EqualNum field num) = (show field) ++ ":" ++ (show num) + show (EqualStr field str) = (show field) ++ ":" ++ (show str) + show (NotEqualNum field num) = (show field) ++ ":{" ++ (show "$neq") ++ ":" ++ (show num) ++ "}" + show (NotEqualStr field str) = (show field) ++ ":{" ++ (show "$neq") ++ ":" ++ (show str) ++ "}" + show (InNumList field nums) = (show field) ++ ":{" ++ (show "$in") ++ ":[" ++ (join "," $ map show nums) ++ "]}" + show (InStrList field strs) = (show field) ++ ":{" ++ (show "$in") ++ ":[" ++ (join "," $ map show strs) ++ "]}" + show (NotInNumList field nums) = (show field) ++ ":{" ++ (show "$nin") ++ ":[" ++ (join "," $ map show nums) ++ "]}" + show (NotInStrList field strs) = (show field) ++ ":{" ++ (show "$nin") ++ ":[" ++ (join "," $ map show strs) ++ "]}" + show (BeginsWith field str) = (show field) ++ ":{" ++ (show "$bw") ++ ":" ++ (show str) ++ "}" + show (NotBeginsWith field str) = (show field) ++ ":{" ++ (show "$nbw") ++ ":" ++ (show str) ++ "}" + show (BeginsWithAny field strs) = (show field) ++ ":{" ++ (show "$bwin") ++ ":[" ++ (join "," $ map show strs) ++ "]}" + 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 (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. +showFilter :: Filter -> String +showFilter filter = "{" ++ (show filter) ++ "}" + +filtersString :: [Filter] -> String +filtersString [] = "" +filtersString fs = "filters={" ++ (join "," $ map show fs) ++ "}" diff --git a/Data/Factual/Shared/Geo.hs b/Data/Factual/Shared/Geo.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Shared/Geo.hs @@ -0,0 +1,45 @@ +-- | This module exports the Geo type used to create read and facet queries. +module Data.Factual.Shared.Geo + ( + -- * Geo type + Lat + , Long + , Radius + , Geo(..) + -- * Helper functions + , geoString + ) where + +-- | A Lat is the latitude represented as a Double. +type Lat = Double +-- | A Long is the longitude represented as a Double. +type Long = Double +-- | A Radius is the radius of the circle as a Double in meters. +type Radius = Double + +-- | The Geo type is used to limit the search to specific geograph location. +-- Currently, only circles are supported. Supply a latitude, longitude and +-- radius in meters for the circle. +data Geo = Circle Lat Long Radius + | Point Lat Long + deriving Eq + +-- Geo is a member of Show to help generate query strings. +instance Show Geo where + show (Circle lat long radius) = "{\"$circle\":{\"$center\":[" + ++ (show lat) + ++ ", " + ++ (show long) + ++ "],\"$meters\":" + ++ (show radius) + ++ "}}" + show (Point lat long) = "{\"$point\":[" + ++ (show lat) + ++ "," + ++ (show long) + ++ "]}" + +-- Helper functions +geoString :: Maybe Geo -> String +geoString (Just c) = "geo=" ++ show c +geoString Nothing = "" diff --git a/Data/Factual/Shared/Search.hs b/Data/Factual/Shared/Search.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Shared/Search.hs @@ -0,0 +1,26 @@ +-- | This module exports the Search type used to create read and facet queries. +module Data.Factual.Shared.Search + ( + -- * Search type + Search(..) + -- * Helper functions + , searchString + ) where + +import Data.Factual.Utils + +-- | 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. +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=" ++ show search diff --git a/Data/Factual/Shared/Table.hs b/Data/Factual/Shared/Table.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Shared/Table.hs @@ -0,0 +1,21 @@ +-- | This module exports the type used to represent a table for the read or +-- schema query types. +module Data.Factual.Shared.Table + ( + -- * Table type + Table(..) + ) where + +-- | Three Table values are currently available for the Factual API. +data Table = Places + | USRestaurants + | Global + | Custom String + deriving Eq + +-- Table is a member of the Show typeclass to generate the beginning of the path. +instance Show Table where + show Places = "/t/places/" + show USRestaurants = "/t/restaurants-us/" + show Global = "/t/global/" + show (Custom name) = "/t/" ++ name ++ "/" diff --git a/Data/Factual/Table.hs b/Data/Factual/Table.hs deleted file mode 100644 --- a/Data/Factual/Table.hs +++ /dev/null @@ -1,16 +0,0 @@ --- | This module exports the type used to represent a table for the read or --- schema query types. -module Data.Factual.Table - ( - -- * Table type - Table(..) - ) where - --- | Three Table values are currently available for the Factual API. -data Table = Places | USRestaurants | Global deriving Eq - --- Table is a member of the Show typeclass to generate the beginning of the path. -instance Show Table where - show Places = "/t/places/" - show USRestaurants = "/t/restaurants-us/" - show Global = "/t/global/" diff --git a/Data/Factual/Utils.hs b/Data/Factual/Utils.hs --- a/Data/Factual/Utils.hs +++ b/Data/Factual/Utils.hs @@ -4,6 +4,9 @@ -- * Utility methods join , joinAndFilter + , selectString + , limitString + , includeCountString ) where import Data.List (intersperse) @@ -18,3 +21,16 @@ -- 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=" ++ (join "," selects) + +limitString :: Maybe Int -> String +limitString (Just x) = "limit=" ++ show x +limitString Nothing = "" + +includeCountString :: Bool -> String +includeCountString True = "include_count=true" +includeCountString False = "include_count=false" diff --git a/Data/Factual/Write.hs b/Data/Factual/Write.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Write.hs @@ -0,0 +1,12 @@ +-- | This module exports the definition of the Write typeclass. +module Data.Factual.Write + ( + -- * Query 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. +class Write w where + path :: w -> String + body :: w -> String diff --git a/Data/Factual/Write/Flag.hs b/Data/Factual/Write/Flag.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Write/Flag.hs @@ -0,0 +1,64 @@ +-- | This module exports the types used to create flag writes. +module Data.Factual.Write.Flag + ( + -- * Flag type + Flag(..) + -- * Problem type + , Problem(..) + -- * Required modules + , module Data.Factual.Shared.Table + ) where + +import Data.Factual.Write +import Data.Factual.Shared.Table +import Data.Maybe (fromJust) +import Data.Factual.Utils + +-- | A Problem represents what is wrong with the row being flagged +data Problem = Duplicate + | Nonexistent + | Inaccurate + | Inappropriate + | Spam + | Other + deriving (Eq, Show) + +-- | The Flag type represents a Write to be made to the API which flags a +-- row as having some kind of problem. The table and factualId identify the +-- problematic row, while the problem indicates the type of issue the row +-- has. The user is specified as a string. Other fields such as comment and +-- reference are optional. The debug flag is used to write in debug mode. +data Flag = Flag { table :: Table + , factualId :: String + , problem :: Problem + , user :: String + , comment :: Maybe String + , debug :: Bool + , reference :: Maybe String + } deriving (Eq, Show) + +-- The Flag type is a member of the Write typeclass so it can be sent as a post +-- 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 ] + +-- The following functions are helpers for the body function +commentString :: Flag -> String +commentString flag + | comment flag == Nothing = "" + | otherwise = "comment=" ++ (fromJust $ comment flag) + +debugString :: Flag -> String +debugString flag + | debug flag == True = "debug=true" + | otherwise = "debug=false" + +referenceString :: Flag -> String +referenceString flag + | reference flag == Nothing = "" + | otherwise = "reference=" ++ (fromJust $ reference flag) diff --git a/Data/Factual/Write/Submit.hs b/Data/Factual/Write/Submit.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Write/Submit.hs @@ -0,0 +1,44 @@ +-- | This module exports the types used to create contributions. +module Data.Factual.Write.Submit + ( + -- * Submit type + Submit(..) + -- * Required modules + , module Data.Factual.Shared.Table + ) where + +import Data.Factual.Write +import Data.Factual.Shared.Table +import Data.Maybe (fromJust) +import Data.Factual.Utils +import qualified Data.Map as M + +-- | The Submit type represents a Write to the API which performs an upsert +-- (a row can be updated or a new row can be written). The table and user +-- must be specified, while the factual ID is optional (omitted for new +-- rows). Finally the values are specified in a String to String Map. +data Submit = Submit { table :: Table + , user :: String + , factualId :: Maybe String + , values :: M.Map String String + } deriving (Eq, Show) + +-- 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) + +-- The following functions are helpers for the Write typeclass functions. +pathString :: Submit -> String +pathString submit + | factualId submit == Nothing = (show $ table submit) ++ "submit" + | otherwise = (show $ table submit) ++ + (fromJust $ factualId submit) ++ + "/submit" + +valuesString :: M.Map String String -> String +valuesString values = "{" ++ join "," (map valueString $ M.keys values) ++ "}" + where valueString key = "\"" ++ key ++ "\":\"" ++ + (fromJust $ M.lookup key values) ++ "\"" diff --git a/Network/Factual/API.hs b/Network/Factual/API.hs --- a/Network/Factual/API.hs +++ b/Network/Factual/API.hs @@ -2,42 +2,75 @@ -- the OAuth authentication process. module Network.Factual.API ( - -- * API functions - makeRequest - , generateToken + -- * Authentication + generateToken + -- * Read functions + , makeRequest + , makeRawRequest + -- * Write functions + , sendWrite -- * The hoauth Token type , Token(..) ) where import Data.Maybe (fromJust) import Network.OAuth.Consumer -import Network.OAuth.Http.Request (Request(..), parseURL, fromList) +import Network.OAuth.Http.Request (Request(..), Method(..), parseURL, fromList) import Network.OAuth.Http.Response (Response(..)) import Network.OAuth.Http.CurlHttpClient (CurlClient(..)) import Data.Aeson (Value, decode) import Data.Factual.Query -import Data.Factual.Credentials +import Data.Factual.Write +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. +type Secret = String + +-- | This function takes a set of credentials and returns an OAuth token that +-- can be 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 +-- 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 = do - let fullpath = "http://api.v3.factual.com" ++ toPath query +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 + let fullpath = basePath ++ queryString let request = generateRequest fullpath - response <- runOAuthM token $ setupOAuth request - return $ F.fromValue $ extractJSON response + makeRequest' token request --- | This function takes a set of credentials and returns an OAuth token that --- can be used to make requests. -generateToken :: Credentials -> Token -generateToken (Credentials key secret) = fromApplication $ Application key secret OOB +-- | 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 F.Response +sendWrite token write = do + let fullpath = basePath ++ path write + let request = generatePostRequest fullpath (body write) + makeRequest' token request -- The following helper functions aid the exported API functions +makeRequest' :: Token -> Request -> IO F.Response +makeRequest' token request = do + response <- runOAuthM token $ setupOAuth request + return $ F.fromValue $ extractJSON response + generateRequest :: String -> Request generateRequest url = (fromJust $ parseURL url) { reqHeaders = (fromList headersList) } +generatePostRequest :: String -> String -> Request +generatePostRequest url body = baseRequest { reqHeaders = (fromList headersList) + , method = POST + , reqPayload = B.pack body } + where baseRequest = (fromJust $ parseURL url) + setupOAuth :: Request -> OAuthMonadT IO Response setupOAuth request = do oauthRequest <- signRq2 HMACSHA1 Nothing request @@ -47,4 +80,7 @@ extractJSON = fromJust . decode . rspPayload headersList :: [(String, String)] -headersList = [("X-Factual-Lib", "factual-haskell-driver-0.1.2")] +headersList = [("X-Factual-Lib", "factual-haskell-driver-0.2.0")] + +basePath :: String +basePath = "http://api.v3.factual.com" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -31,15 +31,15 @@ $ ghci test/Tests.hs -To run the response tests you'll need an API key and secret, but you -can always run the query tests: +To run the integration tests you'll need an API key and secret, but you +can always run the unit tests: - *Main> runQueryTests - Cases: 33 Tried: 33 Errors: 0 Failures: 0 - Counts {cases = 33, tried = 33, errors = 0, failures = 0} - *Main> runResponseTests "mykey" "mysecret" - Cases: 4 Tried: 4 Errors: 0 Failures: 0 - Counts {cases = 4, tried = 4, errors = 0, failures = 0} + *Main> runUnitTests + Cases: 41 Tried: 41 Errors: 0 Failures: 0 + Counts {cases = 41, tried = 41, errors = 0, failures = 0} + *Main> runIntegrationTests "mykey" "mysecret" + Cases: 8 Tried: 8 Errors: 0 Failures: 0 + Counts {cases = 8, tried = 8, errors = 0, failures = 0} # Documentation diff --git a/examples/CrosswalkExample.hs b/examples/CrosswalkExample.hs --- a/examples/CrosswalkExample.hs +++ b/examples/CrosswalkExample.hs @@ -2,9 +2,7 @@ import System (getArgs) import Network.Factual.API -import Data.Factual.Credentials -import Data.Factual.Table -import Data.Factual.CrosswalkQuery +import Data.Factual.Query.CrosswalkQuery import Data.Factual.Response main :: IO() @@ -12,7 +10,7 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken (Credentials oauthKey oauthSecret) + let token = generateToken oauthKey oauthSecret let query = CrosswalkQuery { factualId = Just "97598010-433f-4946-8fd5-4a6dd1639d77" , limit = Nothing , namespace = Nothing diff --git a/examples/FacetsExample.hs b/examples/FacetsExample.hs new file mode 100644 --- /dev/null +++ b/examples/FacetsExample.hs @@ -0,0 +1,25 @@ +module Main where + +import System (getArgs) +import Network.Factual.API +import Data.Factual.Query.FacetsQuery +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 = FacetsQuery { table = Places + , search = AndSearch ["Starbucks"] + , select = ["country"] + , filters = [] + , geo = Nothing + , limit = Nothing + , minCount = Nothing + , includeCount = False } + result <- makeRequest 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 new file mode 100644 --- /dev/null +++ b/examples/GeocodeExample.hs @@ -0,0 +1,18 @@ +module Main where + +import System (getArgs) +import Network.Factual.API +import Data.Factual.Query.GeocodeQuery +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 = GeocodeQuery $ Point 34.06021 (-118.41828) + result <- makeRequest 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 new file mode 100644 --- /dev/null +++ b/examples/GeopulseExample.hs @@ -0,0 +1,19 @@ +module Main where + +import System (getArgs) +import Network.Factual.API +import Data.Factual.Query.GeopulseQuery +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 = GeopulseQuery { geo = Point 34.06021 (-118.41828) + , select = ["commercial_density"] } + result <- makeRequest token query + putStrLn $ "Status: " ++ status result + putStrLn $ "Version: " ++ show (version result) + putStrLn $ "Data: " ++ show (response result) diff --git a/examples/RawReadExample.hs b/examples/RawReadExample.hs new file mode 100644 --- /dev/null +++ b/examples/RawReadExample.hs @@ -0,0 +1,16 @@ +module Main where + +import System (getArgs) +import Network.Factual.API +import Data.Factual.Response + +main :: IO() +main = do + args <- getArgs + let oauthKey = head args + let oauthSecret = last args + let token = generateToken oauthKey oauthSecret + result <- makeRawRequest token "/t/places?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 @@ -2,9 +2,7 @@ import System (getArgs) import Network.Factual.API -import Data.Factual.Credentials -import Data.Factual.Table -import Data.Factual.ReadQuery +import Data.Factual.Query.ReadQuery import Data.Factual.Response main :: IO() @@ -12,7 +10,7 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken (Credentials oauthKey oauthSecret) + let token = generateToken oauthKey oauthSecret let query = ReadQuery { table = Places , search = AndSearch [] , select = ["name"] diff --git a/examples/ResolveExample.hs b/examples/ResolveExample.hs --- a/examples/ResolveExample.hs +++ b/examples/ResolveExample.hs @@ -2,9 +2,7 @@ import System (getArgs) import Network.Factual.API -import Data.Factual.Credentials -import Data.Factual.Table -import Data.Factual.ResolveQuery +import Data.Factual.Query.ResolveQuery import Data.Factual.Response main :: IO() @@ -12,7 +10,7 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken (Credentials oauthKey oauthSecret) + let token = generateToken oauthKey oauthSecret let query = ResolveQuery [ ResolveStr "name" "McDonalds" , ResolveStr "address" "10451 Santa Monica Blvd" ] result <- makeRequest token query diff --git a/examples/SchemaExample.hs b/examples/SchemaExample.hs --- a/examples/SchemaExample.hs +++ b/examples/SchemaExample.hs @@ -2,9 +2,7 @@ import System (getArgs) import Network.Factual.API -import Data.Factual.Credentials -import Data.Factual.Table -import Data.Factual.SchemaQuery +import Data.Factual.Query.SchemaQuery import Data.Factual.Response main :: IO() @@ -12,7 +10,7 @@ args <- getArgs let oauthKey = head args let oauthSecret = last args - let token = generateToken (Credentials oauthKey oauthSecret) + let token = generateToken oauthKey oauthSecret let query = SchemaQuery Places result <- makeRequest token query putStrLn $ "Status: " ++ status result diff --git a/factual-api.cabal b/factual-api.cabal --- a/factual-api.cabal +++ b/factual-api.cabal @@ -1,12 +1,12 @@ name: factual-api -version: 0.1.2 +version: 0.2.0 license: BSD3 license-file: LICENSE.txt category: API, Web copyright: (c) 2011 Rudiger Lippert author: Rudiger Lippert maintainer: Rudiger Lippert -stability: experimental +stability: stable tested-with: GHC == 7.0.4 synopsis: A driver for the Factual API cabal-version: >= 1.8 @@ -14,9 +14,8 @@ bug-reports: https://github.com/rudyl313/factual-haskell-driver/issues build-type: Simple description: - This is a driver for the Factual API. It provides a typesafe way to - generate queries, an easy way to setup OAuth authentication and a - simple way to send queries to the API. + This is a driver for the Factual API. It provides a type-safe, easy way to + generate queries, setup OAuth authentication and send queries to the API. extra-source-files: README.md @@ -27,14 +26,22 @@ library exposed-modules: Network.Factual.API - Data.Factual.Credentials - Data.Factual.CrosswalkQuery Data.Factual.Query - Data.Factual.ReadQuery - Data.Factual.ResolveQuery + Data.Factual.Query.CrosswalkQuery + Data.Factual.Query.FacetsQuery + Data.Factual.Query.GeocodeQuery + Data.Factual.Query.GeopulseQuery + Data.Factual.Query.ReadQuery + Data.Factual.Query.ResolveQuery + Data.Factual.Query.SchemaQuery + Data.Factual.Write + Data.Factual.Write.Flag + Data.Factual.Write.Submit Data.Factual.Response - Data.Factual.SchemaQuery - Data.Factual.Table + Data.Factual.Shared.Filter + Data.Factual.Shared.Geo + Data.Factual.Shared.Search + Data.Factual.Shared.Table other-modules: Data.Factual.Utils @@ -43,7 +50,7 @@ aeson >= 0.6.0.0, attoparsec >= 0.10.1.0, base == 4.*, - hoauth >= 0.3.3, + hoauth >= 0.3.0, text >= 0.11.1.5, unordered-containers >= 0.1.4.6, vector >= 0.9.1 diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,57 +1,74 @@ import Test.HUnit import Network.Factual.API import Data.Factual.Query -import Data.Factual.Table -import Data.Factual.ReadQuery -import Data.Factual.SchemaQuery -import Data.Factual.ResolveQuery +import Data.Factual.Query.ReadQuery +import Data.Factual.Query.SchemaQuery +import Data.Factual.Query.ResolveQuery +import Data.Factual.Query.GeocodeQuery import Data.Factual.Response -import Data.Factual.Credentials -import qualified Data.Factual.CrosswalkQuery as C +import qualified Data.Map as M +import qualified Data.Factual.Write as W +import qualified Data.Factual.Query.CrosswalkQuery as C +import qualified Data.Factual.Query.FacetsQuery as F +import qualified Data.Factual.Query.GeopulseQuery as G +import qualified Data.Factual.Write.Submit as S +import qualified Data.Factual.Write.Flag as L -runQueryTests = runTestTT queryTests +runUnitTests = runTestTT unitTests -runResponseTests key secret = runTestTT $ responseTests (Credentials key secret) +runIntegrationTests key secret = runTestTT $ integrationTests key secret -queryTests = TestList [ TestLabel "Place table test" placeTablePathTest - , TestLabel "Restaurants table test" restaurantsTablePathTest - , TestLabel "Global table test" globalTablePathTest - , TestLabel "And search test" andSearchPathTest - , TestLabel "Or search test" orSearchPathTest - , TestLabel "Select test" selectPathTest - , TestLabel "Limit test" limitPathTest - , TestLabel "Offset test" offsetPathTest - , TestLabel "Equal number filter test" equalNumFilterTest - , TestLabel "Equal string filter test" equalStrFilterTest - , TestLabel "Not equal number filter test" notEqualNumFilterTest - , TestLabel "Not equal string filter test" notEqualStrFilterTest - , TestLabel "In number list filter test" inNumListFilterTest - , TestLabel "In string list filter test" inStrListFilterTest - , TestLabel "Not in number list filter test" notInNumListFilterTest - , TestLabel "Not in string list filter test" notInStrListFilterTest - , TestLabel "Begins with filter test" beginsWithFilterTest - , TestLabel "Not begins with filter test" notBeginsWithFilterTest - , TestLabel "Begins with any filter test" beginsWithAnyFilterTest - , TestLabel "Not begins with any filter test" notBeginsWithAnyFilterTest - , TestLabel "Is blank filter test" isBlankFilterTest - , TestLabel "Is not blank filter test" isNotBlankFilterTest - , TestLabel "And filter test" andFilterTest - , TestLabel "Or filter test" andFilterTest - , TestLabel "Geo test" geoTest - , TestLabel "Include count test" includeCountTest - , TestLabel "Schema query test" schemaQueryTest - , TestLabel "Resolve query test" resolveQueryTest - , TestLabel "Factual ID test" factualIdTest - , TestLabel "Crosswalk limit test" limitCWPathTest - , TestLabel "Namespace test" namespaceTest - , TestLabel "Namespace ID test" namespaceIdTest - , TestLabel "Only test" onlyTest ] +unitTests = TestList [ TestLabel "Place table test" placeTablePathTest + , TestLabel "Restaurants table test" restaurantsTablePathTest + , TestLabel "Global table test" globalTablePathTest + , TestLabel "Custom table test" customTablePathTest + , TestLabel "Geopulse test" geopulsePathTest + , TestLabel "Geocode test" geocodePathTest + , TestLabel "And search test" andSearchPathTest + , TestLabel "Or search test" orSearchPathTest + , TestLabel "Select test" selectPathTest + , TestLabel "Limit test" limitPathTest + , TestLabel "Offset test" offsetPathTest + , TestLabel "Equal number filter test" equalNumFilterTest + , TestLabel "Equal string filter test" equalStrFilterTest + , TestLabel "Not equal number filter test" notEqualNumFilterTest + , TestLabel "Not equal string filter test" notEqualStrFilterTest + , TestLabel "In number list filter test" inNumListFilterTest + , TestLabel "In string list filter test" inStrListFilterTest + , TestLabel "Not in number list filter test" notInNumListFilterTest + , TestLabel "Not in string list filter test" notInStrListFilterTest + , TestLabel "Begins with filter test" beginsWithFilterTest + , TestLabel "Not begins with filter test" notBeginsWithFilterTest + , TestLabel "Begins with any filter test" beginsWithAnyFilterTest + , TestLabel "Not begins with any filter test" notBeginsWithAnyFilterTest + , TestLabel "Is blank filter test" isBlankFilterTest + , TestLabel "Is not blank filter test" isNotBlankFilterTest + , TestLabel "And filter test" andFilterTest + , TestLabel "Or filter test" andFilterTest + , TestLabel "Geo test" geoTest + , TestLabel "Include count test" includeCountTest + , TestLabel "Schema query test" schemaQueryTest + , TestLabel "Resolve query test" resolveQueryTest + , TestLabel "Factual ID test" factualIdTest + , TestLabel "Crosswalk limit test" limitCWPathTest + , TestLabel "Namespace test" namespaceTest + , TestLabel "Namespace ID test" namespaceIdTest + , TestLabel "Only test" onlyTest + , TestLabel "Facets test" facetsTest + , TestLabel "Submit path test" submitPathTest + , TestLabel "Submit body test" submitBodyTest + , TestLabel "Flag path test" flagPathTest + , TestLabel "Flag body test" flagBodyTest ] -responseTests creds = TestList [ TestLabel "Read test" (readResponseTest token) - , TestLabel "Schema test" (schemaResponseTest token) - , TestLabel "Resolve test" (resolveResponseTest token) - , TestLabel "Crosswalk test" (crosswalkResponseTest token) ] - where token = generateToken creds +integrationTests key secret = TestList [ TestLabel "Read test" (readIntegrationTest token) + , TestLabel "Schema test" (schemaIntegrationTest token) + , TestLabel "Resolve test" (resolveIntegrationTest token) + , TestLabel "Crosswalk test" (crosswalkIntegrationTest token) + , TestLabel "Raw read test" (rawIntegrationTest token) + , TestLabel "Facets test" (facetsIntegrationTest token) + , TestLabel "Geopulse test" (geopulseIntegrationTest token) + , TestLabel "Geocode test" (geocodeIntegrationTest token) ] + where token = generateToken key secret placeTablePathTest = TestCase (do let expected = "/t/places/read?include_count=false" @@ -68,6 +85,21 @@ let path = toPath $ blankReadQuery { table = Global } assertEqual "Correct path for global table" expected path) +customTablePathTest = TestCase (do + let expected = "/t/foo/read?include_count=false" + let path = toPath $ blankReadQuery { table = Custom "foo" } + assertEqual "Correct path for custom table" expected path) + +geopulsePathTest = TestCase (do + let expected = "/places/geopulse?geo={\"$point\":[34.06021,-118.41828]}&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) + +geocodePathTest = TestCase (do + let expected = "/places/geocode?geo={\"$point\":[34.06021,-118.41828]}" + let path = toPath $ GeocodeQuery $ Point 34.06021 (-118.41828) + assertEqual "Correct path for geocode" expected path) + andSearchPathTest = TestCase (do let expected = "/t/places/read?q=foo bar&include_count=false" let path = toPath $ blankReadQuery { search = AndSearch ["foo", "bar"] } @@ -218,8 +250,42 @@ let path = toPath $ blankCrosswalkQuery { C.only = ["yelp", "loopd"] } assertEqual "Correct path for a only" expected path) -readResponseTest :: Token -> Test -readResponseTest token = TestCase (do +facetsTest = TestCase (do + let expected = "/t/places/facets?q=starbucks&select=locality,region&" + ++ "filters={\"country\":\"US\"}&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) + +submitPathTest = TestCase (do + let expected = "/t/places/foobar/submit" + let path = W.path submitWrite + assertEqual "Correct path for submit" expected path) + +submitBodyTest = TestCase (do + let expected = "user=user123&values={\"key\":\"val\"}" + let body = W.body submitWrite + assertEqual "Correct body for submit" expected body) + +flagPathTest = TestCase (do + let expected = "/t/places/foobar/flag" + let path = W.path flagWrite + assertEqual "Correct path for flag" expected path) + +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) + +readIntegrationTest :: Token -> Test +readIntegrationTest token = TestCase (do let query = ReadQuery { table = Places , search = AndSearch ["McDonalds", "Burger King"] , select = ["name"] @@ -231,28 +297,56 @@ result <- makeRequest token query assertEqual "Valid read query" "ok" (status result)) -schemaResponseTest :: Token -> Test -schemaResponseTest token = TestCase (do +schemaIntegrationTest :: Token -> Test +schemaIntegrationTest token = TestCase (do let query = SchemaQuery Places result <- makeRequest token query - assertEqual "Valid read query" "ok" (status result)) + assertEqual "Valid schema query" "ok" (status result)) -resolveResponseTest :: Token -> Test -resolveResponseTest token = TestCase (do +resolveIntegrationTest :: Token -> Test +resolveIntegrationTest token = TestCase (do let query = ResolveQuery [ResolveStr "name" "McDonalds"] result <- makeRequest token query - assertEqual "Valid read query" "ok" (status result)) + assertEqual "Valid resolve query" "ok" (status result)) -crosswalkResponseTest :: Token -> Test -crosswalkResponseTest token = TestCase (do +crosswalkIntegrationTest :: Token -> Test +crosswalkIntegrationTest token = TestCase (do let query = C.CrosswalkQuery { C.factualId = Just "97598010-433f-4946-8fd5-4a6dd1639d77" - , C.limit = Nothing - , C.namespace = Nothing - , C.namespaceId = Nothing - , C.only = ["loopt"] } + , C.limit = Nothing + , C.namespace = Nothing + , C.namespaceId = Nothing + , C.only = ["loopt"] } result <- makeRequest token query + assertEqual "Valid crosswalk query" "ok" (status result)) + +rawIntegrationTest :: Token -> Test +rawIntegrationTest token = TestCase (do + result <- makeRawRequest token "/t/places?q=starbucks" assertEqual "Valid read query" "ok" (status result)) +facetsIntegrationTest token = TestCase (do + let query = F.FacetsQuery { F.table = Places + , F.search = AndSearch ["Starbucks"] + , F.select = ["country"] + , F.filters = [] + , F.geo = Nothing + , F.limit = Just 100 + , F.minCount = Just 1 + , F.includeCount = False } + result <- makeRequest token query + assertEqual "Valid facets 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 + assertEqual "Valid geopulse query" "ok" (status result)) + +geocodeIntegrationTest token = TestCase (do + let query = GeocodeQuery $ Point 34.06021 (-118.41828) + result <- makeRequest token query + assertEqual "Valid geopulse query" "ok" (status result)) + blankReadQuery :: ReadQuery blankReadQuery = ReadQuery { table = Places , search = AndSearch [] @@ -269,3 +363,18 @@ , C.namespace = Nothing , C.namespaceId = Nothing , C.only = [] } + +submitWrite :: S.Submit +submitWrite = S.Submit { S.table = Places + , S.user = "user123" + , S.factualId = Just "foobar" + , S.values = M.fromList [("key", "val")] } + +flagWrite :: L.Flag +flagWrite = L.Flag { L.table = Places + , L.factualId = "foobar" + , L.problem = L.Duplicate + , L.user = "user123" + , L.comment = Just "There was a problem" + , L.debug = False + , L.reference = Nothing }