Monoid #

class Semigroup a => Monoid a where
    mempty  :: a
    mappend :: a -> a -> a
    mconcat :: [a] -> a

class Semigroup a where
    (<>) :: a -> a -> a

-- Monoid继承Semigroup
class Semigroup a => Monoid a where
    mempty :: a

-- 单位元律
mempty <> x = x
x <> mempty = x

-- 结合律
(x <> y) <> z = x <> (y <> z)

instance Semigroup [a] where
    (<>) = (++)

instance Monoid [a] where
    mempty = []
    mappend = (<>)
    mconcat = concat

-- 使用
[1, 2] <> [3, 4]  -- [1, 2, 3, 4]
mempty :: [Int]   -- []
mconcat [[1], [2, 3], [4]]  -- [1, 2, 3, 4]

newtype Sum a = Sum { getSum :: a }
newtype Product a = Product { getProduct :: a }

instance Num a => Semigroup (Sum a) where
    Sum x <> Sum y = Sum (x + y)

instance Num a => Monoid (Sum a) where
    mempty = Sum 0

instance Num a => Semigroup (Product a) where
    Product x <> Product y = Product (x * y)

instance Num a => Monoid (Product a) where
    mempty = Product 1

-- 使用
getSum $ mconcat [Sum 1, Sum 2, Sum 3]  -- 6
getProduct $ mconcat [Product 2, Product 3, Product 4]  -- 24

newtype All = All { getAll :: Bool }
newtype Any = Any { getAny :: Bool }

instance Semigroup All where
    All x <> All y = All (x && y)

instance Monoid All where
    mempty = All True

instance Semigroup Any where
    Any x <> Any y = Any (x || y)

instance Monoid Any where
    mempty = Any False

-- 使用
getAll $ mconcat [All True, All True, All False]  -- False
getAny $ mconcat [Any False, Any True, Any False]  -- True

newtype First a = First { getFirst :: Maybe a }
newtype Last a = Last { getLast :: Maybe a }

instance Semigroup (First a) where
    First Nothing <> y = y
    x <> _ = x

instance Monoid (First a) where
    mempty = First Nothing

instance Semigroup (Last a) where
    x <> Last Nothing = x
    _ <> y = y

instance Monoid (Last a) where
    mempty = Last Nothing

-- 使用
getFirst $ mconcat [First Nothing, First (Just 1), First (Just 2)]  -- Just 1
getLast $ mconcat [Last (Just 1), Last (Just 2), Last Nothing]  -- Just 2

instance Semigroup a => Semigroup (Maybe a) where
    Nothing <> y = y
    x <> Nothing = x
    Just x <> Just y = Just (x <> y)

instance Semigroup a => Monoid (Maybe a) where
    mempty = Nothing

-- 使用
Just [1, 2] <> Just [3, 4]  -- Just [1, 2, 3, 4]
Just (Sum 1) <> Just (Sum 2)  -- Just (Sum 3)
Nothing <> Just [1]  -- Just [1]

instance Semigroup Ordering where
    LT <> _ = LT
    EQ <> y = y
    GT <> _ = GT

instance Monoid Ordering where
    mempty = EQ

-- 使用
compareLengthThenAlpha :: String -> String -> Ordering
compareLengthThenAlpha s1 s2 = 
    (length s1 `compare` length s2) <> (s1 `compare` s2)

-- mconcat：折叠列表
mconcat :: Monoid a => [a] -> a
mconcat = foldr (<>) mempty

-- 使用
mconcat ["Hello", " ", "World"]  -- "Hello World"
mconcat [Sum 1, Sum 2, Sum 3]    -- Sum 6

import Data.Foldable

-- foldMap：映射后折叠
foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m

-- 使用
foldMap Sum [1, 2, 3, 4, 5]  -- Sum 15
foldMap Product [1, 2, 3, 4, 5]  -- Product 120
foldMap (All . even) [2, 4, 6, 8]  -- All True

