matebeamter/src/Types/Orphans.hs

63 lines
2.0 KiB
Haskell

{-# OPTIONS_GHC -fno-warn-missing-methods #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Types.Orphans where
import qualified "mateamt" Types as MT
import Servant.API
import Servant.HTML.Blaze
import Web.Internal.FormUrlEncoded
import qualified Data.Text as T
import Data.Maybe (fromJust)
instance MimeUnrender HTML MT.UserSubmit
instance FromForm MT.UserSubmit
instance MimeUnrender HTML MT.UserDetailsSubmit
instance FromForm MT.UserDetailsSubmit
instance MimeUnrender HTML [MT.PurchaseDetail]
instance FromForm [MT.PurchaseDetail] where
fromForm form =
let kvs = toListStable form
ks = map fst kvs
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
instance MimeUnrender HTML [MT.AmountRefill]
instance FromForm [MT.AmountRefill] where
fromForm form =
let kvs = toListStable form
ks = map fst kvs
kpids = filter ("amountRefillproductId" `T.isPrefixOf`) ks
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)
in MT.AmountRefill pid amountSingles amountCrates
res = map digestForm kpids
in
Right res