shithub: MicroHs

Download patch

ref: 40371d32a47f24de3188731764fe0820f710c426
parent: 939a495716346cd288f6d9347d32c0229efd2559
author: Lennart Augustsson <lennart@augustsson.net>
date: Wed Dec 27 04:20:38 EST 2023 

Move virtual tuple fields to Records.


--- a/lib/Data/Records.hs
+++ b/lib/Data/Records.hs
@@ -2,6 +2,7 @@
 import Primitives
 import Data.Function
 import Data.Proxy
+import Data.Tuple
 
 type GetSet r a = r -> (a, a -> r)
 
@@ -21,3 +22,27 @@
     (b, b_to_a) ->
       case gs2 b of
         (c, c_to_b) -> (c, b_to_a . c_to_b)
+
+-----------------------------------
+-- Virtual fields for tuples.
+
+instance forall a b . HasField "_1" (a, b) a where
+  hasField _ (a, b) = (a, \ a -> (a, b))
+instance forall a b . HasField "_2" (a, b) b where
+  hasField _ (a, b) = (b, \ b -> (a, b))
+
+instance forall a b c . HasField "_1" (a, b, c) a where
+  hasField _ (a, b, c) = (a, \ a -> (a, b, c))
+instance forall a b c . HasField "_2" (a, b, c) b where
+  hasField _ (a, b, c) = (b, \ b -> (a, b, c))
+instance forall a b c . HasField "_3" (a, b, c) c where
+  hasField _ (a, b, c) = (c, \ c -> (a, b, c))
+
+instance forall a b c d . HasField "_1" (a, b, c, d) a where
+  hasField _ (a, b, c, d) = (a, \ a -> (a, b, c, d))
+instance forall a b c d . HasField "_2" (a, b, c, d) b where
+  hasField _ (a, b, c, d) = (b, \ b -> (a, b, c, d))
+instance forall a b c d . HasField "_3" (a, b, c, d) c where
+  hasField _ (a, b, c, d) = (c, \ c -> (a, b, c, d))
+instance forall a b c d . HasField "_4" (a, b, c, d) d where
+  hasField _ (a, b, c, d) = (d, \ d -> (a, b, c, d))
--- a/lib/Data/Tuple.hs
+++ b/lib/Data/Tuple.hs
@@ -10,7 +10,6 @@
 import Data.Eq
 import Data.Function
 import Data.Monoid
-import Data.Records
 import Data.Semigroup
 import Text.Show
 
@@ -98,27 +97,3 @@
 
 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
-  hasField _ (a, b) = (a, \ a -> (a, b))
-instance forall a b . HasField "_2" (a, b) b where
-  hasField _ (a, b) = (b, \ b -> (a, b))
-
-instance forall a b c . HasField "_1" (a, b, c) a where
-  hasField _ (a, b, c) = (a, \ a -> (a, b, c))
-instance forall a b c . HasField "_2" (a, b, c) b where
-  hasField _ (a, b, c) = (b, \ b -> (a, b, c))
-instance forall a b c . HasField "_3" (a, b, c) c where
-  hasField _ (a, b, c) = (c, \ c -> (a, b, c))
-
-instance forall a b c d . HasField "_1" (a, b, c, d) a where
-  hasField _ (a, b, c, d) = (a, \ a -> (a, b, c, d))
-instance forall a b c d . HasField "_2" (a, b, c, d) b where
-  hasField _ (a, b, c, d) = (b, \ b -> (a, b, c, d))
-instance forall a b c d . HasField "_3" (a, b, c, d) c where
-  hasField _ (a, b, c, d) = (c, \ c -> (a, b, c, d))
-instance forall a b c d . HasField "_4" (a, b, c, d) d where
-  hasField _ (a, b, c, d) = (d, \ d -> (a, b, c, d))
-- 
⑨