Add two additional Haskell examples (with their note files)

2026-04-28 11:13:07 +02:00 · 2026-04-28 11:13:07 +02:00 · f517fa533f
commit f517fa533f
parent 6787a9cc4f
17 changed files with 949 additions and 0 deletions
--- a/28-haskell-applicative-validation/README.md
+++ b/28-haskell-applicative-validation/README.md
@ -0,0 +1,25 @@
+# 28-haskell-applicative-validation
+
+This example shows intermediate Haskell validation with an Applicative error accumulator.
+
+It includes:
+
+- a custom `Validation` type that accumulates multiple errors,
+- a release manifest built from validated fields,
+- a CLI that reports all invalid fields at once, and
+- a test suite run by `nix flake check`.
+
+Useful commands:
+
+```bash
+nix develop
+cabal run
+cabal run -- service=api-gateway env=production owners=platform,security replicas=3 strategy=canary:20 window=22-24
+cabal test
+
+nix build
+./result/bin/mini-validation service=api-gateway env=production owners=platform,security replicas=3 strategy=canary:20 window=22-24
+
+nix run . -- service=api-gateway env=production owners=platform,security replicas=3 strategy=canary:20 window=22-24
+nix flake check
+```
--- a/28-haskell-applicative-validation/app/Main.hs
+++ b/28-haskell-applicative-validation/app/Main.hs
@ -0,0 +1,33 @@
+module Main where
+
+import MiniValidation.Manifest
+  ( Validation (Failure, Success)
+  , readRawManifest
+  , renderManifest
+  , renderValidationErrors
+  , validateManifest
+  )
+import System.Environment (getArgs)
+import System.Exit (die)
+
+main :: IO ()
+main = do
+  args <- getArgs
+  let inputArgs =
+        case args of
+          [] ->
+            [ "service=api-gateway"
+            , "env=production"
+            , "owners=platform,security"
+            , "replicas=3"
+            , "strategy=canary:20"
+            , "window=22-24"
+            ]
+          _ -> args
+
+  case readRawManifest inputArgs of
+    Left err -> die err
+    Right rawManifest ->
+      case validateManifest rawManifest of
+        Failure validationErrors -> die (renderValidationErrors validationErrors)
+        Success manifest -> putStrLn (renderManifest manifest)
--- a/28-haskell-applicative-validation/flake.lock
+++ b/28-haskell-applicative-validation/flake.lock
@ -0,0 +1,27 @@
+{
+  "nodes": {
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1776548001,
+        "narHash": "sha256-ZSK0NL4a1BwVbbTBoSnWgbJy9HeZFXLYQizjb2DPF24=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "b12141ef619e0a9c1c84dc8c684040326f27cdcc",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "ref": "nixos-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}
--- a/28-haskell-applicative-validation/flake.nix
+++ b/28-haskell-applicative-validation/flake.nix
@ -0,0 +1,38 @@
+{
+  # Builds a Haskell project that validates a release manifest with an
+  # Applicative validation type that accumulates multiple field errors.
+  description = "A Haskell project for Applicative validation";
+
+  inputs = {
+    nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
+  };
+
+  outputs =
+    { self, nixpkgs, ... }:
+    let
+      system = "x86_64-linux";
+      pkgs = import nixpkgs { inherit system; };
+      inherit (pkgs) haskellPackages;
+      project = haskellPackages.callCabal2nix "mini-validation" ./. { };
+      checkedProject = pkgs.haskell.lib.doCheck project;
+    in
+    {
+      packages.${system}.default = project;
+
+      apps.${system}.default = {
+        type = "app";
+        program = "${self.packages.${system}.default}/bin/mini-validation";
+        meta.description = "Run the Applicative validation example.";
+      };
+
+      devShells.${system}.default = pkgs.mkShell {
+        packages = [
+          haskellPackages.ghc
+          pkgs.cabal-install
+          pkgs.haskell-language-server
+        ];
+      };
+
+      checks.${system}.test-suite = checkedProject;
+    };
+}
--- a/28-haskell-applicative-validation/mini-validation.cabal
+++ b/28-haskell-applicative-validation/mini-validation.cabal
@ -0,0 +1,28 @@
+cabal-version:      2.4
+name:               mini-validation
+version:            0.1.0.0
+build-type:         Simple
+
+library
+  exposed-modules:  MiniValidation.Manifest
+  hs-source-dirs:   src
+  build-depends:
+      base >=4.14 && <5
+  default-language: Haskell2010
+
+executable mini-validation
+  main-is:          Main.hs
+  hs-source-dirs:   app
+  build-depends:
+      base >=4.14 && <5,
+      mini-validation
+  default-language: Haskell2010
+
+test-suite mini-validation-test
+  type:             exitcode-stdio-1.0
+  main-is:          Main.hs
+  hs-source-dirs:   test
+  build-depends:
+      base >=4.14 && <5,
+      mini-validation
+  default-language: Haskell2010
--- a/28-haskell-applicative-validation/src/MiniValidation/Manifest.hs
+++ b/28-haskell-applicative-validation/src/MiniValidation/Manifest.hs
@ -0,0 +1,222 @@
+module MiniValidation.Manifest where
+
+import Data.Char (isDigit, isLower)
+import Data.List (group, intercalate)
+
+data Validation errorValue value
+  = Failure errorValue
+  | Success value
+  deriving (Eq, Show)
+
+instance Functor (Validation errorValue) where
+  fmap _ (Failure err) = Failure err
+  fmap f (Success value) = Success (f value)
+
+instance Semigroup errorValue => Applicative (Validation errorValue) where
+  pure = Success
+  Failure leftError <*> Failure rightError = Failure (leftError <> rightError)
+  Failure err <*> _ = Failure err
+  _ <*> Failure err = Failure err
+  Success f <*> Success value = Success (f value)
+
+data Environment
+  = Staging
+  | Production
+  deriving (Eq, Show)
+
+data RolloutStrategy
+  = Rolling
+  | Canary Int
+  deriving (Eq, Show)
+
+data MaintenanceWindow = MaintenanceWindow
+  { windowStartHour :: Int
+  , windowEndHour :: Int
+  }
+  deriving (Eq, Show)
+
+data ReleaseManifest = ReleaseManifest
+  { manifestService :: String
+  , manifestEnvironment :: Environment
+  , manifestOwners :: [String]
+  , manifestReplicas :: Int
+  , manifestStrategy :: RolloutStrategy
+  , manifestWindow :: MaintenanceWindow
+  }
+  deriving (Eq, Show)
+
+data RawManifest = RawManifest
+  { rawService :: Maybe String
+  , rawEnvironment :: Maybe String
+  , rawOwners :: Maybe String
+  , rawReplicas :: Maybe String
+  , rawStrategy :: Maybe String
+  , rawWindow :: Maybe String
+  }
+  deriving (Eq, Show)
+
+emptyRawManifest :: RawManifest
+emptyRawManifest =
+  RawManifest
+    { rawService = Nothing
+    , rawEnvironment = Nothing
+    , rawOwners = Nothing
+    , rawReplicas = Nothing
+    , rawStrategy = Nothing
+    , rawWindow = Nothing
+    }
+
+readRawManifest :: [String] -> Either String RawManifest
+readRawManifest = foldl step (Right emptyRawManifest)
+  where
+    step (Left err) _ = Left err
+    step (Right manifest) assignment = do
+      (key, value) <- parseAssignment assignment
+      applyAssignment key value manifest
+
+parseAssignment :: String -> Either String (String, String)
+parseAssignment input =
+  case break (== '=') input of
+    ([], _) -> Left ("expected key=value, got: " ++ input)
+    (_, "") -> Left ("expected key=value, got: " ++ input)
+    (key, '=' : value)
+      | null value -> Left ("missing value for key: " ++ key)
+      | otherwise -> Right (key, value)
+    _ -> Left ("expected key=value, got: " ++ input)
+
+applyAssignment :: String -> String -> RawManifest -> Either String RawManifest
+applyAssignment "service" value manifest = Right manifest { rawService = Just value }
+applyAssignment "env" value manifest = Right manifest { rawEnvironment = Just value }
+applyAssignment "owners" value manifest = Right manifest { rawOwners = Just value }
+applyAssignment "replicas" value manifest = Right manifest { rawReplicas = Just value }
+applyAssignment "strategy" value manifest = Right manifest { rawStrategy = Just value }
+applyAssignment "window" value manifest = Right manifest { rawWindow = Just value }
+applyAssignment key _ _ = Left ("unknown field: " ++ key)
+
+validateManifest :: RawManifest -> Validation [String] ReleaseManifest
+validateManifest rawManifest =
+  ReleaseManifest
+    <$> validateService (rawService rawManifest)
+    <*> validateEnvironment (rawEnvironment rawManifest)
+    <*> validateOwners (rawOwners rawManifest)
+    <*> validateReplicas (rawReplicas rawManifest)
+    <*> validateStrategy (rawStrategy rawManifest)
+    <*> validateWindow (rawWindow rawManifest)
+
+validateService :: Maybe String -> Validation [String] String
+validateService Nothing = Failure ["service is required"]
+validateService (Just serviceName)
+  | length serviceName < 3 = Failure ["service must be at least 3 characters long"]
+  | not (all validServiceChar serviceName) =
+      Failure ["service must use lowercase letters and hyphens only"]
+  | otherwise = Success serviceName
+
+validateEnvironment :: Maybe String -> Validation [String] Environment
+validateEnvironment Nothing = Failure ["env is required"]
+validateEnvironment (Just "staging") = Success Staging
+validateEnvironment (Just "production") = Success Production
+validateEnvironment (Just otherValue) = Failure ["unknown environment: " ++ otherValue]
+
+validateOwners :: Maybe String -> Validation [String] [String]
+validateOwners Nothing = Failure ["owners is required"]
+validateOwners (Just rawOwnerList) =
+  let owners = splitOn ',' rawOwnerList
+   in case () of
+        _ | null owners -> Failure ["owners must contain at least one owner"]
+          | any null owners -> Failure ["owners must not contain empty entries"]
+          | hasDuplicates owners -> Failure ["owners must not contain duplicates"]
+          | otherwise -> Success owners
+
+validateReplicas :: Maybe String -> Validation [String] Int
+validateReplicas Nothing = Failure ["replicas is required"]
+validateReplicas (Just rawValue) =
+  case reads rawValue of
+    [(replicaCount, "")]
+      | replicaCount >= 2 -> Success replicaCount
+      | otherwise -> Failure ["replicas must be at least 2"]
+    _ -> Failure ["replicas must be a whole number"]
+
+validateStrategy :: Maybe String -> Validation [String] RolloutStrategy
+validateStrategy Nothing = Failure ["strategy is required"]
+validateStrategy (Just "rolling") = Success Rolling
+validateStrategy (Just rawValue) =
+  case break (== ':') rawValue of
+    ("canary", ':' : rawPercent) ->
+      case reads rawPercent of
+        [(percent, "")]
+          | percent >= 1 && percent <= 50 -> Success (Canary percent)
+          | otherwise -> Failure ["canary percentage must be between 1 and 50"]
+        _ -> Failure ["canary percentage must be a whole number"]
+    _ -> Failure ["strategy must be rolling or canary:<percent>"]
+
+validateWindow :: Maybe String -> Validation [String] MaintenanceWindow
+validateWindow Nothing = Failure ["window is required"]
+validateWindow (Just rawValue) =
+  case break (== '-') rawValue of
+    (rawStart, '-' : rawEnd)
+      | all isDigits [rawStart, rawEnd] ->
+          case (reads rawStart, reads rawEnd) of
+            ([(startHour, "")], [(endHour, "")])
+              | startHour < 0 || endHour > 24 ->
+                  Failure ["window hours must stay within 0 and 24"]
+              | startHour >= endHour ->
+                  Failure ["window start must be before window end"]
+              | otherwise ->
+                  Success
+                    MaintenanceWindow
+                      { windowStartHour = startHour
+                      , windowEndHour = endHour
+                      }
+            _ -> Failure ["window must use whole hours"]
+      | otherwise -> Failure ["window must use whole hours"]
+    _ -> Failure ["window must use the form start-end"]
+
+renderManifest :: ReleaseManifest -> String
+renderManifest manifest =
+  intercalate
+    ", "
+    [ "service " ++ manifestService manifest
+    , "env " ++ renderEnvironment (manifestEnvironment manifest)
+    , "owners " ++ intercalate "/" (manifestOwners manifest)
+    , "replicas " ++ show (manifestReplicas manifest)
+    , "strategy " ++ renderStrategy (manifestStrategy manifest)
+    , "window " ++ renderWindow (manifestWindow manifest)
+    ]
+
+renderValidationErrors :: [String] -> String
+renderValidationErrors errors = unlines (map ("- " ++) errors)
+
+renderEnvironment :: Environment -> String
+renderEnvironment Staging = "staging"
+renderEnvironment Production = "production"
+
+renderStrategy :: RolloutStrategy -> String
+renderStrategy Rolling = "rolling"
+renderStrategy (Canary percent) = "canary " ++ show percent ++ "%"
+
+renderWindow :: MaintenanceWindow -> String
+renderWindow window = show (windowStartHour window) ++ "-" ++ show (windowEndHour window)
+
+splitOn :: Char -> String -> [String]
+splitOn separator = go []
+  where
+    go current [] = [reverse current]
+    go current (nextChar : remainingChars)
+      | nextChar == separator = reverse current : go [] remainingChars
+      | otherwise = go (nextChar : current) remainingChars
+
+validServiceChar :: Char -> Bool
+validServiceChar nextChar = isLower nextChar || nextChar == '-'
+
+isDigits :: String -> Bool
+isDigits = all isDigit
+
+hasDuplicates :: Ord value => [value] -> Bool
+hasDuplicates = any ((> 1) . length) . group . quickSort
+
+quickSort :: Ord value => [value] -> [value]
+quickSort [] = []
+quickSort (pivot : remainingValues) =
+  quickSort [ value | value <- remainingValues, value <= pivot ]
+    ++ [pivot]
+    ++ quickSort [ value | value <- remainingValues, value > pivot ]
--- a/28-haskell-applicative-validation/test/Main.hs
+++ b/28-haskell-applicative-validation/test/Main.hs
@ -0,0 +1,47 @@
+module Main where
+
+import MiniValidation.Manifest
+  ( Environment (Production)
+  , MaintenanceWindow (MaintenanceWindow)
+  , ReleaseManifest (ReleaseManifest)
+  , RolloutStrategy (Canary)
+  , Validation (Failure, Success)
+  , readRawManifest
+  , renderManifest
+  , validateManifest
+  )
+import System.Exit (die)
+
+main :: IO ()
+main =
+  case
+    ( readRawManifest
+        [ "service=api-gateway"
+        , "env=production"
+        , "owners=platform,security"
+        , "replicas=3"
+        , "strategy=canary:20"
+        , "window=22-24"
+        ]
+    , readRawManifest
+        [ "service=API"
+        , "env=prod"
+        , "owners=platform,platform"
+        , "replicas=1"
+        , "strategy=canary:75"
+        , "window=24-20"
+        ]
+    ) of
+    ( Right validRawManifest
+      , Right invalidRawManifest
+      ) ->
+        case (validateManifest validRawManifest, validateManifest invalidRawManifest) of
+          ( Success (ReleaseManifest "api-gateway" Production ["platform", "security"] 3 (Canary 20) (MaintenanceWindow 22 24))
+            , Failure validationErrors
+            ) | renderManifest
+                  (ReleaseManifest "api-gateway" Production ["platform", "security"] 3 (Canary 20) (MaintenanceWindow 22 24))
+                  == "service api-gateway, env production, owners platform/security, replicas 3, strategy canary 20%, window 22-24"
+                  && length validationErrors == 6 ->
+                    putStrLn "test passed"
+          _ -> die "unexpected validation result"
+    _ -> die "unexpected manifest parse result"
--- a/29-haskell-foldmap-summary/README.md
+++ b/29-haskell-foldmap-summary/README.md
@ -0,0 +1,25 @@
+# 29-haskell-foldmap-summary
+
+This example shows intermediate Haskell aggregation with `foldMap` and monoids.
+
+It includes:
+
+- a structured deployment event type,
+- a summary type built from monoidal fields,
+- one `foldMap` pass that aggregates several useful metrics, and
+- a test suite run by `nix flake check`.
+
+Useful commands:
+
+```bash
+nix develop
+cabal run
+cabal run -- api:production:succeeded:3:platform,security worker:staging:failed-db-lock:1:ops ui:production:cancelled:2:frontend
+cabal test
+
+nix build
+./result/bin/mini-summary api:production:succeeded:3:platform,security worker:staging:failed-db-lock:1:ops ui:production:cancelled:2:frontend
+
+nix run . -- api:production:succeeded:3:platform,security worker:staging:failed-db-lock:1:ops ui:production:cancelled:2:frontend
+nix flake check
+```
--- a/29-haskell-foldmap-summary/app/Main.hs
+++ b/29-haskell-foldmap-summary/app/Main.hs
@ -0,0 +1,25 @@
+module Main where
+
+import MiniSummary.Report
+  ( parseEvent
+  , renderSummary
+  , summarizeEvents
+  )
+import System.Environment (getArgs)
+import System.Exit (die)
+
+main :: IO ()
+main = do
+  args <- getArgs
+  let inputArgs =
+        case args of
+          [] ->
+            [ "api:production:succeeded:3:platform,security"
+            , "worker:staging:failed-db-lock:1:ops"
+            , "ui:production:cancelled:2:frontend"
+            ]
+          _ -> args
+
+  case traverse parseEvent inputArgs of
+    Left err -> die err
+    Right events -> putStrLn (renderSummary (summarizeEvents events))
--- a/29-haskell-foldmap-summary/flake.lock
+++ b/29-haskell-foldmap-summary/flake.lock
@ -0,0 +1,27 @@
+{
+  "nodes": {
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1776548001,
+        "narHash": "sha256-ZSK0NL4a1BwVbbTBoSnWgbJy9HeZFXLYQizjb2DPF24=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "b12141ef619e0a9c1c84dc8c684040326f27cdcc",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "ref": "nixos-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}
--- a/29-haskell-foldmap-summary/flake.nix
+++ b/29-haskell-foldmap-summary/flake.nix
@ -0,0 +1,38 @@
+{
+  # Builds a Haskell project that summarizes deployment events with foldMap
+  # and monoidal summary values.
+  description = "A Haskell project for foldMap summaries";
+
+  inputs = {
+    nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
+  };
+
+  outputs =
+    { self, nixpkgs, ... }:
+    let
+      system = "x86_64-linux";
+      pkgs = import nixpkgs { inherit system; };
+      inherit (pkgs) haskellPackages;
+      project = haskellPackages.callCabal2nix "mini-summary" ./. { };
+      checkedProject = pkgs.haskell.lib.doCheck project;
+    in
+    {
+      packages.${system}.default = project;
+
+      apps.${system}.default = {
+        type = "app";
+        program = "${self.packages.${system}.default}/bin/mini-summary";
+        meta.description = "Run the foldMap summary example.";
+      };
+
+      devShells.${system}.default = pkgs.mkShell {
+        packages = [
+          haskellPackages.ghc
+          pkgs.cabal-install
+          pkgs.haskell-language-server
+        ];
+      };
+
+      checks.${system}.test-suite = checkedProject;
+    };
+}
--- a/29-haskell-foldmap-summary/mini-summary.cabal
+++ b/29-haskell-foldmap-summary/mini-summary.cabal
@ -0,0 +1,30 @@
+cabal-version:      2.4
+name:               mini-summary
+version:            0.1.0.0
+build-type:         Simple
+
+library
+  exposed-modules:  MiniSummary.Report
+  hs-source-dirs:   src
+  build-depends:
+      base >=4.14 && <5,
+      containers
+  default-language: Haskell2010
+
+executable mini-summary
+  main-is:          Main.hs
+  hs-source-dirs:   app
+  build-depends:
+      base >=4.14 && <5,
+      mini-summary
+  default-language: Haskell2010
+
+test-suite mini-summary-test
+  type:             exitcode-stdio-1.0
+  main-is:          Main.hs
+  hs-source-dirs:   test
+  build-depends:
+      base >=4.14 && <5,
+      containers,
+      mini-summary
+  default-language: Haskell2010
--- a/29-haskell-foldmap-summary/src/MiniSummary/Report.hs
+++ b/29-haskell-foldmap-summary/src/MiniSummary/Report.hs
@ -0,0 +1,190 @@
+module MiniSummary.Report where
+
+import Data.List (intercalate)
+import qualified Data.Set as Set
+import Data.Set (Set)
+
+data Environment
+  = Staging
+  | Production
+  deriving (Eq, Ord, Show)
+
+data DeploymentStatus
+  = Succeeded
+  | Failed String
+  | Cancelled
+  deriving (Eq, Ord, Show)
+
+data DeploymentEvent = DeploymentEvent
+  { eventService :: String
+  , eventEnvironment :: Environment
+  , eventStatus :: DeploymentStatus
+  , eventReplicas :: Int
+  , eventOwners :: [String]
+  }
+  deriving (Eq, Show)
+
+newtype Count = Count
+  { unCount :: Int
+  }
+  deriving (Eq, Show)
+
+instance Semigroup Count where
+  Count leftValue <> Count rightValue = Count (leftValue + rightValue)
+
+instance Monoid Count where
+  mempty = Count 0
+
+newtype LargestReplicas = LargestReplicas
+  { unLargestReplicas :: Int
+  }
+  deriving (Eq, Show)
+
+instance Semigroup LargestReplicas where
+  LargestReplicas leftValue <> LargestReplicas rightValue =
+    LargestReplicas (max leftValue rightValue)
+
+instance Monoid LargestReplicas where
+  mempty = LargestReplicas 0
+
+newtype CancelledSeen = CancelledSeen
+  { unCancelledSeen :: Bool
+  }
+  deriving (Eq, Show)
+
+instance Semigroup CancelledSeen where
+  CancelledSeen leftValue <> CancelledSeen rightValue = CancelledSeen (leftValue || rightValue)
+
+instance Monoid CancelledSeen where
+  mempty = CancelledSeen False
+
+data DeploymentSummary = DeploymentSummary
+  { totalDeployments :: Count
+  , productionDeployments :: Count
+  , totalReplicas :: Count
+  , failedServices :: Set String
+  , activeOwners :: Set String
+  , cancelledSeen :: CancelledSeen
+  , largestReplicaCount :: LargestReplicas
+  }
+  deriving (Eq, Show)
+
+instance Semigroup DeploymentSummary where
+  leftSummary <> rightSummary =
+    DeploymentSummary
+      { totalDeployments = totalDeployments leftSummary <> totalDeployments rightSummary
+      , productionDeployments = productionDeployments leftSummary <> productionDeployments rightSummary
+      , totalReplicas = totalReplicas leftSummary <> totalReplicas rightSummary
+      , failedServices = failedServices leftSummary <> failedServices rightSummary
+      , activeOwners = activeOwners leftSummary <> activeOwners rightSummary
+      , cancelledSeen = cancelledSeen leftSummary <> cancelledSeen rightSummary
+      , largestReplicaCount = largestReplicaCount leftSummary <> largestReplicaCount rightSummary
+      }
+
+instance Monoid DeploymentSummary where
+  mempty =
+    DeploymentSummary
+      { totalDeployments = mempty
+      , productionDeployments = mempty
+      , totalReplicas = mempty
+      , failedServices = mempty
+      , activeOwners = mempty
+      , cancelledSeen = mempty
+      , largestReplicaCount = mempty
+      }
+
+parseEvent :: String -> Either String DeploymentEvent
+parseEvent rawEvent =
+  case splitOn ':' rawEvent of
+    [serviceName, environmentName, statusName, rawReplicas, rawOwners] -> do
+      environment <- parseEnvironment environmentName
+      status <- parseStatus statusName
+      replicas <- parseReplicas rawReplicas
+      let owners = splitOn ',' rawOwners
+      if any null owners then
+        Left "owners must not contain empty entries"
+      else
+        Right
+          DeploymentEvent
+            { eventService = serviceName
+            , eventEnvironment = environment
+            , eventStatus = status
+            , eventReplicas = replicas
+            , eventOwners = owners
+            }
+    _ -> Left ("expected <service>:<environment>:<status>:<replicas>:<owners>, got: " ++ rawEvent)
+
+parseEnvironment :: String -> Either String Environment
+parseEnvironment "staging" = Right Staging
+parseEnvironment "production" = Right Production
+parseEnvironment otherValue = Left ("unknown environment: " ++ otherValue)
+
+parseStatus :: String -> Either String DeploymentStatus
+parseStatus "succeeded" = Right Succeeded
+parseStatus "cancelled" = Right Cancelled
+parseStatus rawStatus =
+  case splitOn '-' rawStatus of
+    "failed" : reasonParts
+      | not (null reasonParts) -> Right (Failed (intercalate "-" reasonParts))
+    _ -> Left ("unknown status: " ++ rawStatus)
+
+parseReplicas :: String -> Either String Int
+parseReplicas rawReplicas =
+  case reads rawReplicas of
+    [(replicas, "")]
+      | replicas > 0 -> Right replicas
+      | otherwise -> Left "replicas must be greater than zero"
+    _ -> Left ("invalid replica count: " ++ rawReplicas)
+
+summarizeEvents :: [DeploymentEvent] -> DeploymentSummary
+summarizeEvents = foldMap summarizeEvent
+
+summarizeEvent :: DeploymentEvent -> DeploymentSummary
+summarizeEvent deploymentEvent =
+  DeploymentSummary
+    { totalDeployments = Count 1
+    , productionDeployments =
+        case eventEnvironment deploymentEvent of
+          Production -> Count 1
+          Staging -> Count 0
+    , totalReplicas = Count (eventReplicas deploymentEvent)
+    , failedServices =
+        case eventStatus deploymentEvent of
+          Failed _ -> Set.singleton (eventService deploymentEvent)
+          _ -> Set.empty
+    , activeOwners = Set.fromList (eventOwners deploymentEvent)
+    , cancelledSeen =
+        case eventStatus deploymentEvent of
+          Cancelled -> CancelledSeen True
+          _ -> CancelledSeen False
+    , largestReplicaCount = LargestReplicas (eventReplicas deploymentEvent)
+    }
+
+renderSummary :: DeploymentSummary -> String
+renderSummary summary =
+  unlines
+    [ "total deployments: " ++ show (unCount (totalDeployments summary))
+    , "production deployments: " ++ show (unCount (productionDeployments summary))
+    , "total replicas: " ++ show (unCount (totalReplicas summary))
+    , "largest rollout: " ++ show (unLargestReplicas (largestReplicaCount summary))
+    , "cancelled seen: " ++ renderBool (unCancelledSeen (cancelledSeen summary))
+    , "failed services: " ++ renderSet (failedServices summary)
+    , "owners: " ++ renderSet (activeOwners summary)
+    ]
+
+renderBool :: Bool -> String
+renderBool True = "yes"
+renderBool False = "no"
+
+renderSet :: Set String -> String
+renderSet values
+  | Set.null values = "none"
+  | otherwise = intercalate ", " (Set.toAscList values)
+
+splitOn :: Char -> String -> [String]
+splitOn separator = go []
+  where
+    go current [] = [reverse current]
+    go current (nextChar : remainingChars)
+      | nextChar == separator = reverse current : go [] remainingChars
+      | otherwise = go (nextChar : current) remainingChars
--- a/29-haskell-foldmap-summary/test/Main.hs
+++ b/29-haskell-foldmap-summary/test/Main.hs
@ -0,0 +1,38 @@
+module Main where
+
+import MiniSummary.Report
+  ( Count (Count)
+  , DeploymentSummary (..)
+  , LargestReplicas (LargestReplicas)
+  , parseEvent
+  , renderSummary
+  , summarizeEvents
+  )
+import qualified Data.Set as Set
+import System.Exit (die)
+
+main :: IO ()
+main =
+  case
+    traverse
+      parseEvent
+      [ "api:production:succeeded:3:platform,security"
+      , "worker:staging:failed-db-lock:1:ops"
+      , "ui:production:cancelled:2:frontend"
+      ] of
+    Left err -> die err
+    Right events ->
+      case summarizeEvents events of
+        DeploymentSummary
+          { totalDeployments = Count 3
+          , productionDeployments = Count 2
+          , totalReplicas = Count 6
+          , failedServices = failedServicesSet
+          , activeOwners = ownerSet
+          , largestReplicaCount = LargestReplicas 3
+          }
+            | failedServicesSet == Set.fromList ["worker"]
+                && ownerSet == Set.fromList ["frontend", "ops", "platform", "security"]
+                && "cancelled seen: yes" `elem` lines (renderSummary (summarizeEvents events)) ->
+                    putStrLn "test passed"
+        _ -> die "unexpected foldMap summary result"
--- a/notes/014-haskell-learning-path.md
+++ b/notes/014-haskell-learning-path.md
@ -19,6 +19,8 @@ This note links the Haskell examples in a suggested order from first project str
 11. `25-haskell-state/`: pure stateful planning with global and per-environment counters
 12. `26-haskell-quickcheck/`: property testing for a non-trivial normalization function
 13. `27-haskell-aeson-roundtrip/`: explicit JSON instances and round-trip checks
+14. `28-haskell-applicative-validation/`: accumulated field validation with an Applicative error type
+15. `29-haskell-foldmap-summary/`: monoidal event aggregation with one `foldMap` pass

 ---

@ -37,6 +39,8 @@ This note links the Haskell examples in a suggested order from first project str
 - `25-haskell-state/`: how to thread evolving planning state without leaving pure code
 - `26-haskell-quickcheck/`: how to test invariants across many generated inputs
 - `27-haskell-aeson-roundtrip/`: how to keep domain values and JSON formats aligned
+- `28-haskell-applicative-validation/`: how to report several field errors without stopping at the first one
+- `29-haskell-foldmap-summary/`: how to express batch aggregation through monoidal summary fragments

 ---

@ -55,3 +59,5 @@ This note links the Haskell examples in a suggested order from first project str
 - `notes/028-haskell-state.md`
 - `notes/029-haskell-quickcheck.md`
 - `notes/030-haskell-aeson-roundtrip.md`
+- `notes/031-haskell-applicative-validation.md`
+- `notes/032-haskell-foldmap-summary.md`
--- a/notes/031-haskell-applicative-validation.md
+++ b/notes/031-haskell-applicative-validation.md
@ -0,0 +1,79 @@
+# Haskell Applicative Validation
+
+This note covers `28-haskell-applicative-validation/`, which validates a release manifest with a custom `Validation` type that accumulates several
+field errors at once.
+
+---
+
+## 1. Why This Is Not Just `Either`
+
+`Either` stops at the first failure. That is useful for many workflows, but it is not always the best fit for validating a form-like input.
+
+This example wants a different behavior:
+
+- validate `service`,
+- validate `env`,
+- validate `owners`,
+- validate `replicas`,
+- validate `strategy`, and
+- validate `window`,
+
+and report every invalid field in one pass.
+
+That is why the example uses a `Validation` type with an `Applicative` instance that combines errors through `Semigroup`.
+
+---
+
+## 2. Where the Accumulation Happens
+
+The important function is:
+
+```haskell
+validateManifest :: RawManifest -> Validation [String] ReleaseManifest
+```
+
+It builds the final manifest with applicative style:
+
+```haskell
+ReleaseManifest
+  <$> validateService ...
+  <*> validateEnvironment ...
+  <*> validateOwners ...
+  <*> validateReplicas ...
+  <*> validateStrategy ...
+  <*> validateWindow ...
+```
+
+Each field validator can fail independently, and the `Applicative` instance combines all the resulting error lists.
+
+---
+
+## 3. Why the Input Is Split into Two Stages
+
+The example still parses `key=value` assignments with `Either`.
+
+That keeps syntax errors separate from semantic validation:
+
+- malformed assignments such as `service` or `owners=` fail immediately, and
+- well-shaped assignments become a `RawManifest` that the validation layer can inspect field by field.
+
+This separation keeps the example focused. The interesting part is accumulated validation, not ad hoc string parsing.
+
+---
+
+## 4. Commands to Try
+
+```bash
+cd 28-haskell-applicative-validation
+
+nix develop
+cabal run
+cabal run -- service=api-gateway env=production owners=platform,security replicas=3 strategy=canary:20 window=22-24
+cabal test
+
+nix build
+./result/bin/mini-validation service=api-gateway env=production owners=platform,security replicas=3 strategy=canary:20 window=22-24
+
+nix run . -- service=api-gateway env=production owners=platform,security replicas=3 strategy=canary:20 window=22-24
+nix flake check
+```
--- a/notes/032-haskell-foldmap-summary.md
+++ b/notes/032-haskell-foldmap-summary.md
@ -0,0 +1,71 @@
+# Haskell foldMap Summaries
+
+This note covers `29-haskell-foldmap-summary/`, which summarizes deployment events with one `foldMap` pass into a monoidal report value.
+
+---
+
+## 1. Why `foldMap` Fits This Problem
+
+Each deployment event contributes a small piece of information:
+
+- one deployment count,
+- maybe one production count,
+- some replica count,
+- maybe one failed service,
+- some owners,
+- maybe one cancellation flag, and
+- one candidate for the largest rollout.
+
+Those pieces all combine associatively, which makes the problem a good fit for monoids.
+
+The example expresses that directly:
+
+```haskell
+summarizeEvents :: [DeploymentEvent] -> DeploymentSummary
+summarizeEvents = foldMap summarizeEvent
+```
+
+---
+
+## 2. What the Summary Type Encodes
+
+`DeploymentSummary` is not one big counter. It is a record of smaller monoidal fields:
+
+- `Count` for totals,
+- `Set String` for failed services and owners,
+- `CancelledSeen` for a yes-or-no flag, and
+- `LargestReplicas` for the maximum rollout size.
+
+That is the main teaching point: when each field has a lawful combine operation, the whole summary can combine cleanly too.
+
+---
+
+## 3. Why This Is Better Than a Manual Loop
+
+The example could have used an explicit left fold and updated every field by hand inside the loop.
+
+`foldMap` is cleaner here because it splits the work into two precise ideas:
+
+1. how one event becomes a summary fragment, and
+2. how summary fragments combine.
+
+That makes the aggregation easier to extend without tangling the parsing and report logic.
+
+---
+
+## 4. Commands to Try
+
+```bash
+cd 29-haskell-foldmap-summary
+
+nix develop
+cabal run
+cabal run -- api:production:succeeded:3:platform,security worker:staging:failed-db-lock:1:ops ui:production:cancelled:2:frontend
+cabal test
+
+nix build
+./result/bin/mini-summary api:production:succeeded:3:platform,security worker:staging:failed-db-lock:1:ops ui:production:cancelled:2:frontend
+
+nix run . -- api:production:succeeded:3:platform,security worker:staging:failed-db-lock:1:ops ui:production:cancelled:2:frontend
+nix flake check
+```