xenchel/matabas
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

made code less legible

Browse Source
This commit is contained in:
Rachel Lambda Samuelsson 2023-08-10 01:56:19 +02:00
parent c5061e223c
commit bf1d61f733
1 changed files with 30 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
backend/ICAFocus.hs
View File

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