Add two more Haskell examples (with their note files)

26-haskell-quickcheck/README.md

@@ -0,0 +1,25 @@
+# 26-haskell-quickcheck
+
+This example shows intermediate Haskell property testing with QuickCheck.
+
+It includes:
+
+- a non-trivial window normalization function,
+- a CLI that renders merged maintenance windows,
+- QuickCheck properties for normalization shape, idempotence, and coverage, and
+- a test suite run by `nix flake check`.
+
+Useful commands:
+
+```bash
+nix develop
+cabal run
+cabal run -- 0-10 8-14 20-24 24-30
+cabal test
+
+nix build
+./result/bin/mini-windows 0-10 8-14 20-24 24-30
+
+nix run . -- 0-10 8-14 20-24 24-30
+nix flake check
+```

26-haskell-quickcheck/app/Main.hs

@@ -0,0 +1,21 @@
+module Main where
+
+import MiniWindows.Normalize
+  ( normalizeWindows
+  , parseWindow
+  , renderWindows
+  )
+import System.Environment (getArgs)
+import System.Exit (die)
+
+main :: IO ()
+main = do
+  args <- getArgs
+  let inputArgs =
+        case args of
+          [] -> ["0-10", "8-14", "20-24", "24-30"]
+          _ -> args
+
+  case traverse parseWindow inputArgs of
+    Left err -> die err
+    Right windows -> putStrLn (renderWindows (normalizeWindows windows))

26-haskell-quickcheck/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
+}

26-haskell-quickcheck/flake.nix

@@ -0,0 +1,38 @@
+{
+  # Builds a Haskell project that normalizes maintenance windows and checks
+  # the normalization logic with QuickCheck properties.
+  description = "A Haskell project for QuickCheck properties";
+
+  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-windows" ./. { };
+      checkedProject = pkgs.haskell.lib.doCheck project;
+    in
+    {
+      packages.${system}.default = project;
+
+      apps.${system}.default = {
+        type = "app";
+        program = "${self.packages.${system}.default}/bin/mini-windows";
+        meta.description = "Run the QuickCheck maintenance window example.";
+      };
+
+      devShells.${system}.default = pkgs.mkShell {
+        packages = [
+          haskellPackages.ghc
+          pkgs.cabal-install
+          pkgs.haskell-language-server
+        ];
+      };
+
+      checks.${system}.test-suite = checkedProject;
+    };
+}

26-haskell-quickcheck/mini-windows.cabal

@@ -0,0 +1,29 @@
+cabal-version:      2.4
+name:               mini-windows
+version:            0.1.0.0
+build-type:         Simple
+
+library
+  exposed-modules:  MiniWindows.Normalize
+  hs-source-dirs:   src
+  build-depends:
+      base >=4.14 && <5
+  default-language: Haskell2010
+
+executable mini-windows
+  main-is:          Main.hs
+  hs-source-dirs:   app
+  build-depends:
+      base >=4.14 && <5,
+      mini-windows
+  default-language: Haskell2010
+
+test-suite mini-windows-test
+  type:             exitcode-stdio-1.0
+  main-is:          Main.hs
+  hs-source-dirs:   test
+  build-depends:
+      base >=4.14 && <5,
+      mini-windows,
+      QuickCheck
+  default-language: Haskell2010

26-haskell-quickcheck/src/MiniWindows/Normalize.hs

