amazon-products (empty) → 0.1.0.0
raw patch · 9 files changed
+855/−0 lines, 9 filesdep +amazon-productsdep +basedep +base64-bytestringsetup-changed
Dependencies added: amazon-products, base, base64-bytestring, byteable, bytestring, conduit, containers, cryptohash, http-conduit, http-types, mtl, old-locale, resourcet, text, time, transformers, transformers-base, xml-conduit, xml-picklers, xml-types
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- amazon-products.cabal +54/−0
- repl/Main.hs +25/−0
- src/Amazon.hs +128/−0
- src/Amazon/Item.hs +28/−0
- src/Amazon/Types.hs +166/−0
- src/Amazon/Types/Item.hs +420/−0
- src/Amazon/Utils.hs +12/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Andrew Rademacher++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ amazon-products.cabal view
@@ -0,0 +1,54 @@++name: amazon-products+version: 0.1.0.0+synopsis: Connector for Amazon Products API+description: Allows users to directly access Amazon Products API,+ without having to work with the underlying REST and+ authentication layers.+license: MIT+license-file: LICENSE+author: Andrew Rademacher+maintainer: andrewrademacher@gmail.com+category: Web+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules: Amazon+ , Amazon.Item+ , Amazon.Utils+ , Amazon.Types+ , Amazon.Types.Item+ + build-depends: base >=4.6 && <4.7+ , old-locale >=1.0 && <1.1+ , time >=1.4 && <1.5+ , text >=1.1 && <1.2+ , bytestring >=0.10 && <0.11+ , mtl >=2.1 && <2.2+ , transformers >=0.3 && <0.4+ , transformers-base >=0.4 && <0.5+ , resourcet >=1.1 && <1.2+ , conduit >=1.1 && <1.2+ , http-conduit >=2.1 && <2.2+ , xml-types >=0.3 && <0.4+ , xml-picklers >=0.3 && <0.4+ , xml-conduit >=1.2 && <1.3+ , http-types >=0.8 && <0.9+ , base64-bytestring >=1.0 && <1.1+ , containers >=0.5 && <0.6+ , cryptohash >=0.11 && <0.12+ , byteable >=0.1 && <0.2++executable repl+ main-is: Main.hs+ hs-source-dirs: repl+ default-language: Haskell2010+ build-depends: base >=4.6 && <4.7+ , text >=1.0 && <1.2+ , bytestring >=0.10 && <0.11+ , transformers >=0.3 && <0.4+ , http-conduit >=2.1 && <2.2+ , amazon-products
+ repl/Main.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString.Lazy.Char8 as Char8+import Data.Text as T+import Network.HTTP.Conduit+import System.Environment++import Amazon+import Amazon.Item++main :: IO ()+main = do+ conf <- getSandbox+ {-res <- runAmazonT conf $ itemLookup "B00F0DD0I6" IdASIN [Images, ItemAttributes] CAll-}+ {-res <- runAmazonT conf $ itemLookup "B00EV97UD6" IdASIN [Images, ItemAttributes] CAll-}+ res <- runAmazonT conf $ itemSearch "jambox" All [ItemAttributes] CAll Nothing Nothing+ print res++getSandbox :: IO AmazonConf+getSandbox = do+ accessId <- getEnv "AWS_ACCESS_ID"+ accessSecret <- getEnv "AWS_ACCESS_SECRET"+ associateTag <- getEnv "AWS_ASSOCIATE_TAG"+ manager <- newManager conduitManagerSettings+ return $ liveConf manager (T.pack accessId) (Char8.pack accessSecret) (T.pack associateTag)
+ src/Amazon.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Amazon+ ( liveConf++ , AmazonT (..)+ , runAmazonT++ , amazonRequest+ , amazonGet++ , module Amazon.Types+ ) where++import Control.Applicative+import Control.Monad.Base+import Control.Monad.Error+import Control.Monad.Reader+import Control.Monad.Trans.Resource+import Crypto.Hash+import Data.Byteable+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as Base64+import qualified Data.ByteString.Char8 as Char8+import qualified Data.ByteString.Lazy as LBS+import Data.Conduit+import Data.Function+import Data.List+import Data.String+import Data.Text as T+import Data.Text.Encoding as TE+import Data.Time+import Data.XML.Pickle+import Data.XML.Types+import Network.HTTP.Conduit+import Network.HTTP.Types.Status+import Network.HTTP.Types.URI+import System.Locale+import Text.XML.Unresolved++import Amazon.Types++version :: Text+version = "2011-08-01"++liveConf :: Manager -> AccessID -> AccessSecret -> AssociateTag -> AmazonConf+liveConf = AmazonConf $ AmazonEndpoint+ { endpointURL = "http://webservices.amazon.com/onca/xml"+ , endpointHost = "webservices.amazon.com"+ , endpointPath = "/onca/xml"+ }++newtype AmazonT a = AmazonT+ { unAmazonT :: ResourceT (ReaderT AmazonConf (ErrorT AmazonFailure IO)) a+ } deriving ( Functor, Applicative, Monad, MonadIO, MonadThrow+ , MonadError AmazonFailure+ , MonadReader AmazonConf+ , MonadBase IO+ , MonadResource )++runAmazonT :: AmazonConf -> AmazonT a -> IO (Either AmazonFailure a)+runAmazonT conf = runErrorT . flip runReaderT conf . runResourceT . unAmazonT++amazonRequest :: (MonadIO m, MonadThrow m, MonadReader AmazonConf m) =>+ Text -> [(Text, Text)] -> m Request+amazonRequest opName opParams = do+ now <- liftIO $ getCurrentTime+ (AmazonConf{..}) <- ask+ let defParams = [ ("AssociateTag", amazonAssociateTag)+ , ("AWSAccessKeyId", amazonAccessId)+ , ("Operation", opName)+ , ("Version", version)+ , ("Timestamp", T.pack $ formatTime defaultTimeLocale timeFormat now)+ ]+ fnParams = sortBy (compare `on` fst) $ defParams ++ opParams+ paramsTxt = T.intercalate "&" $+ fmap (\(k, v) -> T.concat [k, "=", (encodeText v)]) fnParams+ signTxt = T.intercalate "\n" [ "GET"+ , endpointHost amazonEndpoint+ , endpointPath amazonEndpoint+ , paramsTxt+ ]+ paramsUrl = TE.encodeUtf8 paramsTxt+ signature = urlEncode True $ Base64.encode $ toBytes $ hmacAlg SHA256+ (LBS.toStrict amazonAccessSecret) (TE.encodeUtf8 signTxt)+ parseUrl $ (endpointURL amazonEndpoint) ++ "?" ++ (Char8.unpack paramsUrl) +++ "&Signature=" ++ (Char8.unpack signature)++encodeText :: Text -> Text+encodeText = TE.decodeUtf8 . urlEncode True . TE.encodeUtf8++amazonGet :: (Parameterize a) => Text -> a -> PU [Node] b -> AmazonT (OperationRequest, b)+amazonGet opName opParams resPickler = do+ (AmazonConf{..}) <- ask+ initReq <- amazonRequest opName (toParams opParams)+ res <- http initReq amazonManager+ case responseStatus res of+ s | s == status200 -> handleResult res resXp (return)+ | otherwise -> handleResult res errXp (throwError . AmazonFailure . Just)+ where errName = fromString $ T.unpack $+ T.concat [ "{http://webservices.amazon.com/AWSECommerceService/2011-08-01}"+ , opName+ , "ErrorResponse"+ ]+ errXp = xpRoot $ xpElemNodes errName $ xpAmazonError+ resName = fromString $ T.unpack $+ T.concat [ "{http://webservices.amazon.com/AWSECommerceService/2011-08-01}"+ , opName+ , "Response"+ ]+ resXp = xpRoot $ xpElemNodes resName $+ xpPair+ (xpElemNodes (nsName "OperationRequest") xpOperationRequest)+ resPickler++handleResult :: (MonadBase IO m, MonadResource m, MonadThrow m, MonadError AmazonFailure m) =>+ Response (ResumableSource m BS.ByteString) -> PU Node a -> (a -> m b) -> m b+handleResult res xpOut constOut = do+ doc@(Document _ root _) <- responseBody res $$+- sinkDoc def+ let out = unpickle xpOut (NodeElement root)+ case out of+ Left e -> throwError $ ParseFailure $ Just e+ Right s -> constOut s
+ src/Amazon/Item.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module Amazon.Item+ ( itemSearch+ , itemLookup++ , module Amazon.Types.Item+ ) where++import Data.Text as T+import Data.XML.Pickle++import Amazon+import Amazon.Types.Item++itemSearch :: Text -> SearchIndex -> [ResponseGroup] -> Condition ->+ Maybe Int -> Maybe Int -> AmazonT (OperationRequest, [Item])+itemSearch keyword si res cond max min = amazonGet "ItemSearch" req xpSearch+ where req = ItemSearchRequest cond keyword res si max min+ xpSearch = xpElemNodes (nsName "Items") $ xpClean $+ xpFindMatches $ xpElemNodes (nsName "Item") xpItem++itemLookup :: ItemID -> IdType -> [ResponseGroup] -> Condition ->+ AmazonT (OperationRequest, Item)+itemLookup iid iType resGroup cond = amazonGet "ItemLookup" req xpLookup+ where req = ItemLookupRequest cond iType iid resGroup VPAll+ xpLookup = xpElemNodes (nsName "Items") $ xpClean $+ xpElemNodes (nsName "Item") xpItem
+ src/Amazon/Types.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE OverloadedStrings #-}++module Amazon.Types+ ( nsName+ , timeFormat+ , AccessID+ , AccessSecret+ , AssociateTag++ , AmazonEndpoint (..)+ , AmazonConf (..)+ , AmazonFailure (..)++ , ResponseGroup (..)++ , OperationRequest (..)+ , AmazonError (..)+ , RequestContainer (..)++ , xpResponseGroup+ , xpOperationRequest+ , xpAmazonError+ , xpRequestContainer++ , Parameterize (..)+ ) where++import Control.Monad.Trans.Error (Error, noMsg, strMsg)+import Data.ByteString.Lazy as LBS+import Data.Map as Map+import Data.Text as T+import Data.XML.Pickle+import Data.XML.Types+import Network.HTTP.Conduit++nsName :: Text -> Name+nsName n = Name n (Just "http://webservices.amazon.com/AWSECommerceService/2011-08-01")+ Nothing++timeFormat :: String+timeFormat = "%Y-%m-%dT%H:%M:%S.000Z"++type AccessID = Text+type AccessSecret = LBS.ByteString+type AssociateTag = Text++data AmazonEndpoint = AmazonEndpoint+ { endpointURL :: String+ , endpointHost :: Text+ , endpointPath :: Text+ } deriving (Eq, Show)++data AmazonConf = AmazonConf+ { amazonEndpoint :: AmazonEndpoint+ , amazonManager :: Manager+ , amazonAccessId :: AccessID+ , amazonAccessSecret :: AccessSecret+ , amazonAssociateTag :: AssociateTag+ }++data AmazonFailure = AmazonFailure (Maybe AmazonError)+ | ParseFailure (Maybe UnpickleError)+ | OtherFailure (Maybe Text)+ deriving (Show)++instance Error AmazonFailure where+ noMsg = OtherFailure Nothing+ strMsg = OtherFailure . Just . T.pack++data ResponseGroup = Accessories+ | AlternateVersions+ | BrowseNodeInfo+ | BrowseNodes+ | Cart+ | CartNewReleases+ | CartTopSellers+ | CartSimilarities+ | EditoralReview+ | Images+ | ItemAttributes+ | ItemIds+ | Large+ | Medium+ | MostGifted+ | MostWishedFor+ | NewReleases+ | OfferFull+ | OfferListings+ | Offers+ | OfferSummary+ | PromotionSummary+ | RelatedItems+ | Request+ | Reviews+ | SalesRank+ | SearchBins+ | Similarities+ | Small+ | TopSellers+ | Tracks+ | Variations+ | VariationImages+ | VariationMatrix+ | VariationOffers+ | VariationSummary+ deriving (Eq, Show, Read)++xpResponseGroup :: PU Text ResponseGroup+xpResponseGroup = xpPrim++data OperationRequest = OperationRequest+ { opRequestId :: Text+ , opArguments :: Map Text Text+ , opRequestProcessingTime :: Double+ } deriving (Eq, Show)++xpOperationRequest :: PU [Node] OperationRequest+xpOperationRequest =+ xpWrap (\(r, a, t) -> OperationRequest r (Map.fromList a) t)+ (\(OperationRequest r a t) -> (r, (Map.toList a), t)) $+ xp3Tuple+ (xpElemText (nsName "RequestId"))+ (xpElemNodes (nsName "Arguments") $+ xpList $ xpElemAttrs (nsName "Argument") $+ xp2Tuple (xpAttr "Name" xpId)+ (xpAttr "Value" xpId))+ (xpElemNodes (nsName "RequestProcessingTime") $ xpContent xpPrim)++data AmazonError = AmazonError+ { errorCode :: Text+ , errorMessage :: Text+ , errorRequestId :: Text+ } deriving (Eq, Show)++xpAmazonError :: PU [Node] AmazonError+xpAmazonError =+ xpWrap wrap unwrap $+ xp2Tuple+ (xpElemNodes (nsName "Error") $+ xp2Tuple (xpElemText (nsName "Code"))+ (xpElemText (nsName "Message")))+ (xpElemText (nsName "RequestId"))+ where wrap :: ((Text, Text), Text) -> AmazonError+ wrap ((code, message), reqId) = AmazonError code message reqId++ unwrap :: AmazonError -> ((Text, Text), Text)+ unwrap (AmazonError code message reqId) = ((code, message), reqId)++class Parameterize a where+ toParams :: a -> [(Text, Text)]++----++data RequestContainer a = RequestContainer+ { requestIsValid :: Bool+ , requestSubset :: a+ } deriving (Eq, Show)++xpRequestContainer :: (Eq a, Show a) => Name -> PU [Node] a -> PU [Node] (RequestContainer a)+xpRequestContainer elemName xpSubset =+ xpWrap (\(a, b) -> RequestContainer a b)+ (\(RequestContainer a b) -> (a, b)) $+ xp2Tuple+ (xpElemNodes (nsName "IsValid") $+ xpContent xpPrim)+ (xpElemNodes elemName $ xpSubset)
+ src/Amazon/Types/Item.hs view
@@ -0,0 +1,420 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Amazon.Types.Item+ ( ItemLookupRequest (..)+ , ItemSearchRequest (..)+ , Item (..)+ , ItemID+ , SearchIndex (..)+ , Condition (..)+ , IdType (..)+ , VariationPage (..)+ , ImageSetType (..)+ , ImageSet (..)+ , Attributes (..)+ , Dimensions (..)+ , ListPrice (..)++ , HundredthInch (..)+ , HundredthPound (..)++ , parseCondition+ , parseIdType+ , parseVariationPage++ , xpItem+ , xpItemLookupRequest+ , xpItemSearchRequest+ , xpItemId+ , xpSearchIndex+ , xpCondition+ , xpIdType+ , xpVariationPage+ , xpImageSetType+ , xpImageSet+ , xpAttributes+ , xpDimensions+ , xpListPrice++ , xpHundredthInch+ , xpHundredthPound+ ) where++import Data.Text as T+import Data.XML.Pickle+import Data.XML.Types+import Prelude as P++import Amazon.Types++type ItemID = Text++xpItemId :: PU Text ItemID+xpItemId = xpId++data SearchIndex = All+ | Apparel+ | Appliances+ | ArtsAndCrafts+ | Automotive+ | Baby+ | Beauty+ | Blended+ | Books+ | Classical+ | Collectibles+ | DigitalMusic+ | Grocery+ | DVD+ | Electronics+ | HealthPersonalCare+ | HomeGarden+ | Industrial+ | Jewelry+ | KindleStore+ | Kitchen+ | LawnGarden+ | Magazines+ | Marketplace+ | Merchants+ | Miscellaneous+ | MobileApps+ | MP3Downloads+ | Music+ | MusicalInstruments+ | MusicTracks+ | OfficeProducts+ | OutdoorLiving+ | PCHardware+ | PetSupplies+ | Photo+ | Shoes+ | Software+ | SportingGoods+ | Tools+ | Toys+ | UnboxVideo+ | VHS+ | Video+ | VideoGames+ | Watches+ | Wireless+ | WirelessAccessories+ deriving (Eq, Show, Read)++xpSearchIndex :: PU Text SearchIndex+xpSearchIndex = xpPrim++data Condition = CAll | CNew | CUsed | CCollectible | CRefurbished deriving (Eq)++instance Show Condition where+ show CAll = "All"+ show CNew = "New"+ show CUsed = "Used"+ show CCollectible = "Collectible"+ show CRefurbished = "Refurbished"++parseCondition :: Text -> Condition+parseCondition "All" = CAll+parseCondition "New" = CNew+parseCondition "Used" = CUsed+parseCondition "Collectible" = CCollectible+parseCondition "Refurbished" = CRefurbished++xpCondition :: PU Text Condition+xpCondition = PU { unpickleTree = return . parseCondition+ , pickleTree = T.pack . show+ }++data IdType = IdASIN | IdSKU | IdUPC | IdEAN | IdISBN deriving (Eq)++instance Show IdType where+ show IdASIN = "ASIN"+ show IdSKU = "SKU"+ show IdUPC = "UPC"+ show IdEAN = "EAN"+ show IdISBN = "ISBN"++parseIdType :: Text -> IdType+parseIdType "ASIN" = IdASIN+parseIdType "SKU" = IdSKU+parseIdType "UPC" = IdUPC+parseIdType "EAN" = IdEAN+parseIdType "ISBN" = IdISBN++xpIdType :: PU Text IdType+xpIdType = PU { unpickleTree = return . parseIdType+ , pickleTree = T.pack . show+ }++data VariationPage = VPAll+ deriving (Eq)++instance Show VariationPage where+ show VPAll = "All"++parseVariationPage :: Text -> VariationPage+parseVariationPage "All" = VPAll++xpVariationPage :: PU Text VariationPage+xpVariationPage = PU { unpickleTree = return . parseVariationPage+ , pickleTree = T.pack . show+ }++----++data ItemLookupRequest = ItemLookupRequest+ { lookupCondition :: Condition+ , lookupIdType :: IdType+ , lookupItemId :: ItemID+ , lookupResponseGroups :: [ResponseGroup]+ , lookupVariationPage :: VariationPage+ } deriving (Eq, Show)++xpItemLookupRequest :: PU [Node] ItemLookupRequest+xpItemLookupRequest =+ xpWrap (\(a, b, c, d, e) -> ItemLookupRequest a b c d e)+ (\(ItemLookupRequest a b c d e) -> (a, b, c, d, e)) $+ xp5Tuple+ (xpElemNodes (nsName "Condition") $+ xpContent xpCondition)+ (xpElemNodes (nsName "IdType") $+ xpContent xpIdType)+ (xpElemNodes (nsName "ItemId") $+ xpContent xpItemId)+ (xpList $ xpElemNodes (nsName "ResponseGroup") $+ xpContent xpResponseGroup)+ (xpElemNodes (nsName "VariationPage") $+ xpContent xpVariationPage)++instance Parameterize ItemLookupRequest where+ toParams (ItemLookupRequest{..}) =+ [ ("Condition", (T.pack $ show lookupCondition))+ , ("IdType", (T.pack $ show lookupIdType))+ , ("ItemId", lookupItemId)+ , ("ResponseGroup", intercalate "," (P.map (T.pack . show) lookupResponseGroups))+ ]++----++data ItemSearchRequest = ItemSearchRequest+ { searchCondition :: Condition+ , searchKeywords :: Text+ , searchResponseGroups :: [ResponseGroup]+ , searchIndex :: SearchIndex+ , searchMaxPrice :: Maybe Int+ , searchMinPrice :: Maybe Int+ } deriving (Eq, Show)++xpItemSearchRequest :: PU [Node] ItemSearchRequest+xpItemSearchRequest =+ xpWrap (\(a, b, c, d, e, f) -> ItemSearchRequest a b c d e f)+ (\(ItemSearchRequest a b c d e f) -> (a, b, c, d, e, f)) $+ xp6Tuple+ (xpElemNodes (nsName "Condition") $+ xpContent xpCondition)+ (xpElemText (nsName "Keywords"))+ (xpList $ xpElemNodes (nsName "ResponseGroup") $+ xpContent xpResponseGroup)+ (xpElemNodes (nsName "SearchIndex") $+ xpContent xpSearchIndex)+ (xpElemNodes (nsName "MaximumPrice") $ xpContent xpPrim)+ (xpElemNodes (nsName "MinimumPrice") $ xpContent xpPrim)++instance Parameterize ItemSearchRequest where+ toParams (ItemSearchRequest{..}) =+ [ ("Condition", (T.pack $ show searchCondition))+ , ("Keywords", searchKeywords)+ , ("ResponseGroup", intercalate "," (P.map (T.pack . show) searchResponseGroups))+ , ("SearchIndex", (T.pack $ show searchIndex))+ ] ++ P.concatMap hPrice [ ("MaximumPrice", searchMaxPrice)+ , ("MinimumPrice", searchMinPrice) ]+ where hPrice (_, Nothing) = []+ hPrice (n, Just v) = [(n, (T.pack $ show v))]++----++data Item = Item+ { itemASIN :: Text+ , itemParentASIN :: Maybe Text+ , itemAttributes :: Maybe Attributes+ , itemImageSets :: Maybe [ImageSet]+ } deriving (Eq, Show)++xpItem :: PU [Node] Item+xpItem =+ xpWrap (\(a, b, c, d) -> Item a b c (fmap (fmap removeTuple) d))+ (\(Item a b c d) -> (a, b, c, (fmap (fmap addTuple) d))) $+ xpClean $ xp4Tuple+ (xpElemText (nsName "ASIN"))+ (xpOption $ xpElemText (nsName "ParentASIN"))+ (xpOption $ xpElemNodes (nsName "ItemAttributes") $ xpClean xpAttributes)+ (xpOption $ xpElemNodes (nsName "ImageSets") $+ xpList $ xpElem (nsName "ImageSet") (xpAttr ("Category") xpId) xpImageSet)+ where removeTuple (_,d) = d+ addTuple d = ("",d)++----++data Attributes = Attributes+ { attrBinding :: Text+ , attrBrand :: Text+ , attrCatalogNumbers :: Maybe [Text]+ , attrColor :: Maybe Text+ , attrEAN :: Int+ , attrEANList :: [Int]+ , attrFeatures :: [Text]+ , attrAutographed :: Maybe Bool+ , attrEligibleForTradeIn :: Maybe Bool+ , attrMemorabilia :: Maybe Bool+ , attrDimensions :: Maybe Dimensions+ , attrLabel :: Text+ , attrLegalDisclaimer :: Maybe Text+ , attrListPrice :: ListPrice+ , attrManufacturer :: Maybe Text+ , attrModel :: Maybe Text+ , attrMPN :: Maybe Text+ , attrNumberOfItems :: Maybe Int+ , attrPackageDimensions :: Dimensions+ , attrPackageQuantity :: Int+ , attrPartNumber :: Maybe Text+ , attrProductGroup :: Text+ , attrProductTypeName :: Text+ , attrTitle :: Text+ , attrUPC :: Maybe Int+ , attrUPCList :: Maybe [Int]+ } deriving (Eq, Show)++xpAttributes :: PU [Node] Attributes+xpAttributes =+ xpWrap (\(((((((((((((((((((((((((a, b), c), d), e), f), g), h), i), j), k), l), m), n), o), p), q), r), s), t), u), v), x), y), z), aa)+ -> Attributes a b c d e f g h i j k l m n o p q r s t u v x y z aa)+ (\(Attributes a b c d e f g h i j k l m n o p q r s t u v x y z aa)+ -> (((((((((((((((((((((((((a, b), c), d), e), f), g), h), i), j), k), l), m), n), o), p), q), r), s), t), u), v), x), y), z), aa)) $+ (xpElemText (nsName "Binding"))+ <#> (xpElemText (nsName "Brand"))+ <#> (xpOption $ xpElemNodes (nsName "CatalogNumberList") $+ xpList $ xpElemText (nsName "CatalogNumberListElement"))+ <#> (xpOption $ xpElemText (nsName "Color"))+ <#> (xpElemNodes (nsName "EAN") $ xpContent xpPrim)+ <#> (xpElemNodes (nsName "EANList") $+ xpList $ xpElemNodes (nsName "EANListElement") $ xpContent xpPrim)+ <#> (xpList $ xpElemText (nsName "Feature"))+ <#> (xpOption $ xpElemNodes (nsName "IsAutographed") $ xpContent xpTextBool)+ <#> (xpOption $ xpElemNodes (nsName "IsEligibleForTradeIn") $ xpContent xpTextBool)+ <#> (xpOption $ xpElemNodes (nsName "IsMemorabilia") $ xpContent xpTextBool)+ <#> (xpOption $ xpElemNodes (nsName "ItemDimensions") xpDimensions)+ <#> (xpElemText (nsName "Label"))+ <#> (xpOption $ xpElemText (nsName "LegalDisclaimer"))+ <#> (xpElemNodes (nsName "ListPrice") xpListPrice)+ <#> (xpOption $ xpElemText (nsName "Manufacturer"))+ <#> (xpOption $ xpElemText (nsName "Model"))+ <#> (xpOption $ xpElemText (nsName "MPN"))+ <#> (xpOption $ xpElemNodes (nsName "NumberOfItems") $ xpContent xpPrim)+ <#> (xpElemNodes (nsName "PackageDimensions") xpDimensions)+ <#> (xpElemNodes (nsName "PackageQuantity") $ xpContent xpPrim)+ <#> (xpOption $ xpElemText (nsName "PartNumber"))+ <#> (xpElemText (nsName "ProductGroup"))+ <#> (xpElemText (nsName "ProductTypeName"))+ <#> (xpElemText (nsName "Title"))+ <#> (xpOption $ xpElemNodes (nsName "UPC") $ xpContent xpPrim)+ <#> (xpOption $ xpElemNodes (nsName "UPCList") $+ xpList $ xpElemNodes (nsName "UPCListElement") $ xpContent xpPrim)++xpTextBool :: PU Text Bool+xpTextBool = PU up down+ where up "0" = return False+ up _ = return True+ down False = "0"+ down True = "1"++----++newtype HundredthInch = HundredthInch Int deriving (Eq, Show)+newtype HundredthPound = HundredthPound Int deriving (Eq, Show)++xpHundredthInch :: PU Text HundredthInch+xpHundredthInch = PU (return . HundredthInch . read . T.unpack) (T.pack . show)++xpHundredthPound :: PU Text HundredthPound+xpHundredthPound = PU (return . HundredthPound . read . T.unpack) (T.pack . show)++data Dimensions = Dimensions+ { dimHeight :: Maybe HundredthInch+ , dimLength :: Maybe HundredthInch+ , dimWidth :: Maybe HundredthInch+ , dimWeight :: Maybe HundredthPound+ } deriving (Eq, Show)++xpDimensions :: PU [Node] Dimensions+xpDimensions =+ xpWrap (\(a, b, c, d) -> Dimensions (rt a) (rt b) (rt c) (rt d))+ (\(Dimensions a b c d) -> ((at a), (at b), (at c), (at d))) $+ xp4Tuple+ (xpOption $ xpElem (nsName "Height") (xpClean $ xpOption $ xpAttr ("Units") xpId) $+ xpContent xpHundredthInch)+ (xpOption $ xpElem (nsName "Length") (xpClean $ xpOption $ xpAttr ("Units") xpId) $+ xpContent xpHundredthInch)+ (xpOption $ xpElem (nsName "Width") (xpClean $ xpOption $ xpAttr ("Units") xpId) $+ xpContent xpHundredthInch)+ (xpOption $+ xpElem (nsName "Weight") (xpClean $ xpOption $ xpAttr (nsName "Units") xpId) $+ xpContent xpHundredthPound)+ where rt = fmap (\(_, v) -> v)+ at = fmap (\v -> (Nothing, v))++----++data ListPrice = ListPrice+ { listAmount :: Int+ , listCurrencyCode :: Text+ , listFormattedPrice :: Text+ } deriving (Eq, Show)++xpListPrice :: PU [Node] ListPrice+xpListPrice =+ xpWrap (\(a, b, c) -> ListPrice a b c)+ (\(ListPrice a b c) -> (a, b, c)) $+ xp3Tuple+ (xpElemNodes (nsName "Amount") $ xpContent xpPrim)+ (xpElemText (nsName "CurrencyCode"))+ (xpElemText (nsName "FormattedPrice"))++----++data ImageSetType = ISPrimary | ISVariant deriving (Eq)++instance Show ImageSetType where+ show ISPrimary = "primary"+ show ISVariant = "variant"++parseImageSetType :: Text -> ImageSetType+parseImageSetType "primary" = ISPrimary+parseImageSetType "variant" = ISVariant++xpImageSetType :: PU Text ImageSetType+xpImageSetType = PU { unpickleTree = return . parseImageSetType+ , pickleTree = T.pack . show+ }++data ImageSet = ImageSet+ { isetSwatchUrl :: Text+ , isetThumbnailUrl :: Text+ , isetTinyUrl :: Text+ , isetSmallUrl :: Text+ , isetMediumUrl :: Text+ , isetLargeUrl :: Text+ } deriving (Eq, Show)++xpImageSet :: PU [Node] ImageSet+xpImageSet =+ xpWrap (\(a, b, c, d, e, f) -> ImageSet a b c d e f)+ (\(ImageSet a b c d e f) -> (a, b, c, d, e, f)) $+ xp6Tuple+ (xpElemNodes (nsName "SwatchImage") $ xpClean $ xpElemText (nsName "URL"))+ (xpElemNodes (nsName "ThumbnailImage") $ xpClean $ xpElemText (nsName "URL"))+ (xpElemNodes (nsName "TinyImage") $ xpClean $ xpElemText (nsName "URL"))+ (xpElemNodes (nsName "SmallImage") $ xpClean $ xpElemText (nsName "URL"))+ (xpElemNodes (nsName "MediumImage") $ xpClean $ xpElemText (nsName "URL"))+ (xpElemNodes (nsName "LargeImage") $ xpClean $ xpElemText (nsName "URL"))
+ src/Amazon/Utils.hs view
@@ -0,0 +1,12 @@+module Amazon.Utils+ ( isASIN+ ) where++import Data.Char+import Data.Text as T++isASIN :: Text -> Bool+isASIN x = let l = T.length x == 10+ h = T.head x == 'B'+ a = T.foldl (\b c -> b && isAlphaNum c) True x+ in l && h && a