@k2works/claude-code-booster 2.7.1 → 3.1.0

package/lib/assets/docs/article/functional-desgin-ppp/haskell/14-abstract-server-pattern.md

@@ -0,0 +1,379 @@
+# 第14章: Abstract Server パターン
+
+## はじめに
+
+Abstract Server パターンは、Dependency Inversion Principle（DIP）の適用例であり、高レベルモジュールが低レベルモジュールに依存せず、両者が抽象に依存するようにするパターンです。
+
+本章では、スイッチャブルインターフェース（Light, Fan, Motor）、リポジトリインターフェース、ロガーインターフェースを通じて Abstract Server パターンの実装を学びます。
+
+## 1. パターンの構造
+
+Abstract Server パターンは以下の要素で構成されます：
+
+- **Client**: 抽象インターフェースに依存するクライアント
+- **Abstract Server**: サーバーの抽象インターフェース
+- **Concrete Server**: 具体的なサーバーの実装
+
+```plantuml
+@startuml
+skinparam classAttributeIconSize 0
+
+class Client {
+  +useServer(s: Server)
+}
+
+interface Server {
+  +operation()
+}
+
+class ConcreteServerA {
+  +operation()
+}
+
+class ConcreteServerB {
+  +operation()
+}
+
+Client --> Server
+Server <|.. ConcreteServerA
+Server <|.. ConcreteServerB
+@enduml
+```
+
+## 2. Switchable インターフェース
+
+### 抽象サーバーの定義
+
+```haskell
+-- | State of a switchable device
+data SwitchState = On | Off
+  deriving (Show, Eq)
+
+-- | Switchable interface (Abstract Server)
+class Switchable a where
+  turnOn :: a -> a
+  turnOff :: a -> a
+  isOn :: a -> Bool
+```
+
+### Light の実装
+
+```haskell
+-- | Light device
+data Light = Light
+  { lightState :: SwitchState
+  , lightName :: String
+  } deriving (Show, Eq)
+
+-- | Create a light (off by default)
+makeLight :: String -> Light
+makeLight name = Light Off name
+
+-- | Create a light that is on
+makeLightOn :: String -> Light
+makeLightOn name = Light On name
+
+instance Switchable Light where
+  turnOn light = light { lightState = On }
+  turnOff light = light { lightState = Off }
+  isOn light = lightState light == On
+```
+
+### Fan の実装
+
+```haskell
+-- | Fan speed levels
+data FanSpeed = Low | Medium | High
+  deriving (Show, Eq, Ord)
+
+-- | Fan device
+data Fan = Fan
+  { fanState :: SwitchState
+  , fanSpeed :: FanSpeed
+  , fanName :: String
+  } deriving (Show, Eq)
+
+-- | Create a fan
+makeFan :: String -> Fan
+makeFan name = Fan Off Low name
+
+-- | Set fan speed (only works when on)
+setFanSpeed :: FanSpeed -> Fan -> Fan
+setFanSpeed speed fan
+  | isOn fan = fan { fanSpeed = speed }
+  | otherwise = fan
+
+instance Switchable Fan where
+  turnOn fan = fan { fanState = On }
+  turnOff fan = fan { fanState = Off }
+  isOn fan = fanState fan == On
+```
+
+### Motor の実装
+
+```haskell
+-- | Motor direction
+data MotorDirection = Forward | Reverse
+  deriving (Show, Eq)
+
+-- | Motor device
+data Motor = Motor
+  { motorState :: SwitchState
+  , motorDirection :: MotorDirection
+  , motorName :: String
+  } deriving (Show, Eq)
+
+-- | Create a motor
+makeMotor :: String -> Motor
+makeMotor name = Motor Off Forward name
+
+-- | Reverse motor direction (only works when on)
+reverseMotor :: Motor -> Motor
+reverseMotor motor
+  | isOn motor = motor { motorDirection = flipDir (motorDirection motor) }
+  | otherwise = motor
+  where
+    flipDir Forward = Reverse
+    flipDir Reverse = Forward
+
+instance Switchable Motor where
+  turnOn motor = motor { motorState = On }
+  turnOff motor = motor { motorState = Off }
+  isOn motor = motorState motor == On
+```
+
+## 3. クライアントコード
+
+```haskell
+-- | Engage a switch (turn on)
+engage :: Switchable a => a -> a
+engage = turnOn
+
+-- | Disengage a switch (turn off)
+disengage :: Switchable a => a -> a
+disengage = turnOff
+
+-- | Toggle a switch
+toggle :: Switchable a => a -> a
+toggle device
+  | isOn device = turnOff device
+  | otherwise = turnOn device
+
+-- | Get switch status
+switchStatus :: Switchable a => a -> SwitchState
+switchStatus device
+  | isOn device = On
+  | otherwise = Off
+```
+
+## 4. Repository インターフェース
+
+### Associated Type を使用した定義
+
+```haskell
+{-# LANGUAGE TypeFamilies #-}
+
+-- | Entity with ID
+class Entity a where
+  entityId :: a -> String
+  setEntityId :: String -> a -> a
+
+-- | Repository interface (Abstract Server)
+class Repository r where
+  type Item r
+  findById :: r -> String -> Maybe (Item r)
+  findAll :: r -> [Item r]
+  save :: r -> Item r -> (r, Item r)
+  delete :: r -> String -> (r, Maybe (Item r))
+```
+
+### Memory Repository の実装
+
+```haskell
+import qualified Data.Map.Strict as Map
+
+-- | In-memory repository
+data MemoryRepository a = MemoryRepository
+  { memData :: Map String a
+  , memNextId :: Int
+  } deriving (Show, Eq)
+
+-- | Create an empty memory repository
+makeMemoryRepo :: MemoryRepository a
+makeMemoryRepo = MemoryRepository Map.empty 1
+
+instance Entity a => Repository (MemoryRepository a) where
+  type Item (MemoryRepository a) = a
+  
+  findById repo idVal = Map.lookup idVal (memData repo)
+  
+  findAll repo = Map.elems (memData repo)
+  
+  save repo entity = 
+    let id' = entityId entity
+        newId = if null id' then show (memNextId repo) else id'
+        entity' = setEntityId newId entity
+        newData = Map.insert newId entity' (memData repo)
+        newNextId = if null id' then memNextId repo + 1 else memNextId repo
+    in (repo { memData = newData, memNextId = newNextId }, entity')
+  
+  delete repo idVal =
+    let entity = Map.lookup idVal (memData repo)
+        newData = Map.delete idVal (memData repo)
+    in (repo { memData = newData }, entity)
+```
+
+### Mock Repository の実装
+
+```haskell
+-- | Mock repository for testing
+data MockRepository a = MockRepository
+  { mockData :: [a]
+  } deriving (Show, Eq)
+
+-- | Create a mock repository with predefined data
+makeMockRepo :: [a] -> MockRepository a
+makeMockRepo = MockRepository
+
+instance Entity a => Repository (MockRepository a) where
+  type Item (MockRepository a) = a
+  
+  findById repo idVal = 
+    case filter (\x -> entityId x == idVal) (mockData repo) of
+      (x:_) -> Just x
+      [] -> Nothing
+  
+  findAll repo = mockData repo
+  
+  save repo entity =
+    let id' = entityId entity
+        newId = if null id' then show (length (mockData repo) + 1) else id'
+        entity' = setEntityId newId entity
+        newData = mockData repo ++ [entity']
+    in (repo { mockData = newData }, entity')
+  
+  delete repo idVal =
+    let (deleted, remaining) = partition (\x -> entityId x == idVal) (mockData repo)
+    in (repo { mockData = remaining }, listToMaybe deleted)
+```
+
+## 5. サービス層
+
+```haskell
+-- | User entity
+data User = User
+  { userId :: String
+  , userName :: String
+  , userEmail :: String
+  } deriving (Show, Eq)
+
+instance Entity User where
+  entityId = userId
+  setEntityId idVal user = user { userId = idVal }
+
+-- | Create a new user
+createUser :: (Repository r, Item r ~ User) => r -> String -> String -> (r, User)
+createUser repo name email = 
+  let user = User "" name email
+  in save repo user
+
+-- | Get a user by ID
+getUser :: Repository r => r -> String -> Maybe (Item r)
+getUser = findById
+
+-- | Get all users
+getAllUsers :: Repository r => r -> [Item r]
+getAllUsers = findAll
+
+-- | Delete a user
+deleteUser :: Repository r => r -> String -> (r, Maybe (Item r))
+deleteUser = delete
+```
+
+## 6. Logger インターフェース
+
+```haskell
+-- | Log levels
+data LogLevel = Debug | Info | Warning | Error
+  deriving (Show, Eq, Ord)
+
+-- | Logger interface (Abstract Server)
+class Logger l where
+  logMessage :: l -> LogLevel -> String -> (l, String)
+
+-- | Console logger
+data ConsoleLogger = ConsoleLogger
+  { clMinLevel :: LogLevel
+  } deriving (Show, Eq)
+
+instance Logger ConsoleLogger where
+  logMessage logger level msg
+    | level >= clMinLevel logger = 
+        let output = "[" ++ show level ++ "] " ++ msg
+        in (logger, output)
+    | otherwise = (logger, "")
+
+-- | Null logger (discards all messages)
+data NullLogger = NullLogger
+  deriving (Show, Eq)
+
+instance Logger NullLogger where
+  logMessage logger _ _ = (logger, "")
+
+-- | File logger (stores messages in a list)
+data FileLogger = FileLogger
+  { flPath :: String
+  , flMessages :: [String]
+  } deriving (Show, Eq)
+
+instance Logger FileLogger where
+  logMessage logger level msg =
+    let formatted = "[" ++ show level ++ "] " ++ msg
+        newMessages = flMessages logger ++ [formatted]
+    in (logger { flMessages = newMessages }, formatted)
+```
+
+## 7. テスト
+
+```haskell
+describe "Switchable" $ do
+  it "can toggle any switchable device" $ do
+    let light = toggle (makeLight "Test")
+        fan = toggle (makeFan "Test")
+    isOn light `shouldBe` True
+    isOn fan `shouldBe` True
+
+describe "Repository" $ do
+  it "works with memory repository" $ do
+    let repo = makeMemoryRepo :: MemoryRepository User
+        (repo', user) = createUser repo "John" "john@test.com"
+    getUser repo' (entityId user) `shouldBe` Just user
+  
+  it "works with mock repository" $ do
+    let user1 = User "1" "Alice" "alice@test.com"
+        repo = makeMockRepo [user1]
+    findById repo "1" `shouldBe` Just user1
+
+describe "Logger" $ do
+  it "console logger filters by level" $ do
+    let logger = ConsoleLogger Warning
+        (_, output1) = logMessage logger Info "Info"
+        (_, output2) = logMessage logger Error "Error"
+    output1 `shouldBe` ""
+    output2 `shouldBe` "[Error] Error"
+  
+  it "null logger discards all" $ do
+    let (_, output) = logMessage NullLogger Error "Error"
+    output `shouldBe` ""
+```
+
+## まとめ
+
+Abstract Server パターンの Haskell における実装のポイント：
+
+1. **型クラスによる抽象化**: インターフェースを型クラスで定義
+2. **Associated Types**: リポジトリのように関連する型がある場合は Associated Types を使用
+3. **多態的なクライアント**: クライアントコードは型クラス制約のみに依存
+4. **テスト容易性**: Mock 実装を使ってテストが容易
+5. **DIP の実現**: 高レベルモジュール（サービス層）が低レベルモジュール（リポジトリ実装）に依存しない
+6. **拡張性**: 新しい実装を追加しても既存コードに影響しない

