型によるプログラミング合成によるデザイン:SemigroupとMonoid 単位元

入門Haskellプログラミング
 楽天ブックス
Yahoo!ショッピング
au PAY マーケット

開発環境

入門Haskellプログラミング (Will Kurt(著)、株式会社クイープ(監修、翻訳)、翔泳社)のUNIT3(型によるプログラミング)、LESSON 17(合成によるデザイン:SemigroupとMonoid)、17.5(練習問題)Q17-1の解答を求めてみる。

コード

lesson/app/Main.hs

module Main where

import Lib

main :: IO ()
main = do
  print (mempty :: Color)
  print colors
  print $ mappend <$> colors <*> colors
  print $ mconcat colors

lesson/src/Lib.hs

module Lib where

colors :: [Color]
colors = [Red, Yellow, Blue, Green, Purple, Orange, Brown, Clear]

data Color
  = Red
  | Yellow
  | Blue
  | Green
  | Purple
  | Orange
  | Brown
  | Clear
  deriving (Show, Eq)

instance Semigroup Color where
  (<>) Clear c = c
  (<>) c Clear = c
  (<>) Red Blue = Purple
  (<>) Blue Red = Purple
  (<>) Yellow Blue = Green
  (<>) Blue Yellow = Green
  (<>) Yellow Red = Orange
  (<>) Red Yellow = Orange
  (<>) a b
    | a == b = a
    | all (`elem` [Red, Blue, Purple]) [a, b] = Purple
    | all (`elem` [Blue, Yellow, Green]) [a, b] = Green
    | all (`elem` [Red, Yellow, Orange]) [a, b] = Orange
    | otherwise = Brown

instance Monoid Color where
  mempty = Clear
  mappend = (<>)

入出力結果(Terminal, Zsh)

% stack exec lesson-exe
Clear
[Red,Yellow,Blue,Green,Purple,Orange,Brown,Clear]
[Red,Orange,Purple,Brown,Purple,Orange,Brown,Red,Orange,Yellow,Green,Green,Brown,Orange,Brown,Yellow,Purple,Green,Blue,Green,Purple,Brown,Brown,Blue,Brown,Green,Green,Green,Brown,Brown,Brown,Green,Purple,Brown,Purple,Brown,Purple,Brown,Brown,Purple,Orange,Orange,Brown,Brown,Brown,Orange,Brown,Orange,Brown,Brown,Brown,Brown,Brown,Brown,Brown,Brown,Red,Yellow,Blue,Green,Purple,Orange,Brown,Clear]
Brown
%