WIP Chapter 8

src/Address.hs

@@ -0,0 +1,15 @@
+module Address(
+  Address(Address)
+) where
+
+import SharedTypes
+import String50
+
+data Address = Address {
+  addressLine1 :: String50,
+  addressLine2 :: String50,
+  addressLine3 :: String50,
+  addressLine4 :: String50,
+  city :: City,
+  zipCode :: ZipCode
+}

src/CheckedAddress.hs

@@ -0,0 +1,12 @@
+module CheckedAddress where
+
+import SharedTypes
+
+data CheckedAddress = CheckedAddress {
+  addressLine1 :: String,
+  addressLine2 :: String,
+  addressLine3 :: String,
+  addressLine4 :: String,
+  city :: String,
+  zipCode :: String
+}

src/CustomerInfo.hs

@@ -0,0 +1,10 @@
+module CustomerInfo where
+
+import String50
+import SharedTypes
+import PersonalName
+
+data CustomerInfo = CustomerInfo {
+  name :: PersonalName.PersonalName,
+  emailAddress :: EmailAddress
+}

src/KilogramQuantity.hs

@@ -0,0 +1,12 @@
+module KilogramQuantity(
+  KilogramQuantity, create, value
+) where
+
+newtype KilogramQuantity = KilogramQuantity Double deriving Show
+
+create :: Double -> KilogramQuantity
+create value | value > 0 && value < 1000 = KilogramQuantity value
+             | otherwise = error "Invalid value"
+
+value :: KilogramQuantity -> Double
+value (KilogramQuantity value) = value

src/Lib.hs

@@ -2,6 +2,7 @@ module Lib (someFunc) where
 
 import OrderQuantity
 import OrderTakingDomain
+import qualified KilogramQuantity
 
 someFunc :: IO ()
-someFunc = print $ KilogramQuantity 2.4
+someFunc = print $ KilogramQuantity.create 2.4

src/OrderAcknowledgmentSent.hs

@@ -1,9 +1,10 @@
 module OrderAcknowledgmentSent where
 
 import SharedTypes
+import qualified OrderId
 
 data OrderAcknowledgmentSent = OrderAcknowledgmentSent {
-  orderId :: OrderId,
+  orderId :: OrderId.OrderId,
   emailAddress :: EmailAddress
 }
 

src/OrderId.hs

@@ -0,0 +1,13 @@
+module OrderId(
+  OrderId, orderId, value
+) where
+
+newtype OrderId = OrderId String deriving (Eq, Show)
+
+orderId :: String -> OrderId
+orderId value | null value = error "OrderId must not be empty"
+              | length value > 50 = error "OrderId must not be more than 50 chars"
+              | otherwise = OrderId value 
+
+value :: OrderId -> String
+value (OrderId str) = str

src/OrderLine.hs

@@ -1,10 +1,12 @@
 module OrderLine where
 
 import SharedTypes
+import OrderLineId
+import OrderQuantity
+import ProductCode
 
 data OrderLine = OrderLine {
   orderLineId :: OrderLineId,
-  orderId :: OrderId,
-  productId :: ProductId,
-  orderQuantity :: Int
+  productCode :: ProductCode.ProductCode,
+  quantity :: OrderQuantity
 } deriving (Show)

src/OrderLineId.hs

@@ -0,0 +1,13 @@
+module OrderLineId(
+  OrderLineId, create, value
+) where
+
+newtype OrderLineId = OrderLineId String deriving (Eq, Show)
+
+create :: String -> OrderLineId
+create value | null value = error "OrderLineId must not be empty"
+             | length value > 50 = error "OrderLineId must not be more than 50 chars"
+             | otherwise = OrderLineId value 
+
+value :: OrderLineId -> String
+value (OrderLineId str) = str

src/OrderQuantity.hs

@@ -1,19 +1,8 @@
--- TODO "smart constructors" - book loc 2618 / https://wiki.haskell.org/Smart_constructors
--- This seems cumbersome. We can't pattern match anymore on OrderQuantity. Solutions?
 module OrderQuantity(
   OrderQuantity(UnitQuantity, KilogramQuantity)
-  -- unitQuantity 
 ) where
 
--- data OrderQuantity = OrderUnitQuantity UnitQuantity UnitQuantityValue | OrderKilogramQuantity Double deriving (Show)
-data OrderQuantity = UnitQuantity UnitQuantityValue | KilogramQuantity Double deriving (Show)
+import UnitQuantity
+import KilogramQuantity
 
