factual-api 0.5.0 → 0.5.1
raw patch · 13 files changed
+152/−46 lines, 13 filesdep +MissingHdep ~hoauth
Dependencies added: MissingH
Dependency ranges changed: hoauth
Files
- Data/Factual/Query/GeopulseQuery.hs +1/−1
- Data/Factual/Query/MatchQuery.hs +1/−1
- Data/Factual/Query/ResolveQuery.hs +1/−1
- Data/Factual/Shared/Filter.hs +23/−20
- Data/Factual/Shared/Search.hs +1/−1
- Data/Factual/Shared/SortOrder.hs +1/−1
- Data/Factual/Utils.hs +2/−8
- Data/Factual/Write/Insert.hs +46/−0
- Data/Factual/Write/Submit.hs +2/−2
- Network/Factual/API.hs +9/−3
- README.md +8/−6
- factual-api.cabal +4/−2
- test/Tests.hs +53/−0
Data/Factual/Query/GeopulseQuery.hs view
@@ -1,7 +1,7 @@ -- | This module exports the type used to create geopulse queries. module Data.Factual.Query.GeopulseQuery (- -- * ResolveQuery type+ -- * GeopulseQuery type GeopulseQuery(..) -- * Required modules , module Data.Factual.Shared.Geo
Data/Factual/Query/MatchQuery.hs view
@@ -8,8 +8,8 @@ ) where import Data.Factual.Query-import Data.Factual.Utils import qualified Data.Map as M+import Data.List.Utils (join) -- | A match value can either be a String or a Number (Double). The first -- argument is the name of the field and the second argument is the input
Data/Factual/Query/ResolveQuery.hs view
@@ -8,8 +8,8 @@ ) where import Data.Factual.Query-import Data.Factual.Utils import qualified Data.Map as M+import Data.List.Utils (join) -- | 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
@@ -8,7 +8,7 @@ , filtersPair ) where -import Data.Factual.Utils+import Data.List.Utils (join, replace) -- | A Field is a String representation of the field name. type Field = String@@ -39,31 +39,34 @@ -- 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 (GreaterThan field num) = (show field) ++ ":{" ++ (show "$gt") ++ ":" ++ (show num) ++ "}"- show (GreaterThanOrEqualTo field num) = (show field) ++ ":{" ++ (show "$gte") ++ ":" ++ (show num) ++ "}"- show (LessThan field num) = (show field) ++ ":{" ++ (show "$lt") ++ ":" ++ (show num) ++ "}"- show (LessThanOrEqualTo field num) = (show field) ++ ":{" ++ (show "$lte") ++ ":" ++ (show num) ++ "}"- show (SearchFilter field str) = (show field) ++ ":{" ++ (show "$search") ++ ":" ++ (show str) ++ "}"+ show (EqualNum field num) = (showStr field) ++ ":" ++ (show num)+ show (EqualStr field str) = (showStr field) ++ ":" ++ (showStr str)+ show (NotEqualNum field num) = (showStr field) ++ ":{" ++ (show "$neq") ++ ":" ++ (show num) ++ "}"+ show (NotEqualStr field str) = (showStr field) ++ ":{" ++ (show "$neq") ++ ":" ++ (showStr str) ++ "}"+ show (InNumList field nums) = (showStr field) ++ ":{" ++ (show "$in") ++ ":[" ++ (join "," $ map show nums) ++ "]}"+ show (InStrList field strs) = (showStr field) ++ ":{" ++ (show "$in") ++ ":[" ++ (join "," $ map showStr strs) ++ "]}"+ show (NotInNumList field nums) = (showStr field) ++ ":{" ++ (show "$nin") ++ ":[" ++ (join "," $ map show nums) ++ "]}"+ show (NotInStrList field strs) = (showStr field) ++ ":{" ++ (show "$nin") ++ ":[" ++ (join "," $ map showStr strs) ++ "]}"+ show (BeginsWith field str) = (showStr field) ++ ":{" ++ (show "$bw") ++ ":" ++ (showStr str) ++ "}"+ show (NotBeginsWith field str) = (showStr field) ++ ":{" ++ (show "$nbw") ++ ":" ++ (showStr str) ++ "}"+ show (BeginsWithAny field strs) = (showStr field) ++ ":{" ++ (show "$bwin") ++ ":[" ++ (join "," $ map showStr strs) ++ "]}"+ show (NotBeginsWithAny field strs) = (showStr field) ++ ":{" ++ (show "$nbwin") ++ ":[" ++ (join "," $ map showStr strs) ++ "]}"+ show (IsBlank field) = (showStr field) ++ ":{\"$blank\":true}"+ show (IsNotBlank field) = (showStr field) ++ ":{\"$blank\":false}"+ show (GreaterThan field num) = (showStr field) ++ ":{" ++ (show "$gt") ++ ":" ++ (show num) ++ "}"+ show (GreaterThanOrEqualTo field num) = (showStr field) ++ ":{" ++ (show "$gte") ++ ":" ++ (show num) ++ "}"+ show (LessThan field num) = (showStr field) ++ ":{" ++ (show "$lt") ++ ":" ++ (show num) ++ "}"+ show (LessThanOrEqualTo field num) = (showStr field) ++ ":{" ++ (show "$lte") ++ ":" ++ (show num) ++ "}"+ show (SearchFilter field str) = (showStr field) ++ ":{" ++ (show "$search") ++ ":" ++ (showStr str) ++ "}" show (And filters) = (show "$and") ++ ":[" ++ (join "," $ map showFilter filters) ++ "]" show (Or filters) = (show "$or") ++ ":[" ++ (join "," $ map showFilter filters) ++ "]" -- The following helper functions are used in generating query params. showFilter :: Filter -> String showFilter filter = "{" ++ (show filter) ++ "}"++showStr :: String -> String+showStr str = "\"" ++ replace "\"" "\\\"" str ++ "\"" filtersPair :: [Filter] -> (String, String) filtersPair [] = ("filters", "")
@@ -7,7 +7,7 @@ , searchPair ) where -import Data.Factual.Utils+import Data.List.Utils (join) -- | This type is used to construct an ANDed or ORed search in a query. data Search = AndSearch [String] | OrSearch [String] | NoSearch deriving Eq
@@ -7,7 +7,7 @@ , sortPair ) where -import Data.Factual.Utils+import Data.List.Utils (join) -- | The SortOrder type is used to represent sorting parameters data SortOrder = Asc String | Desc String deriving Eq
Data/Factual/Utils.hs view
@@ -2,20 +2,14 @@ module Data.Factual.Utils ( -- * Utility methods- join- , selectPair+ selectPair , limitPair , includeCountPair ) where import Data.List (intersperse) import qualified Data.Map as M---- | The join function joins a list of lists into a list using a separator list.--- The most common use case is for joining Strings with a common separator--- String.-join :: [a] -> [[a]] -> [a]-join delim xs = concat (intersperse delim xs)+import Data.List.Utils (join) -- The following helper functions are used in generating query params Maps. selectPair :: [String] -> (String, String)
+ Data/Factual/Write/Insert.hs view
@@ -0,0 +1,46 @@+-- | This module exports the types used to create inserts.+module Data.Factual.Write.Insert+ (+ -- * Insert type+ Insert(..)+ -- * Required modules+ , module Data.Factual.Shared.Table+ ) where++import Data.Factual.Write+import Data.Factual.Shared.Table+import Data.Maybe (fromJust)+import qualified Data.Map as M+import Data.List.Utils (join)++-- | The Insert 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 Insert = Insert { table :: Table+ , user :: String+ , factualId :: Maybe String+ , values :: M.Map String String+ } deriving (Eq, Show)++-- The Insert type is a member of the Write typeclass so that it can be+-- sent as a post request to the API.+instance Write Insert where+ path insert = pathString insert+ params _ = M.empty+ body insert = M.fromList [ ("user", user insert) + , ("values", valuesString (values insert)) ]++-- The following functions are helpers for the Write typeclass functions.+pathString :: Insert -> String+pathString insert+ | factualId insert == Nothing = (show $ table insert) ++ "/insert"+ | otherwise = (show $ table insert)+ ++ "/"+ ++ (fromJust $ factualId insert)+ ++ "/insert"++valuesString :: M.Map String String -> String+valuesString values = "{" ++ join "," (map valueString $ M.keys values) ++ "}"+ where valueString key = "\"" ++ key ++ "\":\"" +++ (fromJust $ M.lookup key values) ++ "\""
Data/Factual/Write/Submit.hs view
@@ -1,4 +1,4 @@--- | This module exports the types used to create contributions.+-- | This module exports the types used to create submits. module Data.Factual.Write.Submit ( -- * Submit type@@ -10,8 +10,8 @@ import Data.Factual.Write import Data.Factual.Shared.Table import Data.Maybe (fromJust)-import Data.Factual.Utils import qualified Data.Map as M+import Data.List.Utils (join) -- | 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
Network/Factual/API.hs view
@@ -16,9 +16,9 @@ , debugWrite -- * The hoauth Token type , Token(..)+ , urlEncode ) where -import Network.HTTP.Base (urlEncode) import Data.Maybe (fromJust) import Data.List (intersperse) import Network.OAuth.Consumer@@ -26,12 +26,15 @@ import Network.OAuth.Http.Response (Response(..)) import Network.OAuth.Http.CurlHttpClient (CurlClient(..)) import Data.Aeson (Value, decode)+import Data.Aeson.Encode (encode)+import Data.List.Utils (join) import Data.Factual.Query-import Data.Factual.Utils import qualified Data.Factual.Write as W import qualified Data.Map as M import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.Factual.Response as F+import qualified Codec.Binary.Url as U+import qualified Codec.Binary.UTF8.String as S -- | Key and Secret are both Strings used to create a Token type Key = String@@ -155,8 +158,11 @@ extractJSON :: Response -> Value extractJSON = fromJust . decode . rspPayload +urlEncode :: String -> String+urlEncode = U.encode . S.encode+ headersList :: [(String, String)]-headersList = [("X-Factual-Lib", "factual-haskell-driver-0.5.0")]+headersList = [("X-Factual-Lib", "factual-haskell-driver-0.5.1")] basePath :: String basePath = "http://api.v3.factual.com"
README.md view
@@ -38,6 +38,8 @@ Please follow the installation instructions for your specific platform to install ghc and The Haskell Platform. +You'll need a Factual account to use this driver. If you don't have one yet, [it's free and easy to get one](https://www.factual.com/api-keys/request).+ ## Installation from cabal $ cabal install factual-api@@ -47,6 +49,7 @@ $ git clone git@github.com:rudyl313/factual-haskell-driver.git $ cabal install hoauth $ cabal install aeson+ $ cabal install MissingH # Tests @@ -58,16 +61,15 @@ can always run the unit tests: *Main> runUnitTests- Cases: 51 Tried: 51 Errors: 0 Failures: 0- Counts {cases = 51, tried = 51, errors = 0, failures = 0}+ Cases: 53 Tried: 53 Errors: 0 Failures: 0+ Counts {cases = 53, tried = 53, errors = 0, failures = 0} *Main> runIntegrationTests "mykey" "mysecret"- Cases: 10 Tried: 10 Errors: 0 Failures: 0- Counts {cases = 10, tried = 10, errors = 0, failures = 0}+ Cases: 11 Tried: 11 Errors: 0 Failures: 0+ Counts {cases = 11, tried = 11, errors = 0, failures = 0} # Documentation -You can read library documentation by opening docs/index.html in-your browser or by visiting the [Hackage page](http://hackage.haskell.org/package/factual-api).+You can read library documentation by visiting the [Hackage page](http://hackage.haskell.org/package/factual-api). The [github wiki](https://github.com/rudyl313/factual-haskell-driver/wiki) also provides thorough documentation and examples for each feature.
factual-api.cabal view
@@ -1,5 +1,5 @@ name: factual-api-version: 0.5.0+version: 0.5.1 license: BSD3 license-file: LICENSE.txt category: API, Web@@ -38,6 +38,7 @@ Data.Factual.Write Data.Factual.Write.Flag Data.Factual.Write.Submit+ Data.Factual.Write.Insert Data.Factual.Response Data.Factual.Shared.Filter Data.Factual.Shared.Geo@@ -54,8 +55,9 @@ base == 4.*, bytestring, containers,- hoauth >= 0.3.0,+ hoauth >= 0.3.5, HTTP,+ MissingH >= 1.0.0, text >= 0.11.1.5, unordered-containers >= 0.1.4.6, vector >= 0.9.1
test/Tests.hs view
@@ -13,6 +13,7 @@ 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.Insert as I import qualified Data.Factual.Write.Flag as L runUnitTests = runTestTT unitTests@@ -68,10 +69,13 @@ , TestLabel "Diffs test" diffsTest , TestLabel "Submit path test" submitPathTest , TestLabel "Submit body test" submitBodyTest+ , TestLabel "Insert path test" insertPathTest+ , TestLabel "Insert body test" insertBodyTest , TestLabel "Flag path test" flagPathTest , TestLabel "Flag body test" flagBodyTest ] integrationTests key secret = TestList [ TestLabel "Read test" (readIntegrationTest token)+ , TestLabel "Unicode test" (unicodeIntegrationTest token) , TestLabel "Schema test" (schemaIntegrationTest token) , TestLabel "Resolve test" (resolveIntegrationTest token) , TestLabel "Match test" (matchIntegrationTest token)@@ -82,6 +86,7 @@ , TestLabel "Geocode test" (geocodeIntegrationTest token) , TestLabel "Multi test" (multiIntegrationTest token) --, TestLabel "Submit test" (submitIntegrationTest token)+ --, TestLabel "Insert test" (insertIntegrationTest token) --, TestLabel "Flag test" (flagIntegrationTest token) , TestLabel "Error test" (errorIntegrationTest token) ] where token = generateToken key secret@@ -381,6 +386,17 @@ assertEqual "Correct user" (bodyParams M.! "user") "user123" assertEqual "Correct values" (bodyParams M.! "values") "{\"key\":\"val\"}") +insertPathTest = TestCase (do+ let expected = "/t/places/foobar/insert"+ let writePath = W.path insertWrite+ assertEqual "Correct path for insert" expected writePath)++insertBodyTest = TestCase (do+ let expected = "user=user123&values={\"key\":\"val\"}"+ let bodyParams = W.body insertWrite+ assertEqual "Correct user" (bodyParams M.! "user") "user123"+ assertEqual "Correct values" (bodyParams M.! "values") "{\"key\":\"val\"}")+ flagPathTest = TestCase (do let expected = "/t/places/foobar/flag" let path = W.path flagWrite@@ -409,6 +425,24 @@ result <- executeQuery token query assertEqual "Valid read query" "ok" (status result)) +unicodeIntegrationTest :: Token -> Test+unicodeIntegrationTest token = TestCase (do+ let query = ReadQuery { table = Global+ , search = NoSearch+ , select = []+ , limit = Nothing+ , offset = Nothing+ , includeCount = False+ , geo = Nothing+ , sort = []+ , filters = [EqualStr "locality" "בני ברק"] }+ result <- executeQuery token query+ let resp = response result+ let dat = lookupValue "data" resp+ let row = (toList dat) !! 0+ let loc = lookupString "locality" row+ assertEqual "Correctly encoded locality" loc "בני ברק")+ schemaIntegrationTest :: Token -> Test schemaIntegrationTest token = TestCase (do let query = SchemaQuery Places@@ -492,6 +526,19 @@ result <- executeWrite token write assertEqual "Valid submit" "ok" (status result)) +insertIntegrationTest :: Token -> Test+insertIntegrationTest token = TestCase (do+ let newValues = M.fromList [ ("name","Factual")+ , ("address","1801 Avenue of the Stars, Suite 1450")+ , ("country","USA")+ , ("locality","Los Angeles") ]+ let write = I.Insert { I.table = Custom "canada-edge"+ , I.user = "drivertest"+ , I.factualId = Nothing+ , I.values = newValues }+ result <- executeWrite token write+ assertEqual "Valid insert" "ok" (status result))+ flagIntegrationTest :: Token -> Test flagIntegrationTest token = TestCase (do let write = L.Flag { L.table = Custom "canada-edge"@@ -525,6 +572,12 @@ , S.user = "user123" , S.factualId = Just "foobar" , S.values = M.fromList [("key", "val")] }++insertWrite :: I.Insert+insertWrite = I.Insert { I.table = Places+ , I.user = "user123"+ , I.factualId = Just "foobar"+ , I.values = M.fromList [("key", "val")] } flagWrite :: L.Flag flagWrite = L.Flag { L.table = Places