Add three more Haskell examples (with their note files)
This commit is contained in:
parent
c7b7f2fdd4
commit
6a0c04b9c5
25
23-haskell-maybe-either/README.md
Normal file
25
23-haskell-maybe-either/README.md
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
# 23-haskell-maybe-either
|
||||||
|
|
||||||
|
This example shows intermediate Haskell request building with `Maybe` and `Either`.
|
||||||
|
|
||||||
|
It includes:
|
||||||
|
|
||||||
|
- optional fields read through `Maybe`,
|
||||||
|
- required fields upgraded from `Maybe` into `Either` errors,
|
||||||
|
- validation for rollout strategy and canary percentage, and
|
||||||
|
- a test suite run by `nix flake check`.
|
||||||
|
|
||||||
|
Useful commands:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal run -- service=api env=production replicas=3 strategy=canary canary=10 owner=platform
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-release-request service=api env=production replicas=3 strategy=canary canary=10 owner=platform
|
||||||
|
|
||||||
|
nix run . -- service=api env=production replicas=3 strategy=canary canary=10 owner=platform
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
27
23-haskell-maybe-either/app/Main.hs
Normal file
27
23-haskell-maybe-either/app/Main.hs
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import MiniReleaseRequest.Request
|
||||||
|
( buildReleaseRequest
|
||||||
|
, renderReleaseRequest
|
||||||
|
)
|
||||||
|
import System.Environment (getArgs)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
let inputArgs =
|
||||||
|
case args of
|
||||||
|
[] ->
|
||||||
|
[ "service=api"
|
||||||
|
, "env=production"
|
||||||
|
, "replicas=3"
|
||||||
|
, "strategy=canary"
|
||||||
|
, "canary=10"
|
||||||
|
, "owner=platform"
|
||||||
|
]
|
||||||
|
_ -> args
|
||||||
|
|
||||||
|
case buildReleaseRequest inputArgs of
|
||||||
|
Left err -> die err
|
||||||
|
Right request -> putStrLn (renderReleaseRequest request)
|
||||||
27
23-haskell-maybe-either/flake.lock
generated
Normal file
27
23-haskell-maybe-either/flake.lock
generated
Normal file
@ -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
|
||||||
|
}
|
||||||
38
23-haskell-maybe-either/flake.nix
Normal file
38
23-haskell-maybe-either/flake.nix
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
{
|
||||||
|
# Builds a Haskell project that uses Maybe for optional fields and Either
|
||||||
|
# for validation when constructing a release request.
|
||||||
|
description = "A Haskell project for Maybe and 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-release-request" ./. { };
|
||||||
|
checkedProject = pkgs.haskell.lib.doCheck project;
|
||||||
|
in
|
||||||
|
{
|
||||||
|
packages.${system}.default = project;
|
||||||
|
|
||||||
|
apps.${system}.default = {
|
||||||
|
type = "app";
|
||||||
|
program = "${self.packages.${system}.default}/bin/mini-release-request";
|
||||||
|
meta.description = "Run the Maybe and Either release request example.";
|
||||||
|
};
|
||||||
|
|
||||||
|
devShells.${system}.default = pkgs.mkShell {
|
||||||
|
packages = [
|
||||||
|
haskellPackages.ghc
|
||||||
|
pkgs.cabal-install
|
||||||
|
pkgs.haskell-language-server
|
||||||
|
];
|
||||||
|
};
|
||||||
|
|
||||||
|
checks.${system}.test-suite = checkedProject;
|
||||||
|
};
|
||||||
|
}
|
||||||
28
23-haskell-maybe-either/mini-release-request.cabal
Normal file
28
23-haskell-maybe-either/mini-release-request.cabal
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
cabal-version: 2.4
|
||||||
|
name: mini-release-request
|
||||||
|
version: 0.1.0.0
|
||||||
|
build-type: Simple
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules: MiniReleaseRequest.Request
|
||||||
|
hs-source-dirs: src
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable mini-release-request
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: app
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-release-request
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite mini-release-request-test
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: test
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-release-request
|
||||||
|
default-language: Haskell2010
|
||||||
113
23-haskell-maybe-either/src/MiniReleaseRequest/Request.hs
Normal file
113
23-haskell-maybe-either/src/MiniReleaseRequest/Request.hs
Normal file
@ -0,0 +1,113 @@
|
|||||||
|
module MiniReleaseRequest.Request where
|
||||||
|
|
||||||
|
import Data.List (find, intercalate)
|
||||||
|
|
||||||
|
data Environment
|
||||||
|
= Staging
|
||||||
|
| Production
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data Strategy
|
||||||
|
= Rolling
|
||||||
|
| Canary Int
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data ReleaseRequest = ReleaseRequest
|
||||||
|
{ serviceName :: String
|
||||||
|
, environment :: Environment
|
||||||
|
, replicaCount :: Int
|
||||||
|
, strategy :: Strategy
|
||||||
|
, owner :: Maybe String
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
|
lookupOptional :: String -> [(String, String)] -> Maybe String
|
||||||
|
lookupOptional key assignments = snd <$> find ((== key) . fst) assignments
|
||||||
|
|
||||||
|
lookupRequired :: String -> [(String, String)] -> Either String String
|
||||||
|
lookupRequired key assignments =
|
||||||
|
case lookupOptional key assignments of
|
||||||
|
Just value -> Right value
|
||||||
|
Nothing -> Left ("missing required field: " ++ key)
|
||||||
|
|
||||||
|
parseEnvironment :: String -> Either String Environment
|
||||||
|
parseEnvironment "staging" = Right Staging
|
||||||
|
parseEnvironment "production" = Right Production
|
||||||
|
parseEnvironment other = Left ("unknown environment: " ++ other)
|
||||||
|
|
||||||
|
parseReplicaCount :: String -> Either String Int
|
||||||
|
parseReplicaCount rawValue =
|
||||||
|
case reads rawValue of
|
||||||
|
[(parsedValue, "")]
|
||||||
|
| parsedValue > 0 -> Right parsedValue
|
||||||
|
| otherwise -> Left "replicas must be greater than zero"
|
||||||
|
_ -> Left ("invalid replica count: " ++ rawValue)
|
||||||
|
|
||||||
|
resolveStrategy :: [(String, String)] -> Either String Strategy
|
||||||
|
resolveStrategy assignments = do
|
||||||
|
strategyName <- lookupRequired "strategy" assignments
|
||||||
|
case strategyName of
|
||||||
|
"rolling" ->
|
||||||
|
case lookupOptional "canary" assignments of
|
||||||
|
Nothing -> Right Rolling
|
||||||
|
Just _ -> Left "rolling strategy does not accept a canary percentage"
|
||||||
|
"canary" -> do
|
||||||
|
rawPercent <- lookupRequired "canary" assignments
|
||||||
|
percent <-
|
||||||
|
case reads rawPercent of
|
||||||
|
[(parsedPercent, "")]
|
||||||
|
| parsedPercent >= 1 && parsedPercent <= 50 -> Right parsedPercent
|
||||||
|
| otherwise -> Left "canary percentage must be between 1 and 50"
|
||||||
|
_ -> Left ("invalid canary percentage: " ++ rawPercent)
|
||||||
|
Right (Canary percent)
|
||||||
|
other -> Left ("unknown strategy: " ++ other)
|
||||||
|
|
||||||
|
buildReleaseRequest :: [String] -> Either String ReleaseRequest
|
||||||
|
buildReleaseRequest rawAssignments = do
|
||||||
|
assignments <- traverse parseAssignment rawAssignments
|
||||||
|
releaseService <- lookupRequired "service" assignments
|
||||||
|
releaseEnvironment <- lookupRequired "env" assignments >>= parseEnvironment
|
||||||
|
releaseReplicaCount <- lookupRequired "replicas" assignments >>= parseReplicaCount
|
||||||
|
releaseStrategy <- resolveStrategy assignments
|
||||||
|
let releaseOwner = lookupOptional "owner" assignments
|
||||||
|
pure
|
||||||
|
ReleaseRequest
|
||||||
|
{ serviceName = releaseService
|
||||||
|
, environment = releaseEnvironment
|
||||||
|
, replicaCount = releaseReplicaCount
|
||||||
|
, strategy = releaseStrategy
|
||||||
|
, owner = releaseOwner
|
||||||
|
}
|
||||||
|
|
||||||
|
renderReleaseRequest :: ReleaseRequest -> String
|
||||||
|
renderReleaseRequest request =
|
||||||
|
intercalate
|
||||||
|
", "
|
||||||
|
[ "service " ++ serviceName request
|
||||||
|
, "env " ++ renderEnvironment (environment request)
|
||||||
|
, "replicas " ++ show (replicaCount request)
|
||||||
|
, "strategy " ++ renderStrategy (strategy request)
|
||||||
|
, renderOwner (owner request)
|
||||||
|
]
|
||||||
|
|
||||||
|
renderEnvironment :: Environment -> String
|
||||||
|
renderEnvironment Staging = "staging"
|
||||||
|
renderEnvironment Production = "production"
|
||||||
|
|
||||||
|
renderStrategy :: Strategy -> String
|
||||||
|
renderStrategy Rolling = "rolling"
|
||||||
|
renderStrategy (Canary percent) = "canary " ++ show percent ++ "%"
|
||||||
|
|
||||||
|
renderOwner :: Maybe String -> String
|
||||||
|
renderOwner Nothing = "owner unassigned"
|
||||||
|
renderOwner (Just assignedOwner) = "owner " ++ assignedOwner
|
||||||
41
23-haskell-maybe-either/test/Main.hs
Normal file
41
23-haskell-maybe-either/test/Main.hs
Normal file
@ -0,0 +1,41 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import MiniReleaseRequest.Request
|
||||||
|
( Environment (Production, Staging)
|
||||||
|
, ReleaseRequest (ReleaseRequest)
|
||||||
|
, Strategy (Canary, Rolling)
|
||||||
|
, buildReleaseRequest
|
||||||
|
, renderReleaseRequest
|
||||||
|
)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main =
|
||||||
|
case
|
||||||
|
( buildReleaseRequest
|
||||||
|
[ "service=api"
|
||||||
|
, "env=production"
|
||||||
|
, "replicas=3"
|
||||||
|
, "strategy=canary"
|
||||||
|
, "canary=10"
|
||||||
|
]
|
||||||
|
, buildReleaseRequest
|
||||||
|
[ "service=worker"
|
||||||
|
, "env=staging"
|
||||||
|
, "replicas=2"
|
||||||
|
, "strategy=rolling"
|
||||||
|
, "owner=ops"
|
||||||
|
]
|
||||||
|
, buildReleaseRequest
|
||||||
|
[ "service=cache"
|
||||||
|
, "env=production"
|
||||||
|
, "replicas=2"
|
||||||
|
, "strategy=canary"
|
||||||
|
]
|
||||||
|
) of
|
||||||
|
( Right (ReleaseRequest "api" Production 3 (Canary 10) Nothing)
|
||||||
|
, Right rollingRequest@(ReleaseRequest "worker" Staging 2 Rolling (Just "ops"))
|
||||||
|
, Left _
|
||||||
|
) | renderReleaseRequest rollingRequest == "service worker, env staging, replicas 2, strategy rolling, owner ops" ->
|
||||||
|
putStrLn "test passed"
|
||||||
|
_ -> die "unexpected release request result"
|
||||||
24
24-haskell-deriving/README.md
Normal file
24
24-haskell-deriving/README.md
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
# 24-haskell-deriving
|
||||||
|
|
||||||
|
This example shows intermediate Haskell deriving with stock and newtype strategies.
|
||||||
|
|
||||||
|
It includes:
|
||||||
|
|
||||||
|
- `deriving stock` for ordering, enumeration, and display,
|
||||||
|
- `GeneralizedNewtypeDeriving` for numeric and semigroup behavior,
|
||||||
|
- one release batch that merges and sorts targets through derived instances, and
|
||||||
|
- a test suite run by `nix flake check`.
|
||||||
|
|
||||||
|
Useful commands:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-deriving
|
||||||
|
|
||||||
|
nix run
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
11
24-haskell-deriving/app/Main.hs
Normal file
11
24-haskell-deriving/app/Main.hs
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import MiniDeriving.Batch
|
||||||
|
( mergeBatches
|
||||||
|
, platformBatch
|
||||||
|
, renderBatch
|
||||||
|
, urgentFixBatch
|
||||||
|
)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = putStrLn (renderBatch (mergeBatches platformBatch urgentFixBatch))
|
||||||
27
24-haskell-deriving/flake.lock
generated
Normal file
27
24-haskell-deriving/flake.lock
generated
Normal file
@ -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
|
||||||
|
}
|
||||||
38
24-haskell-deriving/flake.nix
Normal file
38
24-haskell-deriving/flake.nix
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
{
|
||||||
|
# Builds a Haskell project that uses deriving strategies to get ordering,
|
||||||
|
# enumeration, and accumulation behavior for release-planning types.
|
||||||
|
description = "A Haskell project for deriving strategies";
|
||||||
|
|
||||||
|
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-deriving" ./. { };
|
||||||
|
checkedProject = pkgs.haskell.lib.doCheck project;
|
||||||
|
in
|
||||||
|
{
|
||||||
|
packages.${system}.default = project;
|
||||||
|
|
||||||
|
apps.${system}.default = {
|
||||||
|
type = "app";
|
||||||
|
program = "${self.packages.${system}.default}/bin/mini-deriving";
|
||||||
|
meta.description = "Run the deriving strategies example.";
|
||||||
|
};
|
||||||
|
|
||||||
|
devShells.${system}.default = pkgs.mkShell {
|
||||||
|
packages = [
|
||||||
|
haskellPackages.ghc
|
||||||
|
pkgs.cabal-install
|
||||||
|
pkgs.haskell-language-server
|
||||||
|
];
|
||||||
|
};
|
||||||
|
|
||||||
|
checks.${system}.test-suite = checkedProject;
|
||||||
|
};
|
||||||
|
}
|
||||||
28
24-haskell-deriving/mini-deriving.cabal
Normal file
28
24-haskell-deriving/mini-deriving.cabal
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
cabal-version: 2.4
|
||||||
|
name: mini-deriving
|
||||||
|
version: 0.1.0.0
|
||||||
|
build-type: Simple
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules: MiniDeriving.Batch
|
||||||
|
hs-source-dirs: src
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable mini-deriving
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: app
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-deriving
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite mini-deriving-test
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: test
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-deriving
|
||||||
|
default-language: Haskell2010
|
||||||
104
24-haskell-deriving/src/MiniDeriving/Batch.hs
Normal file
104
24-haskell-deriving/src/MiniDeriving/Batch.hs
Normal file
@ -0,0 +1,104 @@
|
|||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
|
||||||
|
module MiniDeriving.Batch where
|
||||||
|
|
||||||
|
import Data.List (sort)
|
||||||
|
|
||||||
|
newtype BatchName = BatchName
|
||||||
|
{ unBatchName :: String
|
||||||
|
}
|
||||||
|
deriving stock (Eq, Show)
|
||||||
|
deriving newtype (Semigroup, Monoid)
|
||||||
|
|
||||||
|
data Environment
|
||||||
|
= Staging
|
||||||
|
| Production
|
||||||
|
deriving stock (Eq, Ord, Show, Enum, Bounded)
|
||||||
|
|
||||||
|
data Priority
|
||||||
|
= Urgent
|
||||||
|
| Standard
|
||||||
|
| Background
|
||||||
|
deriving stock (Eq, Ord, Show, Enum, Bounded)
|
||||||
|
|
||||||
|
newtype FailureBudget = FailureBudget
|
||||||
|
{ unFailureBudget :: Int
|
||||||
|
}
|
||||||
|
deriving stock (Eq, Show)
|
||||||
|
deriving newtype (Num, Ord)
|
||||||
|
|
||||||
|
data ReleaseTarget = ReleaseTarget
|
||||||
|
{ targetEnvironment :: Environment
|
||||||
|
, targetPriority :: Priority
|
||||||
|
, targetService :: String
|
||||||
|
, targetFailureBudget :: FailureBudget
|
||||||
|
}
|
||||||
|
deriving stock (Eq, Ord, Show)
|
||||||
|
|
||||||
|
data ReleaseBatch = ReleaseBatch
|
||||||
|
{ batchName :: BatchName
|
||||||
|
, targets :: [ReleaseTarget]
|
||||||
|
}
|
||||||
|
deriving stock (Eq, Show)
|
||||||
|
|
||||||
|
allEnvironments :: [Environment]
|
||||||
|
allEnvironments = [minBound .. maxBound]
|
||||||
|
|
||||||
|
mergeBatches :: ReleaseBatch -> ReleaseBatch -> ReleaseBatch
|
||||||
|
mergeBatches leftBatch rightBatch =
|
||||||
|
ReleaseBatch
|
||||||
|
{ batchName = batchName leftBatch <> BatchName "+" <> batchName rightBatch
|
||||||
|
, targets = targets leftBatch <> targets rightBatch
|
||||||
|
}
|
||||||
|
|
||||||
|
sortedTargets :: ReleaseBatch -> [ReleaseTarget]
|
||||||
|
sortedTargets = sort . targets
|
||||||
|
|
||||||
|
totalFailureBudget :: ReleaseBatch -> FailureBudget
|
||||||
|
totalFailureBudget = sum . map targetFailureBudget . targets
|
||||||
|
|
||||||
|
renderBatch :: ReleaseBatch -> String
|
||||||
|
renderBatch releaseBatch =
|
||||||
|
unlines
|
||||||
|
( headerLine
|
||||||
|
: map renderTarget (sortedTargets releaseBatch)
|
||||||
|
)
|
||||||
|
where
|
||||||
|
headerLine =
|
||||||
|
"batch "
|
||||||
|
++ unBatchName (batchName releaseBatch)
|
||||||
|
++ " across "
|
||||||
|
++ show (length allEnvironments)
|
||||||
|
++ " environments with failure budget "
|
||||||
|
++ show (unFailureBudget (totalFailureBudget releaseBatch))
|
||||||
|
|
||||||
|
renderTarget :: ReleaseTarget -> String
|
||||||
|
renderTarget releaseTarget =
|
||||||
|
targetService releaseTarget
|
||||||
|
++ " -> "
|
||||||
|
++ show (targetEnvironment releaseTarget)
|
||||||
|
++ " / "
|
||||||
|
++ show (targetPriority releaseTarget)
|
||||||
|
++ " / budget "
|
||||||
|
++ show (unFailureBudget (targetFailureBudget releaseTarget))
|
||||||
|
|
||||||
|
platformBatch :: ReleaseBatch
|
||||||
|
platformBatch =
|
||||||
|
ReleaseBatch
|
||||||
|
{ batchName = BatchName "platform"
|
||||||
|
, targets =
|
||||||
|
[ ReleaseTarget Production Standard "api" 3
|
||||||
|
, ReleaseTarget Staging Background "worker" 1
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
urgentFixBatch :: ReleaseBatch
|
||||||
|
urgentFixBatch =
|
||||||
|
ReleaseBatch
|
||||||
|
{ batchName = BatchName "urgent-fix"
|
||||||
|
, targets =
|
||||||
|
[ ReleaseTarget Production Urgent "auth" 2
|
||||||
|
, ReleaseTarget Staging Urgent "billing" 1
|
||||||
|
]
|
||||||
|
}
|
||||||
35
24-haskell-deriving/test/Main.hs
Normal file
35
24-haskell-deriving/test/Main.hs
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import MiniDeriving.Batch
|
||||||
|
( Environment (Production, Staging)
|
||||||
|
, FailureBudget (FailureBudget)
|
||||||
|
, Priority (Background, Standard, Urgent)
|
||||||
|
, ReleaseTarget (ReleaseTarget)
|
||||||
|
, allEnvironments
|
||||||
|
, mergeBatches
|
||||||
|
, platformBatch
|
||||||
|
, renderBatch
|
||||||
|
, sortedTargets
|
||||||
|
, totalFailureBudget
|
||||||
|
, urgentFixBatch
|
||||||
|
)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main =
|
||||||
|
case
|
||||||
|
( allEnvironments
|
||||||
|
, sortedTargets (mergeBatches platformBatch urgentFixBatch)
|
||||||
|
, totalFailureBudget (mergeBatches platformBatch urgentFixBatch)
|
||||||
|
) of
|
||||||
|
( [Staging, Production]
|
||||||
|
, [ ReleaseTarget Staging Urgent "billing" 1
|
||||||
|
, ReleaseTarget Staging Background "worker" 1
|
||||||
|
, ReleaseTarget Production Urgent "auth" 2
|
||||||
|
, ReleaseTarget Production Standard "api" 3
|
||||||
|
]
|
||||||
|
, FailureBudget 7
|
||||||
|
) | head (lines (renderBatch (mergeBatches platformBatch urgentFixBatch)))
|
||||||
|
== "batch platform+urgent-fix across 2 environments with failure budget 7" ->
|
||||||
|
putStrLn "test passed"
|
||||||
|
_ -> die "unexpected derived behavior"
|
||||||
25
25-haskell-state/README.md
Normal file
25
25-haskell-state/README.md
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
# 25-haskell-state
|
||||||
|
|
||||||
|
This example shows intermediate Haskell planning with `State`.
|
||||||
|
|
||||||
|
It includes:
|
||||||
|
|
||||||
|
- a planner state that tracks build numbers and rollout waves,
|
||||||
|
- stateful allocation of per-environment wave numbers,
|
||||||
|
- a CLI that renders a deployment plan from compact request strings, and
|
||||||
|
- a test suite run by `nix flake check`.
|
||||||
|
|
||||||
|
Useful commands:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal run -- api:production:3 worker:staging:1 cache:production:2
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-state-planner api:production:3 worker:staging:1 cache:production:2
|
||||||
|
|
||||||
|
nix run . -- api:production:3 worker:staging:1 cache:production:2
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
25
25-haskell-state/app/Main.hs
Normal file
25
25-haskell-state/app/Main.hs
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import MiniStatePlanner.Plan
|
||||||
|
( parseRequest
|
||||||
|
, planDeployments
|
||||||
|
, renderPlan
|
||||||
|
)
|
||||||
|
import System.Environment (getArgs)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
let requestArgs =
|
||||||
|
case args of
|
||||||
|
[] ->
|
||||||
|
[ "api:production:3"
|
||||||
|
, "worker:staging:1"
|
||||||
|
, "cache:production:2"
|
||||||
|
]
|
||||||
|
_ -> args
|
||||||
|
|
||||||
|
case traverse parseRequest requestArgs of
|
||||||
|
Left err -> die err
|
||||||
|
Right requests -> putStrLn (renderPlan (planDeployments requests))
|
||||||
27
25-haskell-state/flake.lock
generated
Normal file
27
25-haskell-state/flake.lock
generated
Normal file
@ -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
|
||||||
|
}
|
||||||
38
25-haskell-state/flake.nix
Normal file
38
25-haskell-state/flake.nix
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
{
|
||||||
|
# Builds a Haskell project that uses State to allocate build numbers and
|
||||||
|
# per-environment rollout waves while planning deployments.
|
||||||
|
description = "A Haskell project for State-based planning";
|
||||||
|
|
||||||
|
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-state-planner" ./. { };
|
||||||
|
checkedProject = pkgs.haskell.lib.doCheck project;
|
||||||
|
in
|
||||||
|
{
|
||||||
|
packages.${system}.default = project;
|
||||||
|
|
||||||
|
apps.${system}.default = {
|
||||||
|
type = "app";
|
||||||
|
program = "${self.packages.${system}.default}/bin/mini-state-planner";
|
||||||
|
meta.description = "Run the State-based release planner example.";
|
||||||
|
};
|
||||||
|
|
||||||
|
devShells.${system}.default = pkgs.mkShell {
|
||||||
|
packages = [
|
||||||
|
haskellPackages.ghc
|
||||||
|
pkgs.cabal-install
|
||||||
|
pkgs.haskell-language-server
|
||||||
|
];
|
||||||
|
};
|
||||||
|
|
||||||
|
checks.${system}.test-suite = checkedProject;
|
||||||
|
};
|
||||||
|
}
|
||||||
30
25-haskell-state/mini-state-planner.cabal
Normal file
30
25-haskell-state/mini-state-planner.cabal
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
cabal-version: 2.4
|
||||||
|
name: mini-state-planner
|
||||||
|
version: 0.1.0.0
|
||||||
|
build-type: Simple
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules: MiniStatePlanner.Plan
|
||||||
|
hs-source-dirs: src
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
containers,
|
||||||
|
mtl
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable mini-state-planner
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: app
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-state-planner
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite mini-state-planner-test
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: test
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-state-planner
|
||||||
|
default-language: Haskell2010
|
||||||
121
25-haskell-state/src/MiniStatePlanner/Plan.hs
Normal file
121
25-haskell-state/src/MiniStatePlanner/Plan.hs
Normal file
@ -0,0 +1,121 @@
|
|||||||
|
module MiniStatePlanner.Plan where
|
||||||
|
|
||||||
|
import Control.Monad.State.Strict
|
||||||
|
( State
|
||||||
|
, evalState
|
||||||
|
, get
|
||||||
|
, put
|
||||||
|
)
|
||||||
|
import qualified Data.Map.Strict as Map
|
||||||
|
import Data.Map.Strict (Map)
|
||||||
|
|
||||||
|
data Environment
|
||||||
|
= Staging
|
||||||
|
| Production
|
||||||
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
|
data DeploymentRequest = DeploymentRequest
|
||||||
|
{ requestService :: String
|
||||||
|
, requestEnvironment :: Environment
|
||||||
|
, requestReplicas :: Int
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data PlannedDeployment = PlannedDeployment
|
||||||
|
{ buildNumber :: Int
|
||||||
|
, waveNumber :: Int
|
||||||
|
, requestedDeployment :: DeploymentRequest
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data PlannerState = PlannerState
|
||||||
|
{ nextBuildNumber :: Int
|
||||||
|
, nextWaveByEnvironment :: Map Environment Int
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
initialPlannerState :: PlannerState
|
||||||
|
initialPlannerState =
|
||||||
|
PlannerState
|
||||||
|
{ nextBuildNumber = 1001
|
||||||
|
, nextWaveByEnvironment = Map.fromList [(Staging, 1), (Production, 1)]
|
||||||
|
}
|
||||||
|
|
||||||
|
parseEnvironment :: String -> Either String Environment
|
||||||
|
parseEnvironment "staging" = Right Staging
|
||||||
|
parseEnvironment "production" = Right Production
|
||||||
|
parseEnvironment other = Left ("unknown environment: " ++ other)
|
||||||
|
|
||||||
|
parseRequest :: String -> Either String DeploymentRequest
|
||||||
|
parseRequest rawRequest =
|
||||||
|
case splitOn ':' rawRequest of
|
||||||
|
[service, environmentName, rawReplicas] -> do
|
||||||
|
environment <- parseEnvironment environmentName
|
||||||
|
replicas <-
|
||||||
|
case reads rawReplicas of
|
||||||
|
[(parsedReplicas, "")]
|
||||||
|
| parsedReplicas > 0 -> Right parsedReplicas
|
||||||
|
| otherwise -> Left "replicas must be greater than zero"
|
||||||
|
_ -> Left ("invalid replica count: " ++ rawReplicas)
|
||||||
|
pure
|
||||||
|
DeploymentRequest
|
||||||
|
{ requestService = service
|
||||||
|
, requestEnvironment = environment
|
||||||
|
, requestReplicas = replicas
|
||||||
|
}
|
||||||
|
_ -> Left ("expected <service>:<environment>:<replicas>, got: " ++ rawRequest)
|
||||||
|
|
||||||
|
planDeployment :: DeploymentRequest -> State PlannerState PlannedDeployment
|
||||||
|
planDeployment request = do
|
||||||
|
plannerState <- get
|
||||||
|
let currentBuildNumber = nextBuildNumber plannerState
|
||||||
|
currentWaveNumber =
|
||||||
|
Map.findWithDefault 1 (requestEnvironment request) (nextWaveByEnvironment plannerState)
|
||||||
|
updatedState =
|
||||||
|
PlannerState
|
||||||
|
{ nextBuildNumber = currentBuildNumber + 1
|
||||||
|
, nextWaveByEnvironment =
|
||||||
|
Map.insert
|
||||||
|
(requestEnvironment request)
|
||||||
|
(currentWaveNumber + 1)
|
||||||
|
(nextWaveByEnvironment plannerState)
|
||||||
|
}
|
||||||
|
put updatedState
|
||||||
|
pure
|
||||||
|
PlannedDeployment
|
||||||
|
{ buildNumber = currentBuildNumber
|
||||||
|
, waveNumber = currentWaveNumber
|
||||||
|
, requestedDeployment = request
|
||||||
|
}
|
||||||
|
|
||||||
|
planDeployments :: [DeploymentRequest] -> [PlannedDeployment]
|
||||||
|
planDeployments requests = evalState (traverse planDeployment requests) initialPlannerState
|
||||||
|
|
||||||
|
renderPlan :: [PlannedDeployment] -> String
|
||||||
|
renderPlan = unlines . map renderDeployment
|
||||||
|
|
||||||
|
renderDeployment :: PlannedDeployment -> String
|
||||||
|
renderDeployment plannedDeployment =
|
||||||
|
requestService request
|
||||||
|
++ " -> "
|
||||||
|
++ renderEnvironment (requestEnvironment request)
|
||||||
|
++ ", replicas "
|
||||||
|
++ show (requestReplicas request)
|
||||||
|
++ ", build "
|
||||||
|
++ show (buildNumber plannedDeployment)
|
||||||
|
++ ", wave "
|
||||||
|
++ show (waveNumber plannedDeployment)
|
||||||
|
where
|
||||||
|
request = requestedDeployment plannedDeployment
|
||||||
|
|
||||||
|
renderEnvironment :: Environment -> String
|
||||||
|
renderEnvironment Staging = "staging"
|
||||||
|
renderEnvironment Production = "production"
|
||||||
|
|
||||||
|
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
|
||||||
24
25-haskell-state/test/Main.hs
Normal file
24
25-haskell-state/test/Main.hs
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import MiniStatePlanner.Plan
|
||||||
|
( DeploymentRequest (DeploymentRequest)
|
||||||
|
, Environment (Production, Staging)
|
||||||
|
, PlannedDeployment (PlannedDeployment)
|
||||||
|
, parseRequest
|
||||||
|
, planDeployments
|
||||||
|
, renderPlan
|
||||||
|
)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main =
|
||||||
|
case traverse parseRequest ["api:production:3", "worker:staging:1", "cache:production:2"] of
|
||||||
|
Left err -> die err
|
||||||
|
Right requests ->
|
||||||
|
case planDeployments requests of
|
||||||
|
[ PlannedDeployment 1001 1 (DeploymentRequest "api" Production 3)
|
||||||
|
, PlannedDeployment 1002 1 (DeploymentRequest "worker" Staging 1)
|
||||||
|
, PlannedDeployment 1003 2 (DeploymentRequest "cache" Production 2)
|
||||||
|
] | "cache -> production, replicas 2, build 1003, wave 2" `elem` lines (renderPlan (planDeployments requests)) ->
|
||||||
|
putStrLn "test passed"
|
||||||
|
_ -> die "unexpected planning result"
|
||||||
@ -14,6 +14,11 @@ This note links the Haskell examples in a suggested order from first project str
|
|||||||
6. `10-haskell-effects/`: `ReaderT`, `Except`, and constrained application logic
|
6. `10-haskell-effects/`: `ReaderT`, `Except`, and constrained application logic
|
||||||
7. `11-haskell-typeclasses/`: custom type classes and per-type instances
|
7. `11-haskell-typeclasses/`: custom type classes and per-type instances
|
||||||
8. `12-haskell-parser-combinators/`: parser combinators with Megaparsec
|
8. `12-haskell-parser-combinators/`: parser combinators with Megaparsec
|
||||||
|
9. `23-haskell-maybe-either/`: optional values, required-field errors, and layered request validation
|
||||||
|
10. `24-haskell-deriving/`: deriving strategies for ordering, enumeration, and wrapper behavior
|
||||||
|
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
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
@ -27,6 +32,11 @@ This note links the Haskell examples in a suggested order from first project str
|
|||||||
- `10-haskell-effects/`: how to separate configuration, logic, and failures
|
- `10-haskell-effects/`: how to separate configuration, logic, and failures
|
||||||
- `11-haskell-typeclasses/`: how to abstract shared behavior across several types
|
- `11-haskell-typeclasses/`: how to abstract shared behavior across several types
|
||||||
- `12-haskell-parser-combinators/`: how to build a small language from reusable parser pieces
|
- `12-haskell-parser-combinators/`: how to build a small language from reusable parser pieces
|
||||||
|
- `23-haskell-maybe-either/`: how optional fields and validation errors play different roles
|
||||||
|
- `24-haskell-deriving/`: how derived behavior depends on constructor and field layout
|
||||||
|
- `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
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
@ -40,3 +50,8 @@ This note links the Haskell examples in a suggested order from first project str
|
|||||||
- `notes/012-haskell-effects.md`
|
- `notes/012-haskell-effects.md`
|
||||||
- `notes/013-haskell-typeclasses.md`
|
- `notes/013-haskell-typeclasses.md`
|
||||||
- `notes/015-haskell-parser-combinators.md`
|
- `notes/015-haskell-parser-combinators.md`
|
||||||
|
- `notes/026-haskell-maybe-and-either.md`
|
||||||
|
- `notes/027-haskell-deriving.md`
|
||||||
|
- `notes/028-haskell-state.md`
|
||||||
|
- `notes/029-haskell-quickcheck.md`
|
||||||
|
- `notes/030-haskell-aeson-roundtrip.md`
|
||||||
|
|||||||
73
notes/026-haskell-maybe-and-either.md
Normal file
73
notes/026-haskell-maybe-and-either.md
Normal file
@ -0,0 +1,73 @@
|
|||||||
|
# Haskell Maybe and Either
|
||||||
|
|
||||||
|
This note covers `23-haskell-maybe-either/`, which builds a release request from `key=value` inputs by using `Maybe` for optional data and `Either`
|
||||||
|
for validation failures.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 1. Why Both Types Matter
|
||||||
|
|
||||||
|
`Maybe` answers one question: is a value present or absent?
|
||||||
|
|
||||||
|
`Either` answers a different question: if something failed, why?
|
||||||
|
|
||||||
|
This example uses both on purpose:
|
||||||
|
|
||||||
|
- optional fields such as `owner` stay as `Maybe`,
|
||||||
|
- required fields start as lookups that may be absent, and
|
||||||
|
- missing or invalid required data becomes `Either String ...` with an error message.
|
||||||
|
|
||||||
|
That gives the program a clean progression from raw input toward a validated domain value.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 2. Where `Maybe` Shows Up
|
||||||
|
|
||||||
|
The input is a flat list of assignments such as `service=api` and `owner=platform`.
|
||||||
|
|
||||||
|
`lookupOptional` searches that list and returns `Maybe String`:
|
||||||
|
|
||||||
|
```haskell
|
||||||
|
lookupOptional :: String -> [(String, String)] -> Maybe String
|
||||||
|
```
|
||||||
|
|
||||||
|
That is the right level for values that are genuinely optional. In the example, `owner` can be absent without making the whole request invalid.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 3. Where `Either` Takes Over
|
||||||
|
|
||||||
|
Required fields cannot stay as `Maybe`, because the rest of the program needs a reason when construction fails.
|
||||||
|
|
||||||
|
The example upgrades a missing field into an error:
|
||||||
|
|
||||||
|
```haskell
|
||||||
|
lookupRequired :: String -> [(String, String)] -> Either String String
|
||||||
|
```
|
||||||
|
|
||||||
|
It then adds more validation:
|
||||||
|
|
||||||
|
- environment parsing,
|
||||||
|
- replica count parsing, and
|
||||||
|
- canary percentage rules for the rollout strategy.
|
||||||
|
|
||||||
|
That keeps absence and validation separate, which makes the control flow easier to read.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. Commands to Try
|
||||||
|
|
||||||
|
```bash
|
||||||
|
cd 23-haskell-maybe-either
|
||||||
|
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal run -- service=api env=production replicas=3 strategy=canary canary=10 owner=platform
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-release-request service=api env=production replicas=3 strategy=canary canary=10 owner=platform
|
||||||
|
|
||||||
|
nix run . -- service=api env=production replicas=3 strategy=canary canary=10 owner=platform
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
64
notes/027-haskell-deriving.md
Normal file
64
notes/027-haskell-deriving.md
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
# Haskell Deriving Strategies
|
||||||
|
|
||||||
|
This note covers `24-haskell-deriving/`, which uses `deriving stock` and `GeneralizedNewtypeDeriving` to build useful behavior for release-planning
|
||||||
|
types with very little manual code.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 1. What the Example Derives
|
||||||
|
|
||||||
|
The example derives three kinds of behavior:
|
||||||
|
|
||||||
|
- ordering and display for enums and records,
|
||||||
|
- enumeration for the environment list, and
|
||||||
|
- numeric and semigroup behavior for newtypes.
|
||||||
|
|
||||||
|
Those derived instances are then used directly in the program:
|
||||||
|
|
||||||
|
- `allEnvironments` comes from `Enum` and `Bounded`,
|
||||||
|
- `sortedTargets` relies on derived `Ord`, and
|
||||||
|
- `totalFailureBudget` relies on derived `Num`.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 2. Why the Constructor Order Matters
|
||||||
|
|
||||||
|
Derived ordering is not magical. It follows constructor order for sum types, and field order for product types.
|
||||||
|
|
||||||
|
That matters in this example:
|
||||||
|
|
||||||
|
- `Priority` lists `Urgent` before `Standard` and `Background`, so urgent work sorts first, and
|
||||||
|
- `ReleaseTarget` stores environment and priority before the service name, so the derived record ordering matches the intended rollout order.
|
||||||
|
|
||||||
|
This is the main teaching point: derived instances are only as good as the domain shape you give them.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 3. Why the Newtypes Are Useful
|
||||||
|
|
||||||
|
`BatchName` and `FailureBudget` are wrappers, but they still need behavior.
|
||||||
|
|
||||||
|
`GeneralizedNewtypeDeriving` lets the example reuse the underlying instances:
|
||||||
|
|
||||||
|
- `BatchName` derives `Semigroup` and `Monoid`, and
|
||||||
|
- `FailureBudget` derives `Num` and `Ord`.
|
||||||
|
|
||||||
|
That means the code can concatenate names and sum budgets without unpacking the wrappers everywhere.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. Commands to Try
|
||||||
|
|
||||||
|
```bash
|
||||||
|
cd 24-haskell-deriving
|
||||||
|
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-deriving
|
||||||
|
|
||||||
|
nix run
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
61
notes/028-haskell-state.md
Normal file
61
notes/028-haskell-state.md
Normal file
@ -0,0 +1,61 @@
|
|||||||
|
# Haskell State
|
||||||
|
|
||||||
|
This note covers `25-haskell-state/`, which plans a sequence of deployments by threading a build counter and per-environment wave numbers through
|
||||||
|
`State`.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 1. What the State Represents
|
||||||
|
|
||||||
|
The planner keeps two changing values:
|
||||||
|
|
||||||
|
- the next global build number, and
|
||||||
|
- the next rollout wave number for each environment.
|
||||||
|
|
||||||
|
That is a good fit for `State`, because each planned deployment needs to read the current values and write back updated ones.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 2. Why This Stays Pure
|
||||||
|
|
||||||
|
The planning logic does not perform I/O. It just transforms a list of deployment requests into a list of planned deployments.
|
||||||
|
|
||||||
|
`State` keeps that transformation pure:
|
||||||
|
|
||||||
|
```haskell
|
||||||
|
planDeployment :: DeploymentRequest -> State PlannerState PlannedDeployment
|
||||||
|
```
|
||||||
|
|
||||||
|
The caller still gets a plain value at the end through `evalState`.
|
||||||
|
|
||||||
|
That is the important intermediate Haskell idea here: stateful logic does not have to mean mutable variables or `IO`.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 3. What the Example Allocates
|
||||||
|
|
||||||
|
Each request receives:
|
||||||
|
|
||||||
|
- a build number that increments globally, and
|
||||||
|
- a wave number that increments separately per environment.
|
||||||
|
|
||||||
|
That makes the output more interesting than a single counter example, while still teaching one concept.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. Commands to Try
|
||||||
|
|
||||||
|
```bash
|
||||||
|
cd 25-haskell-state
|
||||||
|
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal run -- api:production:3 worker:staging:1 cache:production:2
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-state-planner api:production:3 worker:staging:1 cache:production:2
|
||||||
|
|
||||||
|
nix run . -- api:production:3 worker:staging:1 cache:production:2
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
Loading…
x
Reference in New Issue
Block a user