@@ -0,0 +1,62 @@
+module MiniWindows.Normalize where
+
+import Data.List (sortOn)
+
+data Window = Window
+  { windowStart :: Int
+  , windowEnd :: Int
+  }
+  deriving (Eq, Show)
+
+mkWindow :: Int -> Int -> Maybe Window
+mkWindow startMinute endMinute
+  | startMinute < 0 = Nothing
+  | endMinute <= startMinute = Nothing
+  | otherwise = Just (Window startMinute endMinute)
+
+parseWindow :: String -> Either String Window
+parseWindow rawWindow =
+  case break (== '-') rawWindow of
+    (rawStart, '-' : rawEnd) ->
+      case (reads rawStart, reads rawEnd) of
+        ([(startMinute, "")], [(endMinute, "")]) ->
+          case mkWindow startMinute endMinute of
+            Just parsedWindow -> Right parsedWindow
+            Nothing -> Left ("invalid window bounds: " ++ rawWindow)
+        _ -> Left ("invalid window bounds: " ++ rawWindow)
+    _ -> Left ("expected <start>-<end>, got: " ++ rawWindow)
+
+normalizeWindows :: [Window] -> [Window]
+normalizeWindows = foldr mergeWindow [] . sortOn windowStart
+
+renderWindows :: [Window] -> String
+renderWindows [] = "no maintenance windows"
+renderWindows windows = unwords (map renderWindow windows)
+
+renderWindow :: Window -> String
+renderWindow window = show (windowStart window) ++ "-" ++ show (windowEnd window)
+
+coversMinute :: Int -> [Window] -> Bool
+coversMinute minute = any covers
+  where
+    covers window = windowStart window <= minute && minute < windowEnd window
+
+isNormalized :: [Window] -> Bool
+isNormalized [] = True
+isNormalized [_] = True
+isNormalized (firstWindow : secondWindow : remainingWindows) =
+  windowStart firstWindow < windowEnd firstWindow
+    && windowEnd firstWindow < windowStart secondWindow
+    && isNormalized (secondWindow : remainingWindows)
+
+mergeWindow :: Window -> [Window] -> [Window]
+mergeWindow window [] = [window]
+mergeWindow window (nextWindow : remainingWindows)
+  | windowEnd window >= windowStart nextWindow =
+      mergeWindow
+        Window
+          { windowStart = min (windowStart window) (windowStart nextWindow)
+          , windowEnd = max (windowEnd window) (windowEnd nextWindow)
+          }
+        remainingWindows
+  | otherwise = window : nextWindow : remainingWindows

26-haskell-quickcheck/test/Main.hs

@@ -0,0 +1,64 @@
+module Main where
+
+import MiniWindows.Normalize
+  ( Window (Window)
+  , coversMinute
+  , isNormalized
+  , normalizeWindows
+  )
+import System.Exit (die)
+import Test.QuickCheck
+  ( Gen
+  , Property
+  , chooseInt
+  , forAll
+  , isSuccess
+  , listOf
+  , quickCheckResult
+  )
+
+newtype WindowList = WindowList [Window]
+  deriving (Show)
+
+genWindow :: Gen Window
+genWindow = do
+  startMinute <- chooseInt (0, 59)
+  endMinute <- chooseInt (startMinute + 1, 60)
+  pure (Window startMinute endMinute)
+
+genWindowList :: Gen WindowList
+genWindowList = WindowList <$> listOf genWindow
+
+prop_exampleMerge :: Bool
+prop_exampleMerge =
+  normalizeWindows [Window 0 10, Window 8 14, Window 20 24, Window 24 30]
+    == [Window 0 14, Window 20 30]
+
+prop_idempotent :: Property
+prop_idempotent =
+  forAll genWindowList $ \(WindowList windows) ->
+    normalizeWindows (normalizeWindows windows) == normalizeWindows windows
+
+prop_resultIsNormalized :: Property
+prop_resultIsNormalized =
+  forAll genWindowList $ \(WindowList windows) ->
+    isNormalized (normalizeWindows windows)
+
+prop_preservesCoverage :: Property
+prop_preservesCoverage =
+  forAll genWindowList $ \(WindowList windows) ->
+    all
+      (\minute -> coversMinute minute windows == coversMinute minute (normalizeWindows windows))
+      [0 .. 60]
+
+main :: IO ()
+main = do
+  exampleResult <- quickCheckResult prop_exampleMerge
+  idempotentResult <- quickCheckResult prop_idempotent
+  normalizedResult <- quickCheckResult prop_resultIsNormalized
+  coverageResult <- quickCheckResult prop_preservesCoverage
+
+  if all isSuccess [exampleResult, idempotentResult, normalizedResult, coverageResult] then
+    putStrLn "test passed"
+  else
+    die "unexpected QuickCheck result"

27-haskell-aeson-roundtrip/README.md

@@ -0,0 +1,25 @@
+# 27-haskell-aeson-roundtrip
+
+This example shows intermediate Haskell JSON work with explicit Aeson round trips.
+
+It includes:
+
+- custom `ToJSON` and `FromJSON` instances for domain types,
+- a nested rollout strategy encoded with a stable JSON shape,
+- a CLI that prints JSON and decodes it back into a summary, and
+- a test suite run by `nix flake check`.
+
+Useful commands:
+
+```bash
+nix develop
+cabal run
+cabal run -- api production 3 platform,security canary:10
+cabal test
+
+nix build
+./result/bin/mini-manifest api production 3 platform,security canary:10
+
+nix run . -- api production 3 platform,security canary:10
+nix flake check
+```

