diff --git a/Data/Factual/Credentials.hs b/Data/Factual/Credentials.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Credentials.hs @@ -0,0 +1,18 @@ +-- | 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 new file mode 100644 --- /dev/null +++ b/Data/Factual/CrosswalkQuery.hs @@ -0,0 +1,52 @@ +-- | 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.hs b/Data/Factual/Query.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Query.hs @@ -0,0 +1,10 @@ +-- | This module exports the definition of the Query typeclass. +module Data.Factual.Query + ( + -- * Query typeclass + Query(..)) where + +-- | A member of the Query typeclass must define a toPath method which converts +-- the Query into a path String. +class Query q where + toPath :: q -> String diff --git a/Data/Factual/ReadQuery.hs b/Data/Factual/ReadQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/ReadQuery.hs @@ -0,0 +1,153 @@ +-- | 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 new file mode 100644 --- /dev/null +++ b/Data/Factual/ResolveQuery.hs @@ -0,0 +1,35 @@ +-- | 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/Response.hs b/Data/Factual/Response.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Response.hs @@ -0,0 +1,76 @@ +-- | This module exports the type which encapsulates Factual API responses. It +-- also provides some utility function that can be used to manipulate the +-- Aeson object which holds the data. +module Data.Factual.Response + ( + -- * Response type + Response(..) + -- * Utility functions + , fromValue + , toList + , lookupNumber + , lookupString + , lookupValue + , lookupValueSafe + -- * Aeson Value type + , Value + ) where + +import Data.Maybe (fromJust) +import Data.Aeson +import Data.Attoparsec.Number +import qualified Data.HashMap.Lazy as L +import qualified Data.Text as T +import qualified Data.Vector as V + +-- | 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 +-- the actual response data which is an Aeson value. +data Response = Response { status :: String + , version :: Double + , response :: Value + } deriving (Eq, Show) + +-- | This function is used by the API module to turn the Aeson value returned by +-- the API into a Response value. +fromValue :: Value -> Response +fromValue value = Response { status = lookupString "status" value + , version = lookupNumber "version" value + , response = lookupValue "response" value } + +-- | This function can be used to convert an Aeson Array value into a vanilla +-- list. +toList :: Value -> [Value] +toList (Array a) = V.toList a +toList v = [v] + +-- | This function can be used to extract a Double from an Aeson Object +-- (HashMap) value. +lookupNumber :: String -> Value -> Double +lookupNumber key hashmap = extractNumber $ lookupValue key hashmap + +-- | This function can be used to extract a String from an Aeson Object +-- (HashMap) value. +lookupString :: String -> Value -> String +lookupString key hashmap = extractString $ lookupValue key hashmap + +-- | This function can be used to extract any Aeson value from an Aeson Object +-- (HashMap) value. +lookupValue :: String -> Value -> Value +lookupValue key hashmap = fromJust $ lookupValueSafe key hashmap + +-- | This function can be used to safely extract any Aeson value from an Aeson +-- Object (HashMap) value. +lookupValueSafe :: String -> Value -> Maybe Value +lookupValueSafe key (Object x) = L.lookup (T.pack key) x + +-- The following helper functions aid the lookup functions. +extractString :: Value -> String +extractString (String x) = T.unpack x + +extractNumber :: Value -> Double +extractNumber (Number x) = toDouble x + +toDouble :: Number -> Double +toDouble (I x) = fromIntegral x +toDouble (D x) = x diff --git a/Data/Factual/SchemaQuery.hs b/Data/Factual/SchemaQuery.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/SchemaQuery.hs @@ -0,0 +1,17 @@ +-- | 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/Table.hs b/Data/Factual/Table.hs new file mode 100644 --- /dev/null +++ b/Data/Factual/Table.hs @@ -0,0 +1,16 @@ +-- | 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 new file mode 100644 --- /dev/null +++ b/Data/Factual/Utils.hs @@ -0,0 +1,20 @@ +-- | This module exports shared utility methods used by the Factual datatypes. +module Data.Factual.Utils + ( + -- * Utility methods + join + , joinAndFilter + ) where + +import Data.List (intersperse) + +-- | 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 +-- String. +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 diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,30 @@ +Copyright (c) 2011, Factual, Inc. + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/Network/Factual/API.hs b/Network/Factual/API.hs new file mode 100644 --- /dev/null +++ b/Network/Factual/API.hs @@ -0,0 +1,47 @@ +-- | This module exports functions which are used to execute queries and handle +-- the OAuth authentication process. +module Network.Factual.API + ( + -- * API functions + makeRequest + , generateToken + -- * The hoauth Token type + , Token(..) + ) where + +import Data.Maybe (fromJust) +import Network.OAuth.Consumer +import Network.OAuth.Http.Request (Request, parseURL) +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 qualified Data.Factual.Response as F + +-- | 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 = do + let fullpath = "http://api.v3.factual.com" ++ toPath query + let request = generateRequest fullpath + response <- runOAuthM token $ setupOAuth request + return $ F.fromValue $ extractJSON response + +-- | 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 + +-- The following helper functions aid the exported API functions +generateRequest :: String -> Request +generateRequest = fromJust . parseURL + +setupOAuth :: Request -> OAuthMonadT IO Response +setupOAuth request = do + oauthRequest <- signRq2 HMACSHA1 Nothing request + serviceRequest CurlClient oauthRequest + +extractJSON :: Response -> Value +extractJSON = fromJust . decode . rspPayload diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,59 @@ +# Introduction + +This is a Haskell driver for [Factual's public API](http://developer.factual.com/display/docs/Factual+Developer+APIs+Version+3). + +# Installation + +## Prerequisites + +This driver was developed on [ghc 7.0.4](http://www.haskell.org/ghc/) +and [The Haskell Platform 2011.4.0.0](http://hackage.haskell.org/platform/). +Please follow the installation instructions for your specific +platform to install ghc and The Haskell Platform. + +## Installation from git + + $ git clone git@github.com:rudyl313/factual-haskell-driver.git + $ cabal install hoauth + $ cabal install aeson + +Note you may require libcurl to install hoauth. On lucid you can run: + + $ sudo apt-get install libcurl4-openssl-dev + +## Installation from cabal + + $ cabal install factual-api + +# Tests + +Load the tests file into ghci to run the tests: + + $ 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: + + *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} + +# Documentation + +You can read library documentation by opening docs/index.html in +your browser. + +# Examples + +See the examples directory for examples of each query type. To +run an example go to the project root and execute these commands: + + $ ghc -o example examples/ReadExample.hs --make + $ ./example mykey mysecret + +In this example replace mykey with your key and mysecret with your +secret. Note that compiling the source code generates .o and .hi +files in the source directories. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/examples/CrosswalkExample.hs b/examples/CrosswalkExample.hs new file mode 100644 --- /dev/null +++ b/examples/CrosswalkExample.hs @@ -0,0 +1,24 @@ +module Main where + +import System (getArgs) +import Network.Factual.API +import Data.Factual.Credentials +import Data.Factual.Table +import Data.Factual.CrosswalkQuery +import Data.Factual.Response + +main :: IO() +main = do + args <- getArgs + let oauthKey = head args + let oauthSecret = last args + let token = generateToken (Credentials oauthKey oauthSecret) + let query = CrosswalkQuery { factualId = Just "97598010-433f-4946-8fd5-4a6dd1639d77" + , limit = Nothing + , namespace = Nothing + , namespaceId = Nothing + , only = ["loopt"] } + result <- makeRequest token query + putStrLn $ "Status: " ++ status result + putStrLn $ "Version: " ++ show (version result) + putStrLn $ "Data: " ++ show (response result) diff --git a/examples/ReadExample.hs b/examples/ReadExample.hs new file mode 100644 --- /dev/null +++ b/examples/ReadExample.hs @@ -0,0 +1,27 @@ +module Main where + +import System (getArgs) +import Network.Factual.API +import Data.Factual.Credentials +import Data.Factual.Table +import Data.Factual.ReadQuery +import Data.Factual.Response + +main :: IO() +main = do + args <- getArgs + let oauthKey = head args + let oauthSecret = last args + let token = generateToken (Credentials oauthKey oauthSecret) + let query = ReadQuery { table = Places + , search = AndSearch [] + , select = ["name"] + , limit = Just 50 + , offset = Nothing + , includeCount = True + , geo = Just (Circle 34.06021 (-118.41828) 5000.0) + , filters = [EqualStr "name" "Stand"] } + result <- makeRequest 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 new file mode 100644 --- /dev/null +++ b/examples/ResolveExample.hs @@ -0,0 +1,21 @@ +module Main where + +import System (getArgs) +import Network.Factual.API +import Data.Factual.Credentials +import Data.Factual.Table +import Data.Factual.ResolveQuery +import Data.Factual.Response + +main :: IO() +main = do + args <- getArgs + let oauthKey = head args + let oauthSecret = last args + let token = generateToken (Credentials oauthKey oauthSecret) + let query = ResolveQuery [ ResolveStr "name" "McDonalds" + , ResolveStr "address" "10451 Santa Monica Blvd" ] + result <- makeRequest 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 new file mode 100644 --- /dev/null +++ b/examples/SchemaExample.hs @@ -0,0 +1,20 @@ +module Main where + +import System (getArgs) +import Network.Factual.API +import Data.Factual.Credentials +import Data.Factual.Table +import Data.Factual.SchemaQuery +import Data.Factual.Response + +main :: IO() +main = do + args <- getArgs + let oauthKey = head args + let oauthSecret = last args + let token = generateToken (Credentials oauthKey oauthSecret) + let query = SchemaQuery Places + result <- makeRequest 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 new file mode 100644 --- /dev/null +++ b/factual-api.cabal @@ -0,0 +1,49 @@ +name: factual-api +version: 0.1.0 +license: BSD3 +license-file: LICENSE.txt +category: API, Web +copyright: (c) 2011 Rudiger Lippert +author: Rudiger Lippert +maintainer: Rudiger Lippert +stability: experimental +tested-with: GHC == 7.0.4 +synopsis: A driver for the Factual API +cabal-version: >= 1.8 +homepage: https://github.com/rudyl313/factual-haskell-driver +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. + +extra-source-files: + README.md + LICENSE.txt + examples/*.hs + test/Tests.hs + +library + exposed-modules: + Network.Factual.API + Data.Factual.Credentials + Data.Factual.CrosswalkQuery + Data.Factual.Query + Data.Factual.ReadQuery + Data.Factual.ResolveQuery + Data.Factual.Response + Data.Factual.SchemaQuery + Data.Factual.Table + + other-modules: + Data.Factual.Utils + + build-depends: + aeson >= 0.6.0.0, + base == 4.*, + hoauth >= 0.3.3 + +source-repository head + type: git + location: git://github.com/rudyl313/factual-haskel-driver.git diff --git a/test/Tests.hs b/test/Tests.hs new file mode 100644 --- /dev/null +++ b/test/Tests.hs @@ -0,0 +1,271 @@ +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.Response +import Data.Factual.Credentials +import qualified Data.Factual.CrosswalkQuery as C + +runQueryTests = runTestTT queryTests + +runResponseTests key secret = runTestTT $ responseTests (Credentials 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 ] + +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 + +placeTablePathTest = TestCase (do + let expected = "/t/places/read?include_count=false" + let path = toPath $ blankReadQuery { table = Places } + assertEqual "Correct path for places table" expected path) + +restaurantsTablePathTest = TestCase (do + let expected = "/t/restaurants-us/read?include_count=false" + let path = toPath $ blankReadQuery { table = USRestaurants } + assertEqual "Correct path for us restaurants table" expected path) + +globalTablePathTest = TestCase (do + let expected = "/t/global/read?include_count=false" + let path = toPath $ blankReadQuery { table = Global } + assertEqual "Correct path for global table" expected path) + +andSearchPathTest = TestCase (do + let expected = "/t/places/read?q=foo bar&include_count=false" + let path = toPath $ blankReadQuery { search = AndSearch ["foo", "bar"] } + assertEqual "Correct path for ANDed search" expected path) + +orSearchPathTest = TestCase (do + let expected = "/t/places/read?q=foo,bar&include_count=false" + let path = toPath $ blankReadQuery { search = OrSearch ["foo", "bar"] } + assertEqual "Correct path for ANDed search" expected path) + +selectPathTest = TestCase (do + let expected = "/t/places/read?select=foo,bar&include_count=false" + let path = toPath $ blankReadQuery { select = ["foo", "bar"] } + assertEqual "Correct path for select terms" expected path) + +limitPathTest = TestCase (do + let expected = "/t/places/read?limit=321&include_count=false" + let path = toPath $ blankReadQuery { limit = Just 321 } + assertEqual "Correct path for limit" expected path) + +offsetPathTest = TestCase (do + let expected = "/t/places/read?offset=321&include_count=false" + let path = toPath $ blankReadQuery { offset = Just 321 } + assertEqual "Correct path for offset" expected path) + +equalNumFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":123.4}&include_count=false" + let path = toPath $ blankReadQuery { filters = [EqualNum "field" 123.4] } + assertEqual "Correct path for equal number filter" expected path) + +equalStrFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":\"value\"}&include_count=false" + let path = toPath $ blankReadQuery { filters = [EqualStr "field" "value"] } + assertEqual "Correct path for equal string filter" expected path) + +notEqualNumFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$neq\":123.4}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [NotEqualNum "field" 123.4] } + assertEqual "Correct path for not equal number filter" expected path) + +notEqualStrFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$neq\":\"value\"}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [NotEqualStr "field" "value"] } + assertEqual "Correct path for not equal string filter" expected path) + +inNumListFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$in\":[123.4,5432.1]}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [InNumList "field" [123.4, 5432.1]] } + assertEqual "Correct path for in number list filter" expected path) + +inStrListFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$in\":[\"value\",\"other\"]}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [InStrList "field" ["value","other"]] } + assertEqual "Correct path for in string list filter" expected path) + +notInNumListFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$nin\":[123.4,5432.1]}}&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) + +notInStrListFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$nin\":[\"value\",\"other\"]}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [NotInStrList "field" ["value","other"]] } + assertEqual "Correct path for not in string list filter" expected path) + +beginsWithFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$bw\":\"val\"}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [BeginsWith "field" "val"] } + assertEqual "Correct path for begins with filter" expected path) + +notBeginsWithFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$nbw\":\"val\"}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [NotBeginsWith "field" "val"] } + assertEqual "Correct path for not begins with filter" expected path) + +beginsWithAnyFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$bwin\":[\"val\",\"ot\"]}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [BeginsWithAny "field" ["val","ot"]] } + assertEqual "Correct path for begins with any filter" expected path) + +notBeginsWithAnyFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$nbwin\":[\"val\",\"ot\"]}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [NotBeginsWithAny "field" ["val","ot"]] } + assertEqual "Correct path for not begins with any filter" expected path) + +isBlankFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$blank\":true}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [IsBlank "field"] } + assertEqual "Correct path for is blank filter" expected path) + +isNotBlankFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"field\":{\"$blank\":false}}&include_count=false" + let path = toPath $ blankReadQuery { filters = [IsNotBlank "field"] } + assertEqual "Correct path for is not blank filter" expected path) + +andFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"$and\":[{\"field1\":{\"$blank\":true}},{\"field2\":{\"$blank\":false}}]}&include_count=false" + let path = toPath $ blankReadQuery { filters = [And [IsBlank "field1", IsNotBlank "field2"]] } + assertEqual "Correct path for and filter" expected path) + +orFilterTest = TestCase (do + let expected = "/t/places/read?filters={\"$or\":[{\"field1\":{\"$blank\":true}},{\"field2\":{\"$blank\":false}}]}&include_count=false" + let path = toPath $ blankReadQuery { filters = [Or [IsBlank "field1", IsNotBlank "field2"]] } + assertEqual "Correct path for or filter" expected path) + +geoTest = TestCase (do + let expected = "/t/places/read?geo={\"$circle\":{\"$center\":[300.1, 200.3],\"$meters\":100.5}}&include_count=false" + let path = toPath $ blankReadQuery { geo = Just (Circle 300.1 200.3 100.5) } + assertEqual "Correct path for geo" expected path) + +includeCountTest = TestCase (do + let expected = "/t/places/read?include_count=true" + let path = toPath $ blankReadQuery { includeCount = True } + assertEqual "Correct path for include count" expected path) + +schemaQueryTest = TestCase (do + let expected = "/t/places/schema" + let path = toPath $ SchemaQuery Places + assertEqual "Correct path for a schema query" expected path) + +resolveQueryTest = TestCase (do + let expected = "/places/resolve?values={\"field1\":\"value1\",\"field2\":32.1}" + let path = toPath $ ResolveQuery [ResolveStr "field1" "value1", ResolveNum "field2" 32.1] + assertEqual "Correct path for a resolve query" expected path) + +factualIdTest = TestCase (do + let expected = "/places/crosswalk?factual_id=1234" + let path = toPath $ blankCrosswalkQuery { C.factualId = Just "1234" } + assertEqual "Correct path for a factual id" expected path) + +limitCWPathTest = TestCase (do + let expected = "/places/crosswalk?limit=1234" + let path = toPath $ blankCrosswalkQuery { C.limit = Just 1234 } + assertEqual "Correct path for a limit in a crosswalk query" expected path) + +namespaceTest = TestCase (do + let expected = "/places/crosswalk?namespace=yelp" + let path = toPath $ blankCrosswalkQuery { C.namespace = Just "yelp" } + assertEqual "Correct path for a namespace" expected path) + +namespaceIdTest = TestCase (do + let expected = "/places/crosswalk?namespace_id=5432" + let path = toPath $ blankCrosswalkQuery { C.namespaceId = Just "5432" } + assertEqual "Correct path for a namespace id" expected path) + +onlyTest = TestCase (do + let expected = "/places/crosswalk?only=yelp,loopd" + let path = toPath $ blankCrosswalkQuery { C.only = ["yelp", "loopd"] } + assertEqual "Correct path for a only" expected path) + +readResponseTest :: Token -> Test +readResponseTest token = TestCase (do + let query = ReadQuery { table = Places + , search = AndSearch ["McDonalds", "Burger King"] + , select = ["name"] + , limit = Just 50 + , offset = Just 10 + , includeCount = True + , geo = Just (Circle 34.06021 (-118.41828) 5000.0) + , filters = [EqualStr "name" "Stand"] } + result <- makeRequest token query + assertEqual "Valid read query" "ok" (status result)) + +schemaResponseTest :: Token -> Test +schemaResponseTest token = TestCase (do + let query = SchemaQuery Places + result <- makeRequest token query + assertEqual "Valid read query" "ok" (status result)) + +resolveResponseTest :: Token -> Test +resolveResponseTest token = TestCase (do + let query = ResolveQuery [ResolveStr "name" "McDonalds"] + result <- makeRequest token query + assertEqual "Valid read query" "ok" (status result)) + +crosswalkResponseTest :: Token -> Test +crosswalkResponseTest 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"] } + result <- makeRequest token query + assertEqual "Valid read query" "ok" (status result)) + +blankReadQuery :: ReadQuery +blankReadQuery = ReadQuery { table = Places + , search = AndSearch [] + , select = [] + , limit = Nothing + , offset = Nothing + , filters = [] + , geo = Nothing + , includeCount = False } + +blankCrosswalkQuery :: C.CrosswalkQuery +blankCrosswalkQuery = C.CrosswalkQuery { C.factualId = Nothing + , C.limit = Nothing + , C.namespace = Nothing + , C.namespaceId = Nothing + , C.only = [] }