--- newtype UnitQuantity = UnitQuantity UnitQuantityValue deriving Show
-type UnitQuantityValue = Int
-
--- unitQuantity :: UnitQuantityValue -> Either String UnitQuantity
--- unitQuantity value | value > 0 && value < 1000 = Right $ UnitQuantity value
---                    | otherwise = Left "Invalid value"
-
--- quantityValue :: UnitQuantity -> UnitQuantityValue
--- quantityValue (UnitQuantity value) = value
+data OrderQuantity = UnitQuantity UnitQuantity | KilogramQuantity KilogramQuantity deriving (Show)

src/OrderTakingDomain.hs

@@ -17,6 +17,19 @@ import SharedTypes
 import PlaceOrderWorkflow
 import qualified UnvalidatedOrder
 import qualified ValidatedOrder
+import qualified OrderId
+import String50
+import qualified UnvalidatedCustomerInfo
+import qualified CustomerInfo
+import qualified PersonalName
+import qualified CheckedAddress
+import qualified Address
+import qualified UnvalidatedOrderLine
+import qualified OrderLineId
+import qualified OrderLine
+import qualified UnitQuantity
+import qualified KilogramQuantity
+import qualified ProductCode
 
 -- data Foo = Foo {
 --   myField :: Int
@@ -94,24 +107,24 @@ calculateTotalPrice :: NonEmpty POL.PricedOrderLine -> Price
 calculateTotalPrice orderLines = 
   Price $ foldr (\l a -> toPriceValue (POL.price l) + a) 0 orderLines
 
-findOrderLine :: NonEmpty POL.PricedOrderLine -> OrderLineId -> Maybe POL.PricedOrderLine
+findOrderLine :: NonEmpty POL.PricedOrderLine -> OrderLineId.OrderLineId -> Maybe POL.PricedOrderLine
 findOrderLine orderLines olId =
   L.find (\ol -> POL.orderLineId ol == olId) orderLines 
 
-replaceOrderLine :: NonEmpty POL.PricedOrderLine -> OrderLineId -> POL.PricedOrderLine -> NonEmpty POL.PricedOrderLine
+replaceOrderLine :: NonEmpty POL.PricedOrderLine -> OrderLineId.OrderLineId -> POL.PricedOrderLine -> NonEmpty POL.PricedOrderLine
 -- TODO optimize
 replaceOrderLine orderLines oldId newOrderLine = 
   map (\ol -> if POL.orderLineId ol == oldId then newOrderLine else ol) orderLines
 
-changeOrderPrice :: PO.PricedOrder -> OrderLineId -> Price -> Maybe PO.PricedOrder
+changeOrderPrice :: PO.PricedOrder -> OrderLineId.OrderLineId -> Price -> Maybe PO.PricedOrder
 changeOrderPrice order orderLineId newPrice =
   let 
     newOrderLines = updateOrderLinesPrice order orderLineId newPrice
   in 
     (\nols -> order { PO.orderLines = nols }) <$> newOrderLines
 
 -- This was added after adding amountToBill to Order. changeOrderPrice is "deprecated" now.
-changeOrderLinePrice :: PO.PricedOrder -> OrderLineId -> Price -> Maybe PO.PricedOrder
+changeOrderLinePrice :: PO.PricedOrder -> OrderLineId.OrderLineId -> Price -> Maybe PO.PricedOrder
 changeOrderLinePrice order orderLineId newPrice =
   let 
     newOrderLines = updateOrderLinesPrice order orderLineId newPrice
@@ -121,30 +134,93 @@ changeOrderLinePrice order orderLineId newPrice =
     (\nols natb -> order { PO.orderLines = nols, PO.amountToBill = natb }) <$> newOrderLines <*> newAmountToBill
 
 -- Helper function to fix HLint repeated code warning 
-updateOrderLinesPrice :: PO.PricedOrder -> OrderLineId -> Price -> Maybe (NonEmpty POL.PricedOrderLine)
+updateOrderLinesPrice :: PO.PricedOrder -> OrderLineId.OrderLineId -> Price -> Maybe (NonEmpty POL.PricedOrderLine)
 updateOrderLinesPrice order orderLineId newPrice = 
   let 
     orderLine = findOrderLine (PO.orderLines order) orderLineId
     newOrderLine = (\ol -> ol { POL.price = newPrice }) <$> orderLine
   in
     replaceOrderLine (PO.orderLines order) orderLineId <$> newOrderLine 
 
-checkProductCodeExists :: ProductCode -> Bool
+checkProductCodeExists :: ProductCode.ProductCode -> Bool
 checkProductCodeExists productCode = undefined
 
-checkAddressExists :: UnvalidatedAddress -> Bool
+type CheckAddressExists = UnvalidatedAddress -> CheckedAddress.CheckedAddress
+checkAddressExists :: CheckAddressExists
 checkAddressExists unvalidatedAddress = undefined
 
-getProductPrice :: ProductCode -> Price
+getProductPrice :: ProductCode.ProductCode -> Price
 getProductPrice product = undefined
 
-type CheckProductCodeExists = ProductCode -> Bool
-type CheckAddressExists = UnvalidatedAddress -> Bool
-validateOrder :: CheckProductCodeExists -> CheckAddressExists -> UnvalidatedOrder.UnvalidatedOrder 
-  -> Either String ValidatedOrder.ValidatedOrder
-validateOrder = undefined
+toAddress :: CheckAddressExists -> UnvalidatedAddress -> Address.Address
+toAddress checkAddressExists unvalidatedAddress =
+  let
+    checkedAddress = checkAddressExists unvalidatedAddress
+    addressLine1 = string50 $ CheckedAddress.addressLine1 checkedAddress
+    addressLine2 = string50 $ CheckedAddress.addressLine2 checkedAddress
+    addressLine3 = string50 $ CheckedAddress.addressLine3 checkedAddress
+    addressLine4 = string50 $ CheckedAddress.addressLine4 checkedAddress
+    city = City $ string50 $ CheckedAddress.city checkedAddress
+    zipCode = ZipCode $ CheckedAddress.zipCode checkedAddress
+  in
+    Address.Address addressLine1 addressLine2 addressLine3 addressLine4 city zipCode
+
+toCustomerInfo :: UnvalidatedCustomerInfo.UnvalidatedCustomerInfo -> CustomerInfo.CustomerInfo
+toCustomerInfo unvalidatedCustomerInfo = 
+  let 
+    firstName = string50 $ UnvalidatedCustomerInfo.firstName unvalidatedCustomerInfo
+    lastName = string50 $ UnvalidatedCustomerInfo.lastName unvalidatedCustomerInfo
+    emailAddress = EmailAddress $ UnvalidatedCustomerInfo.emailAddress unvalidatedCustomerInfo
+    name = PersonalName.PersonalName firstName lastName
+  in
+    CustomerInfo.CustomerInfo name emailAddress
+
+predicatePassthru :: String -> (a -> Bool) -> a -> a
+predicatePassthru errorMsg f x = if f x then x else error errorMsg
+
+toProductCode :: CheckProductCodeExists -> String -> ProductCode.ProductCode
+toProductCode checkProductCodeExists str = 
+  let 
+    errorMsg = "Invalid: " <> str
+    result = predicatePassthru errorMsg checkProductCodeExists str
+  in
+    ProductCode.create result
+
+toOrderQuantity :: ProductCode.ProductCode -> Double -> OrderQuantity
+toOrderQuantity productCode value =
+  case productCode of
+    ProductCode.Widget _ -> (UnitQuantity . UnitQuantity.create) (round value :: Int)
+    ProductCode.Gizmo _ -> (KilogramQuantity . KilogramQuantity.create) value
+
+-- toShippingAddress :: UnvalidatedAddress -> ShippingAddress 
+-- toShippingAddress str = undefined
+
+-- toBillingAddress :: UnvalidatedAddress -> BillingAddress 
+-- toBillingAddress str = undefined
+
+type CheckProductCodeExists = String -> Bool
+validateOrder :: CheckProductCodeExists -> CheckAddressExists -> UnvalidatedOrder.UnvalidatedOrder -> Either String ValidatedOrder.ValidatedOrder
+validateOrder checkProductCodeExists checkAddressExists unvalidatedOrder = 
+  let
+    orderId = OrderId.orderId $ UnvalidatedOrder.orderId unvalidatedOrder 
+    customerInfo = toCustomerInfo $ UnvalidatedOrder.customerInfo unvalidatedOrder
+    shippingAddress = toAddress checkAddressExists $ UnvalidatedOrder.shippingAddress unvalidatedOrder
+    billingAddress = toAddress checkAddressExists $ UnvalidatedOrder.shippingAddress unvalidatedOrder
+    orderLines = map (toValidatedOrderLine checkProductCodeExists) $ UnvalidatedOrder.orderLines unvalidatedOrder
+    validatedOrder = ValidatedOrder.ValidatedOrder orderId customerInfo shippingAddress billingAddress orderLines
+  in
+    Right validatedOrder
+
+type ToValidatedOrderLine = CheckProductCodeExists -> UnvalidatedOrderLine.UnvalidatedOrderLine -> OrderLine.OrderLine
+toValidatedOrderLine checkProductCodeExists unvalidatedOrderLine =
+  let
+    orderLineId = OrderLineId.create $ UnvalidatedOrderLine.orderLineId unvalidatedOrderLine
+    productCode = toProductCode checkProductCodeExists $ UnvalidatedOrderLine.productCode unvalidatedOrderLine
+    quantity = toOrderQuantity productCode (UnvalidatedOrderLine.quantity unvalidatedOrderLine)
+  in
+    OrderLine.OrderLine orderLineId productCode quantity
 
-type GetProductPrice = ProductCode -> Price
+type GetProductPrice = ProductCode.ProductCode -> Price
 priceOrder :: GetProductPrice -> ValidatedOrder.ValidatedOrder -> Either PricingError PricedOrder
 priceOrder = undefined
 

src/PersonalName.hs

@@ -0,0 +1,8 @@
+module PersonalName where
+
+import String50
+
+data PersonalName = PersonalName {
+  firstName :: String50,
+  lastName :: String50
+}

src/PlaceOrderWorkflow.hs

@@ -6,12 +6,13 @@ import ValidatedOrder
 import UnvalidatedOrder
 import qualified PricedOrder
 import qualified OrderLine
+import qualified OrderId
 
 type OrderPlaced = PricedOrder 
 type PlaceOrder = Command UnvalidatedOrder
 
 data BillableOrderPlaced = BillableOrderPlaced {
-  orderId :: OrderId,
+  orderId :: OrderId.OrderId,
   billingAddress :: BillingAddress,
   amountToBill :: BillingAmount
 }

src/PricedOrder.hs

@@ -3,10 +3,12 @@ module PricedOrder where
 import SharedTypes
 import PricedOrderLine
 import Data.List.NonEmpty
+import qualified OrderId
+import qualified CustomerInfo
 
 data PricedOrder = PricedOrder {
-  orderId :: OrderId,
-  customerInfo :: CustomerInfo,
+  orderId :: OrderId.OrderId,
+  customerInfo :: CustomerInfo.CustomerInfo,
   shippingAddress :: ShippingAddress,
   billingAddress :: BillingAddress,
   orderLines :: NonEmpty PricedOrderLine,

src/PricedOrderLine.hs

@@ -1,10 +1,12 @@
 module PricedOrderLine where
 
 import SharedTypes
+import qualified OrderId
+import qualified OrderLineId
 
 data PricedOrderLine = PricedOrderLine {
-  orderLineId :: OrderLineId,
-  orderId :: OrderId,
+  orderLineId :: OrderLineId.OrderLineId,
+  orderId :: OrderId.OrderId,
   productId :: ProductId,
   orderQuantity :: Int,
   price :: Price

src/ProductCode.hs

@@ -0,0 +1,11 @@
+module ProductCode(
+  ProductCode(Widget, Gizmo), create, value -- exporting data constructors to be able to pattern match
+) where
+
+data ProductCode = Widget String | Gizmo String deriving (Show)
+
+create :: String -> ProductCode
+create value = undefined
+
+value :: ProductCode -> Double
+value _ = undefined

src/SharedTypes.hs

@@ -1,9 +1,8 @@
 module SharedTypes where
 
 import Data.Time
+import String50
 
-newtype OrderId = OrderId String deriving (Eq, Show)
-newtype OrderLineId = OrderLineId String deriving (Eq, Show)
 newtype ProductId = ProductId String deriving (Eq, Show)
 newtype CustomerId = CustomerId Int deriving (Show)
 newtype InvoiceId = InvoiceId Int deriving (Show)
@@ -24,23 +23,23 @@ newtype AddressValidationError = AddressValidationError String deriving Show
 
 newtype HTMLString = HTMLString String deriving Show
 
+newtype City = City String50 deriving Show
+newtype ZipCode = ZipCode String deriving Show
+
 -- TODO
 newtype AcknowledgmentSent = AcknowledgmentSent String
 newtype EmailContactInfo = EmailContactInfo String deriving Show
 newtype PostalContactInfo = PostalContactInfo String deriving Show
-newtype CustomerInfo = CustomerInfo String deriving Show
 newtype PricedOrder = PricedOrder String deriving Show
 
 newtype PricingError = PricingError String deriving Show
 
-data ProductCode = WidgetCode String | GizmoCode String deriving (Show)
 data CardType = Visa | Master deriving (Show)
 
 data SendResult = Sent | NotSent
 
 data CustomerEmail = Unverfied EmailAddress | Verified VerifiedEmailAddress deriving Show
 
-
 data ShippingAddress = ShippingAddress {
 }