newtype Dual a = Dual { getDual :: a }

instance Semigroup a => Semigroup (Dual a) where
    Dual x <> Dual y = Dual (y <> x)

instance Monoid a => Monoid (Dual a) where
    mempty = Dual mempty

-- 使用：反向组合
getDual $ mconcat [Dual "a", Dual "b", Dual "c"]  -- "cba"

newtype Endo a = Endo { appEndo :: a -> a }

instance Semigroup (Endo a) where
    Endo f <> Endo g = Endo (f . g)

instance Monoid (Endo a) where
    mempty = Endo id

-- 使用
appEndo (mconcat [Endo (+1), Endo (*2), Endo (+3)]) 5  -- 15
-- ((5 + 3) * 2) + 1 = 15

data Stats = Stats
    { count :: Sum Int
    , total :: Sum Int
    , minVal :: Min Int
    , maxVal :: Max Int
    } deriving (Show)

instance Semigroup Stats where
    Stats c1 t1 min1 max1 <> Stats c2 t2 min2 max2 =
        Stats (c1 <> c2) (t1 <> t2) (min1 <> min2) (max1 <> max2)

instance Monoid Stats where
    mempty = Stats mempty mempty mempty mempty

newtype Min a = Min { getMin :: Maybe a }
newtype Max a = Max { getMax :: Maybe a }

-- 使用
addStat :: Int -> Stats
addStat x = Stats (Sum 1) (Sum x) (Min (Just x)) (Max (Just x))

computeStats :: [Int] -> Stats
computeStats = mconcat . map addStat

type Log = [String]

logEntry :: String -> Log
logEntry = (:[])

collectLogs :: [Log] -> Log
collectLogs = mconcat

-- 使用
processWithLog :: Int -> (Int, Log)
processWithLog x = 
    let result = x * 2
        log = logEntry ("Input: " ++ show x) <> 
              logEntry ("Output: " ++ show result)
    in (result, log)

data Config = Config
    { host :: First String
    , port :: Last Int
    , debug :: Any
    } deriving (Show)

instance Semigroup Config where
    Config h1 p1 d1 <> Config h2 p2 d2 =
        Config (h1 <> h2) (p1 <> p2) (d1 <> d2)

instance Monoid Config where
    mempty = Config mempty mempty mempty

-- 使用
defaultConfig :: Config
defaultConfig = Config (First Nothing) (Last (Just 8080)) (Any False)

userConfig :: Config
userConfig = Config (First (Just "localhost")) (Last Nothing) (Any True)

finalConfig :: Config
finalConfig = defaultConfig <> userConfig
-- Config {host = First (Just "localhost"), port = Last (Just 8080), debug = Any True}

newtype Builder = Builder { unBuilder :: String -> String }

instance Semigroup Builder where
    Builder f <> Builder g = Builder (f . g)

instance Monoid Builder where
    mempty = Builder id

fromString :: String -> Builder
fromString s = Builder (s ++)

build :: Builder -> String
build b = unBuilder b ""

-- 使用
html :: Builder
html = fromString "<html>" <> 
       fromString "<body>Hello</body>" <> 
       fromString "</html>"

-- build html = "<html><body>Hello</body></html>"

instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
    (a1, b1) <> (a2, b2) = (a1 <> a2, b1 <> b2)

instance (Monoid a, Monoid b) => Monoid (a, b) where
    mempty = (mempty, mempty)

-- 使用
(["a"], [1]) <> (["b"], [2])  -- (["a", "b"], [1, 2])

instance Monoid b => Semigroup (a -> b) where
    f <> g = \x -> f x <> g x

instance Monoid b => Monoid (a -> b) where
    mempty = const mempty

-- 使用
sumAndProduct :: Int -> (Sum Int, Product Int)
sumAndProduct = (Sum) <> (Product)

-- sumAndProduct 5 = (Sum 5, Product 5)