shithub: MicroHs

Info  •  Files  •  Log  •  Branches

Make virtual fields for tuples.

--- a/lib/Data/Record.hs

+++ b/lib/Data/Record.hs

@@ -2,7 +2,6 @@

 import Primitives

 import Data.Function

 import Data.Proxy

-import Data.Tuple

 type  HasField :: forall (k::Kind) . k -> Type -> Type -> Constraint

 class HasField x r a | x r -> a where

@@ -9,7 +8,7 @@

   hasField :: Proxy x -> r -> (a, a -> r)

 getField :: forall x r a . HasField x r a => Proxy x -> r -> a

-getField p = fst . hasField p

+getField p r = case hasField p r of { (g,_) -> g }

-setField :: forall x r a . HasField x r a => Proxy x -> r -> a -> r

-setField p = snd . hasField p

+setField :: forall x r a . HasField x r a => Proxy x -> r -> (a -> r)

+setField p r = case hasField p r of { (_,s) -> s }

--- a/lib/Data/Tuple.hs

+++ b/lib/Data/Tuple.hs

@@ -10,6 +10,7 @@

 import Data.Eq

 import Data.Function

 import Data.Monoid

+import Data.Record

 import Data.Semigroup

 import Text.Show

@@ -97,3 +98,27 @@

 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))

-- 

⑨