27-haskell-aeson-roundtrip/app/Main.hs

@@ -0,0 +1,28 @@
+module Main where
+
+import qualified Data.ByteString.Lazy.Char8 as ByteString
+import MiniManifest.Json
+  ( decodeManifest
+  , encodeManifest
+  , parseManifestArgs
+  , renderManifest
+  )
+import System.Environment (getArgs)
+import System.Exit (die)
+
+main :: IO ()
+main = do
+  args <- getArgs
+  let inputArgs =
+        case args of
+          [] -> ["api", "production", "3", "platform,security", "canary:10"]
+          _ -> args
+
+  case parseManifestArgs inputArgs of
+    Left err -> die err
+    Right manifest -> do
+      let encodedManifest = encodeManifest manifest
+      ByteString.putStrLn encodedManifest
+      case decodeManifest encodedManifest of
+        Left err -> die err
+        Right decodedManifest -> putStrLn (renderManifest decodedManifest)

27-haskell-aeson-roundtrip/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
+}

27-haskell-aeson-roundtrip/flake.nix

@@ -0,0 +1,38 @@
+{
+  # Builds a Haskell project that encodes and decodes deployment manifests
+  # with explicit Aeson instances and round-trip checks.
+  description = "A Haskell project for Aeson round trips";
+
+  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-manifest" ./. { };
+      checkedProject = pkgs.haskell.lib.doCheck project;
+    in
+    {
+      packages.${system}.default = project;
+
+      apps.${system}.default = {
+        type = "app";
+        program = "${self.packages.${system}.default}/bin/mini-manifest";
+        meta.description = "Run the Aeson round-trip manifest example.";
+      };
+
+      devShells.${system}.default = pkgs.mkShell {
+        packages = [
+          haskellPackages.ghc
+          pkgs.cabal-install
+          pkgs.haskell-language-server
+        ];
+      };
+
+      checks.${system}.test-suite = checkedProject;
+    };
+}

27-haskell-aeson-roundtrip/mini-manifest.cabal

@@ -0,0 +1,32 @@
+cabal-version:      2.4
+name:               mini-manifest
+version:            0.1.0.0
+build-type:         Simple
+
+library
+  exposed-modules:  MiniManifest.Json
+  hs-source-dirs:   src
+  build-depends:
+      aeson,
+      base >=4.14 && <5,
+      bytestring,
+      text
+  default-language: Haskell2010
+
+executable mini-manifest
+  main-is:          Main.hs
+  hs-source-dirs:   app
+  build-depends:
+      base >=4.14 && <5,
+      bytestring,
+      mini-manifest
+  default-language: Haskell2010
+
+test-suite mini-manifest-test
+  type:             exitcode-stdio-1.0
+  main-is:          Main.hs
+  hs-source-dirs:   test
+  build-depends:
+      base >=4.14 && <5,
+      mini-manifest
+  default-language: Haskell2010

27-haskell-aeson-roundtrip/src/MiniManifest/Json.hs

