summaryrefslogtreecommitdiff
path: root/src/Shop/Handler.hs
blob: c3b0eda920d8376df85184bfdc8ba8b2b0e62427 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE TypeOperators         #-}

module Shop.Handler where

import           Control.Monad.Logger    (LoggingT, runStdoutLoggingT,
                                          logInfo, logWarn)
import           Formatting              (format, (%), fixed)
--import           Formatting.Formatters   (fixed)
import           Shop.Config
import           Shop.Types
import           Protolude               hiding (product, (%))
import           Servant                 (throwError)
import           Servant.Server          (ServantErr(..), err500, (:~>)(..))
import qualified Servant.Server.Internal.Handler as SH


type Handler = LoggingT SH.Handler

type App = ReaderT Config Handler

runHandler :: Handler a -> (a -> Handler a) -> (ServantErr -> Handler a) -> Handler a
runHandler ha fa ferr = do
    ha' <- liftIO $ runHandlerIO ha
    case ha' of
        Right a -> fa a
        Left err -> ferr err

appToInternalHandler :: Config -> App :~> SH.Handler
appToInternalHandler cfg = NT appHandlerToHandler'
  where
    appHandlerToHandler' :: App a -> SH.Handler a
    appHandlerToHandler' h = runStdoutLoggingT $ runReaderT h cfg

runHandlerIO :: Handler a -> IO (Either ServantErr a)
runHandlerIO = SH.runHandler . runStdoutLoggingT

handlerToApp :: Handler a -> App a
handlerToApp = lift

charge :: ChargeForm -> App ChargeResponse
charge chargeform = do
    cfg <- ask
    -- TODO: send email
    let cid = "TODO"
        a = "TODO"
    $(logInfo) $ "Charge successfully created: \"" <> email chargeform <> "\" (" <> showPrice total <> ")"
    return $ ChargeResponse cid a
  where
    total = foldl (\n a -> n + quantity a * prix (product a)) 0 (articles chargeform)

showPrice :: Int -> Text
showPrice p = toS $ format (fixed 2) (fromIntegral p / 100) <> "€"