ref: 725d27c12ec61a2f3eae3f1b550cf2875f029c5e
parent: a855d4546080dfe88c5d24cce7a3b9b2e741fcda
author: Lennart Augustsson <lennart@augustsson.net>
date: Mon Sep 23 07:44:22 EDT 2024
Use record selectors for the monoid types.
--- a/lib/Data/Monoid.hs
+++ b/lib/Data/Monoid.hs
@@ -1,28 +1,25 @@
module Data.Monoid(
Monoid(..),
- Endo(..), appEndo,
- Dual(..), getDual,
- Max(..), getMax,
- Min(..), getMin,
- Sum(..), getSum,
- Product(..), getProduct,
- All(..), getAll,
- Any(..), getAny,
- Arg(..), ArgMin, ArgMax,
- Alt(..), getAlt,
- First(..), getFirst,
- Last(..), getLast,
+ Endo(..),
+ Dual(..),
+ Sum(..),
+ Product(..),
+ All(..),
+ Any(..),
+ Arg(..),
+ Alt(..),
+ First(..),
+ Last(..),
) where
import Prelude()
import Data.Maybe_Type
import Data.Monoid.Internal
+import Data.Records
-- First and Last are different in Monoid and Semigroup,
-- so put them here.
-newtype First a = First (Maybe a)
-getFirst :: forall a . First a -> Maybe a
-getFirst (First a) = a
+newtype First a = First { getFirst :: Maybe a }
instance forall a . Semigroup (First a) where
a@(First (Just _)) <> _ = a
@@ -32,9 +29,7 @@
mempty = First Nothing
-newtype Last a = Last (Maybe a)
-getLast :: forall a . Last a -> Maybe a
-getLast (Last a) = a
+newtype Last a = Last { getLast :: Maybe a }
instance forall a . Semigroup (Last a) where
_ <> a@(Last (Just _)) = a
--- a/lib/Data/Monoid/Internal.hs
+++ b/lib/Data/Monoid/Internal.hs
@@ -15,6 +15,7 @@
import Data.Ord
import Data.Maybe_Type
import Data.Num
+import Data.Records
import Text.Show
class Semigroup a => Monoid a where
@@ -27,9 +28,7 @@
---------------------
-newtype Endo a = Endo (a -> a)
-appEndo :: forall a . Endo a -> (a -> a)
-appEndo (Endo f) = f
+newtype Endo a = Endo { appEndo :: a -> a }
instance forall a . Semigroup (Endo a) where
Endo f <> Endo g = Endo (f . g)
@@ -39,9 +38,8 @@
---------------------
-newtype Dual a = Dual a
-getDual :: forall a . Dual a -> a
-getDual (Dual a) = a
+newtype Dual a = Dual { getDual :: a }
+ deriving (Bounded, Eq, Ord, Show)
instance forall a . Semigroup a => Semigroup (Dual a) where
Dual a <> Dual b = Dual (b <> a)
@@ -58,12 +56,12 @@
---------------------
-newtype Max a = Max a
-getMax :: forall a . Max a -> a
-getMax (Max a) = a
+newtype Max a = Max { getMax :: a }
+ deriving (Bounded, Eq, Ord, Show)
instance forall a . Ord a => Semigroup (Max a) where
Max a <> Max b = Max (a `max` b)
+ stimes = stimesIdempotent
instance forall a . (Ord a, Bounded a) => Monoid (Max a) where
mempty = Max minBound
@@ -70,12 +68,12 @@
---------------------
-newtype Min a = Min a
-getMin :: forall a . Min a -> a
-getMin (Min a) = a
+newtype Min a = Min { getMin :: a }
+ deriving (Bounded, Eq, Ord, Show)
instance forall a . Ord a => Semigroup (Min a) where
Min a <> Min b = Min (a `min` b)
+ stimes = stimesIdempotent
instance forall a . (Ord a, Bounded a) => Monoid (Min a) where
mempty = Min maxBound
@@ -82,9 +80,8 @@
---------------------
-newtype Sum a = Sum a
-getSum :: forall a . Sum a -> a
-getSum (Sum a) = a
+newtype Sum a = Sum { getSum :: a }
+ deriving (Bounded, Eq, Ord, Show)
instance forall a . Num a => Semigroup (Sum a) where
Sum a <> Sum b = Sum (a + b)
@@ -94,9 +91,8 @@
---------------------
-newtype Product a = Product a
-getProduct :: forall a . Product a -> a
-getProduct (Product a) = a
+newtype Product a = Product { getProduct :: a }
+ deriving (Bounded, Eq, Ord, Show)
instance forall a . Num a => Semigroup (Product a) where
Product a <> Product b = Product (a * b)
@@ -106,9 +102,8 @@
---------------------
-newtype All = All Bool
-getAll :: All -> Bool
-getAll (All a) = a
+newtype All = All { getAll :: Bool }
+ deriving (Bounded, Eq, Ord, Show)
instance Semigroup All where
All a <> All b = All (a && b)
@@ -118,9 +113,8 @@
---------------------
-newtype Any = Any Bool
-getAny :: Any -> Bool
-getAny (Any a) = a
+newtype Any = Any { getAny :: Bool }
+ deriving (Bounded, Eq, Ord, Show)
instance Semigroup Any where
Any a <> Any b = Any (a || b)
--- a/lib/Data/Records.hs
+++ b/lib/Data/Records.hs
@@ -9,7 +9,6 @@
import Primitives
import Data.Function
import Data.Proxy
-import Data.Tuple
type Get r a = r -> a
type Set r a = r -> a -> r
@@ -30,27 +29,3 @@
composeSet gs1 b_to_c_to_b a c =
case gs1 a of
(b, b_to_a) -> b_to_a (b_to_c_to_b b c)
-
------------------------------------
--- Virtual fields for tuples.
-
-instance forall a b . HasField "_1" (a, b) a where getField _ (a, b) = a
-instance forall a b . SetField "_1" (a, b) a where setField _ (a, b) = \ a -> (a, b)
-instance forall a b . HasField "_2" (a, b) b where getField _ (a, b) = b
-instance forall a b . SetField "_2" (a, b) b where setField _ (a, b) = \ b -> (a, b)
-
-instance forall a b c . HasField "_1" (a, b, c) a where getField _ (a, b, c) = a
-instance forall a b c . SetField "_1" (a, b, c) a where setField _ (a, b, c) = \ a -> (a, b, c)
-instance forall a b c . HasField "_2" (a, b, c) b where getField _ (a, b, c) = b
-instance forall a b c . SetField "_2" (a, b, c) b where setField _ (a, b, c) = \ b -> (a, b, c)
-instance forall a b c . HasField "_3" (a, b, c) c where getField _ (a, b, c) = c
-instance forall a b c . SetField "_3" (a, b, c) c where setField _ (a, b, c) = \ c -> (a, b, c)
-
-instance forall a b c d . HasField "_1" (a, b, c, d) a where getField _ (a, b, c, d) = a
-instance forall a b c d . SetField "_1" (a, b, c, d) a where setField _ (a, b, c, d) = \ a -> (a, b, c, d)
-instance forall a b c d . HasField "_2" (a, b, c, d) b where getField _ (a, b, c, d) = b
-instance forall a b c d . SetField "_2" (a, b, c, d) b where setField _ (a, b, c, d) = \ b -> (a, b, c, d)
-instance forall a b c d . HasField "_3" (a, b, c, d) c where getField _ (a, b, c, d) = c
-instance forall a b c d . SetField "_3" (a, b, c, d) c where setField _ (a, b, c, d) = \ c -> (a, b, c, d)
-instance forall a b c d . HasField "_4" (a, b, c, d) d where getField _ (a, b, c, d) = d
-instance forall a b c d . SetField "_4" (a, b, c, d) d where setField _ (a, b, c, d) = \ d -> (a, b, c, d)
--- a/lib/Data/Semigroup.hs
+++ b/lib/Data/Semigroup.hs
@@ -1,18 +1,19 @@
module Data.Semigroup(
Semigroup(..),
- Endo(..), appEndo,
- Dual(..), getDual,
- Max(..), getMax,
- Min(..), getMin,
- Sum(..), getSum,
- Product(..), getProduct,
- All(..), getAll,
- Any(..), getAny,
+ Endo(..),
+ Dual(..),
+ Max(..),
+ Min(..),
+ Sum(..),
+ Product(..),
+ All(..),
+ Any(..),
Arg(..), ArgMin, ArgMax,
- Alt(..), getAlt,
- First(..), getFirst,
- Last(..), getLast,
+ Alt(..),
+ First(..),
+ Last(..),
stimesIdempotent, stimesIdempotentMonoid, stimesMonoid,
+ diff, cycle1,
) where
import Prelude() -- do not import Prelude
import Data.Bool
@@ -22,6 +23,7 @@
import Data.List.NonEmpty_Type
import Data.Ord
import Data.Monoid.Internal
+import Data.Records
import Text.Show
{-
@@ -47,10 +49,8 @@
enumFromThenTo (First a) (First b) (First c) = First `fmap` enumFromThenTo a b c
-}
-newtype First a = First a
+newtype First a = First { getFirst :: a }
deriving(Eq, Ord, Show, Bounded)
-getFirst :: First a -> a
-getFirst (First a) = a
instance Semigroup (First a) where
a <> _ = a
@@ -112,10 +112,8 @@
enumFromThenTo (Last a) (Last b) (Last c) = Last `fmap` enumFromThenTo a b c
-}
-newtype Last a = Last a
+newtype Last a = Last { getLast :: a }
deriving(Eq, Ord, Show, Bounded)
-getLast :: Last a -> a
-getLast (Last a) = a
instance Semigroup (Last a) where
_ <> b = b
@@ -152,3 +150,9 @@
instance MonadFix Last where
mfix f = fix (f . getLast)
-}
+
+diff :: Semigroup m => m -> Endo m
+diff = Endo . (<>)
+
+cycle1 :: Semigroup m => m -> m
+cycle1 xs = xs' where xs' = xs <> xs'
--- a/lib/Data/Tuple.hs
+++ b/lib/Data/Tuple.hs
@@ -12,6 +12,7 @@
import Data.Function
import Data.Int
import Data.Monoid.Internal
+import Data.Records
import Data.Ord
import Text.Show
@@ -141,3 +142,28 @@
instance forall a b c d . (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a, b, c, d) where
mempty = (mempty, mempty, mempty, mempty)
+
+
+-----------------------------------
+-- Virtual fields for tuples.
+
+instance forall a b . HasField "_1" (a, b) a where getField _ (a, b) = a
+instance forall a b . SetField "_1" (a, b) a where setField _ (a, b) = \ a -> (a, b)
+instance forall a b . HasField "_2" (a, b) b where getField _ (a, b) = b
+instance forall a b . SetField "_2" (a, b) b where setField _ (a, b) = \ b -> (a, b)
+
+instance forall a b c . HasField "_1" (a, b, c) a where getField _ (a, b, c) = a
+instance forall a b c . SetField "_1" (a, b, c) a where setField _ (a, b, c) = \ a -> (a, b, c)
+instance forall a b c . HasField "_2" (a, b, c) b where getField _ (a, b, c) = b
+instance forall a b c . SetField "_2" (a, b, c) b where setField _ (a, b, c) = \ b -> (a, b, c)
+instance forall a b c . HasField "_3" (a, b, c) c where getField _ (a, b, c) = c
+instance forall a b c . SetField "_3" (a, b, c) c where setField _ (a, b, c) = \ c -> (a, b, c)
+
+instance forall a b c d . HasField "_1" (a, b, c, d) a where getField _ (a, b, c, d) = a
+instance forall a b c d . SetField "_1" (a, b, c, d) a where setField _ (a, b, c, d) = \ a -> (a, b, c, d)
+instance forall a b c d . HasField "_2" (a, b, c, d) b where getField _ (a, b, c, d) = b
+instance forall a b c d . SetField "_2" (a, b, c, d) b where setField _ (a, b, c, d) = \ b -> (a, b, c, d)
+instance forall a b c d . HasField "_3" (a, b, c, d) c where getField _ (a, b, c, d) = c
+instance forall a b c d . SetField "_3" (a, b, c, d) c where setField _ (a, b, c, d) = \ c -> (a, b, c, d)
+instance forall a b c d . HasField "_4" (a, b, c, d) d where getField _ (a, b, c, d) = d
+instance forall a b c d . SetField "_4" (a, b, c, d) d where setField _ (a, b, c, d) = \ d -> (a, b, c, d)
--
⑨