Add three new Haskell examples (with their note files)
This commit is contained in:
parent
87d02e8bc2
commit
f7172b38b2
25
32-haskell-nonempty-waves/README.md
Normal file
25
32-haskell-nonempty-waves/README.md
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
# 32-haskell-nonempty-waves
|
||||||
|
|
||||||
|
This example shows intermediate Haskell rollout planning with `NonEmpty`.
|
||||||
|
|
||||||
|
It includes:
|
||||||
|
|
||||||
|
- a deployment job with rolling and canary modes,
|
||||||
|
- a `NonEmpty` list of rollout waves that guarantees at least one step,
|
||||||
|
- a CLI that renders a wave-by-wave plan, and
|
||||||
|
- a test suite run by `nix flake check`.
|
||||||
|
|
||||||
|
Useful commands:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal run -- api:production:canary:20:6
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-waves api:production:canary:20:6
|
||||||
|
|
||||||
|
nix run . -- api:production:canary:20:6
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
21
32-haskell-nonempty-waves/app/Main.hs
Normal file
21
32-haskell-nonempty-waves/app/Main.hs
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import MiniWaves.Plan
|
||||||
|
( buildPlan
|
||||||
|
, parseJob
|
||||||
|
, renderPlan
|
||||||
|
)
|
||||||
|
import System.Environment (getArgs)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
let inputArg =
|
||||||
|
case args of
|
||||||
|
[] -> "api:production:canary:20:6"
|
||||||
|
firstArg : _ -> firstArg
|
||||||
|
|
||||||
|
case parseJob inputArg of
|
||||||
|
Left err -> die err
|
||||||
|
Right releaseJob -> putStrLn (renderPlan (buildPlan releaseJob))
|
||||||
27
32-haskell-nonempty-waves/flake.lock
generated
Normal file
27
32-haskell-nonempty-waves/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
32-haskell-nonempty-waves/flake.nix
Normal file
38
32-haskell-nonempty-waves/flake.nix
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
{
|
||||||
|
# Builds a Haskell project that models rollout waves with NonEmpty so every
|
||||||
|
# deployment plan is guaranteed to contain at least one step.
|
||||||
|
description = "A Haskell project for NonEmpty rollout waves";
|
||||||
|
|
||||||
|
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-waves" ./. { };
|
||||||
|
checkedProject = pkgs.haskell.lib.doCheck project;
|
||||||
|
in
|
||||||
|
{
|
||||||
|
packages.${system}.default = project;
|
||||||
|
|
||||||
|
apps.${system}.default = {
|
||||||
|
type = "app";
|
||||||
|
program = "${self.packages.${system}.default}/bin/mini-waves";
|
||||||
|
meta.description = "Run the NonEmpty rollout wave example.";
|
||||||
|
};
|
||||||
|
|
||||||
|
devShells.${system}.default = pkgs.mkShell {
|
||||||
|
packages = [
|
||||||
|
haskellPackages.ghc
|
||||||
|
pkgs.cabal-install
|
||||||
|
pkgs.haskell-language-server
|
||||||
|
];
|
||||||
|
};
|
||||||
|
|
||||||
|
checks.${system}.test-suite = checkedProject;
|
||||||
|
};
|
||||||
|
}
|
||||||
28
32-haskell-nonempty-waves/mini-waves.cabal
Normal file
28
32-haskell-nonempty-waves/mini-waves.cabal
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
cabal-version: 2.4
|
||||||
|
name: mini-waves
|
||||||
|
version: 0.1.0.0
|
||||||
|
build-type: Simple
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules: MiniWaves.Plan
|
||||||
|
hs-source-dirs: src
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable mini-waves
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: app
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-waves
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite mini-waves-test
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: test
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-waves
|
||||||
|
default-language: Haskell2010
|
||||||
132
32-haskell-nonempty-waves/src/MiniWaves/Plan.hs
Normal file
132
32-haskell-nonempty-waves/src/MiniWaves/Plan.hs
Normal file
@ -0,0 +1,132 @@
|
|||||||
|
module MiniWaves.Plan where
|
||||||
|
|
||||||
|
import Data.List (intercalate)
|
||||||
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||||
|
import qualified Data.List.NonEmpty as NonEmpty
|
||||||
|
|
||||||
|
data Environment
|
||||||
|
= Staging
|
||||||
|
| Production
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data ReleaseMode
|
||||||
|
= Rolling
|
||||||
|
| Canary Int
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data ReleaseJob = ReleaseJob
|
||||||
|
{ jobService :: String
|
||||||
|
, jobEnvironment :: Environment
|
||||||
|
, jobMode :: ReleaseMode
|
||||||
|
, jobReplicas :: Int
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data Wave = Wave
|
||||||
|
{ waveName :: String
|
||||||
|
, waveTrafficPercent :: Int
|
||||||
|
, waveReplicas :: Int
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data RolloutPlan = RolloutPlan
|
||||||
|
{ planService :: String
|
||||||
|
, planEnvironment :: Environment
|
||||||
|
, planWaves :: NonEmpty Wave
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
parseJob :: String -> Either String ReleaseJob
|
||||||
|
parseJob rawJob =
|
||||||
|
case splitOn ':' rawJob of
|
||||||
|
[serviceName, environmentName, modeName, rawPercent, rawReplicas] -> do
|
||||||
|
environment <- parseEnvironment environmentName
|
||||||
|
mode <- parseMode modeName rawPercent
|
||||||
|
replicas <- parseReplicas rawReplicas
|
||||||
|
pure
|
||||||
|
ReleaseJob
|
||||||
|
{ jobService = serviceName
|
||||||
|
, jobEnvironment = environment
|
||||||
|
, jobMode = mode
|
||||||
|
, jobReplicas = replicas
|
||||||
|
}
|
||||||
|
_ -> Left ("expected <service>:<environment>:<rolling|canary>:<percent>:<replicas>, got: " ++ rawJob)
|
||||||
|
|
||||||
|
buildPlan :: ReleaseJob -> RolloutPlan
|
||||||
|
buildPlan releaseJob =
|
||||||
|
RolloutPlan
|
||||||
|
{ planService = jobService releaseJob
|
||||||
|
, planEnvironment = jobEnvironment releaseJob
|
||||||
|
, planWaves = buildWaves releaseJob
|
||||||
|
}
|
||||||
|
|
||||||
|
buildWaves :: ReleaseJob -> NonEmpty Wave
|
||||||
|
buildWaves releaseJob =
|
||||||
|
case jobMode releaseJob of
|
||||||
|
Rolling ->
|
||||||
|
Wave "full" 100 (jobReplicas releaseJob) :| []
|
||||||
|
Canary percent ->
|
||||||
|
let canaryReplicas = max 1 (jobReplicas releaseJob `div` 2)
|
||||||
|
in Wave "canary" percent canaryReplicas
|
||||||
|
:| [Wave "steady" 100 (jobReplicas releaseJob)]
|
||||||
|
|
||||||
|
renderPlan :: RolloutPlan -> String
|
||||||
|
renderPlan rolloutPlan =
|
||||||
|
unlines
|
||||||
|
( headerLine
|
||||||
|
: map renderWave (NonEmpty.toList (planWaves rolloutPlan))
|
||||||
|
)
|
||||||
|
where
|
||||||
|
headerLine =
|
||||||
|
intercalate
|
||||||
|
", "
|
||||||
|
[ planService rolloutPlan ++ " -> " ++ renderEnvironment (planEnvironment rolloutPlan)
|
||||||
|
, "waves " ++ show (NonEmpty.length (planWaves rolloutPlan))
|
||||||
|
, "first " ++ waveName (NonEmpty.head (planWaves rolloutPlan))
|
||||||
|
, "last " ++ waveName (NonEmpty.last (planWaves rolloutPlan))
|
||||||
|
]
|
||||||
|
|
||||||
|
renderWave :: Wave -> String
|
||||||
|
renderWave wave =
|
||||||
|
waveName wave
|
||||||
|
++ ": "
|
||||||
|
++ show (waveTrafficPercent wave)
|
||||||
|
++ "% traffic, "
|
||||||
|
++ show (waveReplicas wave)
|
||||||
|
++ " replicas"
|
||||||
|
|
||||||
|
parseEnvironment :: String -> Either String Environment
|
||||||
|
parseEnvironment "staging" = Right Staging
|
||||||
|
parseEnvironment "production" = Right Production
|
||||||
|
parseEnvironment otherValue = Left ("unknown environment: " ++ otherValue)
|
||||||
|
|
||||||
|
parseMode :: String -> String -> Either String ReleaseMode
|
||||||
|
parseMode "rolling" "0" = Right Rolling
|
||||||
|
parseMode "rolling" rawPercent = Left ("rolling mode expects percent 0, got: " ++ rawPercent)
|
||||||
|
parseMode "canary" rawPercent =
|
||||||
|
case reads rawPercent of
|
||||||
|
[(percent, "")]
|
||||||
|
| percent >= 1 && percent <= 50 -> Right (Canary percent)
|
||||||
|
| otherwise -> Left "canary percent must be between 1 and 50"
|
||||||
|
_ -> Left ("invalid canary percent: " ++ rawPercent)
|
||||||
|
parseMode otherValue _ = Left ("unknown rollout mode: " ++ otherValue)
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
|
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
|
||||||
29
32-haskell-nonempty-waves/test/Main.hs
Normal file
29
32-haskell-nonempty-waves/test/Main.hs
Normal file
@ -0,0 +1,29 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||||
|
import qualified Data.List.NonEmpty as NonEmpty
|
||||||
|
import MiniWaves.Plan
|
||||||
|
( Environment (Production, Staging)
|
||||||
|
, ReleaseMode (Canary, Rolling)
|
||||||
|
, RolloutPlan (RolloutPlan)
|
||||||
|
, Wave (Wave)
|
||||||
|
, buildPlan
|
||||||
|
, parseJob
|
||||||
|
, renderPlan
|
||||||
|
)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main =
|
||||||
|
case (parseJob "api:production:canary:20:6", parseJob "worker:staging:rolling:0:2") of
|
||||||
|
( Right canaryJob
|
||||||
|
, Right rollingJob
|
||||||
|
) ->
|
||||||
|
case (buildPlan canaryJob, buildPlan rollingJob) of
|
||||||
|
( RolloutPlan "api" Production (Wave "canary" 20 3 :| [Wave "steady" 100 6])
|
||||||
|
, RolloutPlan "worker" Staging (Wave "full" 100 2 :| [])
|
||||||
|
) | "worker -> staging, waves 1, first full, last full"
|
||||||
|
`elem` lines (renderPlan (buildPlan rollingJob)) ->
|
||||||
|
putStrLn "test passed"
|
||||||
|
_ -> die "unexpected NonEmpty wave plan"
|
||||||
|
_ -> die "unexpected rollout parse result"
|
||||||
26
33-haskell-optparse-cli/README.md
Normal file
26
33-haskell-optparse-cli/README.md
Normal file
@ -0,0 +1,26 @@
|
|||||||
|
# 33-haskell-optparse-cli
|
||||||
|
|
||||||
|
This example shows intermediate Haskell CLI parsing with `optparse-applicative`.
|
||||||
|
|
||||||
|
It includes:
|
||||||
|
|
||||||
|
- subcommands for validation and promotion,
|
||||||
|
- named options, repeated options, and typed numeric parsing,
|
||||||
|
- a pure parser entry point that the test suite exercises, and
|
||||||
|
- a test suite run by `nix flake check`.
|
||||||
|
|
||||||
|
Useful commands:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal run -- validate --service api --env production --replicas 3 --track stable
|
||||||
|
cabal run -- promote --service api --from-tag blue --to-tag green --owner platform --owner security --dry-run
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-cli validate --service api --env production --replicas 3 --track stable
|
||||||
|
|
||||||
|
nix run . -- validate --service api --env production --replicas 3 --track stable
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
30
33-haskell-optparse-cli/app/Main.hs
Normal file
30
33-haskell-optparse-cli/app/Main.hs
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import MiniCli.Command
|
||||||
|
( renderCommand
|
||||||
|
, runCliParser
|
||||||
|
)
|
||||||
|
import System.Environment (getArgs)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
let inputArgs =
|
||||||
|
case args of
|
||||||
|
[] ->
|
||||||
|
[ "validate"
|
||||||
|
, "--service"
|
||||||
|
, "api"
|
||||||
|
, "--env"
|
||||||
|
, "production"
|
||||||
|
, "--replicas"
|
||||||
|
, "3"
|
||||||
|
, "--track"
|
||||||
|
, "stable"
|
||||||
|
]
|
||||||
|
_ -> args
|
||||||
|
|
||||||
|
case runCliParser inputArgs of
|
||||||
|
Left err -> die err
|
||||||
|
Right commandValue -> putStrLn (renderCommand commandValue)
|
||||||
27
33-haskell-optparse-cli/flake.lock
generated
Normal file
27
33-haskell-optparse-cli/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
33-haskell-optparse-cli/flake.nix
Normal file
38
33-haskell-optparse-cli/flake.nix
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
{
|
||||||
|
# Builds a Haskell project that parses a non-trivial CLI with
|
||||||
|
# optparse-applicative subcommands and repeated options.
|
||||||
|
description = "A Haskell project for optparse-applicative";
|
||||||
|
|
||||||
|
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-cli" ./. { };
|
||||||
|
checkedProject = pkgs.haskell.lib.doCheck project;
|
||||||
|
in
|
||||||
|
{
|
||||||
|
packages.${system}.default = project;
|
||||||
|
|
||||||
|
apps.${system}.default = {
|
||||||
|
type = "app";
|
||||||
|
program = "${self.packages.${system}.default}/bin/mini-cli";
|
||||||
|
meta.description = "Run the optparse-applicative example.";
|
||||||
|
};
|
||||||
|
|
||||||
|
devShells.${system}.default = pkgs.mkShell {
|
||||||
|
packages = [
|
||||||
|
haskellPackages.ghc
|
||||||
|
pkgs.cabal-install
|
||||||
|
pkgs.haskell-language-server
|
||||||
|
];
|
||||||
|
};
|
||||||
|
|
||||||
|
checks.${system}.test-suite = checkedProject;
|
||||||
|
};
|
||||||
|
}
|
||||||
29
33-haskell-optparse-cli/mini-cli.cabal
Normal file
29
33-haskell-optparse-cli/mini-cli.cabal
Normal file
@ -0,0 +1,29 @@
|
|||||||
|
cabal-version: 2.4
|
||||||
|
name: mini-cli
|
||||||
|
version: 0.1.0.0
|
||||||
|
build-type: Simple
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules: MiniCli.Command
|
||||||
|
hs-source-dirs: src
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
optparse-applicative
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable mini-cli
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: app
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-cli
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite mini-cli-test
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: test
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-cli
|
||||||
|
default-language: Haskell2010
|
||||||
154
33-haskell-optparse-cli/src/MiniCli/Command.hs
Normal file
154
33-haskell-optparse-cli/src/MiniCli/Command.hs
Normal file
@ -0,0 +1,154 @@
|
|||||||
|
module MiniCli.Command where
|
||||||
|
|
||||||
|
import Data.Char (isSpace)
|
||||||
|
import Data.List (intercalate)
|
||||||
|
import Options.Applicative
|
||||||
|
( Parser
|
||||||
|
, ParserInfo
|
||||||
|
, ParserResult (Failure, Success)
|
||||||
|
, ReadM
|
||||||
|
, command
|
||||||
|
, eitherReader
|
||||||
|
, execParserPure
|
||||||
|
, fullDesc
|
||||||
|
, help
|
||||||
|
, helper
|
||||||
|
, hsubparser
|
||||||
|
, info
|
||||||
|
, long
|
||||||
|
, metavar
|
||||||
|
, option
|
||||||
|
, prefs
|
||||||
|
, progDesc
|
||||||
|
, renderFailure
|
||||||
|
, some
|
||||||
|
, strOption
|
||||||
|
, switch
|
||||||
|
, (<**>)
|
||||||
|
)
|
||||||
|
|
||||||
|
data Environment
|
||||||
|
= Staging
|
||||||
|
| Production
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data ReleaseTrack
|
||||||
|
= Stable
|
||||||
|
| Candidate
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data ValidateSpec = ValidateSpec
|
||||||
|
{ validateService :: String
|
||||||
|
, validateEnvironment :: Environment
|
||||||
|
, validateReplicas :: Int
|
||||||
|
, validateTrack :: ReleaseTrack
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data PromoteSpec = PromoteSpec
|
||||||
|
{ promoteService :: String
|
||||||
|
, fromTag :: String
|
||||||
|
, toTag :: String
|
||||||
|
, owners :: [String]
|
||||||
|
, dryRun :: Bool
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data Command
|
||||||
|
= ValidateCommand ValidateSpec
|
||||||
|
| PromoteCommand PromoteSpec
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
runCliParser :: [String] -> Either String Command
|
||||||
|
runCliParser inputArgs =
|
||||||
|
case execParserPure (prefs mempty) parserInfo inputArgs of
|
||||||
|
Success commandValue -> Right commandValue
|
||||||
|
Failure parserFailure ->
|
||||||
|
let (message, _) = renderFailure parserFailure "mini-cli"
|
||||||
|
in Left (trimTrailingWhitespace message)
|
||||||
|
|
||||||
|
renderCommand :: Command -> String
|
||||||
|
renderCommand (ValidateCommand validateSpec) =
|
||||||
|
intercalate
|
||||||
|
", "
|
||||||
|
[ "validate " ++ validateService validateSpec
|
||||||
|
, "env " ++ renderEnvironment (validateEnvironment validateSpec)
|
||||||
|
, "replicas " ++ show (validateReplicas validateSpec)
|
||||||
|
, "track " ++ renderTrack (validateTrack validateSpec)
|
||||||
|
]
|
||||||
|
renderCommand (PromoteCommand promoteSpec) =
|
||||||
|
intercalate
|
||||||
|
", "
|
||||||
|
[ "promote " ++ promoteService promoteSpec
|
||||||
|
, "from " ++ fromTag promoteSpec
|
||||||
|
, "to " ++ toTag promoteSpec
|
||||||
|
, "owners " ++ intercalate "/" (owners promoteSpec)
|
||||||
|
, "dry-run " ++ renderBool (dryRun promoteSpec)
|
||||||
|
]
|
||||||
|
|
||||||
|
parserInfo :: ParserInfo Command
|
||||||
|
parserInfo = info (commandParser <**> helper) fullDesc
|
||||||
|
|
||||||
|
commandParser :: Parser Command
|
||||||
|
commandParser =
|
||||||
|
hsubparser
|
||||||
|
( command "validate" (info (ValidateCommand <$> validateSpecParser) (progDesc "Validate a release specification"))
|
||||||
|
<> command "promote" (info (PromoteCommand <$> promoteSpecParser) (progDesc "Promote a deployment tag"))
|
||||||
|
)
|
||||||
|
|
||||||
|
validateSpecParser :: Parser ValidateSpec
|
||||||
|
validateSpecParser =
|
||||||
|
ValidateSpec
|
||||||
|
<$> strOption (long "service" <> help "Service name" <> metavar "SERVICE")
|
||||||
|
<*> option environmentReader (long "env" <> help "Deployment environment" <> metavar "ENV")
|
||||||
|
<*> option intReader (long "replicas" <> help "Replica count" <> metavar "COUNT")
|
||||||
|
<*> option trackReader (long "track" <> help "Release track" <> metavar "TRACK")
|
||||||
|
|
||||||
|
promoteSpecParser :: Parser PromoteSpec
|
||||||
|
promoteSpecParser =
|
||||||
|
PromoteSpec
|
||||||
|
<$> strOption (long "service" <> help "Service name" <> metavar "SERVICE")
|
||||||
|
<*> strOption (long "from-tag" <> help "Current deployment tag" <> metavar "TAG")
|
||||||
|
<*> strOption (long "to-tag" <> help "Target deployment tag" <> metavar "TAG")
|
||||||
|
<*> some (strOption (long "owner" <> help "Responsible owner" <> metavar "OWNER"))
|
||||||
|
<*> switch (long "dry-run" <> help "Do not apply the promotion")
|
||||||
|
|
||||||
|
environmentReader :: ReadM Environment
|
||||||
|
environmentReader =
|
||||||
|
eitherReader $ \rawValue ->
|
||||||
|
case rawValue of
|
||||||
|
"staging" -> Right Staging
|
||||||
|
"production" -> Right Production
|
||||||
|
_ -> Left ("expected staging or production, got: " ++ rawValue)
|
||||||
|
|
||||||
|
trackReader :: ReadM ReleaseTrack
|
||||||
|
trackReader =
|
||||||
|
eitherReader $ \rawValue ->
|
||||||
|
case rawValue of
|
||||||
|
"stable" -> Right Stable
|
||||||
|
"candidate" -> Right Candidate
|
||||||
|
_ -> Left ("expected stable or candidate, got: " ++ rawValue)
|
||||||
|
|
||||||
|
intReader :: ReadM Int
|
||||||
|
intReader =
|
||||||
|
eitherReader $ \rawValue ->
|
||||||
|
case reads rawValue of
|
||||||
|
[(intValue, "")]
|
||||||
|
| intValue > 0 -> Right intValue
|
||||||
|
| otherwise -> Left "replicas must be greater than zero"
|
||||||
|
_ -> Left ("invalid integer: " ++ rawValue)
|
||||||
|
|
||||||
|
renderEnvironment :: Environment -> String
|
||||||
|
renderEnvironment Staging = "staging"
|
||||||
|
renderEnvironment Production = "production"
|
||||||
|
|
||||||
|
renderTrack :: ReleaseTrack -> String
|
||||||
|
renderTrack Stable = "stable"
|
||||||
|
renderTrack Candidate = "candidate"
|
||||||
|
|
||||||
|
renderBool :: Bool -> String
|
||||||
|
renderBool True = "yes"
|
||||||
|
renderBool False = "no"
|
||||||
|
|
||||||
|
trimTrailingWhitespace :: String -> String
|
||||||
|
trimTrailingWhitespace = reverse . dropWhile isSpace . reverse
|
||||||
26
33-haskell-optparse-cli/test/Main.hs
Normal file
26
33-haskell-optparse-cli/test/Main.hs
Normal file
@ -0,0 +1,26 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import MiniCli.Command
|
||||||
|
( Command (PromoteCommand, ValidateCommand)
|
||||||
|
, Environment (Production)
|
||||||
|
, PromoteSpec (PromoteSpec)
|
||||||
|
, ReleaseTrack (Stable)
|
||||||
|
, ValidateSpec (ValidateSpec)
|
||||||
|
, renderCommand
|
||||||
|
, runCliParser
|
||||||
|
)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main =
|
||||||
|
case
|
||||||
|
( runCliParser ["validate", "--service", "api", "--env", "production", "--replicas", "3", "--track", "stable"]
|
||||||
|
, runCliParser ["promote", "--service", "api", "--from-tag", "blue", "--to-tag", "green", "--owner", "platform", "--owner", "security", "--dry-run"]
|
||||||
|
, runCliParser ["validate", "--service", "api", "--replicas", "3", "--track", "stable"]
|
||||||
|
) of
|
||||||
|
( Right (ValidateCommand (ValidateSpec "api" Production 3 Stable))
|
||||||
|
, Right promoteCommand@(PromoteCommand (PromoteSpec "api" "blue" "green" ["platform", "security"] True))
|
||||||
|
, Left _
|
||||||
|
) | renderCommand promoteCommand == "promote api, from blue, to green, owners platform/security, dry-run yes" ->
|
||||||
|
putStrLn "test passed"
|
||||||
|
_ -> die "unexpected optparse result"
|
||||||
25
34-haskell-dependency-order/README.md
Normal file
25
34-haskell-dependency-order/README.md
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
# 34-haskell-dependency-order
|
||||||
|
|
||||||
|
This example shows intermediate Haskell dependency planning with graph traversal.
|
||||||
|
|
||||||
|
It includes:
|
||||||
|
|
||||||
|
- a service catalog with inter-service dependencies,
|
||||||
|
- cycle detection and unknown-service rejection,
|
||||||
|
- a deployment plan rendered in dependency order, and
|
||||||
|
- a test suite run by `nix flake check`.
|
||||||
|
|
||||||
|
Useful commands:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal run -- frontend billing
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-dependency-order frontend billing
|
||||||
|
|
||||||
|
nix run . -- frontend billing
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
21
34-haskell-dependency-order/app/Main.hs
Normal file
21
34-haskell-dependency-order/app/Main.hs
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import MiniDependency.Order
|
||||||
|
( catalog
|
||||||
|
, renderPlan
|
||||||
|
, resolveDeploymentOrder
|
||||||
|
)
|
||||||
|
import System.Environment (getArgs)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
let requestedServices =
|
||||||
|
case args of
|
||||||
|
[] -> ["frontend", "billing"]
|
||||||
|
_ -> args
|
||||||
|
|
||||||
|
case resolveDeploymentOrder catalog requestedServices of
|
||||||
|
Left err -> die err
|
||||||
|
Right deploymentPlan -> putStrLn (renderPlan deploymentPlan)
|
||||||
27
34-haskell-dependency-order/flake.lock
generated
Normal file
27
34-haskell-dependency-order/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
34-haskell-dependency-order/flake.nix
Normal file
38
34-haskell-dependency-order/flake.nix
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
{
|
||||||
|
# Builds a Haskell project that resolves deployment order from a dependency
|
||||||
|
# graph while rejecting cycles and unknown services.
|
||||||
|
description = "A Haskell project for dependency-ordered deployment plans";
|
||||||
|
|
||||||
|
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-dependency-order" ./. { };
|
||||||
|
checkedProject = pkgs.haskell.lib.doCheck project;
|
||||||
|
in
|
||||||
|
{
|
||||||
|
packages.${system}.default = project;
|
||||||
|
|
||||||
|
apps.${system}.default = {
|
||||||
|
type = "app";
|
||||||
|
program = "${self.packages.${system}.default}/bin/mini-dependency-order";
|
||||||
|
meta.description = "Run the dependency-ordered deployment example.";
|
||||||
|
};
|
||||||
|
|
||||||
|
devShells.${system}.default = pkgs.mkShell {
|
||||||
|
packages = [
|
||||||
|
haskellPackages.ghc
|
||||||
|
pkgs.cabal-install
|
||||||
|
pkgs.haskell-language-server
|
||||||
|
];
|
||||||
|
};
|
||||||
|
|
||||||
|
checks.${system}.test-suite = checkedProject;
|
||||||
|
};
|
||||||
|
}
|
||||||
30
34-haskell-dependency-order/mini-dependency-order.cabal
Normal file
30
34-haskell-dependency-order/mini-dependency-order.cabal
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
cabal-version: 2.4
|
||||||
|
name: mini-dependency-order
|
||||||
|
version: 0.1.0.0
|
||||||
|
build-type: Simple
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules: MiniDependency.Order
|
||||||
|
hs-source-dirs: src
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
containers
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable mini-dependency-order
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: app
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
mini-dependency-order
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite mini-dependency-order-test
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: test
|
||||||
|
build-depends:
|
||||||
|
base >=4.14 && <5,
|
||||||
|
containers,
|
||||||
|
mini-dependency-order
|
||||||
|
default-language: Haskell2010
|
||||||
100
34-haskell-dependency-order/src/MiniDependency/Order.hs
Normal file
100
34-haskell-dependency-order/src/MiniDependency/Order.hs
Normal file
@ -0,0 +1,100 @@
|
|||||||
|
module MiniDependency.Order where
|
||||||
|
|
||||||
|
import qualified Data.Map.Strict as Map
|
||||||
|
import Data.Map.Strict (Map)
|
||||||
|
import qualified Data.Set as Set
|
||||||
|
import Data.Set (Set)
|
||||||
|
|
||||||
|
data ServiceProfile = ServiceProfile
|
||||||
|
{ dependencyNames :: [String]
|
||||||
|
, needsMigration :: Bool
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
data DeploymentStep = DeploymentStep
|
||||||
|
{ deploymentService :: String
|
||||||
|
, deploymentDependencies :: [String]
|
||||||
|
, migrationRequired :: Bool
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
type Catalog = Map String ServiceProfile
|
||||||
|
|
||||||
|
catalog :: Catalog
|
||||||
|
catalog =
|
||||||
|
Map.fromList
|
||||||
|
[ ("postgres", ServiceProfile [] False)
|
||||||
|
, ("redis", ServiceProfile [] False)
|
||||||
|
, ("auth", ServiceProfile ["postgres"] True)
|
||||||
|
, ("api", ServiceProfile ["auth", "redis"] True)
|
||||||
|
, ("billing", ServiceProfile ["api", "postgres"] True)
|
||||||
|
, ("frontend", ServiceProfile ["api"] False)
|
||||||
|
]
|
||||||
|
|
||||||
|
resolveDeploymentOrder :: Catalog -> [String] -> Either String [DeploymentStep]
|
||||||
|
resolveDeploymentOrder serviceCatalog requestedServices =
|
||||||
|
do
|
||||||
|
(_, _, orderedSteps) <- foldl step (Right (Set.empty, Set.empty, [])) requestedServices
|
||||||
|
Right orderedSteps
|
||||||
|
where
|
||||||
|
step (Left err) _ = Left err
|
||||||
|
step (Right visitState) serviceName = visitService serviceCatalog serviceName visitState
|
||||||
|
|
||||||
|
visitService ::
|
||||||
|
Catalog ->
|
||||||
|
String ->
|
||||||
|
(Set String, Set String, [DeploymentStep]) ->
|
||||||
|
Either String (Set String, Set String, [DeploymentStep])
|
||||||
|
visitService serviceCatalog serviceName (visiting, visited, orderedSteps)
|
||||||
|
| Set.member serviceName visited =
|
||||||
|
Right (visiting, visited, orderedSteps)
|
||||||
|
| Set.member serviceName visiting =
|
||||||
|
Left ("dependency cycle detected at: " ++ serviceName)
|
||||||
|
| otherwise =
|
||||||
|
case Map.lookup serviceName serviceCatalog of
|
||||||
|
Nothing -> Left ("unknown service: " ++ serviceName)
|
||||||
|
Just serviceProfile -> do
|
||||||
|
(visitingAfterDeps, visitedAfterDeps, stepsAfterDeps) <-
|
||||||
|
foldl
|
||||||
|
stepDependency
|
||||||
|
(Right (Set.insert serviceName visiting, visited, orderedSteps))
|
||||||
|
(dependencyNames serviceProfile)
|
||||||
|
Right
|
||||||
|
( Set.delete serviceName visitingAfterDeps
|
||||||
|
, Set.insert serviceName visitedAfterDeps
|
||||||
|
, stepsAfterDeps
|
||||||
|
++ [ DeploymentStep
|
||||||
|
{ deploymentService = serviceName
|
||||||
|
, deploymentDependencies = dependencyNames serviceProfile
|
||||||
|
, migrationRequired = needsMigration serviceProfile
|
||||||
|
}
|
||||||
|
]
|
||||||
|
)
|
||||||
|
where
|
||||||
|
stepDependency (Left err) _ = Left err
|
||||||
|
stepDependency (Right visitState) dependencyName =
|
||||||
|
visitService serviceCatalog dependencyName visitState
|
||||||
|
|
||||||
|
renderPlan :: [DeploymentStep] -> String
|
||||||
|
renderPlan = unlines . map renderStep
|
||||||
|
|
||||||
|
renderStep :: DeploymentStep -> String
|
||||||
|
renderStep deploymentStep =
|
||||||
|
deploymentService deploymentStep
|
||||||
|
++ ", deps "
|
||||||
|
++ renderDependencies (deploymentDependencies deploymentStep)
|
||||||
|
++ ", migration "
|
||||||
|
++ renderBool (migrationRequired deploymentStep)
|
||||||
|
|
||||||
|
renderDependencies :: [String] -> String
|
||||||
|
renderDependencies [] = "none"
|
||||||
|
renderDependencies dependencies = commaSeparated dependencies
|
||||||
|
|
||||||
|
renderBool :: Bool -> String
|
||||||
|
renderBool True = "yes"
|
||||||
|
renderBool False = "no"
|
||||||
|
|
||||||
|
commaSeparated :: [String] -> String
|
||||||
|
commaSeparated [] = ""
|
||||||
|
commaSeparated [singleValue] = singleValue
|
||||||
|
commaSeparated (firstValue : remainingValues) = firstValue ++ ", " ++ commaSeparated remainingValues
|
||||||
49
34-haskell-dependency-order/test/Main.hs
Normal file
49
34-haskell-dependency-order/test/Main.hs
Normal file
@ -0,0 +1,49 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import qualified Data.Map.Strict as Map
|
||||||
|
import MiniDependency.Order
|
||||||
|
( Catalog
|
||||||
|
, DeploymentStep (DeploymentStep)
|
||||||
|
, ServiceProfile (ServiceProfile)
|
||||||
|
, catalog
|
||||||
|
, renderPlan
|
||||||
|
, resolveDeploymentOrder
|
||||||
|
)
|
||||||
|
import System.Exit (die)
|
||||||
|
|
||||||
|
cyclicCatalog :: Catalog
|
||||||
|
cyclicCatalog =
|
||||||
|
Map.fromList
|
||||||
|
[ ("a", ServiceProfile ["b"] False)
|
||||||
|
, ("b", ServiceProfile ["a"] False)
|
||||||
|
]
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main =
|
||||||
|
case
|
||||||
|
( resolveDeploymentOrder catalog ["frontend", "billing"]
|
||||||
|
, resolveDeploymentOrder cyclicCatalog ["a"]
|
||||||
|
) of
|
||||||
|
( Right
|
||||||
|
[ DeploymentStep "postgres" [] False
|
||||||
|
, DeploymentStep "auth" ["postgres"] True
|
||||||
|
, DeploymentStep "redis" [] False
|
||||||
|
, DeploymentStep "api" ["auth", "redis"] True
|
||||||
|
, DeploymentStep "frontend" ["api"] False
|
||||||
|
, DeploymentStep "billing" ["api", "postgres"] True
|
||||||
|
]
|
||||||
|
, Left _
|
||||||
|
) | "billing, deps api, postgres, migration yes"
|
||||||
|
`elem`
|
||||||
|
lines
|
||||||
|
( renderPlan
|
||||||
|
[ DeploymentStep "postgres" [] False
|
||||||
|
, DeploymentStep "auth" ["postgres"] True
|
||||||
|
, DeploymentStep "redis" [] False
|
||||||
|
, DeploymentStep "api" ["auth", "redis"] True
|
||||||
|
, DeploymentStep "frontend" ["api"] False
|
||||||
|
, DeploymentStep "billing" ["api", "postgres"] True
|
||||||
|
]
|
||||||
|
) ->
|
||||||
|
putStrLn "test passed"
|
||||||
|
_ -> die "unexpected dependency-order result"
|
||||||
@ -23,6 +23,9 @@ This note links the Haskell examples in a suggested order from first project str
|
|||||||
15. `29-haskell-foldmap-summary/`: monoidal event aggregation with one `foldMap` pass
|
15. `29-haskell-foldmap-summary/`: monoidal event aggregation with one `foldMap` pass
|
||||||
16. `30-haskell-traverse-resolution/`: batch resolution of requests through `traverse`
|
16. `30-haskell-traverse-resolution/`: batch resolution of requests through `traverse`
|
||||||
17. `31-haskell-writer-audit/`: rollout logging with `Writer`
|
17. `31-haskell-writer-audit/`: rollout logging with `Writer`
|
||||||
|
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
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
@ -45,6 +48,9 @@ This note links the Haskell examples in a suggested order from first project str
|
|||||||
- `29-haskell-foldmap-summary/`: how to express batch aggregation through monoidal summary fragments
|
- `29-haskell-foldmap-summary/`: how to express batch aggregation through monoidal summary fragments
|
||||||
- `30-haskell-traverse-resolution/`: how to sequence per-request resolution across a whole batch
|
- `30-haskell-traverse-resolution/`: how to sequence per-request resolution across a whole batch
|
||||||
- `31-haskell-writer-audit/`: how to compute a result while accumulating ordered audit output
|
- `31-haskell-writer-audit/`: how to compute a result while accumulating ordered audit output
|
||||||
|
- `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
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
@ -67,3 +73,6 @@ This note links the Haskell examples in a suggested order from first project str
|
|||||||
- `notes/032-haskell-foldmap-summary.md`
|
- `notes/032-haskell-foldmap-summary.md`
|
||||||
- `notes/033-haskell-traverse-resolution.md`
|
- `notes/033-haskell-traverse-resolution.md`
|
||||||
- `notes/034-haskell-writer-audit.md`
|
- `notes/034-haskell-writer-audit.md`
|
||||||
|
- `notes/035-haskell-nonempty-waves.md`
|
||||||
|
- `notes/036-haskell-optparse-cli.md`
|
||||||
|
- `notes/037-haskell-dependency-order.md`
|
||||||
|
|||||||
58
notes/035-haskell-nonempty-waves.md
Normal file
58
notes/035-haskell-nonempty-waves.md
Normal file
@ -0,0 +1,58 @@
|
|||||||
|
# Haskell NonEmpty Waves
|
||||||
|
|
||||||
|
This note covers `32-haskell-nonempty-waves/`, which models rollout plans with `NonEmpty` so every plan is guaranteed to have at least one wave.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 1. Why `NonEmpty` Matters
|
||||||
|
|
||||||
|
A rollout plan with zero waves is not meaningful.
|
||||||
|
|
||||||
|
Using `[Wave]` would force every caller to handle an impossible-but-representable empty case. This example makes that impossible state unrepresentable
|
||||||
|
instead:
|
||||||
|
|
||||||
|
```haskell
|
||||||
|
planWaves :: NonEmpty Wave
|
||||||
|
```
|
||||||
|
|
||||||
|
That means the rendering code can safely ask for the first and last wave without defensive checks.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 2. What the Example Builds
|
||||||
|
|
||||||
|
The example turns a release job into:
|
||||||
|
|
||||||
|
- one wave for a rolling rollout, or
|
||||||
|
- two waves for a canary rollout.
|
||||||
|
|
||||||
|
Both cases still share the same output type. That is the real teaching point: `NonEmpty` lets you preserve list-like behavior while tightening the
|
||||||
|
domain guarantee.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 3. Why This Is Better Than a Runtime Check
|
||||||
|
|
||||||
|
You could build a plain list and reject `[]` later.
|
||||||
|
|
||||||
|
That would move the invariant into comments and runtime branches. `NonEmpty` pushes the guarantee into the type itself, which is more precise and
|
||||||
|
easier to trust.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. Commands to Try
|
||||||
|
|
||||||
|
```bash
|
||||||
|
cd 32-haskell-nonempty-waves
|
||||||
|
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal run -- api:production:canary:20:6
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-waves api:production:canary:20:6
|
||||||
|
|
||||||
|
nix run . -- api:production:canary:20:6
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
63
notes/036-haskell-optparse-cli.md
Normal file
63
notes/036-haskell-optparse-cli.md
Normal file
@ -0,0 +1,63 @@
|
|||||||
|
# Haskell optparse-applicative
|
||||||
|
|
||||||
|
This note covers `33-haskell-optparse-cli/`, which parses a small deployment CLI with `optparse-applicative`.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 1. Why This Is Different from the Parser-Combinator Example
|
||||||
|
|
||||||
|
`12-haskell-parser-combinators/` builds a parser for a custom command language.
|
||||||
|
|
||||||
|
This example solves a different problem: parsing a conventional CLI with:
|
||||||
|
|
||||||
|
- subcommands,
|
||||||
|
- long options,
|
||||||
|
- repeated options, and
|
||||||
|
- typed option readers.
|
||||||
|
|
||||||
|
That is a common real-world Haskell task, and `optparse-applicative` is the standard tool for it.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 2. What the Pure Parser Gives You
|
||||||
|
|
||||||
|
The example exposes:
|
||||||
|
|
||||||
|
```haskell
|
||||||
|
runCliParser :: [String] -> Either String Command
|
||||||
|
```
|
||||||
|
|
||||||
|
Internally it uses `execParserPure`, which keeps the parsing logic testable without invoking `IO` or shelling out.
|
||||||
|
|
||||||
|
That is the main teaching point here: command-line parsing can still be structured as a pure transformation from argument vectors to typed commands.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 3. What Makes the Example Non-Trivial
|
||||||
|
|
||||||
|
The parser handles two shapes of command:
|
||||||
|
|
||||||
|
- `validate`, which parses typed environment, replica, and track options, and
|
||||||
|
- `promote`, which parses repeated `--owner` flags plus a `--dry-run` switch.
|
||||||
|
|
||||||
|
That is enough surface area to show why a dedicated CLI parser library is useful.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. Commands to Try
|
||||||
|
|
||||||
|
```bash
|
||||||
|
cd 33-haskell-optparse-cli
|
||||||
|
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal run -- validate --service api --env production --replicas 3 --track stable
|
||||||
|
cabal run -- promote --service api --from-tag blue --to-tag green --owner platform --owner security --dry-run
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-cli validate --service api --env production --replicas 3 --track stable
|
||||||
|
|
||||||
|
nix run . -- validate --service api --env production --replicas 3 --track stable
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
56
notes/037-haskell-dependency-order.md
Normal file
56
notes/037-haskell-dependency-order.md
Normal file
@ -0,0 +1,56 @@
|
|||||||
|
# Haskell Dependency Order
|
||||||
|
|
||||||
|
This note covers `34-haskell-dependency-order/`, which computes a deployment order from service dependencies and rejects cycles.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 1. What the Planner Has to Do
|
||||||
|
|
||||||
|
For each requested service, the planner needs to:
|
||||||
|
|
||||||
|
- find its dependencies,
|
||||||
|
- visit those dependencies first,
|
||||||
|
- avoid emitting the same service twice, and
|
||||||
|
- reject cycles and unknown names.
|
||||||
|
|
||||||
|
That makes the example a good fit for a graph-style traversal, even though the code stays small and explicit.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 2. Why the Output Order Matters
|
||||||
|
|
||||||
|
The planner emits `DeploymentStep` values in dependency order.
|
||||||
|
|
||||||
|
That means infrastructure and foundational services appear before dependents such as `api`, `billing`, or `frontend`.
|
||||||
|
|
||||||
|
This is the important behavior the example demonstrates: ordering is part of correctness, not just presentation.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 3. Why the Cycle Check Is Separate
|
||||||
|
|
||||||
|
The example tracks both:
|
||||||
|
|
||||||
|
- services currently being visited, and
|
||||||
|
- services already resolved.
|
||||||
|
|
||||||
|
That distinction is what lets it detect `a -> b -> a` style cycles without falsely rejecting shared dependencies that are reached more than once.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. Commands to Try
|
||||||
|
|
||||||
|
```bash
|
||||||
|
cd 34-haskell-dependency-order
|
||||||
|
|
||||||
|
nix develop
|
||||||
|
cabal run
|
||||||
|
cabal run -- frontend billing
|
||||||
|
cabal test
|
||||||
|
|
||||||
|
nix build
|
||||||
|
./result/bin/mini-dependency-order frontend billing
|
||||||
|
|
||||||
|
nix run . -- frontend billing
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
Loading…
x
Reference in New Issue
Block a user