{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} module Control.Buy where import Servant import Servant.Client import Servant.Client.Core.Auth (mkAuthenticatedRequest) import qualified Data.Text as T import Data.Text.I18n import Data.String (fromString) import Data.Maybe (fromMaybe) import Data.List (sortOn) import Control.Monad.Reader (ask) import Control.Monad.IO.Class (liftIO) -- imports from "mateamt" import qualified "mateamt" Types as MT -- internal imports import Types import View import Util import Client import ClientAuth import API buyControl :: Maybe T.Text -> Int -> [MT.PurchaseDetail] -> UserHandler BuyConfirmPage buyControl mcookie uid pds = do (ReadState l10n backend _) <- ask let (token, _) = parseTokenAndUser mcookie loc = Locale (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie) pids = map MT.purchaseDetailProduct pds epsovs <- liftIO $ runClientM (productShortList (Just MT.AllProducts)) backend case epsovs of Right psovs -> do let currentPsovs = filter ((`elem` pids) . MT.productShortOverviewId) psovs ziptup = sortOn (MT.productShortOverviewIdent . snd) (zip (sortOn MT.purchaseDetailProduct pds) (sortOn MT.productShortOverviewId currentPsovs) ) return (buyConfirmPage l10n loc ziptup)