package/lib/assets/docs/article/functional-desgin-ppp/haskell/15-gossiping-bus-drivers.md

@@ -0,0 +1,175 @@
+# 第15章: ゴシップ好きなバスの運転手
+
+## はじめに
+
+本章では、「ゴシップ好きなバスの運転手」という問題を通じて、関数型プログラミングの実践的なアプローチを学びます。この問題は、バス運転手が停留所で出会ったときに噂を共有するというシミュレーションです。
+
+この問題を通じて以下の概念を学びます：
+
+- 無限シーケンス（`cycle`）による循環データの表現
+- 集合演算による状態の伝播
+- データ変換パイプラインの設計
+
+## 1. 問題の説明
+
+複数のバス運転手がそれぞれのルートを巡回しています。各運転手は最初に1つの噂（自分のID）を知っています。同じ停留所に複数の運転手がいると、彼らは知っている噂をすべて共有します。
+
+**ゴール**: 全ての運転手が全ての噂を知るまでに何分かかるか？
+
+## 2. データモデル
+
+### ドライバーの表現
+
+```haskell
+-- | A stop identifier
+type Stop = Int
+
+-- | A gossip piece (unique per driver)
+type Gossip = Int
+
+-- | A bus driver with their route and known gossip
+data Driver = Driver
+  { driverId :: Int
+  , driverRoute :: [Stop]     -- ^ Infinite cyclic route
+  , driverGossip :: Set Gossip
+  } deriving (Show, Eq)
+
+-- | The world state is a list of drivers
+type World = [Driver]
+```
+
+### ドライバーの作成
+
+```haskell
+-- | Create a driver with a route (cycles infinitely) and initial gossip
+makeDriver :: Int -> [Stop] -> Driver
+makeDriver dId route = Driver
+  { driverId = dId
+  , driverRoute = cycle route
+  , driverGossip = Set.singleton dId
+  }
+
+-- | Create multiple drivers from routes
+makeDrivers :: [[Stop]] -> [Driver]
+makeDrivers routes = zipWith makeDriver [0..] routes
+```
+
+ポイント:
+- `cycle` 関数で有限のルートを無限の循環シーケンスに変換
+- 噂は集合（Set）として管理
+- 各ドライバーは自分のIDを初期の噂として持つ
+
+## 3. 移動と噂の伝播
+
+### ドライバーの移動
+
+```haskell
+-- | Get the current stop of a driver
+currentStop :: Driver -> Stop
+currentStop driver = head (driverRoute driver)
+
+-- | Move a driver to their next stop
+moveDriver :: Driver -> Driver
+moveDriver driver = driver { driverRoute = tail (driverRoute driver) }
+
+-- | Move all drivers to their next stops
+moveDrivers :: World -> World
+moveDrivers = map moveDriver
+```
+
+### 停留所ごとのドライバー集計
+
+```haskell
+-- | Group drivers by their current stop
+driversAtStops :: World -> Map Stop [Driver]
+driversAtStops = foldr addDriver Map.empty
+  where
+    addDriver driver acc = 
+      let stop = currentStop driver
+      in Map.insertWith (++) stop [driver] acc
+```
+
+### 噂の共有
+
+```haskell
+-- | Merge gossip among a group of drivers
+mergeGossip :: [Driver] -> [Driver]
+mergeGossip drivers =
+  let allGossips = Set.unions (map driverGossip drivers)
+  in map (\d -> d { driverGossip = allGossips }) drivers
+
+-- | Spread gossip at all stops
+spreadGossip :: World -> World
+spreadGossip world =
+  let byStop = driversAtStops world
+      merged = Map.map mergeGossip byStop
+  in concatMap snd (Map.toList merged)
+```
+
+## 4. シミュレーション
+
+### 1ステップの処理
+
+```haskell
+-- | One step of simulation: move then spread gossip
+drive :: World -> World
+drive = spreadGossip . moveDrivers
+```
+
+### 完了判定
+
+```haskell
+-- | Check if all drivers know all gossip
+allGossipShared :: World -> Bool
+allGossipShared [] = True
+allGossipShared (d:ds) = all (\driver -> driverGossip driver == driverGossip d) ds
+
+-- | Get the total set of all gossip in the world
+totalGossip :: World -> Set Gossip
+totalGossip = Set.unions . map driverGossip
+```
+
+## 5. ソルバー
+
+```haskell
+-- | Solve the problem: find minutes until all gossip is shared
+-- Returns Nothing if it takes more than 480 minutes (8 hours)
+solve :: [[Stop]] -> Maybe Int
+solve = solveWithLimit 480
+
+-- | Solve with a custom time limit
+solveWithLimit :: Int -> [[Stop]] -> Maybe Int
+solveWithLimit limit routes = go 0 (makeDrivers routes)
+  where
+    go minutes world
+      | minutes > limit = Nothing
+      | allGossipShared world = Just minutes
+      | otherwise = go (minutes + 1) (drive world)
+```
+
+## 6. テスト
+
+```haskell
+describe "Solver" $ do
+  it "solves case requiring multiple steps" $ do
+    -- d0: 1 -> 2 -> 3
+    -- d1: 3 -> 2 -> 1
+    -- Initial: d0 at 1, d1 at 3
+    -- After 1: d0 at 2, d1 at 2 - they meet!
+    let routes = [[1, 2, 3], [3, 2, 1]]
+    solve routes `shouldBe` Just 1
+  
+  it "returns Nothing when drivers never meet" $ do
+    let routes = [[1, 2], [3, 4]]
+    solve routes `shouldBe` Nothing
+```
+
+## まとめ
+
+ゴシップ好きなバスの運転手問題の Haskell 実装のポイント：
+
+1. **無限リスト**: `cycle` で有限ルートを無限化
+2. **不変データ**: 各ステップで新しい World を生成
+3. **集合演算**: `Set.unions` で噂を効率的にマージ
+4. **パイプライン**: `drive = spreadGossip . moveDrivers` で処理を合成
+5. **終了条件**: 全ドライバーの噂が等しければ完了