diff --git a/backend/ICAFocus.hs b/backend/ICAFocus.hs index 0610c3b..10b6a10 100644 --- a/backend/ICAFocus.hs +++ b/backend/ICAFocus.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} - +{- TODO: refactor code into multiple modules -} module ICAFocus where import qualified Network.HTTP.Client as H @@ -11,7 +11,7 @@ import Data.Aeson.KeyMap import Data.Text import Text.Read import Data.ByteString.Lazy -import GHC.Generics +import Control.Monad.Except newtype ImageLink = ImageLink { getLink :: String } deriving (Show) @@ -31,52 +31,46 @@ data ICAFocusItem a = ICAFocusItem type ICAFocusData = ICAFocusItem ImageLink type ICAFocusProduct = ICAFocusItem ImageData +unpackEither :: MonadFail m => Either String a -> m a +unpackEither (Left s) = fail s +unpackEither (Right a) = pure a + +apiEndpoint :: Int -> String +apiEndpoint i = "https://handlaprivatkund.ica.se/stores/1004247/api/v4/products/bop?retailerProductId=" ++ show i + +(.::) :: FromJSON a => Parser Object -> Key -> Parser a +v .:: k = v >>= (.: k) + instance FromJSON ICAFocusData where parseJSON (Object v) = do - productMap <- (v .: "entities") >>= (.: "product") :: Parser Object + productMap <- v .: "entities" .:: "product" product <- case elems productMap of [Object x] -> pure x [] -> fail "No products" _ -> fail "Too many products" - name <- product .: "name" - pricePerUnitStr <- product .: "price" >>= (.: "current") >>= (.: "amount") :: Parser String - pricePerUnit <- case readEither pricePerUnitStr of - Right x -> pure x - Left e -> fail e - pricePerKgStr <- product .: "price" >>= (.: "unit") >>= (.: "current") >>= (.: "amount") :: Parser String - pricePerKg <- case readEither pricePerKgStr of - Right x -> pure x - Left e -> fail e - imageLink <- product .: "image" >>= (.: "src") + ICAFocusItem + <$> product .: "name" + <*> (ImageLink <$> product .: "image" .:: "src") + <*> (unpackEither . readEither =<< product .: "price" .:: "unit" .:: "current" .:: "amount") + <*> (unpackEither . readEither =<< product .: "price" .:: "current" .:: "amount") - pure $ ICAFocusItem name (ImageLink imageLink) pricePerUnit pricePerKg - -loadProductData :: Int -> IO (Either String ICAFocusData) +loadProductData :: Int -> ExceptT String IO ICAFocusData loadProductData product_id = do - httpman <- H.newManager H.tlsManagerSettings - req <- H.parseRequest $ "https://handlaprivatkund.ica.se/stores/1004247/api/v4/products/bop?retailerProductId=" ++ show product_id - resp <- H.httpLbs req httpman + req <- H.parseRequest $ apiEndpoint product_id + resp <- liftIO $ H.httpLbs req =<< H.newManager H.tlsManagerSettings - if H.responseStatus resp == status200 - then pure $ eitherDecode $ H.responseBody resp - else pure $ Left "Error status code" + unless (H.responseStatus resp == status200) (throwError "Error status code") -loadProductImage :: ICAFocusData -> IO (Either String ICAFocusProduct) + liftEither . eitherDecode $ H.responseBody resp + +loadProductImage :: ICAFocusData -> ExceptT String IO ICAFocusProduct loadProductImage x = do - httpman <- H.newManager H.tlsManagerSettings req <- H.parseRequest $ (getLink . image) x - resp <- H.httpLbs req httpman + resp <- liftIO $ H.httpLbs req =<< H.newManager H.tlsManagerSettings - if H.responseStatus resp == status200 - then do - let imageData = H.responseBody resp - pure $ Right $ (const (ImageData imageData)) <$> x - else pure $ Left "Error status code" + unless (H.responseStatus resp == status200) (throwError "Error status code") + pure $ const (ImageData (H.responseBody resp)) <$> x -loadProduct :: Int -> IO (Either String ICAFocusProduct) -loadProduct product_id = do - prod <- loadProductData product_id - case prod of - Right x -> loadProductImage x - Left e -> pure $ Left e \ No newline at end of file +loadProduct :: Int -> ExceptT String IO ICAFocusProduct +loadProduct = loadProductData >=> loadProductImage