@@ -0,0 +1,158 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module MiniManifest.Json where
+
+import Data.Aeson
+  ( FromJSON (parseJSON)
+  , ToJSON (toJSON)
+  , Value (String)
+  , encode
+  , eitherDecode
+  , object
+  , withObject
+  , withText
+  , (.:)
+  , (.=)
+  )
+import qualified Data.ByteString.Lazy as ByteString
+import Data.List (intercalate)
+import Data.Text (Text)
+import qualified Data.Text as Text
+
+data Environment
+  = Staging
+  | Production
+  deriving (Eq, Show)
+
+data RolloutStrategy
+  = Full
+  | Canary Int
+  deriving (Eq, Show)
+
+data DeploymentManifest = DeploymentManifest
+  { manifestService :: Text
+  , manifestEnvironment :: Environment
+  , manifestReplicas :: Int
+  , manifestOwners :: [Text]
+  , manifestStrategy :: RolloutStrategy
+  }
+  deriving (Eq, Show)
+
+instance ToJSON Environment where
+  toJSON Staging = String "staging"
+  toJSON Production = String "production"
+
+instance FromJSON Environment where
+  parseJSON =
+    withText "Environment" $ \value ->
+      case value of
+        "staging" -> pure Staging
+        "production" -> pure Production
+        _ -> fail ("unknown environment: " ++ Text.unpack value)
+
+instance ToJSON RolloutStrategy where
+  toJSON Full = object ["type" .= String "full"]
+  toJSON (Canary percent) = object ["type" .= String "canary", "percentage" .= percent]
+
+instance FromJSON RolloutStrategy where
+  parseJSON =
+    withObject "RolloutStrategy" $ \value -> do
+      strategyType <- value .: "type"
+      case (strategyType :: Text) of
+        "full" -> pure Full
+        "canary" -> Canary <$> value .: "percentage"
+        _ -> fail ("unknown strategy type: " ++ Text.unpack strategyType)
+
+instance ToJSON DeploymentManifest where
+  toJSON manifest =
+    object
+      [ "service" .= manifestService manifest
+      , "environment" .= manifestEnvironment manifest
+      , "replicas" .= manifestReplicas manifest
+      , "owners" .= manifestOwners manifest
+      , "strategy" .= manifestStrategy manifest
+      ]
+
+instance FromJSON DeploymentManifest where
+  parseJSON =
+    withObject "DeploymentManifest" $ \value ->
+      DeploymentManifest
+        <$> value .: "service"
+        <*> value .: "environment"
+        <*> value .: "replicas"
+        <*> value .: "owners"
+        <*> value .: "strategy"
+
+parseManifestArgs :: [String] -> Either String DeploymentManifest
+parseManifestArgs [serviceName, environmentName, rawReplicas, rawOwners, rawStrategy] = do
+  environment <- parseEnvironment environmentName
+  replicas <- parseReplicas rawReplicas
+  strategy <- parseStrategy rawStrategy
+  pure
+    DeploymentManifest
+      { manifestService = Text.pack serviceName
+      , manifestEnvironment = environment
+      , manifestReplicas = replicas
+      , manifestOwners = map Text.pack (splitOn ',' rawOwners)
+      , manifestStrategy = strategy
+      }
+parseManifestArgs _ =
+  Left "expected either no arguments or: <service> <environment> <replicas> <owners> <full|canary:percent>"
+
+encodeManifest :: DeploymentManifest -> ByteString.ByteString
+encodeManifest = encode
+
+decodeManifest :: ByteString.ByteString -> Either String DeploymentManifest
+decodeManifest = eitherDecode
+
+renderManifest :: DeploymentManifest -> String
+renderManifest manifest =
+  intercalate
+    ", "
+    [ "service " ++ Text.unpack (manifestService manifest)
+    , "env " ++ renderEnvironment (manifestEnvironment manifest)
+    , "replicas " ++ show (manifestReplicas manifest)
+    , "owners " ++ intercalate "/" (map Text.unpack (manifestOwners manifest))
+    , "strategy " ++ renderStrategy (manifestStrategy manifest)
+    ]
+
+parseEnvironment :: String -> Either String Environment
+parseEnvironment "staging" = Right Staging
+parseEnvironment "production" = Right Production
+parseEnvironment other = Left ("unknown environment: " ++ other)
+
+parseReplicas :: String -> Either String Int
+parseReplicas rawReplicas =
+  case reads rawReplicas of
+    [(parsedReplicas, "")]
+      | parsedReplicas > 0 -> Right parsedReplicas
+      | otherwise -> Left "replicas must be greater than zero"
+    _ -> Left ("invalid replica count: " ++ rawReplicas)
+
+parseStrategy :: String -> Either String RolloutStrategy
+parseStrategy "full" = Right Full
+parseStrategy rawStrategy =
+  case break (== ':') rawStrategy of
+    ("canary", ':' : rawPercent) ->
+      case reads rawPercent of
+        [(parsedPercent, "")]
+          | parsedPercent >= 1 && parsedPercent <= 50 -> Right (Canary parsedPercent)
+          | otherwise -> Left "canary percentage must be between 1 and 50"
+        _ -> Left ("invalid canary percentage: " ++ rawPercent)
+    _ -> Left ("unknown strategy: " ++ rawStrategy)
+
+renderEnvironment :: Environment -> String
+renderEnvironment Staging = "staging"
+renderEnvironment Production = "production"
+
+renderStrategy :: RolloutStrategy -> String
+renderStrategy Full = "full"
+renderStrategy (Canary percent) = "canary " ++ show percent ++ "%"
+
+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

