diff --git a/src/App.hs b/src/App.hs index b97b90d..a6c7a1d 100644 --- a/src/App.hs +++ b/src/App.hs @@ -46,11 +46,9 @@ couponServer pool = return Nothing billCouponServer :: ConnectionPool -> Server BillCouponApi -billCouponServer pool = billCouponComputeH +billCouponServer _ = billCouponComputeH where billCouponComputeH bill = liftIO $ billCouponCompute bill - -- return $ Applied 100 - billCouponCompute :: BillCoupon -> IO CouponResult - billCouponCompute bill = do putStrLn $ show bill + billCouponCompute bill = do print bill return $ Applied 100 diff --git a/src/Coupon.hs b/src/Coupon.hs index a13c7fd..584b7f5 100644 --- a/src/Coupon.hs +++ b/src/Coupon.hs @@ -14,29 +14,36 @@ module Coupon where import Data.Aeson import Data.Aeson.Types +import Data.Swagger +import Data.Text import Database.Persist.TH import GHC.Generics import Prelude - data Product = Product { - productName :: String, + productName :: Text, productPrice:: Int -} deriving (Eq, Read, Show, Generic, FromJSON, ToJSON) +} deriving (Eq, Read, Show, Generic, FromJSON, ToJSON, ToSchema) data BillCoupon = BillCoupon { - customer :: String, - coupon :: String, + customer :: Text, + coupon :: Text, productList :: [Product] -} deriving (Eq, Read, Show, Generic, FromJSON, ToJSON) +} deriving (Eq, Read, Show, Generic, FromJSON, ToJSON, ToSchema) data CouponResult = Applied Int | Rejected String | Partial String - deriving (Show, Read, Eq, Generic, FromJSON, ToJSON) + deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, ToSchema) -data CouponType = ProductFlat Int | CartFlat Int | CartPercent Int - deriving (Show, Read, Eq, Generic) +data CouponForProduct = CouponForProduct { + product ::Text, + productDiscount ::Int +} deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, ToSchema) -couponOption = defaultOptions { sumEncoding = ObjectWithSingleField } +data CouponType = ProductFlat CouponForProduct | CartFlat Int | CartPercent Int + deriving (Show, Read, Eq, Generic, ToSchema) + +couponOption :: Options +couponOption = defaultOptions { sumEncoding = ObjectWithSingleField } instance FromJSON CouponType where parseJSON = genericParseJSON couponOption @@ -46,5 +53,11 @@ instance ToJSON CouponType where derivePersistField "CouponType" -prodListEx = [Product {productName = "Water", productPrice = 15}] -billCouponExample = BillCoupon { customer = "test@email.com", coupon = "FLAT100", productList = prodListEx} +-- prodListEx :: [Product] +-- prodListEx = [Product {productName = "Water", productPrice = 15}] + +-- billCouponExample :: BillCoupon +-- billCouponExample = BillCoupon { customer = "test@email.com", +-- coupon = "FLAT100", +-- productList = prodListEx } + diff --git a/src/Models.hs b/src/Models.hs index d479c6b..2e2c107 100644 --- a/src/Models.hs +++ b/src/Models.hs @@ -13,26 +13,30 @@ module Models (module Models,module Coupon) where import Coupon -import Data.Aeson import Data.Text import Data.Time.Clock import Database.Persist.TH import GHC.Generics share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| -Customer +CustomerCoupon email Text + code Text + usage Int UniqueEmail email Primary email + Foreign Coupon fkcoupon code deriving Eq Read Show Generic --- Product --- name Text --- price Int --- code Text --- UniqueName name --- Foreign Coupon fkcoupon code --- Primary name --- deriving Eq Read Show Generic + +ProductCoupon + product Text + code Text + usage Int + UniqueProduct product + Primary product + Foreign Coupon fkcoupon code + deriving Eq Read Show Generic + Coupon json code Text value CouponType diff --git a/src/SwaggerGen.hs b/src/SwaggerGen.hs index 3d98327..1f64e26 100644 --- a/src/SwaggerGen.hs +++ b/src/SwaggerGen.hs @@ -1,9 +1,7 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} module SwaggerGen where @@ -12,7 +10,10 @@ import Control.Lens import Data.Aeson import Data.Aeson.Types (camelTo2) import qualified Data.ByteString.Lazy.Char8 as BL8 +import Data.Proxy +import Data.String.Conversions import Data.Swagger +import qualified Data.Text as T import Servant.Swagger modifier :: String -> String @@ -21,18 +22,23 @@ modifier = drop 1 . dropWhile (/= '_') . camelTo2 '_' prefixSchemaOptions :: SchemaOptions prefixSchemaOptions = defaultSchemaOptions { fieldLabelModifier = modifier } -instance ToSchema BillCoupon where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions -instance ToSchema CouponType where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions -instance ToSchema Coupon where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions -instance ToSchema Product where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions -instance ToSchema Customer where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions -instance ToSchema CouponResult where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions +instance ToSchema Coupon where declareNamedSchema = genericDeclareNamedSchema prefixSchemaOptions swaggerDoc :: Swagger swaggerDoc = toSwagger api - & host ?~ "localhost:3000" + & host ?~ Host {_hostName = "localhost",_hostPort = Just 3000} & info.title .~ "Coupon Api" & info.version .~ "v1" + -- & applyTagsFor billOp ["billcoupon" & description ?~ "Text"] genSwaggerDoc :: IO () genSwaggerDoc = BL8.writeFile "swagger.json" (encode swaggerDoc) + +-- billOp :: Traversal' Swagger Operation +-- billOp = subOperations (Proxy :: Proxy BillCouponApi) (Proxy :: Proxy ServerApi) + +-- billText :: T.Text +-- billText = cs $ encode billCouponExample + +-- billCouponSchema :: BL8.ByteString +-- billCouponSchema = encode $ toSchema (Proxy::Proxy BillCoupon) diff --git a/swagger.json b/swagger.json index 49aa261..fe4467d 100644 --- a/swagger.json +++ b/swagger.json @@ -1 +1 @@ -{"swagger":"2.0","info":{"version":"v1","title":"Coupon Api"},"host":"localhost:3000","paths":{"/coupon/add":{"post":{"consumes":["application/json"],"produces":["application/json"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/Coupon"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/Coupon"},"description":""}}}},"/coupon/get/{name}":{"get":{"produces":["application/json"],"parameters":[{"required":true,"in":"path","name":"name","type":"string"}],"responses":{"404":{"description":"`name` not found"},"200":{"schema":{"$ref":"#/definitions/Coupon"},"description":""}}}},"/coupon/del/{name}":{"get":{"produces":["application/json"],"parameters":[{"required":true,"in":"path","name":"name","type":"string"}],"responses":{"404":{"description":"`name` not found"},"200":{"schema":{"$ref":"#/definitions/Coupon"},"description":""}}}},"/billcoupon":{"post":{"consumes":["application/json"],"produces":["application/json"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/BillCoupon"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/CouponResult"},"description":""}}}}},"definitions":{"Coupon":{"required":["code","value","min_price","valid_from","valid_till"],"properties":{"code":{"type":"string"},"value":{"$ref":"#/definitions/CouponType"},"min_price":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"valid_from":{"$ref":"#/definitions/UTCTime"},"valid_till":{"$ref":"#/definitions/UTCTime"}},"type":"object"},"CouponType":{"properties":{"ProductFlat":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"CartFlat":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"CartPercent":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"maxProperties":1,"minProperties":1,"type":"object"},"UTCTime":{"example":"2016-07-22T00:00:00Z","format":"yyyy-mm-ddThh:MM:ssZ","type":"string"},"CouponResult":{"properties":{"Applied":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"Rejected":{"type":"string"},"Partial":{"type":"string"}},"maxProperties":1,"minProperties":1,"type":"object"},"BillCoupon":{"required":["list"],"properties":{"list":{"items":{"type":"string"},"type":"array"}},"minItems":1,"items":[{"type":"string"}],"maxItems":1,"type":"object"}}} \ No newline at end of file +{"swagger":"2.0","info":{"version":"v1","title":"Coupon Api"},"host":"localhost:3000","paths":{"/coupon/add":{"post":{"consumes":["application/json"],"produces":["application/json"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/Coupon"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/Coupon"},"description":""}}}},"/coupon/get/{name}":{"get":{"produces":["application/json"],"parameters":[{"required":true,"in":"path","name":"name","type":"string"}],"responses":{"404":{"description":"`name` not found"},"200":{"schema":{"$ref":"#/definitions/Coupon"},"description":""}}}},"/coupon/del/{name}":{"get":{"produces":["application/json"],"parameters":[{"required":true,"in":"path","name":"name","type":"string"}],"responses":{"404":{"description":"`name` not found"},"200":{"schema":{"$ref":"#/definitions/Coupon"},"description":""}}}},"/billcoupon":{"post":{"consumes":["application/json"],"produces":["application/json"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/BillCoupon"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/CouponResult"},"description":""}}}}},"definitions":{"Coupon":{"required":["code","value","min_price","customer_limit","usage_limit","valid_from","valid_till"],"properties":{"code":{"type":"string"},"value":{"$ref":"#/definitions/CouponType"},"min_price":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"customer_limit":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"usage_limit":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"valid_from":{"$ref":"#/definitions/UTCTime"},"valid_till":{"$ref":"#/definitions/UTCTime"}},"type":"object"},"CouponType":{"properties":{"ProductFlat":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"CartFlat":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"CartPercent":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"maxProperties":1,"minProperties":1,"type":"object"},"UTCTime":{"example":"2016-07-22T00:00:00Z","format":"yyyy-mm-ddThh:MM:ssZ","type":"string"},"CouponResult":{"properties":{"Applied":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"},"Rejected":{"type":"string"},"Partial":{"type":"string"}},"maxProperties":1,"minProperties":1,"type":"object"},"BillCoupon":{"required":["customer","coupon","productList"],"properties":{"customer":{"type":"string"},"coupon":{"type":"string"},"productList":{"items":{"$ref":"#/definitions/Product"},"type":"array"}},"type":"object"},"Product":{"required":["productName","productPrice"],"properties":{"productName":{"type":"string"},"productPrice":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"}}} \ No newline at end of file