meow!

src/Control/Buy.hs

@@ -15,6 +15,10 @@ 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)
 
@@ -35,7 +39,21 @@ buyControl
   :: Maybe T.Text
   -> Int
   -> [MT.PurchaseDetail]
-  -> UserHandler UserManagePage
-buyControl mcookie uid pds = throwError $ err500
-  { errBody = fromString (show pds)
-  }
+  -> 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)

src/Control/User.hs

@@ -36,18 +36,6 @@ import Hash
 import API
 import Util
 
-parseTokenAndUser
-  :: Maybe T.Text
-  -> (String, Maybe String)
-parseTokenAndUser mcookie =
-  (token, mAuthUser)
-  where
-    token = T.unpack $ fromMaybe "secret"
-      (lookup "x-token" =<< mParsedCookie)
-    mAuthUser = T.unpack <$>
-      (lookup "x-auth-user" =<< mParsedCookie)
-    mParsedCookie = fmap parseCookieText mcookie
-
 userSelectControl :: Maybe T.Text -> UserHandler UserSelectPage
 userSelectControl mcookie = do
   (ReadState l10n backend _) <- ask

src/Types/Views.hs

@@ -13,3 +13,5 @@ type UserManagePage = H.Html
 type ProductListPage = H.Html
 
 type AuthPage = H.Html
+
+type BuyConfirmPage = H.Html

src/Util.hs

@@ -22,6 +22,8 @@ import Data.List.Split (chunksOf)
 
 import Data.String (fromString)
 
+import Data.Maybe (fromMaybe)
+
 import Web.Cookie
 
 import Text.Printf (printf)
@@ -52,7 +54,7 @@ formatMoney amount = pre <> t <> "," <> c
     t = fromString $ reverse (intercalate "." $ chunksOf 3 $ reverse $ fst sp)
     c = fromString $ snd sp
     sp = tail <$>
-      break (== '.') (printf "%.2f" (fromIntegral $ abs amount :: Float))
+      break (== '.') (printf "%.2f" (abs $ (fromIntegral amount / 100) :: Float))
 
 redirect303
   :: Link
@@ -71,6 +73,18 @@ parseCookieText = map
   (\x -> let (one, two) = T.breakOn "=" x in (one, T.tail two))
   . T.splitOn "; "
 
+parseTokenAndUser
+  :: Maybe T.Text
+  -> (String, Maybe String)
+parseTokenAndUser mcookie =
+  (token, mAuthUser)
+  where
+    token = T.unpack $ fromMaybe "secret"
+      (lookup "x-token" =<< mParsedCookie)
+    mAuthUser = T.unpack <$>
+      (lookup "x-auth-user" =<< mParsedCookie)
+    mParsedCookie = fmap parseCookieText mcookie
+
 handleErrors
   :: (Traversable t, Show (t (Maybe ClientError)))
   => Maybe Int

src/View.hs

@@ -4,3 +4,4 @@ module View
 
 import View.Auth as V
 import View.User as V
+import View.Buy as V

src/View/Buy.hs

@@ -26,6 +26,41 @@ import Types
 import View.Scaffold
 import API
 
+buyConfirmPage
+  :: L10n
+  -> Locale
+  -> [(MT.PurchaseDetail, MT.ProductShortOverview)]
+  -> H.Html
+buyConfirmPage l10n locale ziptups = scaffold l10n locale (initPage $
+  translate "Matebeamter" <>
+  " - " <>
+  translate "Home"
+  ) $ do
+    H.p $ H.toHtml $ translate "You are about to buy the following items:"
+    H.ul $
+      mapM_
+        (\( MT.PurchaseDetail pdid amount
+          , MT.ProductShortOverview pid ident price _ _ mava) ->
+            H.li $ do
+              H.img
+                H.!?
+                  ( isJust mava
+                  , HA.src (fromString $ show $ fromJust mava) -- TODO: ask for avatar
+                  )
+              H.toHtml
+                (fromString (show amount)
+                  <> " "
+                  <> ident
+                  <> " @ "
+                  <> formatMoney price
+                  <> " "
+                  -- <> "€" -- TODO: ask for currency symbol
+                  )
+          )
+        ziptups
+  where
+    translate = localize l10n locale . gettext
+
 buyProductsForm
   :: L10n
   -> Locale