27-haskell-aeson-roundtrip/test/Main.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import MiniManifest.Json
+  ( DeploymentManifest (..)
+  , Environment (Production)
+  , RolloutStrategy (Canary)
+  , decodeManifest
+  , encodeManifest
+  , renderManifest
+  )
+import System.Exit (die)
+
+sampleManifest :: DeploymentManifest
+sampleManifest =
+  DeploymentManifest
+    { manifestService = "api"
+    , manifestEnvironment = Production
+    , manifestReplicas = 3
+    , manifestOwners = ["platform", "security"]
+    , manifestStrategy = Canary 10
+    }
+
+main :: IO ()
+main =
+  case
+    ( decodeManifest (encodeManifest sampleManifest)
+    , decodeManifest "{\"service\":\"api\"}"
+    ) of
+    ( Right decodedManifest
+      , Left _
+      ) | renderManifest decodedManifest == "service api, env production, replicas 3, owners platform/security, strategy canary 10%" ->
+          putStrLn "test passed"
+    _ -> die "unexpected JSON round-trip result"

notes/029-haskell-quickcheck.md

@@ -0,0 +1,51 @@
+# Haskell QuickCheck
+
+This note covers `26-haskell-quickcheck/`, which normalizes overlapping maintenance windows and checks the implementation with QuickCheck
+properties.
+
+---
+
+## 1. Why Properties Help Here
+
+The function under test is not a single arithmetic helper. It sorts, merges, and preserves the covered time range of several windows.
+
+That kind of behavior is a strong fit for property testing, because you care about broad rules:
+
+- the result should be normalized,
+- normalizing twice should not change the answer, and
+- the normalized result should cover exactly the same minutes as the input.
+
+Those are better teaching examples for QuickCheck than a one-line `reverse . reverse` property.
+
+---
+
+## 2. What the Generator Controls
+
+The test suite generates windows within a bounded minute range.
+
+That keeps the coverage property finite, because the test can compare membership across `0..60` directly.
+
+The important point is not the numeric range itself. It is the workflow:
+
+1. generate realistic structured input,
+2. state invariant-like properties, and
+3. let QuickCheck search for counterexamples.
+
+---
+
+## 3. Commands to Try
+
+```bash
+cd 26-haskell-quickcheck
+
+nix develop
+cabal run
+cabal run -- 0-10 8-14 20-24 24-30
+cabal test
+
+nix build
+./result/bin/mini-windows 0-10 8-14 20-24 24-30
+
+nix run . -- 0-10 8-14 20-24 24-30
+nix flake check
+```

notes/030-haskell-aeson-roundtrip.md

@@ -0,0 +1,58 @@
+# Haskell Aeson Round Trips
+
+This note covers `27-haskell-aeson-roundtrip/`, which defines explicit JSON instances for deployment manifests and checks that encoding followed by
+decoding preserves the manifest value.
+
+---
+
+## 1. Why the Instances Are Explicit
+
+The example could have used generic deriving, but that would hide the JSON shape.
+
+Instead, it defines instances by hand for:
+
+- `Environment`,
+- `RolloutStrategy`, and
+- `DeploymentManifest`.
+
+That makes the wire format obvious, especially for the nested strategy object.
+
+---
+
+## 2. What the Round Trip Proves
+
+The main test checks this flow:
+
+1. start with a manifest value,
+2. encode it to JSON,
+3. decode the JSON back, and
+4. compare the result with the original value.
+
+That does not prove every possible JSON input is valid, but it does prove that the encoder and decoder agree on the example's own format.
+
+---
+
+## 3. Why the Strategy Shape Is Interesting
+
+`RolloutStrategy` is not encoded as a bare string. It becomes an object with a `type` field and, for canary rollouts, a `percentage` field.
+
+That is a more realistic format for APIs because it leaves room for strategy-specific data while keeping a stable top-level manifest shape.
+
+---
+
+## 4. Commands to Try
+
+```bash
+cd 27-haskell-aeson-roundtrip
+
+nix develop
+cabal run
+cabal run -- api production 3 platform,security canary:10
+cabal test
+
+nix build
+./result/bin/mini-manifest api production 3 platform,security canary:10
+
+nix run . -- api production 3 platform,security canary:10
+nix flake check
+```