2019-10-16 16:07:12 +00:00
|
|
|
{-# OPTIONS_GHC -fno-warn-missing-methods #-}
|
|
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
2019-09-17 19:29:56 +00:00
|
|
|
{-# LANGUAGE PackageImports #-}
|
|
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
2019-10-22 03:54:55 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
2019-09-17 19:29:56 +00:00
|
|
|
|
|
|
|
module Types.Orphans where
|
|
|
|
|
|
|
|
import qualified "mateamt" Types as MT
|
|
|
|
|
|
|
|
import Servant.API
|
|
|
|
import Servant.HTML.Blaze
|
|
|
|
import Web.Internal.FormUrlEncoded
|
|
|
|
|
2019-10-22 03:54:55 +00:00
|
|
|
import qualified Data.Text as T
|
|
|
|
import Data.Maybe (fromJust)
|
|
|
|
|
2019-12-19 01:43:10 +00:00
|
|
|
import Debug.Trace
|
|
|
|
|
2019-09-17 19:29:56 +00:00
|
|
|
instance MimeUnrender HTML MT.UserSubmit
|
|
|
|
instance FromForm MT.UserSubmit
|
2019-10-14 13:07:17 +00:00
|
|
|
|
|
|
|
instance MimeUnrender HTML MT.UserDetailsSubmit
|
|
|
|
instance FromForm MT.UserDetailsSubmit
|
2019-10-22 03:54:55 +00:00
|
|
|
|
|
|
|
instance MimeUnrender HTML [MT.PurchaseDetail]
|
|
|
|
instance FromForm [MT.PurchaseDetail] where
|
|
|
|
fromForm form =
|
|
|
|
let kvs = toListStable form
|
2019-12-12 02:41:22 +00:00
|
|
|
ks = map fst kvs
|
2019-10-22 03:54:55 +00:00
|
|
|
kpids = filter ("productSelect" `T.isPrefixOf`) ks
|
|
|
|
prods = filter ((`notElem` kpids) . fst) kvs
|
|
|
|
stripPid = snd . T.breakOnEnd "-"
|
|
|
|
digestForm key =
|
|
|
|
let pid = read (T.unpack $ stripPid key)
|
|
|
|
amount = read
|
|
|
|
(T.unpack . fromJust $
|
|
|
|
lookup ("productAmount-" <> stripPid key) prods)
|
|
|
|
in MT.PurchaseDetail pid amount
|
|
|
|
res = map digestForm kpids
|
|
|
|
in
|
|
|
|
Right res
|
2019-12-14 23:05:12 +00:00
|
|
|
|
|
|
|
instance MimeUnrender HTML [MT.AmountRefill]
|
|
|
|
instance FromForm [MT.AmountRefill] where
|
|
|
|
fromForm form =
|
|
|
|
let kvs = toListStable form
|
|
|
|
ks = map fst kvs
|
2019-12-19 01:43:10 +00:00
|
|
|
kpids = filter ("amountRefillProductId" `T.isPrefixOf`) ks
|
2019-12-14 23:05:12 +00:00
|
|
|
prods = filter ((`notElem` kpids) . fst) kvs
|
|
|
|
stripPid = snd . T.breakOnEnd "-"
|
|
|
|
digestForm key =
|
|
|
|
let pid = read (T.unpack $ stripPid key)
|
|
|
|
amountSingles = read
|
|
|
|
(T.unpack . fromJust $
|
|
|
|
lookup ("amountRefillAmountSingles-" <> stripPid key) prods)
|
|
|
|
amountCrates = read
|
|
|
|
(T.unpack . fromJust $
|
|
|
|
lookup ("amountRefillAmountCrates-" <> stripPid key) prods)
|
2019-12-19 01:43:10 +00:00
|
|
|
in MT.AmountRefill
|
|
|
|
(trace (show pid) pid)
|
|
|
|
(trace (show amountSingles) amountSingles)
|
|
|
|
(trace (show amountCrates) amountCrates)
|
|
|
|
res = map digestForm (trace (show kvs) kpids)
|
2019-12-14 23:05:12 +00:00
|
|
|
in
|
|
|
|
Right res
|