Nw Fp Haskell

# Install GHCup (manages GHC, cabal, stack, HLS)
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh

# Create project
mkdir order-service && cd order-service && cabal init --interactive
# Or: stack new order-service simple && stack build && stack test

data PaymentMethod
  = CreditCard CardNumber ExpiryDate
  | BankTransfer AccountNumber
  | Cash
  deriving (Eq, Show)

data Customer = Customer
  { customerId    :: CustomerId
  , customerName  :: CustomerName
  , customerEmail :: EmailAddress
  } deriving (Eq, Show)

newtype OrderId = OrderId Int deriving (Eq, Ord, Show)
newtype EmailAddress = EmailAddress Text deriving (Eq, Show)

module Domain.Email (EmailAddress, mkEmailAddress, emailToText) where

import Data.Text (Text)
import qualified Data.Text as T

newtype EmailAddress = EmailAddress Text deriving (Eq, Show)

mkEmailAddress :: Text -> Either ValidationError EmailAddress
mkEmailAddress raw
  | "@" `T.isInfixOf` raw = Right (EmailAddress raw)
  | otherwise              = Left (InvalidEmail raw)

-- (.) composes right-to-left
processOrder :: RawOrder -> Either OrderError Confirmation
processOrder = confirmOrder . priceOrder . validateOrder

placeOrder :: RawOrder -> Either OrderError Confirmation
placeOrder raw = do
  validated <- validateOrder raw
  priced    <- priceOrder validated
  confirmOrder priced

mkCustomer :: Text -> Text -> Either ValidationError Customer
mkCustomer rawName rawEmail =
  Customer
    <$> mkCustomerId 0
    <*> mkCustomerName rawName
    <*> mkEmailAddress rawEmail

import Data.Validation (Validation, failure, success)

mkCustomerV :: Text -> Text -> Validation [ValidationError] Customer
mkCustomerV rawName rawEmail =
  Customer
    <$> validateName rawName    -- Validation [ValidationError] CustomerName
    <*> validateEmail rawEmail  -- all errors collected, not short-circuited

calculateTotal :: Order -> Money           -- Pure: compiler guarantees no side effects
calculateTotal order = sumOf (orderLines order)

saveOrder :: Order -> IO ()                -- Impure: IO in the type
saveOrder order = writeToDatabase order
-- calculateTotal CANNOT call saveOrder -- compiler error

-- Layer 1: Pure domain (no IO, no effects)
module Domain.Order (calculateDiscount, validateOrder) where
calculateDiscount :: Order -> Discount
calculateDiscount order
  | totalLines order > 10 = Discount 0.1
  | otherwise              = Discount 0.0

-- Layer 2: Effect interfaces (type classes as ports)
class Monad m => OrderRepo m where
  findOrder :: OrderId -> m (Maybe Order)
  saveOrder :: Order -> m ()

-- Layer 3: IO implementations (adapters)
instance OrderRepo IO where
  findOrder orderId = queryDatabase orderId
  saveOrder order   = insertDatabase order

import Test.Hspec
import Test.QuickCheck

spec :: Spec
spec = describe "validateOrder" $ do
  it "round-trips through serialization" $
    property $ \order ->
      deserializeOrder (serializeOrder order) === Right order

  it "validated orders always have positive totals" $
    property $ \rawOrder ->
      case validateOrder rawOrder of
        Left _      -> discard
        Right valid -> orderTotal valid > Money 0

import Data.Text (pack)
import Test.QuickCheck

genValidEmail :: Gen EmailAddress
genValidEmail = do
  user   <- listOf1 (elements ['a'..'z'])
  domain <- listOf1 (elements ['a'..'z'])
  pure (EmailAddress (pack (user ++ "@" ++ domain ++ ".com")))

{-# LANGUAGE GADTs, DataKinds #-}

data OrderState = Unvalidated | Validated | Priced

data Order (s :: OrderState) where
  UnvalidatedOrder :: RawData -> Order 'Unvalidated
  ValidatedOrder   :: ValidData -> Order 'Validated
  PricedOrder      :: PricedData -> Order 'Priced

-- Type-safe transitions: only validated orders can be priced
priceOrder :: Order 'Validated -> Either PricingError (Order 'Priced)
priceOrder (ValidatedOrder d) = Right (PricedOrder (addPricing d))

eligibleOrders :: [Order] -> [Order]
eligibleOrders = take 10 . filter isEligible . sortBy orderDate