diff --git a/35-haskell-monad-chaining/README.md b/35-haskell-monad-chaining/README.md new file mode 100644 index 0000000..6746796 --- /dev/null +++ b/35-haskell-monad-chaining/README.md @@ -0,0 +1,25 @@ +# 35-haskell-monad-chaining + +This example shows intermediate Haskell sequencing with monadic `Either` chains. + +It includes: + +- a rollout request parsed from compact CLI input, +- dependent resolution steps that each need earlier successful results, +- `do` notation over `Either String` for ticket, policy, tag, and approver checks, and +- a test suite run by `nix flake check`. + +Useful commands: + +```bash +nix develop +cabal run +cabal run -- api:production:stable:CHG-2048 +cabal test + +nix build +./result/bin/mini-monad-chain api:production:stable:CHG-2048 + +nix run . -- api:production:stable:CHG-2048 +nix flake check +``` diff --git a/35-haskell-monad-chaining/app/Main.hs b/35-haskell-monad-chaining/app/Main.hs new file mode 100644 index 0000000..e35bffc --- /dev/null +++ b/35-haskell-monad-chaining/app/Main.hs @@ -0,0 +1,25 @@ +module Main where + +import MiniMonadChain.Rollout + ( approveRollout + , catalog + , parseRequest + , renderRollout + ) +import System.Environment (getArgs) +import System.Exit (die) + +main :: IO () +main = do + args <- getArgs + let inputArg = + case args of + [] -> "api:production:stable:CHG-2048" + firstArg : _ -> firstArg + + case parseRequest inputArg of + Left err -> die err + Right request -> + case approveRollout catalog request of + Left err -> die err + Right rollout -> putStrLn (renderRollout rollout) diff --git a/35-haskell-monad-chaining/flake.lock b/35-haskell-monad-chaining/flake.lock new file mode 100644 index 0000000..dfdfdf9 --- /dev/null +++ b/35-haskell-monad-chaining/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 +} diff --git a/35-haskell-monad-chaining/flake.nix b/35-haskell-monad-chaining/flake.nix new file mode 100644 index 0000000..8b666c7 --- /dev/null +++ b/35-haskell-monad-chaining/flake.nix @@ -0,0 +1,38 @@ +{ + # Builds a Haskell project that chains dependent rollout resolution steps + # with Either and do notation. + description = "A Haskell project for monad chaining with Either"; + + 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-monad-chain" ./. { }; + checkedProject = pkgs.haskell.lib.doCheck project; + in + { + packages.${system}.default = project; + + apps.${system}.default = { + type = "app"; + program = "${self.packages.${system}.default}/bin/mini-monad-chain"; + meta.description = "Run the monad chaining rollout example."; + }; + + devShells.${system}.default = pkgs.mkShell { + packages = [ + haskellPackages.ghc + pkgs.cabal-install + pkgs.haskell-language-server + ]; + }; + + checks.${system}.test-suite = checkedProject; + }; +} diff --git a/35-haskell-monad-chaining/mini-monad-chain.cabal b/35-haskell-monad-chaining/mini-monad-chain.cabal new file mode 100644 index 0000000..fd05076 --- /dev/null +++ b/35-haskell-monad-chaining/mini-monad-chain.cabal @@ -0,0 +1,29 @@ +cabal-version: 2.4 +name: mini-monad-chain +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: MiniMonadChain.Rollout + hs-source-dirs: src + build-depends: + base >=4.14 && <5, + containers + default-language: Haskell2010 + +executable mini-monad-chain + main-is: Main.hs + hs-source-dirs: app + build-depends: + base >=4.14 && <5, + mini-monad-chain + default-language: Haskell2010 + +test-suite mini-monad-chain-test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + build-depends: + base >=4.14 && <5, + mini-monad-chain + default-language: Haskell2010 diff --git a/35-haskell-monad-chaining/src/MiniMonadChain/Rollout.hs b/35-haskell-monad-chaining/src/MiniMonadChain/Rollout.hs new file mode 100644 index 0000000..1abf3c6 --- /dev/null +++ b/35-haskell-monad-chaining/src/MiniMonadChain/Rollout.hs @@ -0,0 +1,146 @@ +module MiniMonadChain.Rollout where + +import qualified Data.Map.Strict as Map +import Data.Map.Strict (Map) +import Data.List (intercalate) + +data Environment + = Staging + | Production + deriving (Eq, Show) + +data ReleaseTrack + = Stable + | Candidate + deriving (Eq, Show) + +data RolloutRequest = RolloutRequest + { requestService :: String + , requestEnvironment :: Environment + , requestTrack :: ReleaseTrack + , requestTicket :: String + } + deriving (Eq, Show) + +data ServiceProfile = ServiceProfile + { stableTag :: String + , candidateTag :: Maybe String + , changeApprover :: String + , productionAllowed :: Bool + } + deriving (Eq, Show) + +data ApprovedRollout = ApprovedRollout + { rolloutService :: String + , rolloutEnvironment :: Environment + , rolloutImageTag :: String + , rolloutTicket :: String + , rolloutApprover :: String + } + deriving (Eq, Show) + +type Catalog = Map String ServiceProfile + +catalog :: Catalog +catalog = + Map.fromList + [ ("api", ServiceProfile "2026.05.1" (Just "2026.06-rc1") "platform" True) + , ("worker", ServiceProfile "2026.05.0" (Just "2026.06-beta2") "ops" False) + , ("auth", ServiceProfile "2026.05.3" Nothing "security" True) + ] + +parseRequest :: String -> Either String RolloutRequest +parseRequest rawRequest = + case splitOn ':' rawRequest of + [serviceName, environmentName, trackName, ticketValue] -> + RolloutRequest + <$> pure serviceName + <*> parseEnvironment environmentName + <*> parseTrack trackName + <*> pure ticketValue + _ -> Left ("expected :::, got: " ++ rawRequest) + +approveRollout :: Catalog -> RolloutRequest -> Either String ApprovedRollout +approveRollout serviceCatalog request = do + serviceProfile <- lookupService serviceCatalog (requestService request) + ensureEnvironmentAllowed serviceProfile (requestEnvironment request) + ensureTicketMatches request + imageTag <- resolveTag serviceProfile (requestTrack request) + approver <- resolveApprover serviceProfile (requestEnvironment request) + pure + ApprovedRollout + { rolloutService = requestService request + , rolloutEnvironment = requestEnvironment request + , rolloutImageTag = imageTag + , rolloutTicket = requestTicket request + , rolloutApprover = approver + } + +lookupService :: Catalog -> String -> Either String ServiceProfile +lookupService serviceCatalog serviceName = + case Map.lookup serviceName serviceCatalog of + Just serviceProfile -> Right serviceProfile + Nothing -> Left ("unknown service: " ++ serviceName) + +ensureEnvironmentAllowed :: ServiceProfile -> Environment -> Either String () +ensureEnvironmentAllowed _ Staging = Right () +ensureEnvironmentAllowed serviceProfile Production + | productionAllowed serviceProfile = Right () + | otherwise = Left "service is staging-only" + +ensureTicketMatches :: RolloutRequest -> Either String () +ensureTicketMatches request = + case requestEnvironment request of + Staging -> Right () + Production + | "CHG-" `prefixOf` requestTicket request -> Right () + | otherwise -> Left "production rollouts require a CHG- ticket" + +resolveTag :: ServiceProfile -> ReleaseTrack -> Either String String +resolveTag serviceProfile Stable = Right (stableTag serviceProfile) +resolveTag serviceProfile Candidate = + case candidateTag serviceProfile of + Just tagValue -> Right tagValue + Nothing -> Left "service does not publish a candidate tag" + +resolveApprover :: ServiceProfile -> Environment -> Either String String +resolveApprover serviceProfile Staging = Right ("staging-" ++ changeApprover serviceProfile) +resolveApprover serviceProfile Production = Right (changeApprover serviceProfile) + +renderRollout :: ApprovedRollout -> String +renderRollout rollout = + intercalate + ", " + [ rolloutService rollout ++ " -> " ++ renderEnvironment (rolloutEnvironment rollout) + , "tag " ++ rolloutImageTag rollout + , "ticket " ++ rolloutTicket rollout + , "approver " ++ rolloutApprover rollout + ] + +parseEnvironment :: String -> Either String Environment +parseEnvironment "staging" = Right Staging +parseEnvironment "production" = Right Production +parseEnvironment otherValue = Left ("unknown environment: " ++ otherValue) + +parseTrack :: String -> Either String ReleaseTrack +parseTrack "stable" = Right Stable +parseTrack "candidate" = Right Candidate +parseTrack otherValue = Left ("unknown track: " ++ otherValue) + +renderEnvironment :: Environment -> String +renderEnvironment Staging = "staging" +renderEnvironment Production = "production" + +prefixOf :: String -> String -> Bool +prefixOf [] _ = True +prefixOf _ [] = False +prefixOf (leftChar : leftRest) (rightChar : rightRest) = + leftChar == rightChar && prefixOf leftRest rightRest + +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 diff --git a/35-haskell-monad-chaining/test/Main.hs b/35-haskell-monad-chaining/test/Main.hs new file mode 100644 index 0000000..9671fa1 --- /dev/null +++ b/35-haskell-monad-chaining/test/Main.hs @@ -0,0 +1,37 @@ +module Main where + +import MiniMonadChain.Rollout + ( ApprovedRollout (ApprovedRollout) + , Environment (Production, Staging) + , ReleaseTrack (Candidate, Stable) + , RolloutRequest (RolloutRequest) + , approveRollout + , catalog + , parseRequest + , renderRollout + ) +import System.Exit (die) + +main :: IO () +main = + case + ( parseRequest "api:production:stable:CHG-2048" + , parseRequest "worker:production:candidate:CHG-3000" + , parseRequest "auth:production:candidate:CHG-4000" + ) of + ( Right apiRequest + , Right workerRequest + , Right authRequest + ) -> + case + ( approveRollout catalog apiRequest + , approveRollout catalog workerRequest + , approveRollout catalog authRequest + ) of + ( Right rollout@(ApprovedRollout "api" Production "2026.05.1" "CHG-2048" "platform") + , Left _ + , Left _ + ) | renderRollout rollout == "api -> production, tag 2026.05.1, ticket CHG-2048, approver platform" -> + putStrLn "test passed" + _ -> die "unexpected monad chain result" + _ -> die "unexpected request parse result" diff --git a/36-haskell-map-set-modeling/README.md b/36-haskell-map-set-modeling/README.md new file mode 100644 index 0000000..a2dcc58 --- /dev/null +++ b/36-haskell-map-set-modeling/README.md @@ -0,0 +1,25 @@ +# 36-haskell-map-set-modeling + +This example shows intermediate Haskell domain modeling with `Map` and `Set`. + +It includes: + +- a release-access policy stored in maps and sets, +- team membership, service ownership, and environment grants, +- a CLI that reports required owners and unexpected approvers, and +- a test suite run by `nix flake check`. + +Useful commands: + +```bash +nix develop +cabal run +cabal run -- api:production:platform,security +cabal test + +nix build +./result/bin/mini-access-policy api:production:platform,security + +nix run . -- api:production:platform,security +nix flake check +``` diff --git a/36-haskell-map-set-modeling/app/Main.hs b/36-haskell-map-set-modeling/app/Main.hs new file mode 100644 index 0000000..33b91eb --- /dev/null +++ b/36-haskell-map-set-modeling/app/Main.hs @@ -0,0 +1,26 @@ +module Main where + +import MiniAccessPolicy.Policy + ( accessMatrix + , buildApprovalReport + , ownershipIndex + , parseRequest + , renderReport + ) +import System.Environment (getArgs) +import System.Exit (die) + +main :: IO () +main = do + args <- getArgs + let inputArg = + case args of + [] -> "api:production:platform,security" + firstArg : _ -> firstArg + + case parseRequest inputArg of + Left err -> die err + Right request -> + case buildApprovalReport ownershipIndex accessMatrix request of + Left err -> die err + Right report -> putStrLn (renderReport report) diff --git a/36-haskell-map-set-modeling/flake.lock b/36-haskell-map-set-modeling/flake.lock new file mode 100644 index 0000000..dfdfdf9 --- /dev/null +++ b/36-haskell-map-set-modeling/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 +} diff --git a/36-haskell-map-set-modeling/flake.nix b/36-haskell-map-set-modeling/flake.nix new file mode 100644 index 0000000..2041346 --- /dev/null +++ b/36-haskell-map-set-modeling/flake.nix @@ -0,0 +1,38 @@ +{ + # Builds a Haskell project that models release access policy directly with + # Map and Set. + description = "A Haskell project for Map and Set domain modeling"; + + 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-access-policy" ./. { }; + checkedProject = pkgs.haskell.lib.doCheck project; + in + { + packages.${system}.default = project; + + apps.${system}.default = { + type = "app"; + program = "${self.packages.${system}.default}/bin/mini-access-policy"; + meta.description = "Run the Map and Set access policy example."; + }; + + devShells.${system}.default = pkgs.mkShell { + packages = [ + haskellPackages.ghc + pkgs.cabal-install + pkgs.haskell-language-server + ]; + }; + + checks.${system}.test-suite = checkedProject; + }; +} diff --git a/36-haskell-map-set-modeling/mini-access-policy.cabal b/36-haskell-map-set-modeling/mini-access-policy.cabal new file mode 100644 index 0000000..e95f065 --- /dev/null +++ b/36-haskell-map-set-modeling/mini-access-policy.cabal @@ -0,0 +1,30 @@ +cabal-version: 2.4 +name: mini-access-policy +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: MiniAccessPolicy.Policy + hs-source-dirs: src + build-depends: + base >=4.14 && <5, + containers + default-language: Haskell2010 + +executable mini-access-policy + main-is: Main.hs + hs-source-dirs: app + build-depends: + base >=4.14 && <5, + mini-access-policy + default-language: Haskell2010 + +test-suite mini-access-policy-test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + build-depends: + base >=4.14 && <5, + containers, + mini-access-policy + default-language: Haskell2010 diff --git a/36-haskell-map-set-modeling/src/MiniAccessPolicy/Policy.hs b/36-haskell-map-set-modeling/src/MiniAccessPolicy/Policy.hs new file mode 100644 index 0000000..0072773 --- /dev/null +++ b/36-haskell-map-set-modeling/src/MiniAccessPolicy/Policy.hs @@ -0,0 +1,121 @@ +module MiniAccessPolicy.Policy where + +import qualified Data.Map.Strict as Map +import Data.Map.Strict (Map) +import qualified Data.Set as Set +import Data.Set (Set) +import Data.List (intercalate) + +data Environment + = Staging + | Production + deriving (Eq, Ord, Show) + +data ApprovalRequest = ApprovalRequest + { requestService :: String + , requestEnvironment :: Environment + , providedTeams :: Set String + } + deriving (Eq, Show) + +data ApprovalReport = ApprovalReport + { reportService :: String + , reportEnvironment :: Environment + , requiredTeams :: Set String + , suppliedTeams :: Set String + , missingTeams :: Set String + , unexpectedTeams :: Set String + , allowed :: Bool + } + deriving (Eq, Show) + +type OwnershipIndex = Map String (Set String) +type AccessMatrix = Map Environment (Set String) + +ownershipIndex :: OwnershipIndex +ownershipIndex = + Map.fromList + [ ("api", Set.fromList ["platform", "security"]) + , ("worker", Set.fromList ["ops"]) + , ("auth", Set.fromList ["security", "platform"]) + , ("frontend", Set.fromList ["frontend", "platform"]) + ] + +accessMatrix :: AccessMatrix +accessMatrix = + Map.fromList + [ (Staging, Set.fromList ["platform", "ops", "security", "frontend"]) + , (Production, Set.fromList ["platform", "security"]) + ] + +parseRequest :: String -> Either String ApprovalRequest +parseRequest rawRequest = + case splitOn ':' rawRequest of + [serviceName, environmentName, rawTeams] -> + ApprovalRequest + <$> pure serviceName + <*> parseEnvironment environmentName + <*> pure (Set.fromList (splitOn ',' rawTeams)) + _ -> Left ("expected ::, got: " ++ rawRequest) + +buildApprovalReport :: OwnershipIndex -> AccessMatrix -> ApprovalRequest -> Either String ApprovalReport +buildApprovalReport serviceOwners environmentAccess approvalRequest = do + owners <- + case Map.lookup (requestService approvalRequest) serviceOwners of + Just serviceTeams -> Right serviceTeams + Nothing -> Left ("unknown service: " ++ requestService approvalRequest) + allowedTeamsForEnvironment <- + case Map.lookup (requestEnvironment approvalRequest) environmentAccess of + Just allowedTeams -> Right allowedTeams + Nothing -> Left "missing environment access configuration" + let requiredApprovers = Set.intersection owners allowedTeamsForEnvironment + missingApprovers = Set.difference requiredApprovers (providedTeams approvalRequest) + unexpectedApprovers = Set.difference (providedTeams approvalRequest) allowedTeamsForEnvironment + pure + ApprovalReport + { reportService = requestService approvalRequest + , reportEnvironment = requestEnvironment approvalRequest + , requiredTeams = requiredApprovers + , suppliedTeams = providedTeams approvalRequest + , missingTeams = missingApprovers + , unexpectedTeams = unexpectedApprovers + , allowed = Set.null missingApprovers && Set.null unexpectedApprovers + } + +renderReport :: ApprovalReport -> String +renderReport report = + intercalate + ", " + [ reportService report ++ " -> " ++ renderEnvironment (reportEnvironment report) + , "required " ++ renderSet (requiredTeams report) + , "supplied " ++ renderSet (suppliedTeams report) + , "missing " ++ renderSet (missingTeams report) + , "unexpected " ++ renderSet (unexpectedTeams report) + , "allowed " ++ renderBool (allowed report) + ] + +parseEnvironment :: String -> Either String Environment +parseEnvironment "staging" = Right Staging +parseEnvironment "production" = Right Production +parseEnvironment otherValue = Left ("unknown environment: " ++ otherValue) + +renderEnvironment :: Environment -> String +renderEnvironment Staging = "staging" +renderEnvironment Production = "production" + +renderSet :: Set String -> String +renderSet values + | Set.null values = "none" + | otherwise = intercalate "/" (Set.toAscList values) + +renderBool :: Bool -> String +renderBool True = "yes" +renderBool False = "no" + +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 diff --git a/36-haskell-map-set-modeling/test/Main.hs b/36-haskell-map-set-modeling/test/Main.hs new file mode 100644 index 0000000..123fc58 --- /dev/null +++ b/36-haskell-map-set-modeling/test/Main.hs @@ -0,0 +1,38 @@ +module Main where + +import qualified Data.Set as Set +import MiniAccessPolicy.Policy + ( ApprovalReport (ApprovalReport) + , Environment (Production, Staging) + , accessMatrix + , buildApprovalReport + , ownershipIndex + , parseRequest + , renderReport + ) +import System.Exit (die) + +main :: IO () +main = + case + ( parseRequest "api:production:platform,security" + , parseRequest "frontend:production:frontend,platform" + ) of + ( Right allowedRequest + , Right deniedRequest + ) -> + case + ( buildApprovalReport ownershipIndex accessMatrix allowedRequest + , buildApprovalReport ownershipIndex accessMatrix deniedRequest + ) of + ( Right allowedReport@(ApprovalReport "api" Production required supplied missing unexpected True) + , Right deniedReport@(ApprovalReport "frontend" Production _ _ _ deniedUnexpected False) + ) | required == Set.fromList ["platform", "security"] + && missing == Set.empty + && unexpected == Set.empty + && deniedUnexpected == Set.fromList ["frontend"] + && renderReport deniedReport + == "frontend -> production, required platform, supplied frontend/platform, missing none, unexpected frontend, allowed no" -> + putStrLn "test passed" + _ -> die "unexpected Map/Set modeling result" + _ -> die "unexpected access policy parse result" diff --git a/notes/014-haskell-learning-path.md b/notes/014-haskell-learning-path.md index 50703f1..da48557 100644 --- a/notes/014-haskell-learning-path.md +++ b/notes/014-haskell-learning-path.md @@ -26,6 +26,8 @@ This note links the Haskell examples in a suggested order from first project str 18. `32-haskell-nonempty-waves/`: rollout planning with `NonEmpty` 19. `33-haskell-optparse-cli/`: command-line parsing with `optparse-applicative` 20. `34-haskell-dependency-order/`: dependency-ordered planning with cycle checks +21. `35-haskell-monad-chaining/`: dependent rollout approval with monadic `Either` +22. `36-haskell-map-set-modeling/`: access-policy modeling with `Map` and `Set` --- @@ -51,6 +53,8 @@ This note links the Haskell examples in a suggested order from first project str - `32-haskell-nonempty-waves/`: how to encode “at least one rollout step” in the type - `33-haskell-optparse-cli/`: how to parse a real CLI into typed commands - `34-haskell-dependency-order/`: how to derive a correct deployment order from dependencies +- `35-haskell-monad-chaining/`: how to express fail-fast workflows where each step depends on earlier results +- `36-haskell-map-set-modeling/`: how to use `Map` and `Set` as primary domain structures, not just helpers --- @@ -76,3 +80,5 @@ This note links the Haskell examples in a suggested order from first project str - `notes/035-haskell-nonempty-waves.md` - `notes/036-haskell-optparse-cli.md` - `notes/037-haskell-dependency-order.md` +- `notes/038-haskell-monad-chaining.md` +- `notes/039-haskell-map-set-modeling.md` diff --git a/notes/038-haskell-monad-chaining.md b/notes/038-haskell-monad-chaining.md new file mode 100644 index 0000000..1fb98a7 --- /dev/null +++ b/notes/038-haskell-monad-chaining.md @@ -0,0 +1,65 @@ +# Haskell Monad Chaining + +This note covers `35-haskell-monad-chaining/`, which sequences several dependent rollout checks with `Either` and `do` notation. + +--- + +## 1. Why Monad Chaining Matters + +Some workflows cannot be expressed as independent field checks. + +In this example, later steps depend on earlier successful results: + +- find the service profile first, +- then check whether the environment is allowed, +- then validate the production change ticket, +- then choose the image tag for the requested track, and +- finally choose the approver. + +That dependency chain is the point. Each step needs the result of the previous one. + +--- + +## 2. Why `Either` Still Fits + +This example does not need accumulated errors. It needs short-circuiting business logic. + +That makes `Either String` a good fit: + +```haskell +approveRollout :: Catalog -> RolloutRequest -> Either String ApprovedRollout +``` + +`do` notation keeps the happy path readable while preserving the fail-fast semantics. + +--- + +## 3. How This Complements the Validation Example + +`28-haskell-applicative-validation/` teaches independent checks that all run so several errors can be reported together. + +This example teaches the opposite shape: + +- one decision unlocks the next, and +- the workflow stops once a prerequisite fails. + +That contrast is useful. It shows why “Applicative versus Monad” is not just theory. The control flow shape changes the design. + +--- + +## 4. Commands to Try + +```bash +cd 35-haskell-monad-chaining + +nix develop +cabal run +cabal run -- api:production:stable:CHG-2048 +cabal test + +nix build +./result/bin/mini-monad-chain api:production:stable:CHG-2048 + +nix run . -- api:production:stable:CHG-2048 +nix flake check +``` diff --git a/notes/039-haskell-map-set-modeling.md b/notes/039-haskell-map-set-modeling.md new file mode 100644 index 0000000..42587ab --- /dev/null +++ b/notes/039-haskell-map-set-modeling.md @@ -0,0 +1,61 @@ +# Haskell Map and Set Modeling + +This note covers `36-haskell-map-set-modeling/`, which models release approval policy directly with `Map` and `Set`. + +--- + +## 1. Why These Structures Deserve Their Own Example + +Several earlier examples already use `containers`, but only as support code. + +This example makes the data structures themselves the teaching point: + +- `Map` for service ownership and environment access rules, and +- `Set` for required, supplied, missing, and unexpected approver groups. + +That is a practical step up from list-based toy models. + +--- + +## 2. What the Policy Computation Shows + +The report logic uses set operations directly: + +- intersection for required approvers that are valid in the environment, +- difference for missing approvers, and +- difference again for unexpected approvers. + +That makes the policy behavior compact and declarative. The code describes the relationships instead of manually looping over lists. + +--- + +## 3. Why This Is Good Domain Modeling + +Ownership, access grants, and approval groups are not “just lists”. + +They have semantics: + +- service names map to owner teams, +- environments map to allowed teams, and +- approver groups should not contain duplicates. + +Using `Map` and `Set` makes those semantics explicit in the type choices. + +--- + +## 4. Commands to Try + +```bash +cd 36-haskell-map-set-modeling + +nix develop +cabal run +cabal run -- api:production:platform,security +cabal test + +nix build +./result/bin/mini-access-policy api:production:platform,security + +nix run . -- api:production:platform,security +nix flake check +```